From gitlab at gitlab.haskell.org Wed Aug 10 16:11:27 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Wed, 10 Aug 2022 12:11:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/nr/indentable Message-ID: <62f3d8afcc4d_142b4951798925bf@gitlab.mail> Norman Ramsey pushed new branch wip/nr/indentable at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/nr/indentable You're receiving 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 Aug 12 12:33:04 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 12 Aug 2022 08:33:04 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 4 commits: fixup: misc. fixes post rebase Message-ID: <62f64880eaef4_3d81494883c49235d@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 060791a8 by doyougnu at 2022-08-12T14:34:59+02:00 fixup: misc. fixes post rebase - - - - - a2d693ce by Sylvain Henry at 2022-08-12T14:34:59+02:00 PrimOps: add more 64-bit primops - - - - - 9eae0d8e by Sylvain Henry at 2022-08-12T14:34:59+02:00 PrimOp: implement more 64-bit primops + PM fix Ensure that we cover every primop explicitly - - - - - f10b4f79 by Sylvain Henry at 2022-08-12T14:34:59+02:00 Fix more redundant imports - - - - - 11 changed files: - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Linker/Compactor.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Foreign.hs - js/arith.js.pp Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -842,8 +842,8 @@ cmmPipeline pipe_env hsc_env input_fn = do -- | This JS pipeline is just a no-op because the JS backend short circuits to -- 'GHC.StgToJS' before Cmm -jsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath -jsPipeline _ _ _ input_fn = pure input_fn -- .o file has been generated by StgToJS +jsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) +jsPipeline _ _ _ input_fn = pure $! pure input_fn -- .o file has been generated by StgToJS hscPostBackendPipeline :: P m => PipeEnv -> HscEnv -> HscSource -> Backend -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) hscPostBackendPipeline _ _ HsBootFile _ _ _ = return Nothing @@ -859,9 +859,9 @@ applyPostHscPipeline NcgPostHscPipeline = \pe he ml fp -> asPipeline False pe he ml fp applyPostHscPipeline ViaCPostHscPipeline = viaCPipeline HCc applyPostHscPipeline LlvmPostHscPipeline = - \pe he ml fp -> Just <$> llvmPipeline pe he ml fp + \pe he ml fp -> llvmPipeline pe he ml fp applyPostHscPipeline JSPostHscPipeline = - \pe he ml fp -> Just <$> jsPipeline pe he ml fp + \pe he ml fp -> jsPipeline pe he ml fp applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing -- Pipeline from a given suffix ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -28,7 +28,6 @@ import GHC.StgToJS.Profiling import GHC.Builtin.Types import GHC.Stg.Syntax import GHC.Core.DataCon -import GHC.Data.FastString import GHC.Types.CostCentre import GHC.Types.Unique.FM ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -32,7 +32,6 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.FastString -import qualified Data.Map as M import Data.Maybe genCon :: ExprCtx -> DataCon -> [JExpr] -> G JStat ===================================== compiler/GHC/StgToJS/Linker/Compactor.hs ===================================== @@ -1203,7 +1203,7 @@ fixHashesIter n invDeps allKeys checkKeys sccs hashes finalHashes lookupDep (LexicalFastString d) | Just b <- lookupUniqMap finalHashes d = b | Just i <- lookupUniqMap toHashIdx d - = grpHash <> (utf8EncodeString . show $ i) + = grpHash <> (utf8EncodeByteString . show $ i) | otherwise = panic $ "Gen2.Compactor.hashRootSCC: unknown key: " ++ unpackFS d @@ -1287,7 +1287,7 @@ hd d = HashBuilder (BB.doubleLE d) [] htxt :: FastString -> HashBuilder htxt x = HashBuilder (BB.int64LE (fromIntegral $ BS.length bs) <> BB.byteString bs) [] where - bs = utf8EncodeString $ unpackFS x + bs = utf8EncodeByteString $ unpackFS x hobj :: FastString -> HashBuilder hobj x = HashBuilder (BB.int8 127) [x] ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -124,7 +124,7 @@ import System.Directory ( createDirectoryIfMissing ) import GHC.Driver.Session (targetWays_, DynFlags(..)) -import GHC.Unit.Module.Name +import Language.Haskell.Syntax.Module.Name import GHC.Unit.Module (moduleStableString) import GHC.Utils.Logger (Logger) import GHC.Utils.TmpFs (TmpFs) ===================================== compiler/GHC/StgToJS/Literal.hs ===================================== @@ -23,7 +23,6 @@ import GHC.Utils.Panic import GHC.Utils.Outputable import GHC.Float -import qualified Data.ByteString.Short as Short import Data.Bits as Bits import Data.Char (ord) ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -113,7 +113,6 @@ import GHC.StgToJS.Types import GHC.Unit.Module import GHC.Data.FastString -import GHC.Data.ShortText as ST import GHC.Types.Unique.Map import GHC.Float (castDoubleToWord64, castWord64ToDouble) @@ -814,4 +813,4 @@ instance Binary StaticLit where 5 -> StringLit <$> get bh 6 -> BinLit <$> get bh 7 -> LabelLit <$> get bh <*> get bh - n -> error ("Binary get bh StaticLit: invalid tag " ++ show n) \ No newline at end of file + n -> error ("Binary get bh StaticLit: invalid tag " ++ show n) ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -40,7 +40,7 @@ genPrim :: Bool -- ^ Profiling (cost-centres) enabled -> [JExpr] -- ^ where to store the result -> [JExpr] -- ^ arguments -> PrimRes -genPrim prof ty = \case +genPrim prof ty op = case op of CharGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y) CharGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y) CharEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y) @@ -321,10 +321,12 @@ genPrim prof ty = \case , r2 |= x2 ] - Word64EqOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LAnd (l0 .===. l1) (h0 .===. h1)) - Word64NeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (l0 .!==. l1) (h0 .!==. h1)) - - Word64AddOp -> \[hr,hl] [h0, l0, h1, l1] -> PrimInline $ appT [hr, hl] "h$hs_plusInt64" [h0, l0, h1, l1] + Word64EqOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LAnd (l0 .===. l1) (h0 .===. h1)) + Word64NeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (l0 .!==. l1) (h0 .!==. h1)) + Word64GeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .!==. h1) (l0 .>=. l1))) + Word64GtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .!==. h1) (l0 .>. l1))) + Word64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .!==. h1) (l0 .<=. l1))) + Word64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .!==. h1) (l0 .<. l1))) Word64SllOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedIShiftL64" [h, l, n] Word64SrlOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftRL64" [h, l, n] @@ -354,6 +356,12 @@ genPrim prof ty = \case , hl |= BNot l ] + Word64AddOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_plusWord64" [h0,l0,h1,l1] + Word64SubOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_minusWord64" [h0,l0,h1,l1] + Word64MulOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_timesWord64" [h0,l0,h1,l1] + Word64QuotOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_quotWord64" [h0,l0,h1,l1] + Word64RemOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_remWord64" [h0,l0,h1,l1] + ------------------------------ Word --------------------------------------------- WordAddOp -> \[r] [x,y] -> PrimInline $ r |= (x `Add` y) .>>>. zero_ @@ -1012,77 +1020,162 @@ genPrim prof ty = \case TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] --- FIXME: Sylvain (2022-06) We want to support every primop, or disable them --- explicitly. So we should remove this catch-all case ultimately, or make it --- crash at compilation time. - op -> \rs as -> PrimInline $ mconcat - [ appS "h$log" [toJExpr $ mconcat - [ "warning, unhandled primop: " - , renderWithContext defaultSDocContext (ppr op) - , " " - , show (length rs, length as) - ]] - , appS (mkFastString $ "h$primop_" ++ zEncodeString (renderWithContext defaultSDocContext (ppr op))) as - -- copyRes - , mconcat $ zipWith (\r reg -> r |= toJExpr reg) rs (enumFrom Ret1) - ] - -{- new ops in 8.6 - , IndexByteArrayOp_Word8AsChar - , IndexByteArrayOp_Word8AsWideChar - , IndexByteArrayOp_Word8AsAddr - , IndexByteArrayOp_Word8AsFloat - , IndexByteArrayOp_Word8AsDouble - , IndexByteArrayOp_Word8AsStablePtr - , IndexByteArrayOp_Word8AsInt16 - , IndexByteArrayOp_Word8AsInt32 - , IndexByteArrayOp_Word8AsInt64 - , IndexByteArrayOp_Word8AsInt - , IndexByteArrayOp_Word8AsWord16 - , IndexByteArrayOp_Word8AsWord32 - , IndexByteArrayOp_Word8AsWord64 - , IndexByteArrayOp_Word8AsWord - - , ReadByteArrayOp_Word8AsChar - , ReadByteArrayOp_Word8AsWideChar - , ReadByteArrayOp_Word8AsAddr - , ReadByteArrayOp_Word8AsFloat - , ReadByteArrayOp_Word8AsDouble - , ReadByteArrayOp_Word8AsStablePtr - , ReadByteArrayOp_Word8AsInt16 - , ReadByteArrayOp_Word8AsInt32 - , ReadByteArrayOp_Word8AsInt64 - , ReadByteArrayOp_Word8AsInt - , ReadByteArrayOp_Word8AsWord16 - , ReadByteArrayOp_Word8AsWord32 - , ReadByteArrayOp_Word8AsWord64 - , ReadByteArrayOp_Word8AsWord - , WriteByteArrayOp_Word8AsChar - , WriteByteArrayOp_Word8AsWideChar - , WriteByteArrayOp_Word8AsAddr - , WriteByteArrayOp_Word8AsFloat - , WriteByteArrayOp_Word8AsDouble - , WriteByteArrayOp_Word8AsStablePtr - , WriteByteArrayOp_Word8AsInt16 - , WriteByteArrayOp_Word8AsInt32 - , WriteByteArrayOp_Word8AsInt64 - , WriteByteArrayOp_Word8AsInt - , WriteByteArrayOp_Word8AsWord16 - , WriteByteArrayOp_Word8AsWord32 - , WriteByteArrayOp_Word8AsWord64 - , WriteByteArrayOp_Word8AsWord - -} -{- -AnyToAddrOp -MkApUpd0_Op -NewBCOOp -UnpackClosureOp -GetApStackValOp --} - -{- -GetSparkOp --} +------------------------------ Unhandled primops ------------------- + + BRevOp -> unhandledPrimop op + BRev8Op -> unhandledPrimop op + BRev16Op -> unhandledPrimop op + BRev32Op -> unhandledPrimop op + BRev64Op -> unhandledPrimop op + + DoubleExpM1Op -> unhandledPrimop op + DoubleLog1POp -> unhandledPrimop op + FloatExpM1Op -> unhandledPrimop op + FloatLog1POp -> unhandledPrimop op + + ShrinkSmallMutableArrayOp_Char -> unhandledPrimop op + GetSizeofSmallMutableArrayOp -> unhandledPrimop op + + IndexByteArrayOp_Word8AsChar -> unhandledPrimop op + IndexByteArrayOp_Word8AsWideChar -> unhandledPrimop op + IndexByteArrayOp_Word8AsAddr -> unhandledPrimop op + IndexByteArrayOp_Word8AsFloat -> unhandledPrimop op + IndexByteArrayOp_Word8AsDouble -> unhandledPrimop op + IndexByteArrayOp_Word8AsStablePtr -> unhandledPrimop op + IndexByteArrayOp_Word8AsInt16 -> unhandledPrimop op + IndexByteArrayOp_Word8AsInt32 -> unhandledPrimop op + IndexByteArrayOp_Word8AsInt64 -> unhandledPrimop op + IndexByteArrayOp_Word8AsInt -> unhandledPrimop op + IndexByteArrayOp_Word8AsWord16 -> unhandledPrimop op + IndexByteArrayOp_Word8AsWord32 -> unhandledPrimop op + IndexByteArrayOp_Word8AsWord64 -> unhandledPrimop op + IndexByteArrayOp_Word8AsWord -> unhandledPrimop op + + ReadByteArrayOp_Word8AsChar -> unhandledPrimop op + ReadByteArrayOp_Word8AsWideChar -> unhandledPrimop op + ReadByteArrayOp_Word8AsAddr -> unhandledPrimop op + ReadByteArrayOp_Word8AsFloat -> unhandledPrimop op + ReadByteArrayOp_Word8AsDouble -> unhandledPrimop op + ReadByteArrayOp_Word8AsStablePtr -> unhandledPrimop op + ReadByteArrayOp_Word8AsInt16 -> unhandledPrimop op + ReadByteArrayOp_Word8AsInt32 -> unhandledPrimop op + ReadByteArrayOp_Word8AsInt64 -> unhandledPrimop op + ReadByteArrayOp_Word8AsInt -> unhandledPrimop op + ReadByteArrayOp_Word8AsWord16 -> unhandledPrimop op + ReadByteArrayOp_Word8AsWord32 -> unhandledPrimop op + ReadByteArrayOp_Word8AsWord64 -> unhandledPrimop op + ReadByteArrayOp_Word8AsWord -> unhandledPrimop op + + WriteByteArrayOp_Word8AsChar -> unhandledPrimop op + WriteByteArrayOp_Word8AsWideChar -> unhandledPrimop op + WriteByteArrayOp_Word8AsAddr -> unhandledPrimop op + WriteByteArrayOp_Word8AsFloat -> unhandledPrimop op + WriteByteArrayOp_Word8AsDouble -> unhandledPrimop op + WriteByteArrayOp_Word8AsStablePtr -> unhandledPrimop op + WriteByteArrayOp_Word8AsInt16 -> unhandledPrimop op + WriteByteArrayOp_Word8AsInt32 -> unhandledPrimop op + WriteByteArrayOp_Word8AsInt64 -> unhandledPrimop op + WriteByteArrayOp_Word8AsInt -> unhandledPrimop op + WriteByteArrayOp_Word8AsWord16 -> unhandledPrimop op + WriteByteArrayOp_Word8AsWord32 -> unhandledPrimop op + WriteByteArrayOp_Word8AsWord64 -> unhandledPrimop op + WriteByteArrayOp_Word8AsWord -> unhandledPrimop op + + CasByteArrayOp_Int8 -> unhandledPrimop op + CasByteArrayOp_Int16 -> unhandledPrimop op + CasByteArrayOp_Int32 -> unhandledPrimop op + CasByteArrayOp_Int64 -> unhandledPrimop op + + InterlockedExchange_Addr -> unhandledPrimop op + InterlockedExchange_Word -> unhandledPrimop op + + CasAddrOp_Addr -> unhandledPrimop op + CasAddrOp_Word -> unhandledPrimop op + CasAddrOp_Word8 -> unhandledPrimop op + CasAddrOp_Word16 -> unhandledPrimop op + CasAddrOp_Word32 -> unhandledPrimop op + CasAddrOp_Word64 -> unhandledPrimop op + + FetchAddAddrOp_Word -> unhandledPrimop op + FetchSubAddrOp_Word -> unhandledPrimop op + FetchAndAddrOp_Word -> unhandledPrimop op + FetchNandAddrOp_Word -> unhandledPrimop op + FetchOrAddrOp_Word -> unhandledPrimop op + FetchXorAddrOp_Word -> unhandledPrimop op + + AtomicReadAddrOp_Word -> unhandledPrimop op + AtomicWriteAddrOp_Word -> unhandledPrimop op + + NewIOPortOp -> unhandledPrimop op + ReadIOPortOp -> unhandledPrimop op + WriteIOPortOp -> unhandledPrimop op + + KeepAliveOp -> unhandledPrimop op + + GetSparkOp -> unhandledPrimop op + AnyToAddrOp -> unhandledPrimop op + MkApUpd0_Op -> unhandledPrimop op + NewBCOOp -> unhandledPrimop op + UnpackClosureOp -> unhandledPrimop op + ClosureSizeOp -> unhandledPrimop op + GetApStackValOp -> unhandledPrimop op + WhereFromOp -> unhandledPrimop op -- should be easily implementable with o.f.n + SetThreadAllocationCounter -> unhandledPrimop op + + VecBroadcastOp _ _ _ -> unhandledPrimop op + VecPackOp _ _ _ -> unhandledPrimop op + VecUnpackOp _ _ _ -> unhandledPrimop op + VecInsertOp _ _ _ -> unhandledPrimop op + VecAddOp _ _ _ -> unhandledPrimop op + VecSubOp _ _ _ -> unhandledPrimop op + VecMulOp _ _ _ -> unhandledPrimop op + VecDivOp _ _ _ -> unhandledPrimop op + VecQuotOp _ _ _ -> unhandledPrimop op + VecRemOp _ _ _ -> unhandledPrimop op + VecNegOp _ _ _ -> unhandledPrimop op + VecIndexByteArrayOp _ _ _ -> unhandledPrimop op + VecReadByteArrayOp _ _ _ -> unhandledPrimop op + VecWriteByteArrayOp _ _ _ -> unhandledPrimop op + VecIndexOffAddrOp _ _ _ -> unhandledPrimop op + VecReadOffAddrOp _ _ _ -> unhandledPrimop op + VecWriteOffAddrOp _ _ _ -> unhandledPrimop op + + VecIndexScalarByteArrayOp _ _ _ -> unhandledPrimop op + VecReadScalarByteArrayOp _ _ _ -> unhandledPrimop op + VecWriteScalarByteArrayOp _ _ _ -> unhandledPrimop op + VecIndexScalarOffAddrOp _ _ _ -> unhandledPrimop op + VecReadScalarOffAddrOp _ _ _ -> unhandledPrimop op + VecWriteScalarOffAddrOp _ _ _ -> unhandledPrimop op + + PrefetchByteArrayOp3 -> unhandledPrimop op + PrefetchMutableByteArrayOp3 -> unhandledPrimop op + PrefetchAddrOp3 -> unhandledPrimop op + PrefetchValueOp3 -> unhandledPrimop op + PrefetchByteArrayOp2 -> unhandledPrimop op + PrefetchMutableByteArrayOp2 -> unhandledPrimop op + PrefetchAddrOp2 -> unhandledPrimop op + PrefetchValueOp2 -> unhandledPrimop op + PrefetchByteArrayOp1 -> unhandledPrimop op + PrefetchMutableByteArrayOp1 -> unhandledPrimop op + PrefetchAddrOp1 -> unhandledPrimop op + PrefetchValueOp1 -> unhandledPrimop op + PrefetchByteArrayOp0 -> unhandledPrimop op + PrefetchMutableByteArrayOp0 -> unhandledPrimop op + PrefetchAddrOp0 -> unhandledPrimop op + PrefetchValueOp0 -> unhandledPrimop op + +unhandledPrimop :: PrimOp -> [JExpr] -> [JExpr] -> PrimRes +unhandledPrimop op rs as = PrimInline $ mconcat + [ appS "h$log" [toJExpr $ mconcat + [ "warning, unhandled primop: " + , renderWithContext defaultSDocContext (ppr op) + , " " + , show (length rs, length as) + ]] + , appS (mkFastString $ "h$primop_" ++ zEncodeString (renderWithContext defaultSDocContext (ppr op))) as + -- copyRes + , mconcat $ zipWith (\r reg -> r |= toJExpr reg) rs (enumFrom Ret1) + ] -- tuple returns ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.JS.Syntax import GHC.JS.Make -import GHC.JS.Ppr +import GHC.JS.Ppr () import GHC.Stg.Syntax import GHC.Core.TyCon ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -326,7 +326,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh | cconv == JavaScriptCallConv = do checkCg (Right idecl) backendValidityOfCImport -- leave the rest to the JS backend (at least for now) - return idecl + return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) | otherwise = do -- Normal foreign import checkCg (Right idecl) backendValidityOfCImport cconv' <- checkCConv (Right idecl) cconv ===================================== js/arith.js.pp ===================================== @@ -7,6 +7,8 @@ function h$logArith() { h$log.apply(h$log,arguments); } #define TRACE_ARITH(args...) #endif +#define UN(x) ((x)>>>0) + function h$hs_leInt64(h1,l1,h2,l2) { if(h1 === h2) { var l1s = l1 >>> 1; @@ -48,15 +50,82 @@ function h$hs_gtInt64(h1,l1,h2,l2) { } function h$hs_quotWord64(h1,l1,h2,l2) { - throw "hs_quotWord64 not implemented yet"; - // var a = h$ghcjsbn_mkBigNat_ww(h1,l1); // bigFromWord64(h1,l1); - // var b = h$ghcjsbn_mkBigNat_ww(h2,l2); // bigFromWord64(h2,l2); - var q = h$ghcjsbn_quot_bb(h$ghcjsbn_mkBigNat_ww(h1,l1), - h$ghcjsbn_mkBigNat_ww(h2,l2)); - return h$ghcjsbn_toWord64_b(q); // this should return the tuple - //RETURN_UBX_TUP2(h$ghcjsbn_toWord_b(h$ghcjsbn_shr_b(q, 32)) - // a.divide(b); - // RETURN_UBX_TUP2(c.shiftRight(32).intValue(), c.intValue()); + // algorithm adapted from Hacker's Delight p198 + + // if divisor > numerator, just return 0 + if ((h2 > h1) || (h2 === h1 && l2 > l1)) { + RETURN_UBX_TUP2(0,0); + } + + if (h2 === 0) { + if (h1 < l2) { + var ql = h$quotRem2Word32(h1,l1,l2); + RETURN_UBX_TUP2(0,ql); + } + else { + var qh = h$quotRem2Word32(0,h1,l2); + var rh = h$ret1; // remainder + var ql = h$quotRem2Word32(rh,l1,l2); + RETURN_UBX_TUP2(qh,ql); + } + } + else { + var n = Math.clz32(h2); + // normalize divisor (MSB = 1) + var dh = UN((h2 << n) | (l2 >>> (32-n))); + // shift numerator 1 bit right (MSB = 0) + var nh = h1 >>> 1; + var nl = UN((h1 << 31) | (l1 >>> 1)); + // compute quotient estimation + var q1 = h$quotRem2Word32(nh,nl,dh); + // undo normalization and division of numerator by 2 + var q0 = q1 >>> (31 - n); + if (q0 !== 0) { + q0 = UN(q0 - 1); + } + // q0 might be too small by 1. q0*arg2 doesn't overflow + var q0vh = h$hs_timesWord64(h2,l2,0,q0); + var q0vl = h$ret1; + var sh = h$hs_minusWord64(h1,l1,q0vh,q0vl); + var sl = h$ret1; + if ((sh > h2) || (sh === h2 && sl >= l2)) { + q0 = UN(q0 + 1); + } + RETURN_UBX_TUP2(0,q0); + } +} + +function h$hs_remWord64(h1,l1,h2,l2) { + var qh = h$hs_quotWord64(h1,l1,h2,l2); + var ql = h$ret1; + var qvh = h$hs_timesWord64(h2,l2,qh,ql); + var qvl = h$ret1; + return h$hs_minusWord64(h1,l1,qvh,qvl); +} + +function h$hs_timesWord64(h1,l1,h2,l2) { + var rl = UN(l1 * l2); + var rh = UN(UN(l2 * h1) + UN(l1 * h2)); + RETURN_UBX_TUP2(rh,rl); +} + +function h$hs_minusWord64(h1,l1,h2,l2) { + var b = l2 > l1 ? 1 : 0 + var rl = UN(l1 - l2); + var rh = UN(UN(h2 - h1) - b); + RETURN_UBX_TUP2(rh,rl); +} + +function h$hs_plusWord64(h1,l1,h2,l2) { + var c1 = (l1 & 0x80000000) >>> 31; + var c2 = (l2 & 0x80000000) >>> 31; + var rl = UN(l1 & 0x7FFFFFFF) + UN(l1 & 0x7FFFFFFF); + var cr = (rl & 0x80000000) >>> 31; + var rh = UN(h1+h2); + var c = UN(c1+c2+cr); + rl = UN(rl + UN(c << 31)); + rh = UN(rh + (c >>> 1)); + RETURN_UBX_TUP2(rh,rl); } function h$hs_timesInt64(h1,l1,h2,l2) { @@ -435,8 +504,6 @@ function h$quotRemWord32(n,d) { RETURN_UBX_TUP2((q + (c ? 1 : 0)) >>> 0, (r - (c ? d : 0)) >>> 0); } -#define UN(x) ((x)>>>0) - function h$quotRem2Word32(nh,nl,d) { // from Hacker's Delight book (p196) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e85fbdbf42d7447959cfa2730ab7bcfabd6b8900...f10b4f791b1d7eac78223003e1bf57ab85563cd1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e85fbdbf42d7447959cfa2730ab7bcfabd6b8900...f10b4f791b1d7eac78223003e1bf57ab85563cd1 You're receiving 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 Aug 11 14:21:56 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 Aug 2022 10:21:56 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f51084a345b_142b495217038551e@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: 01a497a7 by Ben Gamari at 2022-08-11T10:21:46-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,63 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +904,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2023,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2034,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,195 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * In general, we run finalizers in the reverse order of the associated + * initializers. That is to say, e.g., .init_array entries are run from first + * to last entry and therefore .fini_array entries are run from last-to-first. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + // .fini_array finalizers are run backwards + for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01a497a780215e3b3fab042074e31b7bca9a114a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01a497a780215e3b3fab042074e31b7bca9a114a You're receiving 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 Aug 8 23:20:41 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 19:20:41 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 18 commits: NCG(x86): Compile add+shift as lea if possible. Message-ID: <62f19a492228c_25b01650d5c6355d9@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 7bd11fad by Ben Gamari at 2022-08-08T19:19:35-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 82eeb5f1 by Ben Gamari at 2022-08-08T19:19:36-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - c5a85a16 by Ben Gamari at 2022-08-08T19:20:12-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - 8287dc33 by Ben Gamari at 2022-08-08T19:20:12-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - a1168d82 by Ben Gamari at 2022-08-08T19:20:12-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 2fff83f7 by Ben Gamari at 2022-08-08T19:20:12-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 036a5f86 by Ben Gamari at 2022-08-08T19:20:12-04:00 XXX: Bump up freebsd job - - - - - ce9008f1 by Ben Gamari at 2022-08-08T19:20:12-04:00 gitlab-ci: Use cabal-install-3.6.2.0 on FreeBSD - - - - - 7313a9b1 by Ben Gamari at 2022-08-08T19:20:12-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - a2f7068c by Ben Gamari at 2022-08-08T19:20:12-04:00 Update jobs.yaml - - - - - aebd437e by Ben Gamari at 2022-08-08T19:20:12-04:00 fix - - - - - 77ee3c22 by Ben Gamari at 2022-08-08T19:20:12-04:00 cabal - - - - - 1d57ba83 by Ben Gamari at 2022-08-08T19:20:12-04:00 temp - - - - - 23 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Expr.hs - docs/users_guide/bugs.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_compile/T21710a.hs - + testsuite/tests/codeGen/should_compile/T21710a.stderr - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs - testsuite/tests/codeGen/should_gen_asm/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -279,6 +282,9 @@ function fetch_ghc() { start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + if [ "$(uname)" = "FreeBSD" ]; then + url="http://home.smart-cactus.org/~ben/ghc/ghc-9.4.1-x86_64-portbld-freebsd.tar.xz" + fi info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" @@ -287,7 +293,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +331,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,15 +299,15 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "GHC_VERSION" =: "9.4.1" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,9 +766,10 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , modifyJobs (\x -> x {jobStage = "quick-build"}) $ allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) ===================================== .gitlab/jobs.yaml ===================================== @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -358,6 +416,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -541,7 +658,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +668,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +677,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -586,19 +703,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -1864,6 +1981,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -2050,7 +2227,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2237,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2246,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2095,20 +2272,20 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2970,7 +3147,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +3157,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +3166,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3015,19 +3192,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1048,10 +1048,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -------------------- add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register + -- x + imm add_code rep x (CmmLit (CmmInt y _)) | is32BitInteger y , rep /= W8 -- LEA doesn't support byte size (#18614) = add_int rep x y + -- x + (y << imm) + add_code rep x y + -- Byte size is not supported and 16bit size is slow when computed via LEA + | rep /= W8 && rep /= W16 + -- 2^3 = 8 is the highest multiplicator supported by LEA. + , Just (x,y,shift_bits) <- get_shift x y + = add_shiftL rep x y (fromIntegral shift_bits) + where + -- x + (y << imm) + get_shift x (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) + | shift_bits <= 3 + = Just (x, y, shift_bits) + -- (y << imm) + x + get_shift (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) x + | shift_bits <= 3 + = Just (x, y, shift_bits) + get_shift _ _ + = Nothing add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y where format = intFormat rep -- TODO: There are other interesting patterns we want to replace @@ -1066,6 +1085,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y -- our three-operand add instruction: + add_int :: (Width -> CmmExpr -> Integer -> NatM Register) add_int width x y = do (x_reg, x_code) <- getSomeReg x let @@ -1079,6 +1099,22 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -- return (Any format code) + -- x + (y << shift_bits) using LEA + add_shiftL :: (Width -> CmmExpr -> CmmExpr -> Int -> NatM Register) + add_shiftL width x y shift_bits = do + (x_reg, x_code) <- getSomeReg x + (y_reg, y_code) <- getSomeReg y + let + format = intFormat width + imm = ImmInt 0 + code dst + = (x_code `appOL` y_code) `snocOL` + LEA format + (OpAddr (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg (2 ^ shift_bits)) imm)) + (OpReg dst) + -- + return (Any format code) + ---------------------- -- See Note [DIV/IDIV for bytes] ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -20,6 +20,7 @@ where import GHC.Prelude +import GHC.Builtin.PrimOps ( PrimOp(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply @@ -346,6 +347,19 @@ fvArgs args = do type IsScrut = Bool +rewriteArgs :: [StgArg] -> RM [StgArg] +rewriteArgs = mapM rewriteArg +rewriteArg :: StgArg -> RM StgArg +rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v +rewriteArg (lit at StgLitArg{}) = return lit + +-- Attach a tagSig if it's tagged +rewriteId :: Id -> RM Id +rewriteId v = do + is_tagged <- isTagged v + if is_tagged then return $! setIdTagSig v (TagSig TagProper) + else return v + rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr rewriteExpr _ (e at StgCase {}) = rewriteCase e rewriteExpr _ (e at StgLet {}) = rewriteLet e @@ -355,8 +369,11 @@ rewriteExpr _ e@(StgConApp {}) = rewriteConApp e rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e rewriteExpr _ (StgLit lit) = return $! (StgLit lit) +rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do + (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) + rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ @@ -415,6 +432,7 @@ rewriteApp True (StgApp f []) = do -- isTagged looks at more than the result of our analysis. -- So always update here if useful. let f' = if f_tagged + -- TODO: We might consisder using a subst env instead of setting the sig only for select places. then setIdTagSig f (TagSig TagProper) else f return $! StgApp f' [] ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -76,6 +76,8 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = -- dataToTag# :: a -> Int# -- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold +-- TODO: There are some more optimization ideas for this code path +-- in #21710 cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do platform <- getPlatform emitComment (mkFastString "dataToTag#") @@ -92,15 +94,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do -- the constructor index is too large to fit in the pointer and therefore -- we must look in the info table. See Note [Tagging big families]. - slow_path <- getCode $ do - tmp <- newTemp (bWord platform) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - profile <- getProfile - align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig - emitAssign (CmmLocal result_reg) - $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) - - fast_path <- getCode $ do + (fast_path :: CmmAGraph) <- getCode $ do -- Return the constructor index from the pointer tag return_ptr_tag <- getCode $ do emitAssign (CmmLocal result_reg) @@ -113,8 +107,22 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do $ getConstrTag profile align_check (cmmUntag platform amode) emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False) - - emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) + -- If we know the argument is already tagged there is no need to generate code to evaluate it + -- so we skip straight to the fast path. If we don't know if there is a tag we take the slow + -- path which evaluates the argument before fetching the tag. + case (idTagSig_maybe a) of + Just sig + | isTaggedSig sig + -> emit fast_path + _ -> do + slow_path <- getCode $ do + tmp <- newTemp (bWord platform) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + profile <- getProfile + align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig + emitAssign (CmmLocal result_reg) + $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) + emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) emitReturn [CmmReg $ CmmLocal result_reg] ===================================== docs/users_guide/bugs.rst ===================================== @@ -115,6 +115,10 @@ Lexical syntax varid → small {idchar} ⟨reservedid⟩ conid → large {idchar} +- GHC allows redundant parantheses around the function name in the `funlhs` part of declarations. + That is GHC will succeed in parsing a declaration like `((f)) x = ` for any number + of parantheses around `f`. + .. _infelicities-syntax: Context-free syntax ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -83,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -230,12 +195,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== rts/PrimOps.cmm ===================================== @@ -2801,21 +2801,6 @@ stg_getApStackValzh ( P_ ap_stack, W_ offset ) } } -// Write the cost center stack of the first argument on stderr; return -// the second. Possibly only makes sense for already evaluated -// things? -stg_traceCcszh ( P_ obj, P_ ret ) -{ - W_ ccs; - -#if defined(PROFILING) - ccs = StgHeader_ccs(UNTAG(obj)); - ccall fprintCCS_stderr(ccs "ptr"); -#endif - - jump stg_ap_0_fast(ret); -} - stg_getSparkzh () { W_ spark; ===================================== rts/RtsSymbols.c ===================================== @@ -1015,7 +1015,6 @@ extern char **environ; SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(enabled_capabilities) \ - SymI_HasDataProto(stg_traceCcszh) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -566,7 +566,6 @@ RTS_FUN_DECL(stg_numSparkszh); RTS_FUN_DECL(stg_noDuplicatezh); -RTS_FUN_DECL(stg_traceCcszh); RTS_FUN_DECL(stg_clearCCSzh); RTS_FUN_DECL(stg_traceEventzh); RTS_FUN_DECL(stg_traceBinaryEventzh); ===================================== testsuite/tests/codeGen/should_compile/T21710a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# OPTIONS_GHC -O #-} + +module M where + +import GHC.Exts + +data E = A | B | C | D | E + +foo x = + case x of + A -> 2# + B -> 42# + -- In this branch we already now `x` is evaluated, so we shouldn't generate an extra `call` for it. + _ -> dataToTag# x ===================================== testsuite/tests/codeGen/should_compile/T21710a.stderr ===================================== @@ -0,0 +1,446 @@ + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'E2_bytes" { + M.$tc'E2_bytes: + I8[] "'E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'D2_bytes" { + M.$tc'D2_bytes: + I8[] "'D" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'C2_bytes" { + M.$tc'C2_bytes: + I8[] "'C" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'B2_bytes" { + M.$tc'B2_bytes: + I8[] "'B" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'A3_bytes" { + M.$tc'A3_bytes: + I8[] "'A" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tcE2_bytes" { + M.$tcE2_bytes: + I8[] "E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule2_bytes" { + M.$trModule2_bytes: + I8[] "M" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule4_bytes" { + M.$trModule4_bytes: + I8[] "main" + }] + + + +==================== Output Cmm ==================== +[M.foo_entry() { // [R2] + { info_tbls: [(cBa, + label: block_cBa_info + rep: StackRep [] + srt: Nothing), + (cBi, + label: M.foo_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cBi: // global + if ((Sp + -8) < SpLim) (likely: False) goto cBj; else goto cBk; // CmmCondBranch + cBj: // global + R1 = M.foo_closure; // CmmAssign + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall + cBk: // global + I64[Sp - 8] = cBa; // CmmStore + R1 = R2; // CmmAssign + Sp = Sp - 8; // CmmAssign + if (R1 & 7 != 0) goto cBa; else goto cBb; // CmmCondBranch + cBb: // global + call (I64[R1])(R1) returns to cBa, args: 8, res: 8, upd: 8; // CmmCall + cBa: // global + _cBh::P64 = R1 & 7; // CmmAssign + if (_cBh::P64 != 1) goto uBz; else goto cBf; // CmmCondBranch + uBz: // global + if (_cBh::P64 != 2) goto cBe; else goto cBg; // CmmCondBranch + cBe: // global + // dataToTag# + _cBn::P64 = R1 & 7; // CmmAssign + if (_cBn::P64 == 7) (likely: False) goto cBs; else goto cBr; // CmmCondBranch + cBs: // global + _cBo::I64 = %MO_UU_Conv_W32_W64(I32[I64[R1 & (-8)] - 4]); // CmmAssign + goto cBq; // CmmBranch + cBr: // global + _cBo::I64 = _cBn::P64 - 1; // CmmAssign + goto cBq; // CmmBranch + cBq: // global + R1 = _cBo::I64; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBg: // global + R1 = 42; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBf: // global + R1 = 2; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }, + section ""data" . M.foo_closure" { + M.foo_closure: + const M.foo_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule3_closure" { + M.$trModule3_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule4_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule1_closure" { + M.$trModule1_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule_closure" { + M.$trModule_closure: + const GHC.Types.Module_con_info; + const M.$trModule3_closure+1; + const M.$trModule1_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE1_closure" { + M.$tcE1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tcE2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE_closure" { + M.$tcE_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tcE1_closure+1; + const GHC.Types.krep$*_closure+5; + const 10475418246443540865; + const 12461417314693222409; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A1_closure" { + M.$tc'A1_closure: + const GHC.Types.KindRepTyConApp_con_info; + const M.$tcE_closure+1; + const GHC.Types.[]_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A2_closure" { + M.$tc'A2_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'A3_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A_closure" { + M.$tc'A_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'A2_closure+1; + const M.$tc'A1_closure+1; + const 10991425535368257265; + const 3459663971500179679; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B1_closure" { + M.$tc'B1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'B2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B_closure" { + M.$tc'B_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'B1_closure+1; + const M.$tc'A1_closure+1; + const 13038863156169552918; + const 13430333535161531545; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C1_closure" { + M.$tc'C1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'C2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C_closure" { + M.$tc'C_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'C1_closure+1; + const M.$tc'A1_closure+1; + const 8482817676735632621; + const 8146597712321241387; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D1_closure" { + M.$tc'D1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'D2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D_closure" { + M.$tc'D_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'D1_closure+1; + const M.$tc'A1_closure+1; + const 7525207739284160575; + const 13746130127476219356; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E1_closure" { + M.$tc'E1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'E2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E_closure" { + M.$tc'E_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'E1_closure+1; + const M.$tc'A1_closure+1; + const 6748545530683684316; + const 10193016702094081137; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.A_closure" { + M.A_closure: + const M.A_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.B_closure" { + M.B_closure: + const M.B_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.C_closure" { + M.C_closure: + const M.C_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.D_closure" { + M.D_closure: + const M.D_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.E_closure" { + M.E_closure: + const M.E_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""relreadonly" . M.E_closure_tbl" { + M.E_closure_tbl: + const M.A_closure+1; + const M.B_closure+2; + const M.C_closure+3; + const M.D_closure+4; + const M.E_closure+5; + }] + + + +==================== Output Cmm ==================== +[M.A_con_entry() { // [] + { info_tbls: [(cC5, + label: M.A_con_info + rep: HeapRep 1 nonptrs { Con {tag: 0 descr:"main:M.A"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cC5: // global + R1 = R1 + 1; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.B_con_entry() { // [] + { info_tbls: [(cCa, + label: M.B_con_info + rep: HeapRep 1 nonptrs { Con {tag: 1 descr:"main:M.B"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCa: // global + R1 = R1 + 2; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.C_con_entry() { // [] + { info_tbls: [(cCf, + label: M.C_con_info + rep: HeapRep 1 nonptrs { Con {tag: 2 descr:"main:M.C"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCf: // global + R1 = R1 + 3; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.D_con_entry() { // [] + { info_tbls: [(cCk, + label: M.D_con_info + rep: HeapRep 1 nonptrs { Con {tag: 3 descr:"main:M.D"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCk: // global + R1 = R1 + 4; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.E_con_entry() { // [] + { info_tbls: [(cCp, + label: M.E_con_info + rep: HeapRep 1 nonptrs { Con {tag: 4 descr:"main:M.E"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCp: // global + R1 = R1 + 5; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -108,3 +108,4 @@ test('T18614', normal, compile, ['']) test('mk-big-obj', [unless(opsys('mingw32'), skip), pre_cmd('$PYTHON mk-big-obj.py > mk-big-obj.c')], multimod_compile, ['mk-big-obj.c', '-c -v0 -no-hs-main']) +test('T21710a', [ only_ways(['optasm']), when(wordsize(32), skip), grep_errmsg('(call)',[1]) ], compile, ['-ddump-cmm -dno-typeable-binds']) ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm ===================================== @@ -0,0 +1,46 @@ +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_f_info +.type AddMulX86_f_info, @function +AddMulX86_f_info: +.LcAx: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_f_info, .-AddMulX86_f_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_f_closure +.type AddMulX86_f_closure, @object +AddMulX86_f_closure: + .quad AddMulX86_f_info +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_g_info +.type AddMulX86_g_info, @function +AddMulX86_g_info: +.LcAL: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_g_info, .-AddMulX86_g_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_g_closure +.type AddMulX86_g_closure, @object +AddMulX86_g_closure: + .quad AddMulX86_g_info +.section .note.GNU-stack,"", at progbits +.ident "GHC 9.3.20220228" + + ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash #-} + +module AddMulX86 where + +import GHC.Exts + +f :: Int# -> Int# -> Int# +f x y = + x +# (y *# 8#) -- Should result in a lea instruction, which we grep the assembly output for. + +g x y = + (y *# 8#) +# x -- Should result in a lea instruction, which we grep the assembly output for. ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -10,3 +10,4 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', '']) test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections']) +test('AddMulX86', is_amd64_codegen, compile_cmp_asm, ['hs', '-dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ec9269f76595f1370f85c45bb21986c7cac74dd...1d57ba83b94a907212ddf5a58811dc8ae2dfce54 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ec9269f76595f1370f85c45bb21986c7cac74dd...1d57ba83b94a907212ddf5a58811dc8ae2dfce54 You're receiving 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 Aug 10 20:52:08 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 16:52:08 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f41a7893a1f_142b494c57c2008fe@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: ff313f33 by Ben Gamari at 2022-08-10T16:51:58-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -852,8 +851,70 @@ ocGetNames_ELF ( ObjectCode* oc ) + shdr[i].sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + const char *sh_name = oc->sections[i].info->name; + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } - + // N.B. Sadly we can't always trust getSectionKind_ELF since some + // toolschains don't apply the correct DT_* flags to + // initializer/finalizer sections. Consequently, we may have fixed up + // the kind above (e.g. if a section is named `.init_array` yet wasn't + // marked as DT_INIT_ARRAY). Fix up the section's kind here to ensure + // that it gets relocated. + oc->sections[i].kind = kind; if (shdr[i].sh_type != SHT_SYMTAB) continue; @@ -1971,62 +2032,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2043,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &&prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff313f33c5d6185da9956068d7ef6e05222ae0a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff313f33c5d6185da9956068d7ef6e05222ae0a3 You're receiving 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 Aug 8 13:59:07 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 09:59:07 -0400 Subject: [Git][ghc/ghc][wip/T21965] hadrian: Fix access mode of installed package registration files Message-ID: <62f116ab3e32a_25b01650d5c48775a@gitlab.mail> Ben Gamari pushed to branch wip/T21965 at Glasgow Haskell Compiler / GHC Commits: b3cffa9b by Ben Gamari at 2022-08-08T09:56:40-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -83,6 +83,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3cffa9bfd2ac8e19750458799bd4804607c2d18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3cffa9bfd2ac8e19750458799bd4804607c2d18 You're receiving 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 Aug 7 21:42:36 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 17:42:36 -0400 Subject: [Git][ghc/ghc][ghc-9.4] configure: Set RELEASE=NO Message-ID: <62f031cc25eb1_25b0164bff0347117@gitlab.mail> Ben Gamari pushed to branch ghc-9.4 at Glasgow Haskell Compiler / GHC Commits: 616c77fa by Ben Gamari at 2022-08-07T17:42:19-04:00 configure: Set RELEASE=NO - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.4.1], [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/616c77fac9bc022e76eb9a00b0d2841e85679e37 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/616c77fac9bc022e76eb9a00b0d2841e85679e37 You're receiving 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 Aug 7 20:30:54 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 16:30:54 -0400 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.4.1-release Message-ID: <62f020fea20bf_25b0164c0543433e9@gitlab.mail> Ben Gamari pushed new tag ghc-9.4.1-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.4.1-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 Thu Aug 11 02:41:25 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 22:41:25 -0400 Subject: [Git][ghc/ghc][master] Note [Trimming auto-rules]: State that this improves compiler perf. Message-ID: <62f46c55ec4fb_142b49521d4247123@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 1 changed file: - compiler/GHC/Iface/Tidy.hs Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -965,6 +965,13 @@ NB: if a binding is kept alive for some *other* reason (e.g. f_spec is called in the final code), we keep the rule too. This stuff is the only reason for the ru_auto field in a Rule. + +NB: In #18532 we looked at keeping auto-rules and it turned out to just make +compiler performance worse while increasing code sizes at the same time. The impact +varied. Compiling Cabal got ~3% slower, allocated ~3% more and wrote 15% more code to disk. +Nofib only saw 0.7% more compiler allocations and executable file size growth. But given +there was no difference in runtime for these benchmarks it turned out to be flat out worse. +See the ticket for more details. -} findExternalRules :: TidyOpts View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45eb4cbe372eadb8331c6dbc84f14c681b1a8a9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45eb4cbe372eadb8331c6dbc84f14c681b1a8a9b You're receiving 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 Aug 10 23:11:21 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 19:11:21 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: hadrian: Don't attempt to install documentation if doc/ doesn't exist Message-ID: <62f43b1938cfe_142b4951838235381@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - d408b6e9 by Andreas Klebinger at 2022-08-10T19:11:03-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 8e4a58b0 by Bodigrim at 2022-08-10T19:11:07-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - 11 changed files: - compiler/CodeGen.Platform.h - compiler/GHC/Iface/Tidy.hs - hadrian/bindist/Makefile - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/POSIX.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/Event/Windows.hsc - libraries/base/GHC/Event/Windows/Thread.hs - libraries/base/System/Timeout.hs Changes: ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -965,6 +965,13 @@ NB: if a binding is kept alive for some *other* reason (e.g. f_spec is called in the final code), we keep the rule too. This stuff is the only reason for the ru_auto field in a Rule. + +NB: In #18532 we looked at keeping auto-rules and it turned out to just make +compiler performance worse while increasing code sizes at the same time. The impact +varied. Compiling Cabal got ~3% slower, allocated ~3% more and wrote 15% more code to disk. +Nofib only saw 0.7% more compiler allocations and executable file size growth. But given +there was no difference in runtime for these benchmarks it turned out to be flat out worse. +See the ticket for more details. -} findExternalRules :: TidyOpts ===================================== hadrian/bindist/Makefile ===================================== @@ -184,10 +184,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ ===================================== libraries/base/GHC/Conc/IO.hs ===================================== @@ -189,6 +189,9 @@ closeFdWith close fd -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- Consider using @Control.Concurrent.Thread.Delay.delay@ from @unbounded-delays@ package. threadDelay :: Int -> IO () threadDelay time #if defined(mingw32_HOST_OS) @@ -206,6 +209,9 @@ threadDelay time -- after a given number of microseconds. The caveats associated with -- 'threadDelay' also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay usecs #if defined(mingw32_HOST_OS) ===================================== libraries/base/GHC/Conc/POSIX.hs ===================================== @@ -107,6 +107,9 @@ asyncWriteBA fd isSock len off bufB = -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- threadDelay :: Int -> IO () threadDelay time | threaded = waitForDelayEvent time @@ -118,6 +121,9 @@ threadDelay time -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay usecs | threaded = waitForDelayEventSTM usecs ===================================== libraries/base/GHC/Conc/Windows.hs ===================================== @@ -95,12 +95,18 @@ asyncWriteBA fd isSock len off bufB = -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- threadDelay :: Int -> IO () threadDelay = POSIX.threadDelay WINIO.threadDelay -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay = POSIX.registerDelay WINIO.registerDelay ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -55,6 +55,10 @@ import System.Posix.Types (Fd) -- There is no guarantee that the thread will be rescheduled promptly -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- threadDelay :: Int -> IO () threadDelay usecs = mask_ $ do mgr <- getSystemTimerManager @@ -65,6 +69,9 @@ threadDelay usecs = mask_ $ do -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay usecs = do t <- atomically $ newTVar False ===================================== libraries/base/GHC/Event/TimerManager.hs ===================================== @@ -212,6 +212,10 @@ expirationTime us = do -- returned 'TimeoutKey' can be used to later unregister or update the -- timeout. The timeout is automatically unregistered after the given -- time has passed. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerTimeout :: TimerManager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout mgr us cb = do !key <- newUnique (emUniqueSource mgr) @@ -231,6 +235,10 @@ unregisterTimeout mgr (TK key) = -- | Update an active timeout to fire in the given number of -- microseconds. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- updateTimeout :: TimerManager -> TimeoutKey -> Int -> IO () updateTimeout mgr (TK key) us = do expTime <- expirationTime us ===================================== libraries/base/GHC/Event/Windows.hsc ===================================== @@ -853,6 +853,10 @@ expirationTime mgr us = do -- The timeout is automatically unregistered when it fires. -- -- The 'TimeoutCallback' will not be called more than once. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- {-# NOINLINE registerTimeout #-} registerTimeout :: Manager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout mgr at Manager{..} uSrelTime cb = do @@ -866,6 +870,10 @@ registerTimeout mgr at Manager{..} uSrelTime cb = do -- | Update an active timeout to fire in the given number of seconds (from the -- time 'updateTimeout' is called), instead of when it was going to fire. -- This has no effect if the timeout has already fired. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- updateTimeout :: Manager -> TimeoutKey -> Seconds -> IO () updateTimeout mgr (TK key) relTime = do now <- getTime (mgrClock mgr) ===================================== libraries/base/GHC/Event/Windows/Thread.hs ===================================== @@ -19,6 +19,8 @@ ensureIOManagerIsRunning = wakeupIOManager interruptIOManager :: IO () interruptIOManager = interruptSystemManager +-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. threadDelay :: Int -> IO () threadDelay usecs = mask_ $ do m <- newEmptyIOPort @@ -26,6 +28,8 @@ threadDelay usecs = mask_ $ do reg <- registerTimeout mgr usecs $ writeIOPort m () >> return () readIOPort m `onException` unregisterTimeout mgr reg +-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. registerDelay :: Int -> IO (TVar Bool) registerDelay usecs = do t <- newTVarIO False ===================================== libraries/base/System/Timeout.hs ===================================== @@ -58,7 +58,9 @@ instance Exception Timeout where -- is available within @n@ microseconds (@1\/10^6@ seconds). In case a result -- is available before the timeout expires, @Just a@ is returned. A negative -- timeout interval means \"wait indefinitely\". When specifying long timeouts, --- be careful not to exceed @maxBound :: Int at . +-- be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- Consider using @Control.Concurrent.Timeout.timeout@ from @unbounded-delays@ package. -- -- >>> timeout 1000000 (threadDelay 1000 *> pure "finished on time") -- Just "finished on time" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74351150d32aff4866352757ac69b4eecc6b245b...8e4a58b0d2cc16652f1e72aaf5f2b38757a488b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74351150d32aff4866352757ac69b4eecc6b245b...8e4a58b0d2cc16652f1e72aaf5f2b38757a488b7 You're receiving 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 Aug 11 02:42:06 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 22:42:06 -0400 Subject: [Git][ghc/ghc][master] Document that threadDelay / timeout are susceptible to overflows on 32-bit machines Message-ID: <62f46c7e85dec_142b495218425087c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - 8 changed files: - libraries/base/GHC/Conc/IO.hs - libraries/base/GHC/Conc/POSIX.hs - libraries/base/GHC/Conc/Windows.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/Event/Windows.hsc - libraries/base/GHC/Event/Windows/Thread.hs - libraries/base/System/Timeout.hs Changes: ===================================== libraries/base/GHC/Conc/IO.hs ===================================== @@ -189,6 +189,9 @@ closeFdWith close fd -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- Consider using @Control.Concurrent.Thread.Delay.delay@ from @unbounded-delays@ package. threadDelay :: Int -> IO () threadDelay time #if defined(mingw32_HOST_OS) @@ -206,6 +209,9 @@ threadDelay time -- after a given number of microseconds. The caveats associated with -- 'threadDelay' also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay usecs #if defined(mingw32_HOST_OS) ===================================== libraries/base/GHC/Conc/POSIX.hs ===================================== @@ -107,6 +107,9 @@ asyncWriteBA fd isSock len off bufB = -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- threadDelay :: Int -> IO () threadDelay time | threaded = waitForDelayEvent time @@ -118,6 +121,9 @@ threadDelay time -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay usecs | threaded = waitForDelayEventSTM usecs ===================================== libraries/base/GHC/Conc/Windows.hs ===================================== @@ -95,12 +95,18 @@ asyncWriteBA fd isSock len off bufB = -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- threadDelay :: Int -> IO () threadDelay = POSIX.threadDelay WINIO.threadDelay -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay = POSIX.registerDelay WINIO.registerDelay ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -55,6 +55,10 @@ import System.Posix.Types (Fd) -- There is no guarantee that the thread will be rescheduled promptly -- when the delay has expired, but the thread will never continue to -- run /earlier/ than specified. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- threadDelay :: Int -> IO () threadDelay usecs = mask_ $ do mgr <- getSystemTimerManager @@ -65,6 +69,9 @@ threadDelay usecs = mask_ $ do -- | Set the value of returned TVar to True after a given number of -- microseconds. The caveats associated with threadDelay also apply. -- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerDelay :: Int -> IO (TVar Bool) registerDelay usecs = do t <- atomically $ newTVar False ===================================== libraries/base/GHC/Event/TimerManager.hs ===================================== @@ -212,6 +212,10 @@ expirationTime us = do -- returned 'TimeoutKey' can be used to later unregister or update the -- timeout. The timeout is automatically unregistered after the given -- time has passed. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- registerTimeout :: TimerManager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout mgr us cb = do !key <- newUnique (emUniqueSource mgr) @@ -231,6 +235,10 @@ unregisterTimeout mgr (TK key) = -- | Update an active timeout to fire in the given number of -- microseconds. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- updateTimeout :: TimerManager -> TimeoutKey -> Int -> IO () updateTimeout mgr (TK key) us = do expTime <- expirationTime us ===================================== libraries/base/GHC/Event/Windows.hsc ===================================== @@ -853,6 +853,10 @@ expirationTime mgr us = do -- The timeout is automatically unregistered when it fires. -- -- The 'TimeoutCallback' will not be called more than once. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- {-# NOINLINE registerTimeout #-} registerTimeout :: Manager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout mgr at Manager{..} uSrelTime cb = do @@ -866,6 +870,10 @@ registerTimeout mgr at Manager{..} uSrelTime cb = do -- | Update an active timeout to fire in the given number of seconds (from the -- time 'updateTimeout' is called), instead of when it was going to fire. -- This has no effect if the timeout has already fired. +-- +-- Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- updateTimeout :: Manager -> TimeoutKey -> Seconds -> IO () updateTimeout mgr (TK key) relTime = do now <- getTime (mgrClock mgr) ===================================== libraries/base/GHC/Event/Windows/Thread.hs ===================================== @@ -19,6 +19,8 @@ ensureIOManagerIsRunning = wakeupIOManager interruptIOManager :: IO () interruptIOManager = interruptSystemManager +-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. threadDelay :: Int -> IO () threadDelay usecs = mask_ $ do m <- newEmptyIOPort @@ -26,6 +28,8 @@ threadDelay usecs = mask_ $ do reg <- registerTimeout mgr usecs $ writeIOPort m () >> return () readIOPort m `onException` unregisterTimeout mgr reg +-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. registerDelay :: Int -> IO (TVar Bool) registerDelay usecs = do t <- newTVarIO False ===================================== libraries/base/System/Timeout.hs ===================================== @@ -58,7 +58,9 @@ instance Exception Timeout where -- is available within @n@ microseconds (@1\/10^6@ seconds). In case a result -- is available before the timeout expires, @Just a@ is returned. A negative -- timeout interval means \"wait indefinitely\". When specifying long timeouts, --- be careful not to exceed @maxBound :: Int at . +-- be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only +-- 2147483647 μs, less than 36 minutes. +-- Consider using @Control.Concurrent.Timeout.timeout@ from @unbounded-delays@ package. -- -- >>> timeout 1000000 (threadDelay 1000 *> pure "finished on time") -- Just "finished on time" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c24b1b3a9d6a4c2f471fd7d8ec65141a8b46357 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c24b1b3a9d6a4c2f471fd7d8ec65141a8b46357 You're receiving 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 Aug 7 20:31:17 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 16:31:17 -0400 Subject: [Git][ghc/ghc][ghc-9.4] 8 commits: gitlab-ci: Bump Docker images Message-ID: <62f02115c283_25b0164c1583435b5@gitlab.mail> Ben Gamari pushed to branch ghc-9.4 at Glasgow Haskell Compiler / GHC Commits: d1558383 by Ben Gamari at 2022-08-05T11:46:40-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - d24765e4 by Ben Gamari at 2022-08-05T12:53:40-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. (cherry picked from commit b4342e32823bb0bfc8e83b53055647d64e0431ab) - - - - - 69db7406 by Ben Gamari at 2022-08-06T16:32:09-04:00 users-guide: Mention representation change of Word64 and Int64 Closes #21641. - - - - - f08a73a0 by Ben Gamari at 2022-08-06T16:32:09-04:00 make: Fix too-old bootstrap compiler error - - - - - 669fd338 by Ben Gamari at 2022-08-06T16:32:09-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. (cherry picked from commit 4d8e0fd3fe3d648c6d37b3eb43b89e1bdbef36af) - - - - - cc715935 by Ben Gamari at 2022-08-06T16:32:09-04:00 hadrian: Fix installation of system-cxx-std-lib package conf (cherry picked from commit 119ee22dd09d8977de67939de7324af941ae7196) - - - - - cb320017 by Ben Gamari at 2022-08-06T22:58:44-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. (cherry picked from commit a30ef212790e41ba01f92f24e3be4d645502d9ee) - - - - - 6d01245c by Ben Gamari at 2022-08-06T22:58:44-04:00 Bump haddock submodule - - - - - 8 changed files: - .gitlab-ci.yml - compiler/GHC/CmmToAsm/X86/CodeGen.hs - distrib/configure.ac.in - docs/users_guide/9.4.1-notes.rst - ghc.mk - hadrian/bindist/Makefile - libraries/base/changelog.md - utils/haddock Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 0849567cd9780cc8e9652118b949cb050c632ef4 + DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2922,11 +2922,12 @@ genSwitch expr targets = do else do -- See Note [%rip-relative addressing on x86-64]. tableReg <- getNewRegNat (intFormat (platformWordWidth platform)) + targetReg <- getNewRegNat (intFormat (platformWordWidth platform)) let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)) code = e_code `appOL` toOL [ LEA (archWordFormat is32bit) (OpAddr (AddrBaseIndex EABaseRip EAIndexNone (ImmCLbl lbl))) (OpReg tableReg) - , MOV (archWordFormat is32bit) op (OpReg reg) - , JMP_TBL (OpReg reg) ids (Section ReadOnlyData lbl) lbl + , MOV (archWordFormat is32bit) op (OpReg targetReg) + , JMP_TBL (OpReg targetReg) ids (Section ReadOnlyData lbl) lbl ] return code where ===================================== distrib/configure.ac.in ===================================== @@ -79,6 +79,7 @@ AC_PATH_PROG(SedCmd,gsed sed,sed) dnl ** check for Python for testsuite driver FIND_PYTHON +FP_PROG_FIND XCODE_VERSION() ===================================== docs/users_guide/9.4.1-notes.rst ===================================== @@ -40,6 +40,11 @@ upgrading to GHC 9.4: report warnings where it previously did not. In such cases the correct solution is generally to remove the ``hs-boot`` file in question. +- The boxed ``Word64`` and ``Int64`` types are now internally represented by + the unboxed ``Word64#`` and ``Int64#`` primitive types, in contrast + previous releases where they were represented by ``Word#`` and ``Int#`` + on 64-bit platforms. + - Due to various changes in the typechecker's constraint solver, some programs may need additional constraints to be explicitly provided. See the `Migration guide ===================================== ghc.mk ===================================== @@ -136,7 +136,7 @@ ifeq "$(ProjectVersion)" "" $(error Please run ./configure first) endif ifneq "$(CanBootWithMake)" "YES" -$(error The make build system requires a boot compiler older than ghc-9.2. Your boot compiler is too new and cannot be used to build ghc-9.4 with make. Either boot with ghc 9.0.2) +$(error The make build system requires a boot compiler older than ghc-9.2. Your boot compiler is too new and cannot be used to build ghc-9.4 with make. Either boot with ghc 9.0.2 or build with hadrian. See https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html for advice on transitioning to hadrian.) endif endif ===================================== hadrian/bindist/Makefile ===================================== @@ -22,7 +22,8 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -define installscript +# installscript +# # $1 = package name # $2 = wrapper path # $3 = bindir @@ -36,30 +37,32 @@ define installscript # to it. This implementation is a bit hacky and depends on consistency # of program names. For hadrian build this will work as programs have a # consistent naming procedure. - if [ -L 'wrappers/$1' ]; then echo "$1 is a symlink"; fi - @if [ -L 'wrappers/$1' ]; then \ - cp -RP 'wrappers/$1' '$2'; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ +define installscript + echo "installscript $1 -> $2" + @if [ -L 'wrappers/$1' ]; then \ + $(CP) -P 'wrappers/$1' '$2' ; \ + else \ + rm -f '$2' && \ + $(CREATE_SCRIPT) '$2' && \ + echo "#!$(SHELL)" >> '$2' && \ + echo "exedir=\"$4\"" >> '$2' && \ + echo "exeprog=\"$1\"" >> '$2' && \ + echo "executablename=\"$5\"" >> '$2' && \ + echo "bindir=\"$3\"" >> '$2' && \ + echo "libdir=\"$6\"" >> '$2' && \ + echo "docdir=\"$7\"" >> '$2' && \ + echo "includedir=\"$8\"" >> '$2' && \ + echo "" >> '$2' && \ + cat 'wrappers/$1' >> '$2' && \ + $(EXECUTABLE_FILE) '$2' ; \ fi @echo "$1 installed to $2" endef +# patchpackageconf +# # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' # fields in the package .conf files -define patchpackageconf # # $1 = package name (ex: 'bytestring') # $2 = path to .conf file @@ -67,16 +70,17 @@ define patchpackageconf # $4 = (relative) path from $${pkgroot} to docs directory ($3) # $5 = package name and version (ex: bytestring-0.13) # -# We fix the paths to haddock files by using the relative path from the pkgroot -# to the doc files. +define patchpackageconf \ + # We fix the paths to haddock files by using the relative path from the pkgroot + # to the doc files. cat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: "$${pkgroot}/$4/html/libraries/$5/$1.haddock"|' \ | sed 's|haddock-html.*|haddock-html: "$${pkgroot}/$4/html/libraries/$5"|' \ | sed 's| $${pkgroot}/../../doc/html/.*||' \ > '$2.copy' -# The rts package doesn't actually supply haddocks, so we stop advertising them -# altogether. + # The rts package doesn't actually supply haddocks, so we stop advertising them + # altogether. ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') -# We finally replace the original file. + # We finally replace the original file. mv '$2.copy.copy' '$2' endef @@ -171,7 +175,7 @@ install_bin_libdir: @echo "Copying binaries to $(DESTDIR)$(ActualBinsDir)" $(INSTALL_DIR) "$(DESTDIR)$(ActualBinsDir)" for i in $(BINARIES); do \ - cp -R $$i "$(DESTDIR)$(ActualBinsDir)"; \ + $(INSTALL_PROGRAM) $$i "$(DESTDIR)$(ActualBinsDir)"; \ done # Work around #17418 on Darwin if [ -e "${XATTR}" ]; then "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; fi @@ -179,24 +183,46 @@ install_bin_libdir: install_bin_direct: @echo "Copying binaries to $(DESTDIR)$(WrapperBinsDir)" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - cp ./bin/* "$(DESTDIR)$(WrapperBinsDir)/" + $(INSTALL_PROGRAM) ./bin/* "$(DESTDIR)$(WrapperBinsDir)/" -LIBRARIES = $(wildcard ./lib/*) install_lib: lib/settings @echo "Copying libraries to $(DESTDIR)$(ActualLibsDir)" $(INSTALL_DIR) "$(DESTDIR)$(ActualLibsDir)" - for i in $(LIBRARIES); do \ - cp -R $$i "$(DESTDIR)$(ActualLibsDir)/"; \ + + @dest="$(DESTDIR)$(ActualLibsDir)"; \ + cd lib; \ + for i in `$(FIND) . -type f`; do \ + $(INSTALL_DIR) "$$dest/`dirname $$i`" ; \ + case $$i in \ + *.a) \ + $(INSTALL_DATA) $$i "$$dest/`dirname $$i`" ; \ + $(RANLIB_CMD) "$$dest"/$$i ;; \ + *.dll) \ + $(INSTALL_PROGRAM) $$i "$$dest/`dirname $$i`" ; \ + $(STRIP_CMD) "$$dest"/$$i ;; \ + *.so) \ + $(INSTALL_SHLIB) $$i "$$dest/`dirname $$i`" ;; \ + *.dylib) \ + $(INSTALL_SHLIB) $$i "$$dest/`dirname $$i`" ;; \ + *) \ + $(INSTALL_DATA) $$i "$$dest/`dirname $$i`" ;; \ + esac; \ + done; \ + chmod ugo+rx "$$dest"/bin/* + for i in $(DOCS); do \ + cp -R $$i "$(DESTDIR)$(docdir)/"; \ done -DOCS = $(wildcard ./doc/*) install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - for i in $(DOCS); do \ - cp -R $$i "$(DESTDIR)$(docdir)/"; \ - done + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ + $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ + ' sh '{}' \; + if [ -d docs-utils ]; then \ + $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ $(INSTALL_DATA) docs-utils/prologue.txt "$(DESTDIR)$(docdir)/html/libraries/"; \ $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi @@ -211,8 +237,7 @@ install_wrappers: install_bin_libdir PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib @echo "Installing C++ standard library virtual package" - cp mk/system-cxx-std-lib-1.0.conf "$(DESTDIR)$(ActualLibsDir)/" - + $(INSTALL_DATA) mk/system-cxx-std-lib-1.0.conf "$(DESTDIR)$(ActualLibsDir)/package.conf.d" @echo "Updating the package DB" $(foreach p, $(PKG_CONFS),\ $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:\0xxx\0: :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/.conf//g'))) @@ -221,6 +246,7 @@ update_package_db: install_bin install_lib install_mingw: @echo "Installing MingGW" $(INSTALL_DIR) "$(DESTDIR)$(prefix)/mingw" - cp -R ./mingw "$(DESTDIR)$(prefix)" + cp -Rp ./mingw "$(DESTDIR)$(prefix)" + # END INSTALL # ---------------------------------------------------------------------- ===================================== libraries/base/changelog.md ===================================== @@ -73,7 +73,7 @@ This replaces the old ``GHC.Exts.magicDict``, which required an intermediate data type and was less reliable. - * `Data.Word.Word64` and `Data.Int.Int64` are now already represented by + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these were rather represented by `Word#` and `Int#`. See GHC #11953. ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 7484cf883da0ececa8b9c0e039608d6c20654116 +Subproject commit f07a4059efcde05fd26b33a8c902930d3ad90379 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e00b823d46856204fee830e279b467ea4e36b9a8...6d01245c458c49ca25c89ec13be3268ab6930a27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e00b823d46856204fee830e279b467ea4e36b9a8...6d01245c458c49ca25c89ec13be3268ab6930a27 You're receiving 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 Aug 12 13:45:29 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Fri, 12 Aug 2022 09:45:29 -0400 Subject: [Git][ghc/ghc][wip/21611-move-corem] 4 commits: Renamed endPassIO to endPass Message-ID: <62f659798ae95_3d81494887851676b@gitlab.mail> Dominik Peteler pushed to branch wip/21611-move-corem at Glasgow Haskell Compiler / GHC Commits: 2661a216 by Dominik Peteler at 2022-08-12T15:04:59+02:00 Renamed endPassIO to endPass - - - - - 2db3a110 by Dominik Peteler at 2022-08-12T15:15:01+02:00 Renamed hscSimplify/hscSimplify' to optimizeCoreIO/optimizeCoreHsc - - - - - 5030e60d by Dominik Peteler at 2022-08-12T15:24:51+02:00 Run simplifyPgm in SimplCountM - - - - - 375910d6 by Dominik Peteler at 2022-08-12T15:45:04+02:00 Added note on the architecture of the Core optimizer - - - - - 11 changed files: - compiler/GHC.hs - compiler/GHC/Core/EndPass.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt.hs - compiler/GHC/Core/Opt/Config.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/Core/Opt.hs - compiler/GHC/Driver/Core/Opt.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -1285,7 +1285,7 @@ compileCore simplify fn = do hsc_env <- getSession simpl_guts <- liftIO $ do plugins <- readIORef (tcg_th_coreplugins tcg) - hscSimplify hsc_env plugins mod_guts + optimizeCoreIO hsc_env plugins mod_guts tidy_guts <- liftIO $ hscTidy hsc_env simpl_guts return $ Left tidy_guts else ===================================== compiler/GHC/Core/EndPass.hs ===================================== @@ -10,7 +10,7 @@ compilation pass that returns Core. Heavily leverages `GHC.Core.Lint`. module GHC.Core.EndPass ( EndPassConfig (..), - endPassIO, + endPass, dumpPassResult ) where @@ -57,12 +57,14 @@ data EndPassConfig = EndPassConfig , ep_passDetails :: !SDoc } -endPassIO :: Logger - -> EndPassConfig - -> CoreProgram -> [CoreRule] - -> IO () --- Used by the IO-is CorePrep too -endPassIO logger cfg binds rules +-- | Check the correctness of a Core program after running an optimization pass. +-- Used by CorePrep too. +-- See Note [The architecture of the Core optimizer]. +endPass :: Logger + -> EndPassConfig + -> CoreProgram -> [CoreRule] + -> IO () +endPass logger cfg binds rules = do { dumpPassResult logger (ep_dumpCoreSizes cfg) (ep_printUnqual cfg) mb_flag (renderWithContext defaultSDocContext (ep_prettyPass cfg)) (ep_passDetails cfg) binds rules ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -9,6 +9,7 @@ A ``lint'' pass to check for Core correctness. See Note [Core Lint guarantee]. +See Note [The architecture of the Core optimizer]. -} module GHC.Core.Lint ( ===================================== compiler/GHC/Core/Opt.hs ===================================== @@ -1,7 +1,7 @@ {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -\section[SimplCore]{Driver for simplifying @Core@ programs} +\section[GHC.Core.Opt]{Driver for optimizing @Core@ programs} -} {-# LANGUAGE CPP #-} @@ -11,7 +11,7 @@ module GHC.Core.Opt ( CoreOptEnv (..), runCorePasses ) where import GHC.Prelude import GHC.Core -import GHC.Core.EndPass ( EndPassConfig, endPassIO ) +import GHC.Core.EndPass ( EndPassConfig, endPass ) import GHC.Core.Opt.CSE ( cseProgram ) import GHC.Core.Ppr ( pprCoreBindings ) import GHC.Core.Lint ( LintAnnotationsConfig, DebugSetting(..), lintAnnots ) @@ -30,7 +30,7 @@ import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.SpecConstr ( specConstrProgram ) import GHC.Core.Opt.Specialise ( specProgram ) import GHC.Core.Opt.StaticArgs ( doStaticArgs ) -import GHC.Core.Opt.Stats ( SimplCountM, addCounts ) +import GHC.Core.Opt.Stats ( SimplCountM ) import GHC.Core.Opt.WorkWrap ( wwTopBinds ) import GHC.Core.LateCC (addLateCostCentres) import GHC.Core.Rules ( extendRuleBaseList, extendRuleEnv ) @@ -87,6 +87,7 @@ data CoreOptEnv = CoreOptEnv -- creation of the '[CoreToDo]') happens in -- 'GHC.Driver.Config.Core.Opt'. Then this function "executes" that -- plan. +-- See Note [The architecture of the Core optimizer]. runCorePasses :: CoreOptEnv -> [CoreToDo] -> ModGuts @@ -104,7 +105,7 @@ runCorePasses env passes guts withTiming (co_logger env) (ppr pass <+> brackets (ppr this_mod)) (const ()) $ do guts' <- lintAnnots (co_logger env) lint_anno_cfg doCorePassWithoutDebug guts - liftIO $ endPassIO (co_logger env) end_pass_cfg (mg_binds guts') (mg_rules guts') + liftIO $ endPass (co_logger env) end_pass_cfg (mg_binds guts') (mg_rules guts') return guts' this_mod = mg_module guts @@ -126,10 +127,8 @@ doCorePass env pass guts = do let !read_ruleenv = readRuleEnv env guts case pass of - CoreDoSimplify opts -> {-# SCC "Simplify" #-} do - (guts', sc) <- liftIO $ simplifyPgm (co_logger env) read_ruleenv (co_unitEnv env) opts guts - addCounts sc - return guts' + CoreDoSimplify opts -> {-# SCC "Simplify" #-} + simplifyPgm (co_logger env) read_ruleenv (co_unitEnv env) opts guts CoreCSE -> {-# SCC "CommonSubExpr" #-} updateBinds cseProgram ===================================== compiler/GHC/Core/Opt/Config.hs ===================================== @@ -34,10 +34,10 @@ import GHC.Utils.Outputable as Outputable -- | A description of the plugin pass itself type CorePluginPass = ModGuts -> CoreM ModGuts -data CoreToDo -- These are diff core-to-core passes, - -- which may be invoked in any order, - -- as many times as you like. - +-- | These are diff core-to-core passes, which may be invoked in any order, as +-- many times as you like. +-- See Note [The architecture of the Core optimizer]. +data CoreToDo = -- | The core-to-core simplifier. CoreDoSimplify !SimplifyOpts | CoreDoPluginPass String CorePluginPass ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules import GHC.Core.Opt.Simplify.Utils ( activeRule, activeUnfolding ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Monad -import GHC.Core.Opt.Stats ( simplCountN ) +import GHC.Core.Opt.Stats ( SimplCountM, addCounts, simplCountN ) import GHC.Core.FamInstEnv import GHC.Utils.Error ( withTiming ) @@ -44,6 +44,7 @@ import GHC.Types.Unique.FM import GHC.Types.Name.Ppr import Control.Monad +import Control.Monad.IO.Class ( liftIO ) import Data.Foldable ( for_ ) #if __GLASGOW_HASKELL__ <= 810 @@ -144,9 +145,20 @@ simplifyPgm :: Logger -> UnitEnv -> SimplifyOpts -> ModGuts - -> IO (ModGuts, SimplCount) -- New bindings - -simplifyPgm logger read_ruleenv unit_env opts + -> SimplCountM ModGuts -- New bindings +simplifyPgm logger read_ruleenv unit_env opts guts = do + (nguts, sc) <- liftIO $ simplifyPgmIO logger read_ruleenv unit_env opts guts + addCounts sc + return nguts + +simplifyPgmIO :: Logger + -> IO RuleEnv -- ^ Action to get the current RuleEnv + -> UnitEnv + -> SimplifyOpts + -> ModGuts + -> IO (ModGuts, SimplCount) -- New bindings + +simplifyPgmIO logger read_ruleenv unit_env opts guts@(ModGuts { mg_module = this_mod , mg_rdr_env = rdr_env , mg_binds = binds, mg_rules = rules ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -32,7 +32,7 @@ import GHC.Builtin.Types import GHC.Core.Utils import GHC.Core.Opt.Arity -import GHC.Core.EndPass ( EndPassConfig(..), endPassIO ) +import GHC.Core.EndPass ( EndPassConfig(..), endPass ) import GHC.Core import GHC.Core.Make hiding( FloatBind(..) ) -- We use our own FloatBind here import GHC.Core.Type @@ -258,8 +258,7 @@ corePrepPgm logger cp_cfg pgm_cfg floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds return (deFloatTop (floats1 `appendFloats` floats2)) - endPassIO logger (cpPgm_endPassConfig pgm_cfg) - binds_out [] + endPass logger (cpPgm_endPassConfig pgm_cfg) binds_out [] return binds_out corePrepExpr :: Logger -> CorePrepConfig -> CoreExpr -> IO CoreExpr ===================================== compiler/GHC/Driver/Config/Core/Opt.hs ===================================== @@ -1,7 +1,7 @@ {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -\section[SimplCore]{Configuration of the driver for simplifying @Core@ programs} +\section[GHC.Driver.Config.Core.Opt]{Configuration of the driver for optimizing @Core@ programs} -} {-# LANGUAGE CPP #-} @@ -41,6 +41,8 @@ import Data.Foldable ************************************************************************ -} +-- | Construct the main optimisation pipeline from the driver's session state. +-- See Note [The architecture of the Core optimizer]. getCoreToDo :: DynFlags -> [Var] -> [CoreToDo] getCoreToDo dflags extra_vars = execWriter $ do -- We want to do the static argument transform before full laziness as it ===================================== compiler/GHC/Driver/Core/Opt.hs ===================================== @@ -1,4 +1,4 @@ -module GHC.Driver.Core.Opt ( hscSimplify, hscSimplify' ) where +module GHC.Driver.Core.Opt ( optimizeCoreHsc, optimizeCoreIO ) where import GHC.Prelude @@ -34,27 +34,27 @@ import GHC.Utils.Logger as Logger import Control.Monad.IO.Class -------------------------------------------------------------- --- Simplifiers +-- Core optimization entrypoints -------------------------------------------------------------- --- | Run Core2Core simplifier. The list of String is a list of (Core) plugin +-- | Run Core optimizer. The list of String is a list of (Core) plugin -- module names added via TH (cf 'addCorePlugin'). -hscSimplify :: HscEnv -> [String] -> ModGuts -> IO ModGuts -hscSimplify hsc_env plugins modguts = - runHsc hsc_env $ hscSimplify' plugins modguts - --- | Run Core2Core simplifier. The list of String is a list of (Core) plugin --- module names added via TH (cf 'addCorePlugin'). -hscSimplify' :: [String] -> ModGuts -> Hsc ModGuts -hscSimplify' plugins ds_result = do - hsc_env <- getHscEnv +optimizeCoreIO :: HscEnv -> [String] -> ModGuts -> IO ModGuts +optimizeCoreIO hsc_env plugins guts = do hsc_env_with_plugins <- if null plugins -- fast path then return hsc_env - else liftIO $ initializePlugins - $ hscUpdateFlags (\dflags -> foldr addPluginModuleName dflags plugins) - hsc_env + else initializePlugins + $ hscUpdateFlags (\dflags -> foldr addPluginModuleName dflags plugins) + hsc_env {-# SCC "Core2Core" #-} - liftIO $ core2core hsc_env_with_plugins ds_result + core2core hsc_env_with_plugins guts + +-- | Run Core optimizer. The list of String is a list of (Core) plugin +-- module names added via TH (cf 'addCorePlugin'). +optimizeCoreHsc :: [String] -> ModGuts -> Hsc ModGuts +optimizeCoreHsc plugins guts = do + hsc_env <- getHscEnv + liftIO $ optimizeCoreIO hsc_env plugins guts core2core :: HscEnv -> ModGuts -> IO ModGuts core2core hsc_env guts@(ModGuts { mg_module = mod @@ -84,11 +84,6 @@ core2core hsc_env guts@(ModGuts { mg_module = mod , gwib_isBoot = NotBoot }) hpt_rule_base = mkRuleBase home_pkg_rules - -- mod: get the module out of the current HscEnv so we can retrieve it from the monad. - -- This is very convienent for the users of the monad (e.g. plugins do not have to - -- consume the ModGuts to find the module) but somewhat ugly because mg_module may - -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which - -- would mean our cached value would go out of date. env = CoreOptEnv { co_logger = logger , co_debugSetting = InheritDebugLevel @@ -111,6 +106,11 @@ liftCoreMToSimplCountM hsc_env debug_settings guts m = do return a where mod = mg_module guts + -- mod: get the module out of the ModGuts so we can retrieve it from the monad. + -- This is very convienent for the users of the monad (e.g. plugins do not have to + -- consume the ModGuts to find the module) but somewhat ugly because mg_module may + -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which + -- would mean our cached value would go out of date. loc = mg_loc guts orph_mods = mkModuleSet (mod : dep_orphs (mg_deps guts)) gwib = GWIB { gwib_mod = moduleName mod, gwib_isBoot = NotBoot } @@ -122,3 +122,56 @@ liftCoreMToSimplCountM hsc_env debug_settings guts m = do NoDebugging -> let dflags' = (hsc_dflags hsc_env) { debugLevel = 0 } in hsc_env { hsc_dflags = dflags' } + +{- +Note [The architecture of the Core optimizer] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Conceptually the Core optimizer consists of two stages: + + 1. The planning stage. + 2. The execution stage. + +This division is mirrored in the interface of the different optimizations. For +each of those optimzations we have + + 1. a configuration record bundeling the options for a particular optimization + pass. + 2. an initialization function used to obtain such a configuration from + `DynFlags`. This function typically lives in a module named after the pass + in the `GHC.Driver.Config.Core.Opt` namespace and is used in the planning + stage. + 3. the actual optimization pass itself, with an entrypoint that takes the + configuration of the pass along with the execution context as arguments. + This entrypoint is called in the execution stage. + +The plan that is the result of the first stage is constructed by the +`getCoreToDo` function found in the `GHC.Driver.Config.Core.Opt` module. This +function determines the sequence of optimization passes run on the module in +question and derives the configuration for each pass from the session's state +(`DynFlags`) using the aforementioned initialization functions. The `CoreToDo` +type that is finally used to wrap this configuration value is a sum type +enumerating all the optimizations available in GHC. + +The entrypoint of the second stage are the `optimizeCore*` functions found in +GHC.Driver.Core.Opt. These functions is part of the Application Layer and +utilize the `runCorePasses` function from `GHC.Core.Opt` which is the +counterpart of these functions in the Domain Layer. In other words, while the +`optimizeCore*` know about `HscEnv` and are therefore bound to a concrete +driver, `runCorePasses` is more independent as it is a component of its own. + +`runCorePasses` is essentially an interpreter for the `CoreToDo`s constructed in +the planning phase. It calls the entrypoints of the passes with their respective +configurations as arguments as well as some execution context like the unit +environment, the rules and the type family instance in scope, and most notably +the module we wish to compile (`ModGuts`). + +A similar split in functionality is done for the Core Linting: After each pass +we may check the sanity of the resulting Core running a so-called EndPass check. +The entrypoint for this check is the `endPass` function found in +GHC.Core.EndPass. It comes as well with a configuration record and a +corresponding initialization function for it in GHC.Driver.Core.EndPass. The +definition of what actually is a correct Core program is defined by the linting +functions in GHC.Core.Lint. These are used by the EndPass to check the program. + +-} ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Driver.Main , hscTypecheckAndGetWarnings , hscDesugar , makeSimpleDetails - , hscSimplify -- ToDo, shouldn't really export this + , optimizeCoreIO -- TODO: shouldn't really export this , hscDesugarAndSimplify -- * Safe Haskell @@ -88,7 +88,7 @@ module GHC.Driver.Main , hscCompileCoreExpr' -- We want to make sure that we export enough to be able to redefine -- hsc_typecheck in client code - , hscParse', hscSimplify', hscDesugar', tcRnModule', doCodeGen + , hscParse', optimizeCoreHsc, hscDesugar', tcRnModule', doCodeGen , getHscEnv , hscSimpleIface' , oneShotMsg @@ -123,7 +123,7 @@ import GHC.Driver.Config.Stg.Ppr (initStgPprOpts) import GHC.Driver.Config.Stg.Pipeline (initStgPipelineOpts) import GHC.Driver.Config.StgToCmm (initStgToCmmConfig) import GHC.Driver.Config.Cmm (initCmmConfig) -import GHC.Driver.Core.Opt ( hscSimplify, hscSimplify' ) +import GHC.Driver.Core.Opt ( optimizeCoreHsc, optimizeCoreIO ) import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Tidy import GHC.Driver.Hooks @@ -158,7 +158,7 @@ import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result) import GHC.Iface.Ext.Debug ( diffFile, validateScopes ) import GHC.Core -import GHC.Core.EndPass ( EndPassConfig(..), endPassIO ) +import GHC.Core.EndPass ( EndPassConfig(..), endPass ) import GHC.Core.Lint ( LintFlags(..), StaticPtrCheck(..) ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Tidy ( tidyExpr ) @@ -1008,7 +1008,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h -- Just cause we desugared doesn't mean we are generating code, see above. Just desugared_guts | backendGeneratesCode bcknd -> do plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result) - simplified_guts <- hscSimplify' plugins desugared_guts + simplified_guts <- optimizeCoreHsc plugins desugared_guts (cg_guts, details) <- liftIO $ hscTidy hsc_env simplified_guts @@ -2083,7 +2083,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Simplify -} simpl_mg <- liftIO $ do plugins <- readIORef (tcg_th_coreplugins tc_gblenv) - hscSimplify hsc_env plugins ds_result + optimizeCoreIO hsc_env plugins ds_result {- Tidy -} (tidy_cg, mod_details) <- liftIO $ hscTidy hsc_env simpl_mg @@ -2302,7 +2302,7 @@ hscTidy hsc_env guts = do , ep_prettyPass = tidy_ppr , ep_passDetails = empty } - endPassIO logger tidy_cfg all_tidy_binds tidy_rules + endPass logger tidy_cfg all_tidy_binds tidy_rules -- If the endPass didn't print the rules, but ddump-rules is -- on, print now ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -48,7 +48,7 @@ import GHC.Core.Type import GHC.Core.TyCon ( tyConDataCons ) import GHC.Core import GHC.Core.FVs ( exprsSomeFreeVarsList ) -import GHC.Core.EndPass ( EndPassConfig(..), endPassIO ) +import GHC.Core.EndPass ( EndPassConfig(..), endPass ) import GHC.Core.Lint ( LintFlags(..) ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr ) @@ -240,7 +240,7 @@ deSugar hsc_env , ep_prettyPass = desugar_before_ppr , ep_passDetails = empty } - ; endPassIO (hsc_logger hsc_env) desugar_before_cfg final_pgm rules_for_imps + ; endPass (hsc_logger hsc_env) desugar_before_cfg final_pgm rules_for_imps ; let simpl_opts = initSimpleOpts dflags ; let (ds_binds, ds_rules_for_imps, occ_anald_binds) @@ -267,7 +267,7 @@ deSugar hsc_env , ep_prettyPass = desugar_after_ppr , ep_passDetails = empty } - ; endPassIO (hsc_logger hsc_env) desugar_after_cfg ds_binds ds_rules_for_imps + ; endPass (hsc_logger hsc_env) desugar_after_cfg ds_binds ds_rules_for_imps ; let used_names = mkUsedNames tcg_env pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16f3cbad85f3f52355a4b4faf807a85936a5d806...375910d6e279ca29f07782b8b0f90051a950f06c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16f3cbad85f3f52355a4b4faf807a85936a5d806...375910d6e279ca29f07782b8b0f90051a950f06c You're receiving 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 Aug 12 12:38:09 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 12 Aug 2022 08:38:09 -0400 Subject: [Git][ghc/ghc][wip/js-staging] PrimOp: correclty (un)handle new thread related primops Message-ID: <62f649b1b6d10_3d8149488dc4928da@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: c1063659 by Sylvain Henry at 2022-08-12T14:40:39+02:00 PrimOp: correclty (un)handle new thread related primops - - - - - 1 changed file: - compiler/GHC/StgToJS/Prim.hs Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -1120,7 +1120,10 @@ genPrim prof ty op = case op of ClosureSizeOp -> unhandledPrimop op GetApStackValOp -> unhandledPrimop op WhereFromOp -> unhandledPrimop op -- should be easily implementable with o.f.n + SetThreadAllocationCounter -> unhandledPrimop op + GetThreadLabelOp -> unhandledPrimop op + ListThreadsOp -> unhandledPrimop op VecBroadcastOp _ _ _ -> unhandledPrimop op VecPackOp _ _ _ -> unhandledPrimop op View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1063659a48c5c89aa1afb7698d27452019fb7d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1063659a48c5c89aa1afb7698d27452019fb7d1 You're receiving 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 Aug 9 19:18:25 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 15:18:25 -0400 Subject: [Git][ghc/ghc][wip/nr/typed-wasm-control-flow] correct botched opcode in assembly emitter Message-ID: <62f2b3016d8d1_182c4e50668347472@gitlab.mail> Norman Ramsey pushed to branch wip/nr/typed-wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: 780d2d00 by Norman Ramsey at 2022-08-09T15:17:51-04:00 correct botched opcode in assembly emitter - - - - - 1 changed file: - compiler/GHC/Wasm/ControlFlow/ToAsm.hs Changes: ===================================== compiler/GHC/Wasm/ControlFlow/ToAsm.hs ===================================== @@ -64,9 +64,9 @@ toIndentedAsm ps pe indent s = print s print (WasmFallthrough `WasmSeq` s) = print s print (s `WasmSeq` WasmFallthrough) = print s print (WasmIfTop t s WasmFallthrough) = - "br_if" <+> ty t `newline` shift s `newline` "end_if" + "if" <+> ty t `newline` shift s `newline` "end_if" print (WasmIfTop t WasmFallthrough s) = - "br_if" <+> ty t `newline` "else" `newline` shift s `newline` "end_if" + "if" <+> ty t `newline` "else" `newline` shift s `newline` "end_if" -- normal cases print (WasmPush _ e) = pe indent e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/780d2d005eab567f2c616c8b747a836829208dcf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/780d2d005eab567f2c616c8b747a836829208dcf You're receiving 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 Aug 12 11:28:47 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 Aug 2022 07:28:47 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] 2 commits: Fix -fno-code logic to determine which backend to use based on demand Message-ID: <62f6396f4c645_3d814948904467013@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 531f63bd by Matthew Pickering at 2022-08-12T10:38:47+01:00 Fix -fno-code logic to determine which backend to use based on demand - - - - - dec02917 by Matthew Pickering at 2022-08-12T12:28:36+01:00 Fixes - - - - - 29 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Unit/Home/ModInfo.hs - compiler/GHC/Unit/Module/FatIface.hs - compiler/GHC/Unit/Module/ModIface.hs - testsuite/tests/driver/T20300/T20300.stderr - + testsuite/tests/driver/T20348/B.hs - testsuite/tests/driver/T20348/Makefile - testsuite/tests/driver/T20348/T20348.stdout - testsuite/tests/driver/T20348/all.T - testsuite/tests/driver/T20696/T20696.stderr - + testsuite/tests/driver/fat-iface/FatQuote1.hs - + testsuite/tests/driver/fat-iface/FatQuote2.hs - + testsuite/tests/driver/fat-iface/FatTH1.hs - + testsuite/tests/driver/fat-iface/FatTH2.hs - + testsuite/tests/driver/fat-iface/FatTHTop.hs - testsuite/tests/driver/fat-iface/all.T - testsuite/tests/driver/fat-iface/fat008.stdout - testsuite/tests/driver/fat-iface/fat012.stderr - testsuite/tests/driver/fat-iface/fat013.stderr - testsuite/tests/driver/fat-iface/fat014.stdout - + testsuite/tests/driver/fat-iface/fat015.stderr - testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout - testsuite/tests/ghci/T16670/Makefile - testsuite/tests/ghci/T16670/T16670_th.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -599,8 +599,10 @@ toIfaceTopBind b = let top_bndr = toIfaceTopBndr b rhs' = case top_bndr of -- Use the existing unfolding for a global binder if we store that anyway. + -- See Note [Fat Interface: Sharing RHSs] IfGblTopBndr {} -> if already_has_unfolding b then IfUseUnfoldingRhs else IfRhs (toIfaceExpr rhs) - -- Local binders will have had unfoldings trimmed + -- Local binders will have had unfoldings trimmed so have + -- to serialise the whole RHS. IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs) in (top_bndr, rhs') @@ -750,4 +752,27 @@ slower by 8% overall (on #9872a-d, and T1969: the reason is that these NOINLINE'd functions now can't be profitably inlined outside of the hs-boot loop. +Note [Fat Interface: Sharing RHSs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In order to avoid duplicating definitions for bindings which already have unfoldings +we do some minor headstands to avoid serialising the RHS of a definition if it has +*any* unfolding. + +* Only global things have unfoldings, because local things have had their unfoldings stripped. +* For any global thing which has an unfolding, we just use that, and ignore if it's stable or so on. + +Using whatever unfolding means that you could end up with an unoptimised +definition for something (if it has a stable unfolding) rather than an optimised +version but without much further headstanding this seemed a good +compromise until someone raises an issue. + +In order to implement this sharing: + +* When creating the interface, check the criteria above and don't serialise the RHS + if such a case. + See +* When reading an interface, look at the realIdUnfolding, and then the unfoldingTemplate. + See `tc_iface_binding` for where this happens. + -} ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1270,10 +1270,12 @@ during the downsweep we patch the DynFlags in the ModSummary of any home module that is imported by a module that uses template haskell, to generate object code. -The flavour of generated object code is chosen by defaultObjectTarget for the -target platform. It would likely be faster to generate bytecode, but this is not -supported on all platforms(?Please Confirm?), and does not support the entirety -of GHC haskell. See #1257. +The flavour of the generated code depends on whether `-fprefer-byte-code` is enabled +or not in the module which needs the code generation. If the module requires byte-code then +dependencies will generate byte-code, otherwise they will generate object files. +In the case where some modules require byte-code and some object files, both are +generated by enabling `-fbyte-code-and-object-code`, the test "fat015" tests these +configurations. The object files (and interface files if -fwrite-interface is disabled) produced for template haskell are written to temporary files. @@ -1698,6 +1700,12 @@ enableCodeGenForTH enableCodeGenForTH logger tmpfs unit_env = enableCodeGenWhen logger tmpfs TFL_CurrentModule TFL_GhcSession unit_env + +data CodeGenEnable = EnableByteCode | EnableObject | EnableByteCodeAndObject deriving (Eq, Show, Ord) + +instance Outputable CodeGenEnable where + ppr = text . show + -- | Helper used to implement 'enableCodeGenForTH'. -- In particular, this enables -- unoptimized code generation for all modules that meet some @@ -1723,7 +1731,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = , ms_hsc_src = HsSrcFile , ms_hspp_opts = dflags } <- ms - , mkNodeKey n `Set.member` needs_codegen_set = + , Just enable_spec <- mkNodeKey n `Map.lookup` needs_codegen_map = if | nocode_enable ms -> do let new_temp_file suf dynsuf = do tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf @@ -1742,18 +1750,17 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) - -- Setting --interactive sets -fprefer-byte-code so we use interpreterBackend - -- when using -fno-code with --interactive - let new_backend = if gopt Opt_UseBytecodeRatherThanObjects dflags - then interpreterBackend - else defaultBackendOf ms + let new_dflags = case enable_spec of + EnableByteCode -> dflags { backend = interpreterBackend } + EnableObject -> dflags { backend = defaultBackendOf ms } + EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = ms_location { ml_hi_file = hi_file , ml_obj_file = o_file , ml_dyn_hi_file = dyn_hi_file , ml_dyn_obj_file = dyn_o_file } - , ms_hspp_opts = updOptLevel 0 $ dflags {backend = new_backend} + , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases enable_code_gen (ModuleNode deps ms') @@ -1761,13 +1768,13 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If -fprefer-byte-code then satisfy dependency by enabling bytecode (if normal object not enough) -- we only get to this case if the default backend is already generating object files, but we need dynamic -- objects - | bytecode_and_enable ms -> do + | bytecode_and_enable enable_spec ms -> do let ms' = ms { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ByteCodeAndObjectCode } -- Recursive call to catch the other cases enable_code_gen (ModuleNode deps ms') - | dynamic_too_enable ms -> do + | dynamic_too_enable enable_spec ms -> do let ms' = ms { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo } @@ -1790,36 +1797,35 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- can't compile anything anyway! See #16219. isHomeUnitDefinite (ue_unitHomeUnit (ms_unitid ms) unit_env) - bytecode_and_enable ms = + bytecode_and_enable enable_spec ms = -- In the situation where we **would** need to enable dynamic-too - dynamic_too_enable ms + dynamic_too_enable enable_spec ms -- but we prefer to use bytecode rather than objects && prefer_bytecode -- and we haven't already turned it on && not generate_both where lcl_dflags = ms_hspp_opts ms - -- MP: This should be a property of the module which requests this dependency - -- but I will assume it's global for now - prefer_bytecode = gopt Opt_UseBytecodeRatherThanObjects lcl_dflags + prefer_bytecode = EnableByteCodeAndObject == enable_spec generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags -- #8180 - when using TemplateHaskell, switch on -dynamic-too so -- the linker can correctly load the object files. This isn't necessary -- when using -fexternal-interpreter. - dynamic_too_enable ms + dynamic_too_enable enable_spec ms = hostIsDynamic && internalInterpreter && not isDynWay && not isProfWay && not dyn_too_enabled - -- Don't enable dynamic-too if we're handling the situation by generating bytecode. - && not (generate_both && prefer_bytecode) + && enable_object where lcl_dflags = ms_hspp_opts ms internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) dyn_too_enabled = gopt Opt_BuildDynamicToo lcl_dflags isDynWay = hasWay (ways lcl_dflags) WayDyn isProfWay = hasWay (ways lcl_dflags) WayProf - prefer_bytecode = gopt Opt_UseBytecodeRatherThanObjects lcl_dflags - generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags + enable_object = case enable_spec of + EnableByteCode -> False + EnableByteCodeAndObject -> True + EnableObject -> True -- #16331 - when no "internal interpreter" is available but we -- need to process some TemplateHaskell or QuasiQuotes, we automatically @@ -1829,18 +1835,43 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = lcl_dflags = ms_hspp_opts ms internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) - - - (mg, lookup_node) = moduleGraphNodes False mod_graph - needs_codegen_set = Set.fromList $ map (mkNodeKey . node_payload) $ reachablesG mg (map (expectJust "needs_th" . lookup_node) has_th_set) + mk_needed_set roots = Set.fromList $ map (mkNodeKey . node_payload) $ reachablesG mg (map (expectJust "needs_th" . lookup_node) roots) + + needs_obj_set, needs_bc_set :: Set.Set NodeKey + needs_obj_set = mk_needed_set need_obj_set + + needs_bc_set = mk_needed_set need_bc_set + + -- A map which tells us how to enable code generation for a NodeKey + needs_codegen_map :: Map.Map NodeKey CodeGenEnable + needs_codegen_map = + -- Another option here would be to just produce object code, rather than both object and + -- byte code + Map.unionWith (\_ _ -> EnableByteCodeAndObject) + (Map.fromList $ [(m, EnableObject) | m <- Set.toList needs_obj_set]) + (Map.fromList $ [(m, EnableByteCode) | m <- Set.toList needs_bc_set]) + + -- The direct dependencies of modules which require object code + need_obj_set = + concat + -- Note we don't need object code for a module if it uses TemplateHaskell itself. Only + -- it's dependencies. + [ deps + | (ModuleNode deps ms) <- mod_graph + , isTemplateHaskellOrQQNonBoot ms + , not (gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms)) + ] - has_th_set = - [ mkNodeKey mn - | mn@(ModuleNode _ ms) <- mod_graph - , isTemplateHaskellOrQQNonBoot ms - ] + -- The direct dependencies of modules which require byte code + need_bc_set = + concat + [ deps + | (ModuleNode deps ms) <- mod_graph + , isTemplateHaskellOrQQNonBoot ms + , gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms) + ] -- | Populate the Downsweep cache with the root modules. mkRootMap ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -1128,7 +1128,7 @@ pprModIface unit_state iface at ModIface{ mi_final_exts = exts } , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface] , case mi_extra_decls iface of Nothing -> empty - Just eds -> text "extra-decls" + Just eds -> text "extra decls:" $$ nest 2 (vcat ([ppr bs | bs <- eds])) , vcat (map ppr (mi_insts iface)) , vcat (map ppr (mi_fam_insts iface)) ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1201,6 +1201,7 @@ addFingerprints hsc_env iface0 sorted_decls = Map.elems $ Map.fromList $ [(getOccName d, e) | e@(_, d) <- decls_w_hashes] + -- This key is safe because mi_extra_decls contains tidied things. getOcc (IfGblTopBndr b) = getOccName b getOcc (IfLclTopBndr fs _ _ _) = mkVarOccFS fs ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -922,6 +922,7 @@ tc_iface_bindings (IfaceRec bs) = do rs <- mapM (\(b, rhs) -> (b,) <$> tc_iface_binding b rhs) bs return (Rec rs) +-- | See Note [Fat Interface: Sharing RHSs] tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i) tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -841,8 +841,8 @@ getLinkDeps hsc_env pls replace_osuf span mods while_linking_expr = text "while linking an interpreted expression" - -- This one is a build-system bug + -- 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 @@ -899,6 +899,31 @@ getLinkDeps hsc_env pls replace_osuf span mods adjust_ul _ l at LoadedBCOs{} = return l adjust_ul _ (FI (FatIface _ mod _)) = pprPanic "Unhydrated fat interface" (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. + +-} {- ********************************************************************** ===================================== compiler/GHC/Unit/Home/ModInfo.hs ===================================== @@ -58,18 +58,15 @@ data HomeModInfo = HomeModInfo , hm_linkable :: !HomeModLinkable -- ^ The actual artifact we would like to link to access things in - -- this module. + -- this module. See Note [Home module build products] -- - -- 'hm_linkable' might be Nothing: + -- 'hm_linkable' might be empty: -- -- 1. If this is an .hs-boot module -- -- 2. Temporarily during compilation if we pruned away -- the old linkable because it was out of date. -- - -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields - -- in the 'HomePackageTable' will be @Just at . - -- -- When re-linking a module ('GHC.Driver.Main.HscNoRecomp'), we construct the -- 'HomeModInfo' by building a new 'ModDetails' from the old -- 'ModIface' (only). @@ -84,7 +81,7 @@ homeModInfoObject = homeMod_object . hm_linkable emptyHomeModInfoLinkable :: HomeModLinkable emptyHomeModInfoLinkable = HomeModLinkable Nothing Nothing - +-- See Note [Home module build products] data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe Linkable) , homeMod_object :: !(Maybe Linkable) } @@ -106,6 +103,29 @@ bytecodeAndObjects bc o = assertPpr (not (isObjectLinkable bc) && isObjectLinkable o) (ppr bc $$ ppr o) (HomeModLinkable (Just bc) (Just o)) + +{- Note [Home module build products] + +When compiling a home module we can produce some combination of the following +build products. + +1. A byte code linkable, for use with the byte code interpreter. +2. An object file linkable, for linking a final executable or the byte code interpreter + +What we have produced is recorded in the `HomeModLinkable` type. In the case +that these linkables are produced they are stored in the relevant field so that +subsequent modules can retrieve and use them as necessary. + +* `-fbyte-code` will *only* produce a byte code linkable. This is the default in GHCi. +* `-fobject-code` will *only* produce an object file linkable. This is the default in -c and --make mode. +* `-fbyte-code-and-object-code` produces both a byte-code and object file linkable. So both fields are populated. + +Why would you want to produce both an object file and byte code linkable? If you +also want to use `-fprefer-byte-code` then you should probably also use this +flag to make sure that byte code is generated for your modules. + +-} + -- | Helps us find information about modules in the home package type HomePackageTable = DModuleNameEnv HomeModInfo -- Domain = modules in the home unit that have been fully compiled ===================================== compiler/GHC/Unit/Module/FatIface.hs ===================================== @@ -4,6 +4,56 @@ import GHC.Unit.Types (Module) import GHC.Unit.Module.Location import GHC.Iface.Syntax +{- +Note [Fat Interface Files] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A fat interface file contains everything needed in addition to the normal ModIface and ModDetails +to restart compilation after typechecking to generate bytecode. The `fi_bindings` field +is stored in the normal interface file and the other fields populated whilst loading +the interface file. + +The lifecycle of a FatInterface typically proceeds as follows: + +1. The ModIface which contains mi_extra_decls is loaded from disk. A linkable is + created which contains a `FI <>` entry. This is an unhydrated fat interface which + is currently unsuitable for linking, but at the point it is loaded, the ModIface + hasn't been hydrated yet either so the FI constructor allows the delaying of converting + the FatInterface into a proper Linkable (if we ever do that). The FI constructor also + allows us to convert the FI into multiple different linkables if we so desired. + +2. `initFatIface` turns a FatIface into a proper BCO linkable. This step combines together + all the necessary information from a ModIface, ModDetails and FatIface in order to + create the linkable. The linkable created is a "LoadedBCOs" linkable, which + was introduced just for initFatIface, so that the bytecode can be generated lazilly. + Using the `BCOs` constructor directly here leads to the bytecode being forced + too eagerly. + +3. Then when bytecode is needed, the LoadedBCOs value is inspected and unpacked and + the linkable is used as before. + +The flag `-fwrite-fat-interface` determines whether the extra information is written +to an interface file. The program which is written is the core bindings of the module +after whatever simplification the user requested has been performed. So the bindings +of the fat interface file agree with the optimisation level as reported by the interface +file. + +Note [Size of Fat Interface Files] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +How much overhead does `-fwrite-fat-interface` add to a typical interface file? +As an experiment I compiled the `Cabal` library and `ghc` library (Aug 22) with + +| Project | .hi | .hi (fat) | .o | +| --------| ---- | --------- | -- | +| ghc | 32M | 68M | 127M | +| Cabal | 3.2M | 9.8M | 14M | + +So the interface files gained in size but the end result was still smaller than +the object files. + +-} + data FatIface = FatIface { fi_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] , fi_module :: Module , fi_mod_location :: ModLocation ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -203,6 +203,7 @@ data ModIface_ (phase :: ModIfacePhase) mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo], -- ^ Extra variable definitions which are **NOT** exposed but when -- combined with mi_decls allows us to restart code generation. + -- See Note [Fat Interface Files] and Note [Fat Interface: Sharing RHSs] mi_globals :: !(Maybe GlobalRdrEnv), -- ^ Binds all the things defined at the top level in ===================================== testsuite/tests/driver/T20300/T20300.stderr ===================================== @@ -1,4 +1,4 @@ [1 of 4] Compiling T[boot] ( T.hs-boot, nothing ) [2 of 4] Compiling T ( T.hs, nothing ) -[3 of 4] Compiling S ( S.hs, S.o, S.dyn_o ) +[3 of 4] Compiling S ( S.hs, nothing ) [4 of 4] Compiling Top ( Top.hs, nothing ) ===================================== testsuite/tests/driver/T20348/B.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} +module B where + +import A ===================================== testsuite/tests/driver/T20348/Makefile ===================================== @@ -15,7 +15,7 @@ clean: T20348: clean # First run: should produce .hi, .o, .dyn_hi, .dyn_o files. echo 'first run' - '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface A.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface B.hs $(call checkExists,A.hi) $(call checkExists,A.o) $(call checkExists,A.dyn_hi) ===================================== testsuite/tests/driver/T20348/T20348.stdout ===================================== @@ -1,3 +1,4 @@ first run -[1 of 1] Compiling A ( A.hs, A.o, A.dyn_o ) +[1 of 2] Compiling A ( A.hs, A.o, A.dyn_o ) +[2 of 2] Compiling B ( B.hs, nothing ) second run ===================================== testsuite/tests/driver/T20348/all.T ===================================== @@ -1,6 +1,6 @@ # N.B. this package requires a dynamically-linked ghc-bin, since it assumes # that TH evaluation will build dynamic objects. -test('T20348', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, []) +test('T20348', [extra_files(['A.hs', 'B.hs']), unless(have_dynamic(), skip)], makefile_test, []) test('T20348A', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, []) test('T20348B', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, []) test('T20348C', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, []) ===================================== testsuite/tests/driver/T20696/T20696.stderr ===================================== @@ -1,3 +1,3 @@ [1 of 3] Compiling C ( C.hs, C.o, C.dyn_o ) -[2 of 3] Compiling B ( B.hs, B.o, B.dyn_o ) +[2 of 3] Compiling B ( B.hs, B.o ) [3 of 3] Compiling A ( A.hs, A.o ) ===================================== testsuite/tests/driver/fat-iface/FatQuote1.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} +module FatQuote1 where + +import FatQuote () + +import Language.Haskell.TH + +a :: Q Exp +a = [| () |] + + ===================================== testsuite/tests/driver/fat-iface/FatQuote2.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} +module FatQuote2 where + +import FatQuote () + +import Language.Haskell.TH + +a :: Q Exp +a = [| () |] + + ===================================== testsuite/tests/driver/fat-iface/FatTH1.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fprefer-byte-code #-} +module FatTH1 where + +import FatQuote1 + +top = $(a) ===================================== testsuite/tests/driver/fat-iface/FatTH2.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC #-} +module FatTH2 where + +import FatQuote2 + +top = $(a) ===================================== testsuite/tests/driver/fat-iface/FatTHTop.hs ===================================== @@ -0,0 +1,4 @@ +module FatTHTop where + +import FatTH1 +import FatTH2 ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -14,5 +14,6 @@ test('fat012', [unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote. test('fat013', [extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fno-code -fprefer-byte-code']) # When using interpreter should not produce objects test('fat014', [extra_files(['FatTH.hs', 'FatQuote.hs'])], makefile_test, ['fat014']) +test('fat015', [unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) ===================================== testsuite/tests/driver/fat-iface/fat008.stdout ===================================== @@ -1,3 +1,3 @@ [1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, interpreted ) -[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, interpreted ) -[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, interpreted ) [Source file changed] +[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o ) +[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o ) [Source file changed] ===================================== testsuite/tests/driver/fat-iface/fat012.stderr ===================================== @@ -1,2 +1,2 @@ [1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, interpreted ) -[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, interpreted ) +[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o ) ===================================== testsuite/tests/driver/fat-iface/fat013.stderr ===================================== @@ -1,2 +1,2 @@ [1 of 2] Compiling FatQuote ( FatQuote.hs, interpreted ) -[2 of 2] Compiling FatTH ( FatTH.hs, interpreted ) +[2 of 2] Compiling FatTH ( FatTH.hs, nothing ) ===================================== testsuite/tests/driver/fat-iface/fat014.stdout ===================================== @@ -1,3 +1,3 @@ [1 of 2] Compiling FatQuote ( FatQuote.hs, interpreted ) -[2 of 2] Compiling FatTH ( FatTH.hs, interpreted ) +[2 of 2] Compiling FatTH ( FatTH.hs, nothing ) Ok, two modules loaded. ===================================== testsuite/tests/driver/fat-iface/fat015.stderr ===================================== @@ -0,0 +1,6 @@ +[1 of 6] Compiling FatQuote ( FatQuote.hs, FatQuote.o, FatQuote.dyn_o, interpreted ) +[2 of 6] Compiling FatQuote1 ( FatQuote1.hs, interpreted ) +[3 of 6] Compiling FatQuote2 ( FatQuote2.hs, FatQuote2.o, FatQuote2.dyn_o ) +[4 of 6] Compiling FatTH1 ( FatTH1.hs, nothing ) +[5 of 6] Compiling FatTH2 ( FatTH2.hs, nothing ) +[6 of 6] Compiling FatTHTop ( FatTHTop.hs, nothing ) ===================================== testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout ===================================== @@ -1,4 +1,4 @@ [1 of 2] Compiling QuasiExpr ( QuasiExpr.hs, QuasiExpr.o, QuasiExpr.dyn_o ) -[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, QuasiQuote.o, QuasiQuote.dyn_o ) +[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, nothing ) [1 of 2] Compiling QuasiExpr ( QuasiExpr.hs, QuasiExpr.o, QuasiExpr.dyn_o ) [Missing dynamic object file] -[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, QuasiQuote.o, QuasiQuote.dyn_o ) [QuasiExpr[TH] changed] +[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, nothing ) [QuasiExpr[TH] changed] ===================================== testsuite/tests/ghci/T16670/Makefile ===================================== @@ -20,5 +20,5 @@ T16670_th: mkdir my-odir echo ":load T16670_th.hs" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) \ -v0 -fno-code -fno-prefer-byte-code -fwrite-interface -odir my-odir - find . -name T16670_th.o - test -f my-odir/T16670_th.o + find . -name TH.o + test -f my-odir/TH.o ===================================== testsuite/tests/ghci/T16670/T16670_th.stdout ===================================== @@ -1,2 +1,2 @@ ~~~~~~~~ testing T16670_th -./my-odir/T16670_th.o +./my-odir/TH.o View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/943b6f7e90df8d99bb8430fb56bd6ee84cca972d...dec02917c0a6c57e5164b0f0b5f6fb1d9e5128d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/943b6f7e90df8d99bb8430fb56bd6ee84cca972d...dec02917c0a6c57e5164b0f0b5f6fb1d9e5128d9 You're receiving 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 Aug 9 19:16:03 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 Aug 2022 15:16:03 -0400 Subject: [Git][ghc/ghc][wip/armv7l-ci] 15 commits: gitlab-ci: Introduce validation job for aarch64 cross-compilation Message-ID: <62f2b273702bb_182c4e4e0c034313d@gitlab.mail> Ben Gamari pushed to branch wip/armv7l-ci at Glasgow Haskell Compiler / GHC Commits: 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 1b03512a by Ben Gamari at 2022-08-09T15:13:46-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 857a0c34 by Ben Gamari at 2022-08-09T15:15:27-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Unit/Types.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - libraries/process - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - rts/PrimOps.cmm - rts/include/Cmm.h - + testsuite/tests/array/should_run/T21962.hs - testsuite/tests/array/should_run/all.T - testsuite/tests/linters/notes.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -206,6 +207,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +291,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +329,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" @@ -564,15 +566,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${CROSS_TARGET:-}" ]; then + args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" ) + fi + + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +618,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +641,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +807,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -116,6 +116,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +159,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } + llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -210,7 +223,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +242,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] + ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] -- | The hadrian flavour string we are going to use for this build @@ -299,7 +313,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,12 +321,19 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -475,12 +496,13 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +520,10 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -597,7 +621,8 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - + , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -766,14 +791,15 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -232,7 +232,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -271,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -329,7 +332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -392,7 +395,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -451,7 +454,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -510,7 +513,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -529,7 +532,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -569,7 +575,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -628,7 +634,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -658,7 +664,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -668,7 +674,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -677,7 +683,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -693,7 +699,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -705,17 +711,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -754,7 +760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -816,7 +822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -878,7 +884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -938,7 +944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -997,7 +1003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1056,7 +1062,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1116,7 +1122,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1175,7 +1181,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1234,7 +1240,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1293,7 +1299,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1352,7 +1358,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1378,6 +1384,67 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1413,7 +1480,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1472,7 +1539,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1531,7 +1598,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1592,7 +1659,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1654,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1715,7 +1782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1770,7 +1837,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1829,7 +1896,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1892,7 +1959,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1956,7 +2023,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2016,7 +2083,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2076,7 +2143,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2095,8 +2162,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -2136,7 +2206,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2196,7 +2266,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2227,7 +2297,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2237,7 +2307,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2246,7 +2316,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2262,7 +2332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2274,18 +2344,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2324,7 +2394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2387,7 +2457,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2450,7 +2520,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2511,7 +2581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2571,7 +2641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2631,7 +2701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2691,7 +2761,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2751,7 +2821,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2813,7 +2883,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2875,7 +2945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2938,7 +3008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2994,7 +3064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3054,7 +3124,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3118,7 +3188,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3147,7 +3217,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3157,7 +3227,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -3166,7 +3236,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3182,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3194,17 +3264,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { @@ -3242,7 +3312,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3303,7 +3373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3364,7 +3434,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3423,7 +3493,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3482,7 +3552,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3540,7 +3610,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3599,7 +3669,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3657,7 +3727,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3715,7 +3785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3773,7 +3843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3832,7 +3902,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3857,6 +3927,66 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3892,7 +4022,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3950,7 +4080,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4008,7 +4138,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -4068,7 +4198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4129,7 +4259,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4189,7 +4319,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4243,7 +4373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4301,7 +4431,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Cmm.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Cmm ( module GHC.Cmm.Expr, -- * Pretty-printing - pprCmms, pprCmmGroup, pprSection, pprStatic + pprCmmGroup, pprSection, pprStatic ) where import GHC.Prelude @@ -379,12 +379,6 @@ pprBBlock (BasicBlock ident stmts) = -- -- These conventions produce much more readable Cmm output. -pprCmms :: (OutputableP Platform info, OutputableP Platform g) - => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc -pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms)) - where - separator = space $$ text "-------------------" $$ space - pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g) => Platform -> GenCmmGroup d info g -> SDoc pprCmmGroup platform tops ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -294,9 +294,6 @@ data CLabel instance Show CLabel where show = showPprUnsafe . pprDebugCLabel genericPlatform -instance Outputable CLabel where - ppr = text . show - data ModuleLabelKind = MLK_Initializer String | MLK_InitializerArray @@ -1412,19 +1409,19 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] AsmStyle | use_leading_underscores -> pp_cSEP <> doc _ -> doc - tempLabelPrefixOrUnderscore :: Platform -> SDoc - tempLabelPrefixOrUnderscore platform = case sty of + tempLabelPrefixOrUnderscore :: SDoc + tempLabelPrefixOrUnderscore = case sty of AsmStyle -> asmTempLabelPrefix platform CStyle -> char '_' in case lbl of LocalBlockLabel u -> case sty of - AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u + AsmStyle -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u + CStyle -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u AsmTempLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u AsmTempDerivedLabel l suf -> asmTempLabelPrefix platform @@ -1474,7 +1471,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CStyle -> ppr name <> ppIdFlavor flavor SRTLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt" RtsLabel (RtsApFast (NonDetFastString str)) -> maybe_underscore $ ftext str <> text "_fast" @@ -1514,7 +1511,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr" LargeBitmapLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') -- until that gets resolved we'll just force them to start ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -50,14 +50,14 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock config top_info) blocks) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl platform lbl Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ -- pprProcAlignment config $$ (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' + then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain @@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> ppr info_lbl + <+> pdoc platform info_lbl <+> char '-' - <+> ppr (mkDeadStripPreventer info_lbl) + <+> pdoc platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -87,9 +87,6 @@ pprAlignForSection _platform _seg -- .balign is stable, whereas .align is platform dependent. = text "\t.balign 8" -- always 8 -instance Outputable Instr where - ppr = pprInstr genericPlatform - -- | Print section header and appropriate alignment for that section. -- -- This one will emit the header: @@ -118,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel asmLbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -138,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel info_lbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' else empty) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -235,7 +232,7 @@ pprImm _ (ImmInt i) = int i pprImm _ (ImmInteger i) = integer i pprImm p (ImmCLbl l) = pdoc p l pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i -pprImm _ (ImmLit s) = s +pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! pprImm _ (ImmFloat f) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -59,7 +59,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -67,14 +67,8 @@ data Imm | ImmConstantDiff Imm Imm deriving (Eq, Show) -instance Show SDoc where - show = showPprUnsafe . ppr - -instance Eq SDoc where - lhs == rhs = show lhs == show rhs - strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do let code dst = toOL [ LD II32 dst tocAddr ] - tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]")) + tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]") return (Any II32 code) | target32Bit platform = do reg <- getPicBaseNat $ archWordFormat (target32Bit platform) ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -240,7 +240,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/PPC/Regs.hs ===================================== @@ -133,7 +133,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -147,7 +147,7 @@ data Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -432,7 +432,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -55,7 +55,6 @@ import GHC.Platform.Reg.Class import GHC.Cmm import GHC.Cmm.CLabel ( CLabel ) -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -111,7 +110,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -119,7 +118,7 @@ data Imm | ImmConstantDiff Imm Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -580,10 +580,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- Cost to allocate binding with given binder size_up_alloc bndr - | isTyVar bndr -- Doesn't exist at runtime - || isJoinId bndr -- Not allocated at all - || isUnliftedType (idType bndr) -- Doesn't live in heap - -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder) + | isTyVar bndr -- Doesn't exist at runtime + || isJoinId bndr -- Not allocated at all + || not (isBoxedType (idType bndr)) -- Doesn't live in heap = 0 | otherwise = 10 ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -363,7 +363,7 @@ emitTickyCounter cloType tickee Just (CgIdInfo { cg_lf = cg_lf }) | isLFThunk cg_lf -> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf - _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -- | -- #name_types# @@ -282,24 +281,9 @@ pprOccName (OccName sp occ) = getPprStyle $ \ sty -> if codeStyle sty then ztext (zEncodeFS occ) - else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) - where - pp_occ = sdocOption sdocSuppressUniques $ \case - True -> text (strip_th_unique (unpackFS occ)) - False -> ftext occ - - -- See Note [Suppressing uniques in OccNames] - strip_th_unique ('[' : c : _) | isAlphaNum c = [] - strip_th_unique (c : cs) = c : strip_th_unique cs - strip_th_unique [] = [] + else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) {- -Note [Suppressing uniques in OccNames] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is a hack to de-wobblify the OccNames that contain uniques from -Template Haskell that have been turned into a string in the OccName. -See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs" - ************************************************************************ * * \subsection{Construction} ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -207,7 +207,7 @@ pprModule mod@(Module p n) = getPprStyle doc | qualModule sty mod = case p of HoleUnit -> angleBrackets (pprModuleName n) - _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n + _ -> ppr p <> char ':' <> pprModuleName n | otherwise = pprModuleName n ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -83,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -230,12 +195,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 7a7431a0ef586c0f1e602e382398b988c699dfc2 +Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== rts/PrimOps.cmm ===================================== @@ -350,6 +350,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; + /* Ensure that the card array is initialized */ + if (n != 0) { + setCardsValue(arr, 0, n, 0); + } + // Initialise all elements of the array with the value in R2 p = arr + SIZEOF_StgMutArrPtrs; for: ===================================== rts/include/Cmm.h ===================================== @@ -870,10 +870,11 @@ /* * Set the cards in the array pointed to by arr for an * update to n elements, starting at element dst_off to value (0 to indicate - * clean, 1 to indicate dirty). + * clean, 1 to indicate dirty). n must be non-zero. */ #define setCardsValue(arr, dst_off, n, value) \ W_ __start_card, __end_card, __cards, __dst_cards_p; \ + ASSERT(n != 0); \ __dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \ __start_card = mutArrPtrCardDown(dst_off); \ __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \ ===================================== testsuite/tests/array/should_run/T21962.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.IO +import GHC.Exts + +main :: IO () +main = do + IO $ \s0 -> case newArray# 0# () s0 of (# s1, arr #) -> (# s1, () #) ===================================== testsuite/tests/array/should_run/all.T ===================================== @@ -23,3 +23,4 @@ test('arr017', when(fast(), skip), compile_and_run, ['']) test('arr018', when(fast(), skip), compile_and_run, ['']) test('arr019', normal, compile_and_run, ['']) test('arr020', normal, compile_and_run, ['']) +test('T21962', normal, compile_and_run, ['']) ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -44,7 +44,6 @@ ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-bo ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] -ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell] ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81fbffefdd6c338b216c4f36c84fa9e073670da5...857a0c3461b5368b96176089044f9eb5ba160686 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81fbffefdd6c338b216c4f36c84fa9e073670da5...857a0c3461b5368b96176089044f9eb5ba160686 You're receiving 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 Aug 9 14:37:04 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 10:37:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: gitlab-ci: Don't use coreutils on Darwin Message-ID: <62f271104dfb9_182c4e4b85c21721f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 5f651d52 by Ben Gamari at 2022-08-09T10:36:33-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - f97a2861 by Ben Gamari at 2022-08-09T10:36:33-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - b1b4638f by Ben Gamari at 2022-08-09T10:36:33-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 6156ec32 by sheaf at 2022-08-09T10:36:41-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 24 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Unit/Types.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - testsuite/tests/linters/notes.stdout Changes: ===================================== .gitlab/ci.sh ===================================== @@ -207,6 +207,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -288,7 +291,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -326,9 +329,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -223,7 +223,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -242,7 +242,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -313,7 +313,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -321,7 +321,7 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -489,12 +489,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -512,8 +512,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -781,7 +781,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) ===================================== .gitlab/jobs.yaml ===================================== @@ -658,7 +658,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -668,7 +668,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -677,7 +677,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -705,17 +705,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2288,7 +2288,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2298,7 +2298,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2307,7 +2307,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2335,18 +2335,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -3208,7 +3208,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3218,7 +3218,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -3227,7 +3227,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3255,17 +3255,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== compiler/GHC/Cmm.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Cmm ( module GHC.Cmm.Expr, -- * Pretty-printing - pprCmms, pprCmmGroup, pprSection, pprStatic + pprCmmGroup, pprSection, pprStatic ) where import GHC.Prelude @@ -379,12 +379,6 @@ pprBBlock (BasicBlock ident stmts) = -- -- These conventions produce much more readable Cmm output. -pprCmms :: (OutputableP Platform info, OutputableP Platform g) - => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc -pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms)) - where - separator = space $$ text "-------------------" $$ space - pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g) => Platform -> GenCmmGroup d info g -> SDoc pprCmmGroup platform tops ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -294,9 +294,6 @@ data CLabel instance Show CLabel where show = showPprUnsafe . pprDebugCLabel genericPlatform -instance Outputable CLabel where - ppr = text . show - data ModuleLabelKind = MLK_Initializer String | MLK_InitializerArray @@ -1412,19 +1409,19 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] AsmStyle | use_leading_underscores -> pp_cSEP <> doc _ -> doc - tempLabelPrefixOrUnderscore :: Platform -> SDoc - tempLabelPrefixOrUnderscore platform = case sty of + tempLabelPrefixOrUnderscore :: SDoc + tempLabelPrefixOrUnderscore = case sty of AsmStyle -> asmTempLabelPrefix platform CStyle -> char '_' in case lbl of LocalBlockLabel u -> case sty of - AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u + AsmStyle -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u + CStyle -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u AsmTempLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u AsmTempDerivedLabel l suf -> asmTempLabelPrefix platform @@ -1474,7 +1471,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CStyle -> ppr name <> ppIdFlavor flavor SRTLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt" RtsLabel (RtsApFast (NonDetFastString str)) -> maybe_underscore $ ftext str <> text "_fast" @@ -1514,7 +1511,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr" LargeBitmapLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') -- until that gets resolved we'll just force them to start ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -50,14 +50,14 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock config top_info) blocks) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl platform lbl Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ -- pprProcAlignment config $$ (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' + then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain @@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> ppr info_lbl + <+> pdoc platform info_lbl <+> char '-' - <+> ppr (mkDeadStripPreventer info_lbl) + <+> pdoc platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -87,9 +87,6 @@ pprAlignForSection _platform _seg -- .balign is stable, whereas .align is platform dependent. = text "\t.balign 8" -- always 8 -instance Outputable Instr where - ppr = pprInstr genericPlatform - -- | Print section header and appropriate alignment for that section. -- -- This one will emit the header: @@ -118,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel asmLbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -138,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel info_lbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' else empty) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -235,7 +232,7 @@ pprImm _ (ImmInt i) = int i pprImm _ (ImmInteger i) = integer i pprImm p (ImmCLbl l) = pdoc p l pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i -pprImm _ (ImmLit s) = s +pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! pprImm _ (ImmFloat f) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -59,7 +59,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -67,14 +67,8 @@ data Imm | ImmConstantDiff Imm Imm deriving (Eq, Show) -instance Show SDoc where - show = showPprUnsafe . ppr - -instance Eq SDoc where - lhs == rhs = show lhs == show rhs - strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do let code dst = toOL [ LD II32 dst tocAddr ] - tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]")) + tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]") return (Any II32 code) | target32Bit platform = do reg <- getPicBaseNat $ archWordFormat (target32Bit platform) ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -240,7 +240,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/PPC/Regs.hs ===================================== @@ -133,7 +133,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -147,7 +147,7 @@ data Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -432,7 +432,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -55,7 +55,6 @@ import GHC.Platform.Reg.Class import GHC.Cmm import GHC.Cmm.CLabel ( CLabel ) -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -111,7 +110,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -119,7 +118,7 @@ data Imm | ImmConstantDiff Imm Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -580,10 +580,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- Cost to allocate binding with given binder size_up_alloc bndr - | isTyVar bndr -- Doesn't exist at runtime - || isJoinId bndr -- Not allocated at all - || isUnliftedType (idType bndr) -- Doesn't live in heap - -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder) + | isTyVar bndr -- Doesn't exist at runtime + || isJoinId bndr -- Not allocated at all + || not (isBoxedType (idType bndr)) -- Doesn't live in heap = 0 | otherwise = 10 ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -363,7 +363,7 @@ emitTickyCounter cloType tickee Just (CgIdInfo { cg_lf = cg_lf }) | isLFThunk cg_lf -> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf - _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -- | -- #name_types# @@ -282,24 +281,9 @@ pprOccName (OccName sp occ) = getPprStyle $ \ sty -> if codeStyle sty then ztext (zEncodeFS occ) - else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) - where - pp_occ = sdocOption sdocSuppressUniques $ \case - True -> text (strip_th_unique (unpackFS occ)) - False -> ftext occ - - -- See Note [Suppressing uniques in OccNames] - strip_th_unique ('[' : c : _) | isAlphaNum c = [] - strip_th_unique (c : cs) = c : strip_th_unique cs - strip_th_unique [] = [] + else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) {- -Note [Suppressing uniques in OccNames] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is a hack to de-wobblify the OccNames that contain uniques from -Template Haskell that have been turned into a string in the OccName. -See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs" - ************************************************************************ * * \subsection{Construction} ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -207,7 +207,7 @@ pprModule mod@(Module p n) = getPprStyle doc | qualModule sty mod = case p of HoleUnit -> angleBrackets (pprModuleName n) - _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n + _ -> ppr p <> char ':' <> pprModuleName n | otherwise = pprModuleName n ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -83,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -230,12 +195,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -44,7 +44,6 @@ ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-bo ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] -ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell] ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae347f59f5d3885cdba7f4542872c37ef7bc5c59...6156ec32e3ea9b55072d175cd8cf8856f867d268 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae347f59f5d3885cdba7f4542872c37ef7bc5c59...6156ec32e3ea9b55072d175cd8cf8856f867d268 You're receiving 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 Aug 12 13:45:15 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 Aug 2022 09:45:15 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] 19 commits: users-guide: Fix typo in release notes Message-ID: <62f6596bb4e08_3d814948990516524@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: 2441c2f4 by Ben Gamari at 2022-08-12T09:44:50-04:00 users-guide: Fix typo in release notes - - - - - dae00493 by Ben Gamari at 2022-08-12T09:44:50-04:00 users-guide: Fix incorrect directives - - - - - ddd0a67f by Ben Gamari at 2022-08-12T09:44:50-04:00 relnotes: Reintroduce "included libraries" section As requested in #21988. - - - - - 05a86964 by Ben Gamari at 2022-08-12T09:44:50-04:00 make: Fix bootstrapping with profiling enabled 12ae2a9cf89af3ae9e4df051818b631cf213a1b8 attempted to work around a make build system deficiency by adding some dependencies from modules of `containers` which contain TH splices to the `template-haskell` package. However, it only did this for the vanilla way. Here we add similar edges for profiled objects. Fixes #21987. - - - - - b51ceb1f by normalcoder at 2022-08-12T09:44:50-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms (cherry picked from commit 67575f2004340564d6e52af055ed6fb43d3f9711) - - - - - b265e7e8 by Ben Gamari at 2022-08-12T09:44:50-04:00 gitlab-ci: Add release job for aarch64/debian 11 (cherry picked from commit 5765e13370634979eb6a0d9f67aa9afa797bee46) - - - - - 1796e7af by Ben Gamari at 2022-08-12T09:44:50-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. (cherry picked from commit c1c08bd829fb33a185f0a71f08babe5d7e6556fc) - - - - - 620e1220 by Ben Gamari at 2022-08-12T09:44:50-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. (cherry picked from commit 1c582f44e41f534a8506a76618f6cffe5d71ed42) - - - - - 93c23a9b by Ben Gamari at 2022-08-12T09:44:50-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. (cherry picked from commit 681aa076259c05c626266cf516de7e7c5524eadb) - - - - - 3c141e59 by Ben Gamari at 2022-08-12T09:44:50-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. (cherry picked from commit 844df61e8de5e2d9a058e6cbe388802755fc0305) (cherry picked from commit d8961a2dc974b7f8f8752781c4aec261ae8f8c0f) - - - - - 9668b7dc by Ben Gamari at 2022-08-12T09:44:50-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt (cherry picked from commit 5d66a0ce39f47b7b9f6c732a18ac6e102a21ee6b) - - - - - cd616c13 by Ben Gamari at 2022-08-12T09:44:50-04:00 gitlab-ci: Bump to use freebsd13 runners (cherry picked from commit ea90e61dc3c6ba0433e008284dc6c3970ead98a7) - - - - - dc2a3098 by sheaf at 2022-08-12T09:44:50-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 (cherry picked from commit d71a20514546e0befe6e238d0658cbaad5a13996) - - - - - 7a4421b8 by Douglas Wilson at 2022-08-12T09:44:50-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. (cherry picked from commit 76b52cf0c52ee05c20f7d1b80f5600eecab3c42a) - - - - - 33cfc545 by Douglas Wilson at 2022-08-12T09:44:50-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. (cherry picked from commit 7589ee7241d46b393979d98d4ded17a15ee974fb) - - - - - 87d1880c by Jens Petersen at 2022-08-12T09:44:50-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally (cherry picked from commit 823fe5b56450a7eefbf41ce8ece34095bf2217ee) - - - - - 29a74757 by Ben Gamari at 2022-08-12T09:44:50-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. (cherry picked from commit 5bc489cac104717f09be73f2b578719bcc1e3fcb) - - - - - 638b21a3 by Ben Gamari at 2022-08-12T09:44:50-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. (cherry picked from commit 7cabea7c9b10d2d15a4798be9f3130994393dd9c) - - - - - 29319daf by Ben Gamari at 2022-08-12T09:44:50-04:00 relnotes: Fix typo - - - - - 18 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Core/Unfold.hs - docs/users_guide/9.4.1-notes.rst - ghc.mk - hadrian/bindist/Makefile - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/Event/Thread.hs - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - + testsuite/tests/concurrent/should_run/T21651.hs - + testsuite/tests/concurrent/should_run/T21651.stdout - testsuite/tests/concurrent/should_run/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +290,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +328,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,7 +299,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,12 +307,19 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -475,12 +482,13 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +506,10 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,10 +776,11 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -155,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -174,7 +232,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -213,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -271,7 +332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -334,7 +395,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -358,6 +419,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -393,7 +513,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -412,7 +532,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -452,7 +575,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -511,7 +634,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -541,7 +664,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +674,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +683,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -576,7 +699,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -588,17 +711,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -637,7 +760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -699,7 +822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -761,7 +884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -821,7 +944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -880,7 +1003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -939,7 +1062,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -999,7 +1122,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1058,7 +1181,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1117,7 +1240,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1176,7 +1299,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1235,7 +1358,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1296,7 +1419,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1355,7 +1478,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1414,7 +1537,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1475,7 +1598,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1537,7 +1660,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1598,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1776,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1712,7 +1835,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1775,7 +1898,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1839,7 +1962,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1864,6 +1987,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1899,7 +2082,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1918,8 +2101,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -1959,7 +2145,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2019,7 +2205,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2050,7 +2236,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2246,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2255,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2085,7 +2271,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2097,18 +2283,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2147,7 +2333,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2210,7 +2396,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2273,7 +2459,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2334,7 +2520,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2394,7 +2580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2454,7 +2640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2514,7 +2700,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2574,7 +2760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2636,7 +2822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2698,7 +2884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2761,7 +2947,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2817,7 +3003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2877,7 +3063,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2941,7 +3127,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2970,7 +3156,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +3166,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +3175,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3005,7 +3191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3017,17 +3203,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { @@ -3065,7 +3251,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3126,7 +3312,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3187,7 +3373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3246,7 +3432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3305,7 +3491,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3363,7 +3549,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3608,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3480,7 +3666,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3538,7 +3724,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3596,7 +3782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3655,7 +3841,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3715,7 +3901,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3773,7 +3959,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3831,7 +4017,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3891,7 +4077,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3952,7 +4138,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4012,7 +4198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4066,7 +4252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4124,7 +4310,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -580,10 +580,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- Cost to allocate binding with given binder size_up_alloc bndr - | isTyVar bndr -- Doesn't exist at runtime - || isJoinId bndr -- Not allocated at all - || isUnliftedType (idType bndr) -- Doesn't live in heap - -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder) + | isTyVar bndr -- Doesn't exist at runtime + || isJoinId bndr -- Not allocated at all + || not (isBoxedType (idType bndr)) -- Doesn't live in heap = 0 | otherwise = 10 ===================================== docs/users_guide/9.4.1-notes.rst ===================================== @@ -31,7 +31,7 @@ upgrading to GHC 9.4: and are deprecated, having been superceded by the now levity-polymorphic ``Array#`` type. -- The type equality operator, ``(~)``, is not considered to be a type operator +- The type equality operator, ``(~)``, is now considered to be a type operator (exported from ``Prelude``) and therefore requires the enabling of the :extension:`TypeOperators` extension rather than :extension:`GADTs` or :extension:`TypeFamilies` as was sufficient previously. @@ -62,7 +62,7 @@ Language - GHC Proposal `#511 `_ has been implemented, introducing a new language extension, - :lang-ext:`DeepSubsumption`. This extension allows the user + :extension:`DeepSubsumption`. This extension allows the user to opt-in to the deep type subsumption-checking behavior implemented by GHC 8.10 and earlier. @@ -104,7 +104,7 @@ Language - GHC Proposal `#302 `_ has been implemented. This means under ``-XLambdaCase``, a new expression heralded by ``\cases`` is available, which works like ``\case`` but can match on multiple patterns. - This means constructor patterns with arguments have to parenthesized here, + This means constructor patterns with arguments have to be parenthesized here, just like in lambda expressions. - The parsing of implicit parameters is slightly more permissive, as GHC now allows :: @@ -283,7 +283,7 @@ Runtime system ~~~~~~~~~~~~~~~~ - ``GHC.Generics`` now provides a set of newtypes, ``Generically`` and - ``Generically1``, for deriving generic instances via :lang-ext:`DerivingVia`. + ``Generically1``, for deriving generic instances via :extension:`DerivingVia`. ``Generically`` instances include ``Semigroup`` and ``Monoid``. - There's a new special function ``withDict`` in ``GHC.Exts``: :: @@ -513,3 +513,50 @@ Runtime system - The ``link`` field of ``GHC.Exts.Heap.WeakClosure`` has been replaced with a ``weakLink`` field which is ``Nothing`` if and only if ``link`` would have been NULL. + + +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 + ===================================== ghc.mk ===================================== @@ -510,6 +510,11 @@ libraries/containers/containers/dist-install/build/Data/Graph.o: libraries/templ libraries/containers/containers/dist-install/build/Data/Set/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi libraries/containers/containers/dist-install/build/Data/IntSet/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/IntMap/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Graph.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Set/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/IntSet/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi + ifeq "$(BIGNUM_BACKEND)" "gmp" GMP_ENABLED = YES libraries/ghc-bignum_CONFIGURE_OPTS += --configure-option="--with-gmp" ===================================== hadrian/bindist/Makefile ===================================== @@ -22,43 +22,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -82,6 +45,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -216,10 +181,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ @@ -227,12 +194,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -349,6 +349,7 @@ bindistInstallFiles = , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in", "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -278,6 +278,7 @@ runTestBuilderArgs = builder Testsuite ? do where emitWhenSet Nothing _ = mempty emitWhenSet (Just v) f = f v + stageNumber :: Stage -> Int stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot" stageNumber (Stage0 InTreeLibs) = 1 stageNumber Stage1 = 2 ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Event.Thread -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) @@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, - threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) + threadStatus, writeTVar, newTVarIO, readTVar, retry, + throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, @@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM +import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) @@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () -closeFdWith close fd = do - eventManagerArray <- readIORef eventManager - let (low, high) = boundsIOArray eventManagerArray - mgrs <- flip mapM [low..high] $ \i -> do - Just (_,!mgr) <- readIOArray eventManagerArray i - return mgr - -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. - -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have - -- to use uninterruptible mask. - uninterruptibleMask_ $ do - tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd - cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables - close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) +closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys) + -- The array inside 'eventManager' can be swapped out at any time, see + -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by + -- checking the array bounds before and after. When such a swap has + -- happened we cleanup and try again + close_loop = do + eventManagerArray <- readIORef eventManager + let ema_bounds@(low, high) = boundsIOArray eventManagerArray + mgrs <- flip mapM [low..high] $ \i -> do + Just (_,!mgr) <- readIOArray eventManagerArray i + return mgr + + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. + -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have + -- to use uninterruptible mask. + join $ uninterruptibleMask_ $ do + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager + -- Here we exploit Note [The eventManager Array] + if new_ema_bounds /= ema_bounds + then do + -- the array has been modified. + -- mgrs still holds the right EventManagers, by the Note. + -- new_ema_bounds must be larger than ema_bounds, by the note. + -- return the MVars we took and try again + sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables + pure close_loop + else do + -- We surely have taken all the appropriate MVars. Even if the array + -- has been swapped, our mgrs is still correct. + -- Remove the Fd from all callback tables, close the Fd, and run all + -- callbacks. + cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables + close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) + pure (pure ()) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId - (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager - mmgr <- readIOArray eventManagerArray cap - return $ fmap snd mmgr + let r = boundsIOArray eventManagerArray + (cap, _) <- threadCapability t + -- It is possible that we've just increased the number of capabilities and the + -- new EventManager has not yet been constructed by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- Two options to proceed: + -- 1) return the EventManager for capability 0. This is guaranteed to exist, + -- and "shouldn't" cause any correctness issues. + -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, + -- because we must be on a brand capability and there must be a call to + -- 'ioManagerCapabilitiesChanged' pending. + -- + -- We take the second option, with the yield, judging it the most robust. + if not (inRange r cap) + then yield >> getSystemEventManager + else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do @@ -191,6 +229,22 @@ getSystemEventManager_ = do foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A mutable array holding the current EventManager for each capability +-- An entry is Nothing only while the eventmanagers are initialised, see +-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'. +-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality +-- 'cap'. +-- The array will be swapped with newer arrays when the number of capabilities +-- changes(via 'setNumCapabilities'). However: +-- * the size of the arrays will never decrease; and +-- * The 'EventManager's in the array are not replaced with other +-- 'EventManager' constructors. +-- +-- This is a similar strategy as the rts uses for it's +-- capabilities array (n_capabilities is the size of the array, +-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities @@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged = startIOManagerThread new_eventManagerArray -- update the event manager array reference: - writeIORef eventManager new_eventManagerArray + atomicWriteIORef eventManager new_eventManagerArray + -- We need an atomic write here because 'eventManager' is accessed + -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== testsuite/tests/concurrent/should_run/T21651.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test is adapted from setnumcapabilities001. + +import GHC.Conc hiding (threadWaitRead, threadWaitWrite) +import GHC.Exts +import GHC.IO.Encoding +import System.Environment +import System.IO +import Control.Monad +import Text.Printf +import Data.Time.Clock +import Control.DeepSeq + +import System.Posix.IO +import System.Posix.Types +import Control.Concurrent +import Control.Exception + +passTheParcel :: Int -> IO (IO ()) +passTheParcel n = do + pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe + rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do + let + read = fdRead readfd $ fromIntegral 1 + write = fdWrite writefd + mv <- newEmptyMVar + tid <- forkIO $ let + loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do + threadWaitRead readfd + (s, _) <- read + threadWaitWrite writefd + write s + cleanup = do + closeFdWith closeFd readfd + closeFdWith closeFd writefd + putMVar mv () + in loop `finally` cleanup + pure (mv, tid) + + let + cleanup = do + killThread tid1 + forM_ rs $ \(mv, _) -> takeMVar mv + + fdWrite (snd p1) "a" + pure cleanup + + +main = do + setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale + [n,q,t,z] <- fmap (fmap read) getArgs + cleanup_ptp <- passTheParcel z + t <- forkIO $ do + forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do + setNumCapabilities m + threadDelay t + printf "%d\n" (nqueens q) + cleanup_ptp + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 + +nqueens :: Int -> Int +nqueens nq = length (pargen 0 []) + where + safe :: Int -> Int -> [Int] -> Bool + safe x d [] = True + safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l + + gen :: [[Int]] -> [[Int]] + gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] + + pargen :: Int -> [Int] -> [[Int]] + pargen n b + | n >= threshold = iterate gen [b] !! (nq - n) + | otherwise = concat bs + where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq + + threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x ===================================== testsuite/tests/concurrent/should_run/T21651.stdout ===================================== @@ -0,0 +1 @@ +14200 ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, ['']) test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2', 'nonmoving_thr']), + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), extra_run_opts('8 12 2000'), when(have_thread_sanitizer(), expect_broken(18808)), req_smp ], compile_and_run, ['']) +test('T21651', + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), + when(opsys('mingw32'),skip), # uses POSIX pipes + when(opsys('darwin'),extra_run_opts('8 12 2000 100')), + unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files + req_smp ], + compile_and_run, ['']) + test('hs_try_putmvar001', [ when(opsys('mingw32'),skip), # uses pthread APIs in the C code View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/480b066d06e6f7a0fa66c0e73e917935a76390a9...29319dafda95f95f2b2b9f2444b319d8026ab187 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/480b066d06e6f7a0fa66c0e73e917935a76390a9...29319dafda95f95f2b2b9f2444b319d8026ab187 You're receiving 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 Aug 8 00:05:11 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 20:05:11 -0400 Subject: [Git][ghc/ghc][wip/armv7l-ci] Debug Message-ID: <62f0533710a27_25b0164bff035832@gitlab.mail> Ben Gamari pushed to branch wip/armv7l-ci at Glasgow Haskell Compiler / GHC Commits: fe615e4e by Ben Gamari at 2022-08-07T20:05:03-04:00 Debug - - - - - 1 changed file: - .gitlab/jobs.yaml Changes: ===================================== .gitlab/jobs.yaml ===================================== @@ -177,7 +177,8 @@ "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", "GccUseLdOpt": "-fuse-ld=gold", "LD": "ld.gold", - "TEST_ENV": "armv7-linux-deb10-validate" + "TEST_ENV": "armv7-linux-deb10-validate", + "HADRIAN_ARGS": "--test-verbose=4" } }, "i386-linux-deb9-validate": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe615e4ee9ec0628ee4ef65a0ff1a40f635fbca5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe615e4ee9ec0628ee4ef65a0ff1a40f635fbca5 You're receiving 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 Aug 10 11:34:50 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 07:34:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: testsuite: 21651 add test for closeFdWith + setNumCapabilities Message-ID: <62f397da9b2ca_d270451a7c242120@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - 47d40d72 by Sylvain Henry at 2022-08-10T07:34:30-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - b8c39e66 by Ben Gamari at 2022-08-10T07:34:37-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - ad23cf01 by Ben Gamari at 2022-08-10T07:34:37-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Plugins.hs - + compiler/GHC/Driver/Plugins/External.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/ghc.cabal.in - docs/users_guide/bugs.rst - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/binary_literals.rst - docs/users_guide/exts/constrained_class_methods.rst - docs/users_guide/exts/constraint_kind.rst - docs/users_guide/exts/datatype_contexts.rst - docs/users_guide/exts/deriving_extra.rst - docs/users_guide/exts/duplicate_record_fields.rst - docs/users_guide/exts/empty_case.rst - docs/users_guide/exts/empty_data_deriving.rst - docs/users_guide/exts/existential_quantification.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/explicit_namespaces.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/field_selectors.rst - docs/users_guide/exts/flexible_contexts.rst - docs/users_guide/exts/functional_dependencies.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/generics.rst - docs/users_guide/exts/hex_float_literals.rst - docs/users_guide/exts/import_qualified_post.rst - docs/users_guide/exts/instances.rst - docs/users_guide/exts/kind_signatures.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c8dd6ffcf2d07c626a652153aac8613e823d2fb...ad23cf018d60114800361644e690065c340b1234 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c8dd6ffcf2d07c626a652153aac8613e823d2fb...ad23cf018d60114800361644e690065c340b1234 You're receiving 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 Aug 12 12:38:32 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 Aug 2022 08:38:32 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] Docs updates Message-ID: <62f649c89fb9b_3d814948828493074@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 91498f0b by Matthew Pickering at 2022-08-12T13:38:25+01:00 Docs updates - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -625,6 +625,11 @@ Options affecting code generation Omit code generation (and all later phases) altogether. This is useful if you're only interested in type checking code. + If a module contains a Template Haskell splice then in ``--make`` mode, code + generation will be automatically turned on for all dependencies. By default + object files are generated but if ghc-flag:`-fprefer-byte-code` is enable then + byte-code will be generated instead. + .. ghc-flag:: -fwrite-interface :shortdesc: Always write interface files :type: dynamic @@ -637,12 +642,16 @@ Options affecting code generation compiling dependencies. .. ghc-flag:: -fwrite-fat-interface - :shortdesc: Always write fat interface files + :shortdesc: Write a fat interface file :type: dynamic :category: codegen A fat interface file is one which contains all the bindings for a module. From - a fat interface file we can restart code generation to produce byte code. + a fat interface file we can restart code generation to produce byte-code. + + The definition of bindings which are included in a fat interface file + depend on the optimisation level. Any definitions which are already included in + an interface file (via an unfolding for an exported identifier) are reused. .. ghc-flag:: -fobject-code @@ -652,7 +661,7 @@ Options affecting code generation Generate object code. This is the default outside of GHCi, and can be used with GHCi to cause object code to be generated in preference - to bytecode. Therefore this flag disables :ghc-flag:`-fbyte-code-and-object-code`. + to byte-code. Therefore this flag disables :ghc-flag:`-fbyte-code-and-object-code`. .. ghc-flag:: -fbyte-code :shortdesc: Generate byte-code @@ -665,20 +674,18 @@ Options affecting code generation reversing the effect of :ghc-flag:`-fobject-code`. .. ghc-flag:: -fbyte-code-and-object-code - :shortdesc: Generate object code and bytecode + :shortdesc: Generate object code and byte-code :type: dynamic :category: codegen - Generate object code and byte code. This is useful with the flags + Generate object code and byte-code. This is useful with the flags :ghc-flag:`-fprefer-byte-code` and :ghc-flag:`-fwrite-fat-interface`. + This flag implies :ghc-flag:`-fwrite-fat-interface`. + :ghc-flag:`-fbyte-code` and :ghc-flag:`-fobject-code` disable this flag as they specify that GHC should *only* write object code or byte-code respectively. - - - - .. ghc-flag:: -fPIC :shortdesc: Generate position-independent code (where available) :type: dynamic @@ -772,16 +779,20 @@ Options affecting code generation .. ghc-flag:: -fprefer-byte-code - :shortdesc: Use bytecode if it is available to run TH splices + :shortdesc: Use byte-code if it is available to evaluate TH splices :type: dynamic :category: codegen - If a home package module has byte code available then use that instead of + If a home package module has byte-code available then use that instead of and object file (if that's available) to evaluate and run TH splices. This is useful with flags such as :ghc-flag:`-fbyte-code-and-object-code`, which tells the compiler to generate byte-code, and :ghc-flag:`-fwrite-fat-interface` which - allows byte code to be generated from an interface file. + allows byte-code to be generated from an interface file. + + This flag also interacts with :ghc-flag:`-fno-code`, if this flag is enabled + then any modules which are required to be compiled for Template Haskell evaluation + will generate byte-code rather than object code. .. _options-linker: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91498f0b50fc29c9bb69d324df6964c8da821d94 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91498f0b50fc29c9bb69d324df6964c8da821d94 You're receiving 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 Aug 10 10:25:24 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 Aug 2022 06:25:24 -0400 Subject: [Git][ghc/ghc][wip/unfolding-leaks] 2 commits: core stats: Count the number of binders Message-ID: <62f38794197d4_d27044b82022437b@gitlab.mail> Matthew Pickering pushed to branch wip/unfolding-leaks at Glasgow Haskell Compiler / GHC Commits: 5863a12e by Matthew Pickering at 2022-08-10T11:25:14+01:00 core stats: Count the number of binders Counting the number of binders allows you to place reasonable bounds on how many IdInfo you expect to be alive in a program. - - - - - 5353d311 by Matthew Pickering at 2022-08-10T11:25:14+01:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. - - - - - 3 changed files: - compiler/GHC/Core/Stats.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Tidy.hs Changes: ===================================== compiler/GHC/Core/Stats.hs ===================================== @@ -26,26 +26,30 @@ data CoreStats = CS { cs_tm :: !Int -- Terms , cs_ty :: !Int -- Types , cs_co :: !Int -- Coercions , cs_vb :: !Int -- Local value bindings - , cs_jb :: !Int } -- Local join bindings + , cs_jb :: !Int -- Local join bindings + , cs_bs :: !Int -- Total binding sites (local and global) + } instance Outputable CoreStats where - ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5 }) + ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5, cs_bs = i6 }) = braces (sep [text "terms:" <+> intWithCommas i1 <> comma, text "types:" <+> intWithCommas i2 <> comma, text "coercions:" <+> intWithCommas i3 <> comma, text "joins:" <+> intWithCommas i5 <> char '/' <> - intWithCommas (i4 + i5) ]) + intWithCommas (i4 + i5) <> comma, + text "binders:" <+> intWithCommas i6 ]) plusCS :: CoreStats -> CoreStats -> CoreStats -plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1 }) - (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2 }) +plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1, cs_bs = b1 }) + (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2, cs_bs = b2 }) = CS { cs_tm = p1+p2, cs_ty = q1+q2, cs_co = r1+r2, cs_vb = v1+v2 - , cs_jb = j1+j2 } + , cs_jb = j1+j2, cs_bs = b1 + b2 } -zeroCS, oneTM :: CoreStats -zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0 } +zeroCS, oneTM, oneBinder :: CoreStats +zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0, cs_bs = 0 } oneTM = zeroCS { cs_tm = 1 } +oneBinder = zeroCS { cs_bs = 1 } sumCS :: (a -> CoreStats) -> [a] -> CoreStats sumCS f = foldl' (\s a -> plusCS s (f a)) zeroCS @@ -61,13 +65,13 @@ bindingStats :: TopLevelFlag -> Var -> CoreExpr -> CoreStats bindingStats top_lvl v r = letBndrStats top_lvl v `plusCS` exprStats r bndrStats :: Var -> CoreStats -bndrStats v = oneTM `plusCS` tyStats (varType v) +bndrStats v = oneTM `plusCS` tyStats (varType v) `plusCS` oneBinder letBndrStats :: TopLevelFlag -> Var -> CoreStats letBndrStats top_lvl v | isTyVar v || isTopLevel top_lvl = bndrStats v - | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats - | otherwise = oneTM { cs_vb = 1 } `plusCS` ty_stats + | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats `plusCS` oneBinder + | otherwise = oneTM { cs_vb = 1 } `plusCS` ty_stats `plusCS` oneBinder where ty_stats = tyStats (varType v) @@ -89,7 +93,7 @@ altStats (Alt _ bs r) = altBndrStats bs `plusCS` exprStats r altBndrStats :: [Var] -> CoreStats -- Charge one for the alternative, not for each binder -altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs +altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs `plusCS` zeroCS { cs_bs = length vs } tyStats :: Type -> CoreStats tyStats ty = zeroCS { cs_ty = typeSize ty } ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -2153,7 +2153,8 @@ cpCloneBndr env bndr -- Drop (now-useless) rules/unfoldings -- See Note [Drop unfoldings and rules] -- and Note [Preserve evaluatedness] in GHC.Core.Tidy - ; let unfolding' = trimUnfolding (realIdUnfolding bndr) + -- And force it.. otherwise the old unfolding is just retained. + ; let !unfolding' = trimUnfolding (realIdUnfolding bndr) -- Simplifier will set the Id's unfolding bndr'' = bndr' `setIdUnfolding` unfolding' ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1285,12 +1285,13 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf --------- Unfolding ------------ unf_info = realUnfoldingInfo idinfo - unfold_info + -- Force this, otherwise the old unfolding is retained + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs | otherwise = minimal_unfold_info - minimal_unfold_info = trimUnfolding unf_info + !minimal_unfold_info = trimUnfolding unf_info unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04faaf347948e883f7b3d4978b3b59dfe6b46ea...5353d311d2da4aee9405b61fcc41f056963a5365 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04faaf347948e883f7b3d4978b3b59dfe6b46ea...5353d311d2da4aee9405b61fcc41f056963a5365 You're receiving 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 Aug 10 13:54:21 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 09:54:21 -0400 Subject: [Git][ghc/ghc][wip/kill-make] 54 commits: Improve BUILD_PAP comments Message-ID: <62f3b88d23b61_142b49521d450763@gitlab.mail> Ben Gamari pushed to branch wip/kill-make at Glasgow Haskell Compiler / GHC Commits: e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - 7342e646 by Ben Gamari at 2022-08-10T09:53:14-04:00 validate: Drop --legacy flag - - - - - 02522e9f by Ben Gamari at 2022-08-10T09:53:14-04:00 Drop make build system - - - - - a0e146d0 by Ben Gamari at 2022-08-10T09:53:14-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - e4d97eb8 by Ben Gamari at 2022-08-10T09:53:14-04:00 gitlab-ci: Drop make build validation jobs - - - - - a5576161 by Ben Gamari at 2022-08-10T09:53:14-04:00 hadrian: Fix whitespace - - - - - 7a2a5a25 by Ben Gamari at 2022-08-10T09:53:14-04:00 Notes - - - - - 9556c562 by Ben Gamari at 2022-08-10T09:53:14-04:00 Drop MAKEHELP.md - - - - - 8bb64d4c by Ben Gamari at 2022-08-10T09:53:14-04:00 Drop hc-build script This has not worked for many, many years. - - - - - 0c0930de by Ben Gamari at 2022-08-10T09:53:14-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 9cc04f9b by Ben Gamari at 2022-08-10T09:53:14-04:00 Drop mk/{build,install,config}.mk.in - - - - - 41a01daf by Ben Gamari at 2022-08-10T09:53:14-04:00 compiler: Drop comment references to make - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/555754d69f087647d01441da6344e3b92fa6871d...41a01daf46b9c614fd5fdff392c6100fdfb99880 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/555754d69f087647d01441da6344e3b92fa6871d...41a01daf46b9c614fd5fdff392c6100fdfb99880 You're receiving 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 Aug 11 20:20:16 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 Aug 2022 16:20:16 -0400 Subject: [Git][ghc/ghc][master] EPA: DotFieldOcc does not have exact print annotations Message-ID: <62f564801de5a_142b495215c4646c9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - 30 changed files: - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Expr.hs - testsuite/tests/parser/should_compile/T14189.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff67c79ee742024ca0ef41a9a7e540e1662d46bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff67c79ee742024ca0ef41a9a7e540e1662d46bd You're receiving 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 Aug 8 04:50:55 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 00:50:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/aarch64-deb11 Message-ID: <62f0962f363bc_25b0164cff43869b3@gitlab.mail> Ben Gamari pushed new branch wip/aarch64-deb11 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/aarch64-deb11 You're receiving 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 Aug 9 06:32:00 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 02:32:00 -0400 Subject: [Git][ghc/ghc][master] hadrian: Fix access mode of installed package registration files Message-ID: <62f1ff60e5b5c_182c4e4e0c076237@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -46,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/681aa076259c05c626266cf516de7e7c5524eadb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/681aa076259c05c626266cf516de7e7c5524eadb You're receiving 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 Aug 9 19:20:49 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 Aug 2022 15:20:49 -0400 Subject: [Git][ghc/ghc][wip/T21976] 19 commits: NCG(x86): Compile add+shift as lea if possible. Message-ID: <62f2b391ca37e_182c4e4e0c03476b2@gitlab.mail> Ben Gamari pushed to branch wip/T21976 at Glasgow Haskell Compiler / GHC Commits: 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - bf60d0f6 by Ben Gamari at 2022-08-09T15:20:44-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Unit/Types.hs - docs/users_guide/bugs.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - libraries/process - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - rts/PrimOps.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea9adfd98af8326de0cd27625b0fb960d115f68d...bf60d0f6088c3d21f106e3141da716030ed12167 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea9adfd98af8326de0cd27625b0fb960d115f68d...bf60d0f6088c3d21f106e3141da716030ed12167 You're receiving 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 Aug 11 20:20:50 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 Aug 2022 16:20:50 -0400 Subject: [Git][ghc/ghc][master] Revert "gitlab-ci: Add release job for aarch64/debian 11" Message-ID: <62f564a228df3_142b49517fc46786b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -794,7 +794,6 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) - , disableValidate (standardBuilds AArch64 (Linux Debian11)) , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) ===================================== .gitlab/jobs.yaml ===================================== @@ -120,64 +120,6 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", - "junit.xml" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "aarch64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", - "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": [ - "aarch64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", - "TEST_ENV": "aarch64-linux-deb11-validate" - } - }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -419,65 +361,6 @@ "XZ_OPT": "-9" } }, - "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", - "junit.xml" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "aarch64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ - "aarch64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", - "TEST_ENV": "aarch64-linux-deb11-validate", - "XZ_OPT": "-9" - } - }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -2048,66 +1931,6 @@ "XZ_OPT": "-9" } }, - "release-aarch64-linux-deb11-release": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-aarch64-linux-deb11-release.tar.xz", - "junit.xml" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "aarch64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ - "aarch64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", - "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", - "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "aarch64-linux-deb11-release", - "XZ_OPT": "-9" - } - }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dca43a04fb36e0ae0ed61455f215660eed2856a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dca43a04fb36e0ae0ed61455f215660eed2856a9 You're receiving 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 Aug 10 20:59:38 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 16:59:38 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f41c3a696a9_142b49521d4206317@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: d1c862d7 by Ben Gamari at 2022-08-10T16:59:27-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,64 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +905,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2024,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2035,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &&prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1c862d7ec9938950b278b8dd840e13a481d1891 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1c862d7ec9938950b278b8dd840e13a481d1891 You're receiving 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 Aug 9 02:59:09 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 22:59:09 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] gitlab-ci: Bump to use freebsd13 runners Message-ID: <62f1cd7d9f48c_182c4e4e0c03995@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 7e091c81 by Ben Gamari at 2022-08-08T22:58:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +290,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +328,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,7 +299,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,7 +307,7 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) ===================================== .gitlab/jobs.yaml ===================================== @@ -658,7 +658,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -668,7 +668,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -677,7 +677,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -703,19 +703,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2227,7 +2227,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2237,7 +2237,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2246,7 +2246,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2272,20 +2272,20 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -3147,7 +3147,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3157,7 +3157,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -3166,7 +3166,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3192,19 +3192,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e091c8199b47138c5484f46920e0f91382e49bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e091c8199b47138c5484f46920e0f91382e49bf You're receiving 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 Aug 9 17:01:25 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 13:01:25 -0400 Subject: [Git][ghc/ghc][wip/nr/typed-wasm-control-flow] 2 commits: move code that renders WebAssembly control flow to assembly Message-ID: <62f292e55874f_182c4e506b8273128@gitlab.mail> Norman Ramsey pushed to branch wip/nr/typed-wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: 44c37f94 by Norman Ramsey at 2022-08-09T13:00:38-04:00 move code that renders WebAssembly control flow to assembly - - - - - 4c22c583 by Norman Ramsey at 2022-08-09T13:01:01-04:00 make WebAssembly -> .s higher order - - - - - 2 changed files: - compiler/GHC/Wasm/Builder.hs → compiler/GHC/Wasm/ControlFlow/ToAsm.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Wasm/Builder.hs → compiler/GHC/Wasm/ControlFlow/ToAsm.hs ===================================== @@ -1,9 +1,10 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} -module GHC.Wasm.Builder - ( toIndented - , MyExpr(..), MyActions(..) +module GHC.Wasm.ControlFlow.ToAsm + ( toIndentedAsm + , noIndentation ) where @@ -21,11 +22,14 @@ import GHC.Utils.Panic import GHC.Wasm.ControlFlow hiding ((<>)) -defaultIndent :: Builder +type Indentation = Builder + +defaultIndent :: Indentation defaultIndent = " " -toIndented :: WasmControl MyActions MyExpr pre post -> Builder -toIndented s = printWithIndent mempty s <> "\n" +noIndentation :: Indentation +noIndentation = "" + wasmFunctionType :: WasmFunctionType pre post -> Builder wasmFunctionType (WasmFunctionType TypeListNil TypeListNil) = "" @@ -37,41 +41,48 @@ tagBuilder TagI32 = "i32" tagBuilder TagF32 = "f32" -printWithIndent :: Builder -> WasmControl MyActions MyExpr pre post -> Builder -printWithIndent indent s = print s - where print, outdent :: WasmControl MyActions MyExpr pre post -> Builder +type Printer a = Indentation -> a -> Builder + +-- | Converts WebAssembly control-flow code into GNU (Clang) assembly +-- syntax, indented for readability. For ease of combining with other +-- output, the result does not have a trailing newline. +-- +-- Initial `Indentation` argument gives the indentation of the entire output; +-- for most use cases it will likely be `mempty`. + +toIndentedAsm :: forall s e pre post + . Printer s -> Printer e -> Printer (WasmControl s e pre post) +toIndentedAsm ps pe indent s = print s + where print, shift :: WasmControl s e pre' post' -> Builder newline :: Builder -> Builder -> Builder (<+>) :: Builder -> Builder -> Builder ty = wasmFunctionType + -- cases meant to avoid generating any output for `WasmFallthrough` print (WasmFallthrough `WasmSeq` s) = print s print (s `WasmSeq` WasmFallthrough) = print s print (WasmIfTop t s WasmFallthrough) = - "br_if" <+> ty t `newline` outdent s `newline` "end_if" + "br_if" <+> ty t `newline` shift s `newline` "end_if" print (WasmIfTop t WasmFallthrough s) = - "br_if" <+> ty t `newline` "else" `newline` outdent s `newline` "end_if" - - print (WasmPush _ _) = "i32.const 42" - print (WasmBlock t s) = "block" <+> ty t `newline` outdent s `newline` "end_block" - print (WasmLoop t s) = "loop" <+> ty t `newline` outdent s `newline` "end_loop" - print (WasmIfTop t ts fs) = "if" <+> ty t `newline` outdent ts `newline` - "else" `newline` outdent fs `newline` "end_if" + "br_if" <+> ty t `newline` "else" `newline` shift s `newline` "end_if" + + -- normal cases + print (WasmPush _ e) = pe indent e + print (WasmBlock t s) = "block" <+> ty t `newline` shift s `newline` "end_block" + print (WasmLoop t s) = "loop" <+> ty t `newline` shift s `newline` "end_loop" + print (WasmIfTop t ts fs) = "if" <+> ty t `newline` shift ts `newline` + "else" `newline` shift fs `newline` "end_if" print (WasmBr l) = "br" <+> BS.intDec l print (WasmBrTable e _ ts t) = - myExpr e `newline` "br_table {" <+> + pe indent e `newline` "br_table {" <+> mconcat (intersperse ", " [BS.intDec i | i <- ts <> [t]]) <+> "}" print (WasmReturnTop _) = "return" - print (WasmActions as) = myActions as + print (WasmActions as) = ps indent as print (s `WasmSeq` s') = print s `newline` print s' print WasmFallthrough = "// fallthrough" -- hopefully rare newline s s' = s <> "\n" <> indent <> s' - outdent s = defaultIndent <> printWithIndent (indent <> defaultIndent) s + shift s = defaultIndent <> toIndentedAsm ps pe (indent <> defaultIndent) s s <+> s' = s <> " " <> s' - - -newtype MyExpr = MyExpr { myExpr :: Builder } - -newtype MyActions = MyActions { myActions :: Builder } ===================================== compiler/ghc.cabal.in ===================================== @@ -805,9 +805,9 @@ Library GHC.Utils.Ppr.Colour GHC.Utils.TmpFs GHC.Utils.Trace - GHC.Wasm.Builder GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm + GHC.Wasm.ControlFlow.ToAsm Language.Haskell.Syntax Language.Haskell.Syntax.Basic View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5c029678376197ddd365ba2665c361dd908502d...4c22c583c64f5a15c13080f3aaa5701a6a909c7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5c029678376197ddd365ba2665c361dd908502d...4c22c583c64f5a15c13080f3aaa5701a6a909c7c You're receiving 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 Aug 12 12:42:12 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 12 Aug 2022 08:42:12 -0400 Subject: [Git][ghc/ghc][wip/js-staging] PrimOp: disable LabelThreadOp for now Message-ID: <62f64aa495ed6_3d81494899049786a@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 00268fee by Sylvain Henry at 2022-08-12T14:44:55+02:00 PrimOp: disable LabelThreadOp for now - - - - - 1 changed file: - compiler/GHC/StgToJS/Prim.hs Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -915,7 +915,6 @@ genPrim prof ty op = case op of KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - LabelThreadOp -> \[] [t,la,lo] -> PrimInline $ t .^ "label" |= ValExpr (JList [la, lo]) 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] @@ -1124,6 +1123,7 @@ genPrim prof ty op = case op of SetThreadAllocationCounter -> unhandledPrimop op GetThreadLabelOp -> unhandledPrimop op ListThreadsOp -> unhandledPrimop op + LabelThreadOp -> unhandledPrimop op -- \[] [t,la,lo] -> PrimInline $ t .^ "label" |= ValExpr (JList [la, lo]) VecBroadcastOp _ _ _ -> unhandledPrimop op VecPackOp _ _ _ -> unhandledPrimop op View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00268feee9b12b679557f031f3233b68be01e56c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00268feee9b12b679557f031f3233b68be01e56c You're receiving 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 Aug 9 06:31:26 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 02:31:26 -0400 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Don't use coreutils on Darwin Message-ID: <62f1ff3ecc229_182c4e5065472841@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 5 changed files: - .gitlab/darwin/toolchain.nix - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - + mk/install_script.sh Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -230,12 +193,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5ceff56a6f11e4adc17a7cc05645b3e3a66ab97...1c582f44e41f534a8506a76618f6cffe5d71ed42 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5ceff56a6f11e4adc17a7cc05645b3e3a66ab97...1c582f44e41f534a8506a76618f6cffe5d71ed42 You're receiving 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 Aug 8 01:20:30 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 21:20:30 -0400 Subject: [Git][ghc/ghc][wip/armv7l-ci] Debug Message-ID: <62f064de60e97_25b0164c07c369083@gitlab.mail> Ben Gamari pushed to branch wip/armv7l-ci at Glasgow Haskell Compiler / GHC Commits: cff67390 by Ben Gamari at 2022-08-07T21:20:24-04:00 Debug - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -316,6 +316,7 @@ opsysVariables ARMv7 (Linux distro) = -- non-deterministically on ARMv7. See #18280. , "LD" =: "ld.gold" , "GccUseLdOpt" =: "-fuse-ld=gold" + , "HADRIAN_ARGS" =: "--test-verbose=4" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = ===================================== .gitlab/jobs.yaml ===================================== @@ -176,6 +176,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=4", "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } @@ -416,6 +417,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=4", "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" @@ -1924,6 +1926,7 @@ "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=4", "IGNORE_PERF_FAILURES": "all", "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cff673900aad2cc457752ba72e4d530caa6ed336 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cff673900aad2cc457752ba72e4d530caa6ed336 You're receiving 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 Aug 9 19:21:43 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 15:21:43 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/TerrorJack/wasm-ncg-4 Message-ID: <62f2b3c71e053_182c4e4e0c03481b0@gitlab.mail> Norman Ramsey pushed new branch wip/TerrorJack/wasm-ncg-4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/TerrorJack/wasm-ncg-4 You're receiving 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 Aug 9 17:02:25 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 13:02:25 -0400 Subject: [Git][ghc/ghc][wip/nr/typed-wasm-control-flow] render empty FT as void Message-ID: <62f29321b94ab_182c4e4e0c0273364@gitlab.mail> Norman Ramsey pushed to branch wip/nr/typed-wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: 5a38088e by Norman Ramsey at 2022-08-09T13:02:09-04:00 render empty FT as void - - - - - 1 changed file: - compiler/GHC/Wasm/ControlFlow/ToAsm.hs Changes: ===================================== compiler/GHC/Wasm/ControlFlow/ToAsm.hs ===================================== @@ -32,7 +32,7 @@ noIndentation = "" wasmFunctionType :: WasmFunctionType pre post -> Builder -wasmFunctionType (WasmFunctionType TypeListNil TypeListNil) = "" +wasmFunctionType (WasmFunctionType TypeListNil TypeListNil) = "void" wasmFunctionType (WasmFunctionType TypeListNil (TypeListCons t TypeListNil)) = tagBuilder t wasmFunctionType _ = panic "function type needs to be externalized" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a38088ec4cae607e4fae60a1298540409f4a20c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a38088ec4cae607e4fae60a1298540409f4a20c You're receiving 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 Aug 11 12:13:27 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 11 Aug 2022 08:13:27 -0400 Subject: [Git][ghc/ghc][wip/andreask/infer_exprs] 66 commits: Add -dsuppress-coercion-types to make coercions even smaller. Message-ID: <62f4f267430ac_142b495179836333e@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer_exprs at Glasgow Haskell Compiler / GHC Commits: aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - 735a54cb by Andreas Klebinger at 2022-08-11T14:12:56+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Data.hs - + compiler/GHC/Core.hs-boot - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45ab2335c4d8eb1bfd64db657d50dbe5739b9af6...735a54cb6980f811dc34763bb5eea920a4b9a0a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45ab2335c4d8eb1bfd64db657d50dbe5739b9af6...735a54cb6980f811dc34763bb5eea920a4b9a0a8 You're receiving 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 Aug 9 06:32:39 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 02:32:39 -0400 Subject: [Git][ghc/ghc][master] Cleanups around pretty-printing Message-ID: <62f1ff87bf2a4_182c4e5065479884@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 13 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Unit/Types.hs - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Cmm.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Cmm ( module GHC.Cmm.Expr, -- * Pretty-printing - pprCmms, pprCmmGroup, pprSection, pprStatic + pprCmmGroup, pprSection, pprStatic ) where import GHC.Prelude @@ -379,12 +379,6 @@ pprBBlock (BasicBlock ident stmts) = -- -- These conventions produce much more readable Cmm output. -pprCmms :: (OutputableP Platform info, OutputableP Platform g) - => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc -pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms)) - where - separator = space $$ text "-------------------" $$ space - pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g) => Platform -> GenCmmGroup d info g -> SDoc pprCmmGroup platform tops ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -294,9 +294,6 @@ data CLabel instance Show CLabel where show = showPprUnsafe . pprDebugCLabel genericPlatform -instance Outputable CLabel where - ppr = text . show - data ModuleLabelKind = MLK_Initializer String | MLK_InitializerArray @@ -1412,19 +1409,19 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] AsmStyle | use_leading_underscores -> pp_cSEP <> doc _ -> doc - tempLabelPrefixOrUnderscore :: Platform -> SDoc - tempLabelPrefixOrUnderscore platform = case sty of + tempLabelPrefixOrUnderscore :: SDoc + tempLabelPrefixOrUnderscore = case sty of AsmStyle -> asmTempLabelPrefix platform CStyle -> char '_' in case lbl of LocalBlockLabel u -> case sty of - AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u + AsmStyle -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u + CStyle -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u AsmTempLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u AsmTempDerivedLabel l suf -> asmTempLabelPrefix platform @@ -1474,7 +1471,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CStyle -> ppr name <> ppIdFlavor flavor SRTLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt" RtsLabel (RtsApFast (NonDetFastString str)) -> maybe_underscore $ ftext str <> text "_fast" @@ -1514,7 +1511,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr" LargeBitmapLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') -- until that gets resolved we'll just force them to start ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -50,14 +50,14 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock config top_info) blocks) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl platform lbl Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ -- pprProcAlignment config $$ (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' + then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain @@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> ppr info_lbl + <+> pdoc platform info_lbl <+> char '-' - <+> ppr (mkDeadStripPreventer info_lbl) + <+> pdoc platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -87,9 +87,6 @@ pprAlignForSection _platform _seg -- .balign is stable, whereas .align is platform dependent. = text "\t.balign 8" -- always 8 -instance Outputable Instr where - ppr = pprInstr genericPlatform - -- | Print section header and appropriate alignment for that section. -- -- This one will emit the header: @@ -118,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel asmLbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -138,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel info_lbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' else empty) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -235,7 +232,7 @@ pprImm _ (ImmInt i) = int i pprImm _ (ImmInteger i) = integer i pprImm p (ImmCLbl l) = pdoc p l pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i -pprImm _ (ImmLit s) = s +pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! pprImm _ (ImmFloat f) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -59,7 +59,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -67,14 +67,8 @@ data Imm | ImmConstantDiff Imm Imm deriving (Eq, Show) -instance Show SDoc where - show = showPprUnsafe . ppr - -instance Eq SDoc where - lhs == rhs = show lhs == show rhs - strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do let code dst = toOL [ LD II32 dst tocAddr ] - tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]")) + tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]") return (Any II32 code) | target32Bit platform = do reg <- getPicBaseNat $ archWordFormat (target32Bit platform) ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -240,7 +240,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/PPC/Regs.hs ===================================== @@ -133,7 +133,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -147,7 +147,7 @@ data Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -432,7 +432,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -55,7 +55,6 @@ import GHC.Platform.Reg.Class import GHC.Cmm import GHC.Cmm.CLabel ( CLabel ) -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -111,7 +110,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -119,7 +118,7 @@ data Imm | ImmConstantDiff Imm Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -363,7 +363,7 @@ emitTickyCounter cloType tickee Just (CgIdInfo { cg_lf = cg_lf }) | isLFThunk cg_lf -> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf - _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -- | -- #name_types# @@ -282,24 +281,9 @@ pprOccName (OccName sp occ) = getPprStyle $ \ sty -> if codeStyle sty then ztext (zEncodeFS occ) - else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) - where - pp_occ = sdocOption sdocSuppressUniques $ \case - True -> text (strip_th_unique (unpackFS occ)) - False -> ftext occ - - -- See Note [Suppressing uniques in OccNames] - strip_th_unique ('[' : c : _) | isAlphaNum c = [] - strip_th_unique (c : cs) = c : strip_th_unique cs - strip_th_unique [] = [] + else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) {- -Note [Suppressing uniques in OccNames] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is a hack to de-wobblify the OccNames that contain uniques from -Template Haskell that have been turned into a string in the OccName. -See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs" - ************************************************************************ * * \subsection{Construction} ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -207,7 +207,7 @@ pprModule mod@(Module p n) = getPprStyle doc | qualModule sty mod = case p of HoleUnit -> angleBrackets (pprModuleName n) - _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n + _ -> ppr p <> char ':' <> pprModuleName n | otherwise = pprModuleName n ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -44,7 +44,6 @@ ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-bo ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] -ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell] ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9dfd26a38182e9c284b7db16cb10fc889eedf9e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9dfd26a38182e9c284b7db16cb10fc889eedf9e You're receiving 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 Aug 8 11:54:39 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 08 Aug 2022 07:54:39 -0400 Subject: [Git][ghc/ghc][wip/andreask/deep_discounts] A bit of cleanup Message-ID: <62f0f97fae4cc_25b0164c0544562bf@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/deep_discounts at Glasgow Haskell Compiler / GHC Commits: bc1f16af by Andreas Klebinger at 2022-08-08T13:54:11+02:00 A bit of cleanup - - - - - 4 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1394,7 +1394,7 @@ data ArgDiscount , ad_con_discount :: !(ConMap ConDiscount) -- ^ Discounts for specific constructors } -- A discount for the use of a function. - | FunDisc { ad_seq_discount :: !Int, ad_fun :: Id} + | FunDisc { ad_seq_discount :: !Int, ad_fun :: !Name} | NoSeqUse deriving Eq ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -907,14 +907,6 @@ interestingArg env e = | otherwise -> ConArg con (fn_args ++ arg_summaries) _ -> fn_summary - -- | ConArg con args <- fn_summary - -- = if (isClassTyCon $ dataConTyCon con) - -- then ValueArg - -- else ConArg con (args ++ [go env (depth-1) 0 arg]) - -- | otherwise = fn_summary - -- where - -- fn_summary = go env (depth-1) (n+1) fn - go env depth n (Tick _ a) = go env depth n a go env depth n (Cast e _) = go env depth n e go env depth n (Lam v e) ===================================== compiler/GHC/Core/Seq.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Core.Type( seqType, isTyVar ) import GHC.Core.Coercion( seqCo ) import GHC.Types.Id( idInfo ) import GHC.Utils.Misc (seqList) +import GHC.Types.Unique.FM (seqEltsUFM) -- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the -- compiler @@ -113,5 +114,12 @@ seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, seqUnfolding _ = () seqGuidance :: UnfoldingGuidance -> () -seqGuidance (UnfIfGoodArgs ns n b) = n `seq` (seqList ns ()) `seq` b `seq` () +seqGuidance (UnfIfGoodArgs ns n b) = n `seq` (seqList (map seqArgDiscount ns) ()) `seq` b `seq` () seqGuidance _ = () + +seqArgDiscount :: ArgDiscount -> () +seqArgDiscount (DiscSeq !_ sub_args) = seqEltsUFM seqConDiscount sub_args +seqArgDiscount !_ = () + +seqConDiscount :: ConDiscount -> () +seqConDiscount (ConDiscount !_ !_ sub_args) = seqList (map seqArgDiscount sub_args) () \ No newline at end of file ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -62,13 +62,12 @@ import GHC.Types.Tickish import qualified Data.ByteString as BS import Data.List (isPrefixOf) import GHC.Types.Unique.FM --- import GHC.Utils.Trace import Data.Maybe import GHC.Types.Var.Env import GHC.Utils.Panic.Plain (assert) import GHC.Utils.Panic (pprPanic) import GHC.Data.Graph.UnVar --- import GHC.Utils.Trace (pprTrace) +import GHC.Utils.Trace (pprTraceDebug) @@ -262,8 +261,7 @@ calcUnfoldingGuidance opts is_top_bottoming (Tick t expr) | not (tickishIsCode t) -- non-code ticks don't matter for unfolding = calcUnfoldingGuidance opts is_top_bottoming expr calcUnfoldingGuidance opts is_top_bottoming expr - = -- (\r -> pprTrace "calcUnfoldingGuidance" (ppr expr $$ ppr r $$ ppr (sizeExpr opts bOMB_OUT_SIZE val_bndrs body) $$ ppr r $$ ppr is_top_bottoming) r) $ - case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of + = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of TooBig -> UnfNever SizeIs size cased_bndrs scrut_discount | uncondInline expr n_val_bndrs size @@ -275,10 +273,7 @@ calcUnfoldingGuidance opts is_top_bottoming expr -> UnfNever -- See Note [Do not inline top-level bottoming functions] | otherwise - -> - -- (if not (interesting_cased cased_bndrs) then id else pprTrace "UnfWhenDiscount" (ppr cased_bndrs)) - - UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs + -> UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs , ug_size = size , ug_res = scrut_discount } @@ -292,17 +287,6 @@ calcUnfoldingGuidance opts is_top_bottoming expr mk_discount :: VarEnv ArgDiscount -> Id -> ArgDiscount mk_discount cbs bndr = lookupWithDefaultVarEnv cbs NoSeqUse bndr - -- foldl' combine NoSeqUse cbs - -- where - -- combine acc (bndr', use) - -- | bndr == bndr' = acc `plus_disc` use - -- | otherwise = acc - - -- plus_disc :: ArgDiscount -> ArgDiscount -> ArgDiscount - -- plus_disc | isFunTy (idType bndr) = maxArgDiscount - -- | otherwise = combineArgDiscount - -- -- See Note [Function and non-function discounts] - {- Note [Inline unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We really want to inline unsafeCoerce, even when applied to boring @@ -482,95 +466,84 @@ sizeExpr :: UnfoldingOpts -- Forcing bOMB_OUT_SIZE early prevents repeated -- unboxing of the Int argument. sizeExpr opts !bOMB_OUT_SIZE top_args' expr - = let result = size_up depth_limit (mkUnVarSet top_args') expr - in - -- pprTrace "sizeExpr" (ppr expr) $ - -- pprTrace "sizeExpr2" (ppr result) $ - result + = size_up depth_limit (mkUnVarSet top_args') expr where depth_limit = unfoldingMaxGuideDepth opts size_up :: Int -> UnVarSet -> Expr Var -> ExprSize - size_up !depth !disc_args (Cast e _) = size_up depth disc_args e - size_up !depth disc_args (Tick _ e) = size_up depth disc_args e - size_up !_depth _disc_args (Type _) = sizeZero -- Types cost nothing - size_up !_depth _disc_args (Coercion _) = sizeZero - size_up !_depth _disc_args (Lit lit) = sizeN (litSize lit) - size_up !_depth disc_args (Var f) | isZeroBitId f = sizeZero + size_up !depth !arg_comps (Cast e _) = size_up depth arg_comps e + size_up !depth arg_comps (Tick _ e) = size_up depth arg_comps e + size_up !_depth _arg_comps (Type _) = sizeZero -- Types cost nothing + size_up !_depth _arg_comps (Coercion _) = sizeZero + size_up !_depth _arg_comps (Lit lit) = sizeN (litSize lit) + size_up !_depth arg_comps (Var f) | isZeroBitId f = sizeZero -- Make sure we get constructor discounts even -- on nullary constructors - | otherwise = size_up_call disc_args f [] 0 + | otherwise = size_up_call arg_comps f [] 0 - size_up !depth disc_args (App fun arg) - | isTyCoArg arg = size_up depth disc_args fun - | otherwise = size_up depth disc_args arg `addSizeNSD` - size_up_app depth disc_args fun [arg] (if isZeroBitExpr arg then 1 else 0) + size_up !depth arg_comps (App fun arg) + | isTyCoArg arg = size_up depth arg_comps fun + | otherwise = size_up depth arg_comps arg `addSizeNSD` + size_up_app depth arg_comps fun [arg] (if isZeroBitExpr arg then 1 else 0) - size_up !depth disc_args (Lam b e) - | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up depth (delUnVarSet disc_args b) e `addSizeN` 10) - | otherwise = size_up depth (delUnVarSet disc_args b) e + size_up !depth arg_comps (Lam b e) + | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up depth (delUnVarSet arg_comps b) e `addSizeN` 10) + | otherwise = size_up depth (delUnVarSet arg_comps b) e - size_up !depth disc_args (Let (NonRec binder rhs) body) - = let disc_args' = delUnVarSet disc_args binder + size_up !depth arg_comps (Let (NonRec binder rhs) body) + = let arg_comps' = delUnVarSet arg_comps binder in - size_up_rhs depth disc_args' (binder, rhs) `addSizeNSD` - size_up depth disc_args' body `addSizeN` + size_up_rhs depth arg_comps' (binder, rhs) `addSizeNSD` + size_up depth arg_comps' body `addSizeN` size_up_alloc binder - size_up !depth disc_args (Let (Rec pairs) body) + size_up !depth arg_comps (Let (Rec pairs) body) = let lhs_bnds = map fst pairs - disc_args' = delUnVarSetList disc_args lhs_bnds + arg_comps' = delUnVarSetList arg_comps lhs_bnds in - foldr (addSizeNSD . (size_up_rhs depth disc_args')) - (size_up depth disc_args' body `addSizeN` sum (map (size_up_alloc . fst) pairs)) + foldr (addSizeNSD . (size_up_rhs depth arg_comps')) + (size_up depth arg_comps' body `addSizeN` sum (map (size_up_alloc . fst) pairs)) pairs - size_up !depth disc_args (Case e _ _ alts) + size_up !depth arg_comps (Case e _ _ alts) | null alts - = size_up depth disc_args e -- case e of {} never returns, so take size of scrutinee + = size_up depth arg_comps e -- case e of {} never returns, so take size of scrutinee - size_up !depth disc_args (Case e _ _ alts) + size_up !depth arg_comps (Case e _ _ alts) -- Now alts is non-empty - | Just v <- is_top_arg e -- We are scrutinising an argument variable + -- We are scrutinising an argument variable or a subcomponent thereof. + | Just v <- is_top_arg e = let - -- If the constructor is then apply a discount for that constructor that - -- is equal to size_all_alts - size_this_alt. - -- This means the size of the function will be considered the same as if - -- we had replace the whole case with just the rhs of the alternative. - -- Which is what we want. - trim_size tot_size (Alt (DataAlt con) alt_bndrs _rhs) (SizeIs alt_size _ _) = + -- Compute size of alternatives + alt_sizes = map (size_up_alt depth (Just v) arg_comps) alts + + -- Apply a discount for a given constructor that brings the size down to just + -- the size of the alternative. + alt_size_discount tot_size (Alt (DataAlt con) alt_bndrs _rhs) (SizeIs alt_size _ _) = let trim_discount = max 10 $ tot_size - alt_size in Just (unitUFM con (ConDiscount con trim_discount (map (const NoSeqUse) alt_bndrs))) - trim_size _tot_size _ _alt_size = Nothing - - alt_sizes = map (size_up_alt depth (Just v) disc_args) alts + alt_size_discount _tot_size _ _alt_size = Nothing + -- Add up discounts from the alternatives added_alt_sizes = (foldr1 addAltSize alt_sizes) - max_alt_size = (foldr (maxSize bOMB_OUT_SIZE) 0 alt_sizes) + -- Compute size of the largest rhs + largest_alt_size = (foldr (maxSize bOMB_OUT_SIZE) 0 alt_sizes) - -- alts_size tries to compute a good discount for - -- the case when we are scrutinising an argument variable + -- alts_size tries to compute a good discount for + -- the case when we are scrutinising an argument variable or subcomponent thereof alts_size (SizeIs tot tot_disc tot_scrut) - -- Size of all alternatives combined - max_alt_size - - = -- TODO: Perhaps worth having a default-alternative discount (we take the default branch) - -- and "default" discout we apply if no other discount matched. (E.g the alternative was too big) - -- Currently we only have the later - -- Worst case we take the biggest alternative, so the discount is equivalent to eliminating all other - -- alternatives. - let default_alt_discount = 20 + tot - max_alt_size - alt_discounts = unitUFM v $ DiscSeq default_alt_discount $ plusUFMList $ catMaybes $ zipWith (trim_size tot) alts alt_sizes - in + largest_alt_size + = let default_alt_discount = 20 + tot - largest_alt_size + alt_discounts = unitUFM v $ DiscSeq default_alt_discount $ plusUFMList $ catMaybes $ zipWith (alt_size_discount tot) alts alt_sizes + in SizeIs tot (tot_disc `plusDiscountEnv` (alt_discounts)) tot_scrut - -- If the variable is known, we produce a - -- discount that will take us back to 'max', - -- the size of the largest alternative The - -- 1+ is a little discount for reduced - -- allocation in the caller + -- If the variable is known but we don't have a + -- specific constructor discount for it, we produce a + -- discount that will take us back to 'largest_alt_size', + -- the size of the largest alternative. -- -- Notice though, that we return tot_disc, -- the total discount from all branches. I @@ -581,18 +554,18 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr -- Why foldr1? We might get TooBig already after the first few alternatives -- in which case we don't have to look at the remaining ones. alts_size added_alt_sizes -- alts is non-empty - max_alt_size + largest_alt_size -- Good to inline if an arg is scrutinised, because -- that may eliminate allocation in the caller -- And it eliminates the case itself where - is_top_arg (Var v) | v `elemUnVarSet` disc_args = Just v + is_top_arg (Var v) | v `elemUnVarSet` arg_comps = Just v is_top_arg (Cast e _) = is_top_arg e is_top_arg _ = Nothing - size_up !depth disc_args (Case e _ _ alts) = size_up depth disc_args e `addSizeNSD` - foldr (addAltSize . (size_up_alt depth Nothing disc_args) ) case_size alts + size_up !depth arg_comps (Case e _ _ alts) = size_up depth arg_comps e `addSizeNSD` + foldr (addAltSize . (size_up_alt depth Nothing arg_comps) ) case_size alts where case_size | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10) @@ -629,25 +602,25 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr | otherwise = False - size_up_rhs !depth !disc_args (bndr, rhs) + size_up_rhs !depth !arg_comps (bndr, rhs) | Just join_arity <- isJoinId_maybe bndr -- Skip arguments to join point , (bndrs, body) <- collectNBinders join_arity rhs - = size_up depth (delUnVarSetList disc_args bndrs) body + = size_up depth (delUnVarSetList arg_comps bndrs) body | otherwise - = size_up depth disc_args rhs + = size_up depth arg_comps rhs ------------ -- size_up_app is used when there's ONE OR MORE value args - size_up_app depth !disc_args (App fun arg) args voids - | isTyCoArg arg = size_up_app depth disc_args fun args voids - | isZeroBitExpr arg = size_up_app depth disc_args fun (arg:args) (voids + 1) - | otherwise = size_up depth disc_args arg `addSizeNSD` - size_up_app depth disc_args fun (arg:args) voids - size_up_app _depth disc_args (Var fun) args voids = size_up_call disc_args fun args voids - size_up_app depth disc_args (Tick _ expr) args voids = size_up_app depth disc_args expr args voids - size_up_app depth disc_args (Cast expr _) args voids = size_up_app depth disc_args expr args voids - size_up_app depth disc_args other args voids = size_up depth disc_args other `addSizeN` + size_up_app depth !arg_comps (App fun arg) args voids + | isTyCoArg arg = size_up_app depth arg_comps fun args voids + | isZeroBitExpr arg = size_up_app depth arg_comps fun (arg:args) (voids + 1) + | otherwise = size_up depth arg_comps arg `addSizeNSD` + size_up_app depth arg_comps fun (arg:args) voids + size_up_app _depth arg_comps (Var fun) args voids = size_up_call arg_comps fun args voids + size_up_app depth arg_comps (Tick _ expr) args voids = size_up_app depth arg_comps expr args voids + size_up_app depth arg_comps (Cast expr _) args voids = size_up_app depth arg_comps expr args voids + size_up_app depth arg_comps other args voids = size_up depth arg_comps other `addSizeN` callSize (length args) voids -- if the lhs is not an App or a Var, or an invisible thing like a -- Tick or Cast, then we should charge for a complete call plus the @@ -655,27 +628,28 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr ------------ size_up_call :: UnVarSet -> Id -> [CoreExpr] -> Int -> ExprSize - size_up_call !disc_args fun val_args voids + size_up_call !arg_comps fun val_args voids = case idDetails fun of FCallId _ -> sizeN (callSize (length val_args) voids) DataConWorkId dc -> conSize dc (length val_args) PrimOpId op _ -> primOpSize op (length val_args) - ClassOpId _ -> classOpSize opts disc_args val_args - _ -> funSize opts disc_args fun (length val_args) voids + ClassOpId _ -> classOpSize opts arg_comps val_args + _ -> funSize opts arg_comps fun (length val_args) voids ------------ -- Take into acount the binders of scrutinized argument binders -- But not too deeply! Hence we check if we exhausted depth. - size_up_alt depth m_top_arg !disc_args (Alt alt_con bndrs rhs) + -- If so we simply ingore the case binders. + size_up_alt depth m_top_arg !arg_comps (Alt alt_con bndrs rhs) | Just top_arg <- m_top_arg , depth > 0 , DataAlt con <- alt_con = - let alt_size = size_up depth (extendUnVarSetList bndrs disc_args) rhs `addSizeN` 10 - -- let alt_size = size_up (disc_args) rhs `addSizeN` 10 + let alt_size = size_up depth (extendUnVarSetList bndrs arg_comps) rhs `addSizeN` 10 + -- let alt_size = size_up (arg_comps) rhs `addSizeN` 10 in asExprSize top_arg alt_size con bndrs - size_up_alt depth _ disc_args (Alt _con bndrs rhs) = size_up depth (delUnVarSetList disc_args bndrs) rhs `addSizeN` 10 + size_up_alt depth _ arg_comps (Alt _con bndrs rhs) = size_up depth (delUnVarSetList arg_comps bndrs) rhs `addSizeN` 10 -- Don't charge for args, so that wrappers look cheap -- (See comments about wrappers with Case) -- @@ -797,7 +771,7 @@ funSize opts !top_args fun n_val_args voids -- See Note [Function and non-function discounts] arg_discount | some_val_args && fun `elemUnVarSet` top_args = -- pprTrace "mkFunSize" (ppr fun) $ - unitUFM fun (FunDisc (unfoldingFunAppDiscount opts) fun) + unitUFM fun (FunDisc (unfoldingFunAppDiscount opts) (idName fun)) | otherwise = mempty -- If the function is an argument and is applied -- to some values, give it an arg-discount @@ -1026,13 +1000,11 @@ plusDiscountEnv el er = plusUFM_C combineArgDiscount el er classOpArgDiscount :: Int -> ArgDiscount classOpArgDiscount n = SomeArgUse n --- We computes the size of a case alternative. --- Now we want to transfer to discount from scrutinizing the constructor binders --- to the constructor discounts for the current scrutinee. +-- After computing the discounts for an alternatives rhs we transfer discounts from the +-- alt binders to the constructor specific discount of the scrutinee for the given constructor. asExprSize :: Id -> ExprSize -> DataCon -> [Id] -> ExprSize asExprSize _ TooBig _ _ = TooBig asExprSize scrut (SizeIs n arg_discs s_d) con alt_bndrs = - -- pprTrace "asExprSize" (ppr (scrut, (SizeIs n arg_discs s_d))) $ let (alt_discount_bags, top_discounts) = partitionWithKeyUFM (\k _v -> k `elem` map getUnique alt_bndrs) arg_discs alt_discount_map = alt_discount_bags alt_bndr_uses = map (\bndr -> lookupWithDefaultVarEnv alt_discount_map NoSeqUse bndr ) alt_bndrs :: [ArgDiscount] @@ -1044,9 +1016,8 @@ mkConUse :: DataCon -> [ArgDiscount] -> ArgDiscount mkConUse con uses = DiscSeq 0 - -- We apply a penalty of 1 per case alternative, so here we apply a discount of 1 by eliminated - -- case alternative. - -- And then one more because we get rid of a conditional branch which is always good. + -- We apply a penalty of 1 per case alternative, so here we apply a discount of 1 per *eliminated* + -- case alternative. And then one more because we get rid of a conditional branch which is always good. (unitUFM con (ConDiscount con (length uses) uses)) combineArgDiscount :: ArgDiscount -> ArgDiscount -> ArgDiscount @@ -1058,7 +1029,9 @@ combineArgDiscount (DiscSeq d1 m1) (SomeArgUse d2) = DiscSeq (d1 + d2) m1 combineArgDiscount (DiscSeq d1 m1) (DiscSeq d2 m2) = DiscSeq (d1 + d2) (plusUFM_C combineMapEntry m1 m2) -- See Note [Function and non-function discounts] why we need this combineArgDiscount f1@(FunDisc d1 _f1) f2@(FunDisc d2 _f2) = if d1 > d2 then f1 else f2 -combineArgDiscount u1 u2 = pprPanic "Variable seemingly discounted as both function and constructor" (ppr u1 $$ ppr u2) +-- This can happen either through shadowing or with things like unsafeCoerce. A good idea to warn for debug builds but we don't want to panic here. +combineArgDiscount f1@(FunDisc _d _n) u2 = pprTraceDebug "Variable seemingly discounted as both function and constructor" (ppr f1 $$ ppr u2) f1 +combineArgDiscount u1 f2@(FunDisc _d _n) = pprTraceDebug "Variable seemingly discounted as both function and constructor" (ppr u1 $$ ppr f2) f2 combineMapEntry :: ConDiscount -> ConDiscount -> ConDiscount combineMapEntry (ConDiscount c1 dc1 u1) (ConDiscount c2 dc2 u2) = @@ -1609,16 +1582,24 @@ This kind of thing can occur if you have which Roman did. - +Note [Minimum value discount] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We always give *some* benefit to value arguments. +A discount of 10 per arg because we replace the arguments +and another of 10 if it's some non-trivial value. +However when computing unfolding guidance we might have come to +the conclusion that certain argument values deservere little or no +discount. But we want to chance of inlining to only ever increase as +more is known about the argument to keep things more predictable. So +we always give at least 10 discount if the argument is a value. No matter +what the actual value is. -} computeDiscount :: [ArgDiscount] -> Int -> [ArgSummary] -> CallCtxt -> Int computeDiscount arg_discounts res_discount arg_infos cont_info - = - -- pprTrace "computeDiscount" (ppr arg_infos $$ ppr arg_discounts $$ ppr total_arg_discount) $ - 10 -- Discount of 10 because the result replaces the call + = 10 -- Discount of 10 because the result replaces the call -- so we count 10 for the function itself + 10 * length actual_arg_discounts @@ -1630,32 +1611,18 @@ computeDiscount arg_discounts res_discount arg_infos cont_info actual_arg_discounts = zipWith mk_arg_discount arg_discounts arg_infos total_arg_discount = sum actual_arg_discounts - -- mk_arg_discount _ TrivArg = 0 - -- mk_arg_discount _ NonTrivArg = 10 - -- mk_arg_discount discount ValueArg = discount - --- Note [Minimum value discount] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- We always give *some* benefit to value arguments. --- A discount of 10 per arg because we replace the arguments --- and another of 10 if it's some non-trivial value. --- However when computing unfolding guidance we might come to --- the conclusion that inlining something if a certain argument --- is let's say `Nothing` is pointless. --- beyond + -- See Note [Minimum value discount] mk_arg_discount :: ArgDiscount -> ArgSummary -> Int mk_arg_discount _ TrivArg = 0 - mk_arg_discount NoSeqUse _ = 10 mk_arg_discount _ NonTrivArg = 10 - mk_arg_discount discount ValueArg = max (ad_seq_discount discount) 10 + mk_arg_discount NoSeqUse _ = 10 + mk_arg_discount discount ValueArg = max 10 (ad_seq_discount discount) mk_arg_discount (DiscSeq seq_discount con_discounts) (ConArg con args) -- There is a discount specific to this constructor, use that. - -- BUT only use it if the specific one is larger than the generic one. - -- Otherwise we might stop inlining something if the constructor becomes visible. | Just (ConDiscount _ branch_dc arg_discounts) <- lookupUFM con_discounts con = max 10 $ max seq_discount (branch_dc + (sum $ zipWith mk_arg_discount arg_discounts args)) -- Otherwise give it the generic seq discount - | otherwise = seq_discount + | otherwise = max 10 seq_discount mk_arg_discount (SomeArgUse d) ConArg{} = max 10 d mk_arg_discount (FunDisc d _) (ConArg{}) -- How can this arise? With dictionary constructors for example. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc1f16afc7c21bfce83b54902548ac44a3907e38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc1f16afc7c21bfce83b54902548ac44a3907e38 You're receiving 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 Aug 11 18:06:59 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 Aug 2022 14:06:59 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f54543646c6_142b4951838444855@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: 6ab2faa8 by Ben Gamari at 2022-08-11T14:06:49-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,63 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +904,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2023,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2034,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,195 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * In general, we run finalizers in the reverse order of the associated + * initializers. That is to say, e.g., .init_array entries are run from first + * to last entry and therefore .fini_array entries are run from last-to-first. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + // .fini_array finalizers are run backwards + for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,28 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = 0; + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->init = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->fini = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1594,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2128,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ab2faa88364977aa12724ca8a6c4933ef620ce8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ab2faa88364977aa12724ca8a6c4933ef620ce8 You're receiving 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 Aug 11 05:18:11 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 Aug 2022 01:18:11 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f49113801ad_142b49517fc26442@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: 4279f3e7 by Ben Gamari at 2022-08-11T01:18:01-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,64 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +905,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2024,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2035,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4279f3e73149517d052698e36b4b41324838077c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4279f3e73149517d052698e36b4b41324838077c You're receiving 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 Aug 10 04:44:33 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 00:44:33 -0400 Subject: [Git][ghc/ghc][wip/T21986] 14 commits: gitlab-ci: Introduce validation job for aarch64 cross-compilation Message-ID: <62f337b12be86_d27044b80c69440@gitlab.mail> Ben Gamari pushed to branch wip/T21986 at Glasgow Haskell Compiler / GHC Commits: 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 62839fbd by Ben Gamari at 2022-08-10T00:44:14-04:00 gitlab-ci: Use clang-14 on FreeBSD 13 To workaround #21986, which appears to be an upstream bug. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Unit/Types.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - libraries/process - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - rts/PrimOps.cmm - rts/include/Cmm.h - + testsuite/tests/array/should_run/T21962.hs - testsuite/tests/array/should_run/all.T - testsuite/tests/linters/notes.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -206,6 +207,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +291,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +329,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" @@ -564,15 +566,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${CROSS_TARGET:-}" ]; then + args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" ) + fi + + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +618,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +641,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +807,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -116,6 +116,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +159,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } + llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -210,7 +223,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +242,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] + ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] -- | The hadrian flavour string we are going to use for this build @@ -299,7 +313,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,7 +321,11 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" + -- We workaround an upstream clang/FreeBSD bug (#21986) by using clang++14 rather than + -- the default clang-13 compiler. + , "CC" =: "clang14" + , "CXX" =: "clang++14" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +493,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +516,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -597,7 +615,8 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - + , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -766,7 +785,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) @@ -774,6 +793,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -658,7 +658,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -668,7 +668,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -677,7 +677,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -705,17 +705,19 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", + "CC": "clang14", "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 ", + "CXX": "clang++14", "GHC_VERSION": "9.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -1378,6 +1380,67 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -2227,7 +2290,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2237,7 +2300,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2246,7 +2309,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2274,18 +2337,20 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", + "CC": "clang14", "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 ", + "CXX": "clang++14", "GHC_VERSION": "9.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -3147,7 +3212,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3157,7 +3222,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -3166,7 +3231,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3194,17 +3259,19 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", + "CC": "clang14", "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 ", + "CXX": "clang++14", "GHC_VERSION": "9.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { @@ -3857,6 +3924,66 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== compiler/GHC/Cmm.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Cmm ( module GHC.Cmm.Expr, -- * Pretty-printing - pprCmms, pprCmmGroup, pprSection, pprStatic + pprCmmGroup, pprSection, pprStatic ) where import GHC.Prelude @@ -379,12 +379,6 @@ pprBBlock (BasicBlock ident stmts) = -- -- These conventions produce much more readable Cmm output. -pprCmms :: (OutputableP Platform info, OutputableP Platform g) - => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc -pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms)) - where - separator = space $$ text "-------------------" $$ space - pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g) => Platform -> GenCmmGroup d info g -> SDoc pprCmmGroup platform tops ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -294,9 +294,6 @@ data CLabel instance Show CLabel where show = showPprUnsafe . pprDebugCLabel genericPlatform -instance Outputable CLabel where - ppr = text . show - data ModuleLabelKind = MLK_Initializer String | MLK_InitializerArray @@ -1412,19 +1409,19 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] AsmStyle | use_leading_underscores -> pp_cSEP <> doc _ -> doc - tempLabelPrefixOrUnderscore :: Platform -> SDoc - tempLabelPrefixOrUnderscore platform = case sty of + tempLabelPrefixOrUnderscore :: SDoc + tempLabelPrefixOrUnderscore = case sty of AsmStyle -> asmTempLabelPrefix platform CStyle -> char '_' in case lbl of LocalBlockLabel u -> case sty of - AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u + AsmStyle -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u + CStyle -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u AsmTempLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u AsmTempDerivedLabel l suf -> asmTempLabelPrefix platform @@ -1474,7 +1471,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CStyle -> ppr name <> ppIdFlavor flavor SRTLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt" RtsLabel (RtsApFast (NonDetFastString str)) -> maybe_underscore $ ftext str <> text "_fast" @@ -1514,7 +1511,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr" LargeBitmapLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') -- until that gets resolved we'll just force them to start ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -50,14 +50,14 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock config top_info) blocks) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl platform lbl Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ -- pprProcAlignment config $$ (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' + then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain @@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> ppr info_lbl + <+> pdoc platform info_lbl <+> char '-' - <+> ppr (mkDeadStripPreventer info_lbl) + <+> pdoc platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -87,9 +87,6 @@ pprAlignForSection _platform _seg -- .balign is stable, whereas .align is platform dependent. = text "\t.balign 8" -- always 8 -instance Outputable Instr where - ppr = pprInstr genericPlatform - -- | Print section header and appropriate alignment for that section. -- -- This one will emit the header: @@ -118,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel asmLbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -138,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel info_lbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' else empty) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -235,7 +232,7 @@ pprImm _ (ImmInt i) = int i pprImm _ (ImmInteger i) = integer i pprImm p (ImmCLbl l) = pdoc p l pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i -pprImm _ (ImmLit s) = s +pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! pprImm _ (ImmFloat f) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -59,7 +59,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -67,14 +67,8 @@ data Imm | ImmConstantDiff Imm Imm deriving (Eq, Show) -instance Show SDoc where - show = showPprUnsafe . ppr - -instance Eq SDoc where - lhs == rhs = show lhs == show rhs - strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do let code dst = toOL [ LD II32 dst tocAddr ] - tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]")) + tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]") return (Any II32 code) | target32Bit platform = do reg <- getPicBaseNat $ archWordFormat (target32Bit platform) ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -240,7 +240,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/PPC/Regs.hs ===================================== @@ -133,7 +133,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -147,7 +147,7 @@ data Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -432,7 +432,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -55,7 +55,6 @@ import GHC.Platform.Reg.Class import GHC.Cmm import GHC.Cmm.CLabel ( CLabel ) -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -111,7 +110,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -119,7 +118,7 @@ data Imm | ImmConstantDiff Imm Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -580,10 +580,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- Cost to allocate binding with given binder size_up_alloc bndr - | isTyVar bndr -- Doesn't exist at runtime - || isJoinId bndr -- Not allocated at all - || isUnliftedType (idType bndr) -- Doesn't live in heap - -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder) + | isTyVar bndr -- Doesn't exist at runtime + || isJoinId bndr -- Not allocated at all + || not (isBoxedType (idType bndr)) -- Doesn't live in heap = 0 | otherwise = 10 ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -363,7 +363,7 @@ emitTickyCounter cloType tickee Just (CgIdInfo { cg_lf = cg_lf }) | isLFThunk cg_lf -> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf - _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -- | -- #name_types# @@ -282,24 +281,9 @@ pprOccName (OccName sp occ) = getPprStyle $ \ sty -> if codeStyle sty then ztext (zEncodeFS occ) - else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) - where - pp_occ = sdocOption sdocSuppressUniques $ \case - True -> text (strip_th_unique (unpackFS occ)) - False -> ftext occ - - -- See Note [Suppressing uniques in OccNames] - strip_th_unique ('[' : c : _) | isAlphaNum c = [] - strip_th_unique (c : cs) = c : strip_th_unique cs - strip_th_unique [] = [] + else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) {- -Note [Suppressing uniques in OccNames] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is a hack to de-wobblify the OccNames that contain uniques from -Template Haskell that have been turned into a string in the OccName. -See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs" - ************************************************************************ * * \subsection{Construction} ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -207,7 +207,7 @@ pprModule mod@(Module p n) = getPprStyle doc | qualModule sty mod = case p of HoleUnit -> angleBrackets (pprModuleName n) - _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n + _ -> ppr p <> char ':' <> pprModuleName n | otherwise = pprModuleName n ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -83,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -230,12 +195,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 7a7431a0ef586c0f1e602e382398b988c699dfc2 +Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== rts/PrimOps.cmm ===================================== @@ -350,6 +350,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; + /* Ensure that the card array is initialized */ + if (n != 0) { + setCardsValue(arr, 0, n, 0); + } + // Initialise all elements of the array with the value in R2 p = arr + SIZEOF_StgMutArrPtrs; for: ===================================== rts/include/Cmm.h ===================================== @@ -870,10 +870,11 @@ /* * Set the cards in the array pointed to by arr for an * update to n elements, starting at element dst_off to value (0 to indicate - * clean, 1 to indicate dirty). + * clean, 1 to indicate dirty). n must be non-zero. */ #define setCardsValue(arr, dst_off, n, value) \ W_ __start_card, __end_card, __cards, __dst_cards_p; \ + ASSERT(n != 0); \ __dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \ __start_card = mutArrPtrCardDown(dst_off); \ __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \ ===================================== testsuite/tests/array/should_run/T21962.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.IO +import GHC.Exts + +main :: IO () +main = do + IO $ \s0 -> case newArray# 0# () s0 of (# s1, arr #) -> (# s1, () #) ===================================== testsuite/tests/array/should_run/all.T ===================================== @@ -23,3 +23,4 @@ test('arr017', when(fast(), skip), compile_and_run, ['']) test('arr018', when(fast(), skip), compile_and_run, ['']) test('arr019', normal, compile_and_run, ['']) test('arr020', normal, compile_and_run, ['']) +test('T21962', normal, compile_and_run, ['']) ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -44,7 +44,6 @@ ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-bo ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] -ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell] ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6ac9a4f6cbe23ef5898f3a7766c9fe143f1dc8c...62839fbdb0fc50d07c0b5c9edff633bc8c407bd0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6ac9a4f6cbe23ef5898f3a7766c9fe143f1dc8c...62839fbdb0fc50d07c0b5c9edff633bc8c407bd0 You're receiving 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 Aug 7 23:04:31 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 19:04:31 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] Add support for libcxxrt Message-ID: <62f044ff38b1e_25b0164c1583553e1@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 1f25e793 by Ben Gamari at 2022-08-07T19:04:06-04:00 Add support for libcxxrt - - - - - 1 changed file: - m4/fp_find_cxx_std_lib.m4 Changes: ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -19,31 +19,36 @@ unknown EOF AC_MSG_CHECKING([C++ standard library flavour]) if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" - d="`dirname "$p"`" - dnl On some platforms (e.g. Windows) the C++ standard library - dnl can be found in the system search path. In this case $CXX - dnl --print-file-name will simply print the filename without a - dnl directory part. Consequently, dirname will return `.`. However, - dnl we don't want to include such paths in the package database. - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + check_lib() { + if grep "lib$1" actest.out >/dev/null; then + CXX_STD_LIB_LIBS="$1" + p="`"$CXX" --print-file-name lib$1.so`" + d="`dirname "$p"`" + dnl On some platforms (e.g. Windows) the C++ standard library + dnl can be found in the system search path. In this case $CXX + dnl --print-file-name will simply print the filename without a + dnl directory part. Consequently, dirname will return `.`. However, + dnl we don't want to include such paths in the package database. + if test "$d" = "."; then d=""; fi + CXX_STD_LIB_LIB_DIRS="$d" + CXX_STD_LIB_DYN_LIB_DIRS="$d" + AC_MSG_RESULT([lib$1]) + fi + } + + dnl C++ standard library (e.g. STL) + check_lib "c++" + check_lib "stdc++" + if [ -z "$CXX_STD_LIB_LIBS" ]; then + AC_MSG_ERROR([Unknown C++ standard library implementation. Please set CXX_STD_LIB_LIBS, CXX_STD_LIB_LIB_DIRS and CXX_STD_LIB_DYN_LIB_DIRS manually.]) fi + + dnl ABI library + AC_MSG_CHECKING([C++ ABI flavour]) + check_lib "c++abi" + check_lib "cxxrt" + check_lib "supc++" + rm -f actest.cpp actest.out else rm -f actest.cpp actest.out View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f25e793f15c4a43e08e8f01659539604c4455ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f25e793f15c4a43e08e8f01659539604c4455ce You're receiving 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 Aug 8 14:16:48 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 10:16:48 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 11 commits: hadrian: Fix access mode of installed package registration files Message-ID: <62f11ad0752d6_25b0164c0404934d0@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: b3cffa9b by Ben Gamari at 2022-08-08T09:56:40-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - 69f77db6 by Ben Gamari at 2022-08-08T10:16:39-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 0aaab2a4 by Ben Gamari at 2022-08-08T10:16:39-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 5421d694 by Ben Gamari at 2022-08-08T10:16:39-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - f0b561ed by Ben Gamari at 2022-08-08T10:16:39-04:00 XXX: Bump up freebsd job - - - - - c487730b by Ben Gamari at 2022-08-08T10:16:39-04:00 gitlab-ci: Use cabal-install-3.6.2.0 on FreeBSD - - - - - 02cc0201 by Ben Gamari at 2022-08-08T10:16:39-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - daec5cce by Ben Gamari at 2022-08-08T10:16:39-04:00 Update jobs.yaml - - - - - 25eb4afb by Ben Gamari at 2022-08-08T10:16:39-04:00 fix - - - - - 20b22b5e by Ben Gamari at 2022-08-08T10:16:39-04:00 cabal - - - - - c77dad3a by Ben Gamari at 2022-08-08T10:16:39-04:00 temp - - - - - 6 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/bindist/Makefile - m4/fp_find_cxx_std_lib.m4 - rts/Linker.c Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -279,6 +282,9 @@ function fetch_ghc() { start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + if [ "$(uname)" = "FreeBSD" ]; then + url="http://home.smart-cactus.org/~ben/ghc/ghc-9.4.1-x86_64-portbld-freebsd.tar.xz" + fi info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" @@ -287,7 +293,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +331,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,15 +299,15 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "GHC_VERSION" =: "9.4.1" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , modifyJobs (\x -> x {jobStage = "quick-build"}) $ allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) ===================================== .gitlab/jobs.yaml ===================================== @@ -541,7 +541,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +551,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +560,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -586,19 +586,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2050,7 +2050,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2060,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2069,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2095,20 +2095,20 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2970,7 +2970,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +2980,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +2989,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3015,19 +3015,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== hadrian/bindist/Makefile ===================================== @@ -83,6 +83,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb1ec58cd7351063c335a33e3c36dea5672942ec...c77dad3adb6c4d451a44e4b2717ccce14541dc3e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb1ec58cd7351063c335a33e3c36dea5672942ec...c77dad3adb6c4d451a44e4b2717ccce14541dc3e You're receiving 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 Aug 8 17:46:14 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 13:46:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: NCG(x86): Compile add+shift as lea if possible. Message-ID: <62f14be6af9fb_25b0164c158545322@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 3e6f1cfc by Andreas Klebinger at 2022-08-08T13:45:49-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 6543909a by Cheng Shao at 2022-08-08T13:45:54-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - f15a7c8f by Andreas Klebinger at 2022-08-08T13:45:55-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5076c99b by Ben Gamari at 2022-08-08T13:45:55-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Expr.hs - docs/users_guide/bugs.rst - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_compile/T21710a.hs - + testsuite/tests/codeGen/should_compile/T21710a.stderr - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs - testsuite/tests/codeGen/should_gen_asm/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -769,6 +769,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) ===================================== .gitlab/jobs.yaml ===================================== @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -358,6 +416,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1864,6 +1981,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1048,10 +1048,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -------------------- add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register + -- x + imm add_code rep x (CmmLit (CmmInt y _)) | is32BitInteger y , rep /= W8 -- LEA doesn't support byte size (#18614) = add_int rep x y + -- x + (y << imm) + add_code rep x y + -- Byte size is not supported and 16bit size is slow when computed via LEA + | rep /= W8 && rep /= W16 + -- 2^3 = 8 is the highest multiplicator supported by LEA. + , Just (x,y,shift_bits) <- get_shift x y + = add_shiftL rep x y (fromIntegral shift_bits) + where + -- x + (y << imm) + get_shift x (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) + | shift_bits <= 3 + = Just (x, y, shift_bits) + -- (y << imm) + x + get_shift (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) x + | shift_bits <= 3 + = Just (x, y, shift_bits) + get_shift _ _ + = Nothing add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y where format = intFormat rep -- TODO: There are other interesting patterns we want to replace @@ -1066,6 +1085,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y -- our three-operand add instruction: + add_int :: (Width -> CmmExpr -> Integer -> NatM Register) add_int width x y = do (x_reg, x_code) <- getSomeReg x let @@ -1079,6 +1099,22 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -- return (Any format code) + -- x + (y << shift_bits) using LEA + add_shiftL :: (Width -> CmmExpr -> CmmExpr -> Int -> NatM Register) + add_shiftL width x y shift_bits = do + (x_reg, x_code) <- getSomeReg x + (y_reg, y_code) <- getSomeReg y + let + format = intFormat width + imm = ImmInt 0 + code dst + = (x_code `appOL` y_code) `snocOL` + LEA format + (OpAddr (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg (2 ^ shift_bits)) imm)) + (OpReg dst) + -- + return (Any format code) + ---------------------- -- See Note [DIV/IDIV for bytes] ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -20,6 +20,7 @@ where import GHC.Prelude +import GHC.Builtin.PrimOps ( PrimOp(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply @@ -346,6 +347,19 @@ fvArgs args = do type IsScrut = Bool +rewriteArgs :: [StgArg] -> RM [StgArg] +rewriteArgs = mapM rewriteArg +rewriteArg :: StgArg -> RM StgArg +rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v +rewriteArg (lit at StgLitArg{}) = return lit + +-- Attach a tagSig if it's tagged +rewriteId :: Id -> RM Id +rewriteId v = do + is_tagged <- isTagged v + if is_tagged then return $! setIdTagSig v (TagSig TagProper) + else return v + rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr rewriteExpr _ (e at StgCase {}) = rewriteCase e rewriteExpr _ (e at StgLet {}) = rewriteLet e @@ -355,8 +369,11 @@ rewriteExpr _ e@(StgConApp {}) = rewriteConApp e rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e rewriteExpr _ (StgLit lit) = return $! (StgLit lit) +rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do + (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) + rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ @@ -415,6 +432,7 @@ rewriteApp True (StgApp f []) = do -- isTagged looks at more than the result of our analysis. -- So always update here if useful. let f' = if f_tagged + -- TODO: We might consisder using a subst env instead of setting the sig only for select places. then setIdTagSig f (TagSig TagProper) else f return $! StgApp f' [] ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -76,6 +76,8 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = -- dataToTag# :: a -> Int# -- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold +-- TODO: There are some more optimization ideas for this code path +-- in #21710 cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do platform <- getPlatform emitComment (mkFastString "dataToTag#") @@ -92,15 +94,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do -- the constructor index is too large to fit in the pointer and therefore -- we must look in the info table. See Note [Tagging big families]. - slow_path <- getCode $ do - tmp <- newTemp (bWord platform) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - profile <- getProfile - align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig - emitAssign (CmmLocal result_reg) - $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) - - fast_path <- getCode $ do + (fast_path :: CmmAGraph) <- getCode $ do -- Return the constructor index from the pointer tag return_ptr_tag <- getCode $ do emitAssign (CmmLocal result_reg) @@ -113,8 +107,22 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do $ getConstrTag profile align_check (cmmUntag platform amode) emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False) - - emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) + -- If we know the argument is already tagged there is no need to generate code to evaluate it + -- so we skip straight to the fast path. If we don't know if there is a tag we take the slow + -- path which evaluates the argument before fetching the tag. + case (idTagSig_maybe a) of + Just sig + | isTaggedSig sig + -> emit fast_path + _ -> do + slow_path <- getCode $ do + tmp <- newTemp (bWord platform) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + profile <- getProfile + align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig + emitAssign (CmmLocal result_reg) + $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) + emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) emitReturn [CmmReg $ CmmLocal result_reg] ===================================== docs/users_guide/bugs.rst ===================================== @@ -115,6 +115,10 @@ Lexical syntax varid → small {idchar} ⟨reservedid⟩ conid → large {idchar} +- GHC allows redundant parantheses around the function name in the `funlhs` part of declarations. + That is GHC will succeed in parsing a declaration like `((f)) x = ` for any number + of parantheses around `f`. + .. _infelicities-syntax: Context-free syntax ===================================== rts/PrimOps.cmm ===================================== @@ -2801,21 +2801,6 @@ stg_getApStackValzh ( P_ ap_stack, W_ offset ) } } -// Write the cost center stack of the first argument on stderr; return -// the second. Possibly only makes sense for already evaluated -// things? -stg_traceCcszh ( P_ obj, P_ ret ) -{ - W_ ccs; - -#if defined(PROFILING) - ccs = StgHeader_ccs(UNTAG(obj)); - ccall fprintCCS_stderr(ccs "ptr"); -#endif - - jump stg_ap_0_fast(ret); -} - stg_getSparkzh () { W_ spark; ===================================== rts/RtsSymbols.c ===================================== @@ -1015,7 +1015,6 @@ extern char **environ; SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(enabled_capabilities) \ - SymI_HasDataProto(stg_traceCcszh) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -566,7 +566,6 @@ RTS_FUN_DECL(stg_numSparkszh); RTS_FUN_DECL(stg_noDuplicatezh); -RTS_FUN_DECL(stg_traceCcszh); RTS_FUN_DECL(stg_clearCCSzh); RTS_FUN_DECL(stg_traceEventzh); RTS_FUN_DECL(stg_traceBinaryEventzh); ===================================== testsuite/tests/codeGen/should_compile/T21710a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# OPTIONS_GHC -O #-} + +module M where + +import GHC.Exts + +data E = A | B | C | D | E + +foo x = + case x of + A -> 2# + B -> 42# + -- In this branch we already now `x` is evaluated, so we shouldn't generate an extra `call` for it. + _ -> dataToTag# x ===================================== testsuite/tests/codeGen/should_compile/T21710a.stderr ===================================== @@ -0,0 +1,446 @@ + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'E2_bytes" { + M.$tc'E2_bytes: + I8[] "'E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'D2_bytes" { + M.$tc'D2_bytes: + I8[] "'D" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'C2_bytes" { + M.$tc'C2_bytes: + I8[] "'C" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'B2_bytes" { + M.$tc'B2_bytes: + I8[] "'B" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'A3_bytes" { + M.$tc'A3_bytes: + I8[] "'A" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tcE2_bytes" { + M.$tcE2_bytes: + I8[] "E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule2_bytes" { + M.$trModule2_bytes: + I8[] "M" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule4_bytes" { + M.$trModule4_bytes: + I8[] "main" + }] + + + +==================== Output Cmm ==================== +[M.foo_entry() { // [R2] + { info_tbls: [(cBa, + label: block_cBa_info + rep: StackRep [] + srt: Nothing), + (cBi, + label: M.foo_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cBi: // global + if ((Sp + -8) < SpLim) (likely: False) goto cBj; else goto cBk; // CmmCondBranch + cBj: // global + R1 = M.foo_closure; // CmmAssign + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall + cBk: // global + I64[Sp - 8] = cBa; // CmmStore + R1 = R2; // CmmAssign + Sp = Sp - 8; // CmmAssign + if (R1 & 7 != 0) goto cBa; else goto cBb; // CmmCondBranch + cBb: // global + call (I64[R1])(R1) returns to cBa, args: 8, res: 8, upd: 8; // CmmCall + cBa: // global + _cBh::P64 = R1 & 7; // CmmAssign + if (_cBh::P64 != 1) goto uBz; else goto cBf; // CmmCondBranch + uBz: // global + if (_cBh::P64 != 2) goto cBe; else goto cBg; // CmmCondBranch + cBe: // global + // dataToTag# + _cBn::P64 = R1 & 7; // CmmAssign + if (_cBn::P64 == 7) (likely: False) goto cBs; else goto cBr; // CmmCondBranch + cBs: // global + _cBo::I64 = %MO_UU_Conv_W32_W64(I32[I64[R1 & (-8)] - 4]); // CmmAssign + goto cBq; // CmmBranch + cBr: // global + _cBo::I64 = _cBn::P64 - 1; // CmmAssign + goto cBq; // CmmBranch + cBq: // global + R1 = _cBo::I64; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBg: // global + R1 = 42; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBf: // global + R1 = 2; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }, + section ""data" . M.foo_closure" { + M.foo_closure: + const M.foo_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule3_closure" { + M.$trModule3_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule4_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule1_closure" { + M.$trModule1_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule_closure" { + M.$trModule_closure: + const GHC.Types.Module_con_info; + const M.$trModule3_closure+1; + const M.$trModule1_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE1_closure" { + M.$tcE1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tcE2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE_closure" { + M.$tcE_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tcE1_closure+1; + const GHC.Types.krep$*_closure+5; + const 10475418246443540865; + const 12461417314693222409; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A1_closure" { + M.$tc'A1_closure: + const GHC.Types.KindRepTyConApp_con_info; + const M.$tcE_closure+1; + const GHC.Types.[]_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A2_closure" { + M.$tc'A2_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'A3_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A_closure" { + M.$tc'A_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'A2_closure+1; + const M.$tc'A1_closure+1; + const 10991425535368257265; + const 3459663971500179679; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B1_closure" { + M.$tc'B1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'B2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B_closure" { + M.$tc'B_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'B1_closure+1; + const M.$tc'A1_closure+1; + const 13038863156169552918; + const 13430333535161531545; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C1_closure" { + M.$tc'C1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'C2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C_closure" { + M.$tc'C_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'C1_closure+1; + const M.$tc'A1_closure+1; + const 8482817676735632621; + const 8146597712321241387; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D1_closure" { + M.$tc'D1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'D2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D_closure" { + M.$tc'D_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'D1_closure+1; + const M.$tc'A1_closure+1; + const 7525207739284160575; + const 13746130127476219356; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E1_closure" { + M.$tc'E1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'E2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E_closure" { + M.$tc'E_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'E1_closure+1; + const M.$tc'A1_closure+1; + const 6748545530683684316; + const 10193016702094081137; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.A_closure" { + M.A_closure: + const M.A_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.B_closure" { + M.B_closure: + const M.B_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.C_closure" { + M.C_closure: + const M.C_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.D_closure" { + M.D_closure: + const M.D_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.E_closure" { + M.E_closure: + const M.E_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""relreadonly" . M.E_closure_tbl" { + M.E_closure_tbl: + const M.A_closure+1; + const M.B_closure+2; + const M.C_closure+3; + const M.D_closure+4; + const M.E_closure+5; + }] + + + +==================== Output Cmm ==================== +[M.A_con_entry() { // [] + { info_tbls: [(cC5, + label: M.A_con_info + rep: HeapRep 1 nonptrs { Con {tag: 0 descr:"main:M.A"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cC5: // global + R1 = R1 + 1; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.B_con_entry() { // [] + { info_tbls: [(cCa, + label: M.B_con_info + rep: HeapRep 1 nonptrs { Con {tag: 1 descr:"main:M.B"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCa: // global + R1 = R1 + 2; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.C_con_entry() { // [] + { info_tbls: [(cCf, + label: M.C_con_info + rep: HeapRep 1 nonptrs { Con {tag: 2 descr:"main:M.C"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCf: // global + R1 = R1 + 3; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.D_con_entry() { // [] + { info_tbls: [(cCk, + label: M.D_con_info + rep: HeapRep 1 nonptrs { Con {tag: 3 descr:"main:M.D"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCk: // global + R1 = R1 + 4; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.E_con_entry() { // [] + { info_tbls: [(cCp, + label: M.E_con_info + rep: HeapRep 1 nonptrs { Con {tag: 4 descr:"main:M.E"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCp: // global + R1 = R1 + 5; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -108,3 +108,4 @@ test('T18614', normal, compile, ['']) test('mk-big-obj', [unless(opsys('mingw32'), skip), pre_cmd('$PYTHON mk-big-obj.py > mk-big-obj.c')], multimod_compile, ['mk-big-obj.c', '-c -v0 -no-hs-main']) +test('T21710a', [ only_ways(['optasm']), when(wordsize(32), skip), grep_errmsg('(call)',[1]) ], compile, ['-ddump-cmm -dno-typeable-binds']) ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm ===================================== @@ -0,0 +1,46 @@ +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_f_info +.type AddMulX86_f_info, @function +AddMulX86_f_info: +.LcAx: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_f_info, .-AddMulX86_f_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_f_closure +.type AddMulX86_f_closure, @object +AddMulX86_f_closure: + .quad AddMulX86_f_info +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_g_info +.type AddMulX86_g_info, @function +AddMulX86_g_info: +.LcAL: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_g_info, .-AddMulX86_g_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_g_closure +.type AddMulX86_g_closure, @object +AddMulX86_g_closure: + .quad AddMulX86_g_info +.section .note.GNU-stack,"", at progbits +.ident "GHC 9.3.20220228" + + ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash #-} + +module AddMulX86 where + +import GHC.Exts + +f :: Int# -> Int# -> Int# +f x y = + x +# (y *# 8#) -- Should result in a lea instruction, which we grep the assembly output for. + +g x y = + (y *# 8#) +# x -- Should result in a lea instruction, which we grep the assembly output for. ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -10,3 +10,4 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', '']) test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections']) +test('AddMulX86', is_amd64_codegen, compile_cmp_asm, ['hs', '-dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/709ad7c3de1931c8760a92bf7d49b6a0587977be...5076c99beaf8d935937718d8d10037596ce5af2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/709ad7c3de1931c8760a92bf7d49b6a0587977be...5076c99beaf8d935937718d8d10037596ce5af2e You're receiving 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 Aug 11 02:56:26 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 22:56:26 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f46fda51534_142b49517fc251068@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: a16f0722 by Ben Gamari at 2022-08-10T22:56:15-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,64 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +905,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2024,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2035,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &&prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a16f0722faeab747bad393d9dc8506199ab1486b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a16f0722faeab747bad393d9dc8506199ab1486b You're receiving 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 Aug 8 18:54:50 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 08 Aug 2022 14:54:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/cleanup-pp Message-ID: <62f15bfaa44b2_25b0164bfa05724d6@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/cleanup-pp at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/cleanup-pp You're receiving 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 Aug 8 14:18:18 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 10:18:18 -0400 Subject: [Git][ghc/ghc][wip/T19143] 23 commits: Improve BUILD_PAP comments Message-ID: <62f11b2a9616f_25b0164d24c499336@gitlab.mail> Ben Gamari pushed to branch wip/T19143 at Glasgow Haskell Compiler / GHC Commits: e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 9465b8f7 by Ben Gamari at 2022-08-08T10:18:13-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - 3c5752cc by Ben Gamari at 2022-08-08T10:18:13-04:00 testsuite: Add test for #21962 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/CostCentre.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Misc.hs - distrib/configure.ac.in - docs/users_guide/9.6.1-notes.rst - docs/users_guide/debugging.rst - docs/users_guide/profiling.rst - hadrian/bindist/Makefile - + hadrian/bindist/config.mk.in - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - libraries/base/GHC/Conc.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/77099a04f8e6df0470437512a692494181e65eea...3c5752cc409575e1beace88e9bc6e73481485aaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77099a04f8e6df0470437512a692494181e65eea...3c5752cc409575e1beace88e9bc6e73481485aaf You're receiving 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 Aug 10 19:57:53 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 15:57:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21847 Message-ID: <62f40dc1d53ff_142b4952170193252@gitlab.mail> Ben Gamari pushed new branch wip/T21847 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21847 You're receiving 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 Aug 7 23:08:27 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 19:08:27 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] Add support for libcxxrt Message-ID: <62f045eba765e_25b0164c040355932@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: f8d2c299 by Ben Gamari at 2022-08-07T19:08:20-04:00 Add support for libcxxrt - - - - - 1 changed file: - m4/fp_find_cxx_std_lib.m4 Changes: ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -19,31 +19,36 @@ unknown EOF AC_MSG_CHECKING([C++ standard library flavour]) if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" - d="`dirname "$p"`" - dnl On some platforms (e.g. Windows) the C++ standard library - dnl can be found in the system search path. In this case $CXX - dnl --print-file-name will simply print the filename without a - dnl directory part. Consequently, dirname will return `.`. However, - dnl we don't want to include such paths in the package database. - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + check_lib() { + if grep "lib$$1" actest.out >/dev/null; then + CXX_STD_LIB_LIBS="$$1" + p="`"$CXX" --print-file-name lib$$1.so`" + d="`dirname "$p"`" + dnl On some platforms (e.g. Windows) the C++ standard library + dnl can be found in the system search path. In this case $CXX + dnl --print-file-name will simply print the filename without a + dnl directory part. Consequently, dirname will return `.`. However, + dnl we don't want to include such paths in the package database. + if test "$d" = "."; then d=""; fi + CXX_STD_LIB_LIB_DIRS="$d" + CXX_STD_LIB_DYN_LIB_DIRS="$d" + AC_MSG_RESULT([lib$$1]) + fi + } + + dnl C++ standard library (e.g. STL) + check_lib "c++" + check_lib "stdc++" + if [ -z "$CXX_STD_LIB_LIBS" ]; then + AC_MSG_ERROR([Unknown C++ standard library implementation. Please set CXX_STD_LIB_LIBS, CXX_STD_LIB_LIB_DIRS and CXX_STD_LIB_DYN_LIB_DIRS manually.]) fi + + dnl ABI library + AC_MSG_CHECKING([C++ ABI flavour]) + check_lib "c++abi" + check_lib "cxxrt" + check_lib "supc++" + rm -f actest.cpp actest.out else rm -f actest.cpp actest.out View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8d2c2990b4440c028723f60f2cb57b417ecd2b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8d2c2990b4440c028723f60f2cb57b417ecd2b8 You're receiving 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 Aug 9 20:37:00 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 16:37:00 -0400 Subject: [Git][ghc/ghc][wip/nr/wasm-control-flow] add new modules for reducibility and WebAssembly translation Message-ID: <62f2c56cc2af5_182c4e506183646f7@gitlab.mail> Norman Ramsey pushed to branch wip/nr/wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: a8a3a878 by Norman Ramsey at 2022-08-09T16:36:50-04:00 add new modules for reducibility and WebAssembly translation also includes an emitter for GNU assembler code and some regression tests - - - - - 30 changed files: - + compiler/GHC/Cmm/Reducibility.hs - + compiler/GHC/Data/Graph/Collapse.hs - + compiler/GHC/Wasm/ControlFlow.hs - + compiler/GHC/Wasm/ControlFlow/FromCmm.hs - + compiler/GHC/Wasm/ControlFlow/ToAsm.hs - compiler/ghc.cabal.in - testsuite/tests/linters/notes.stdout - + 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8a3a8785fa1a58436bcf6460c2f3bcc8412cd53 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8a3a8785fa1a58436bcf6460c2f3bcc8412cd53 You're receiving 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 Aug 8 14:17:36 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 10:17:36 -0400 Subject: [Git][ghc/ghc][wip/T19143] Apply 1 suggestion(s) to 1 file(s) Message-ID: <62f11b00ab061_25b0164c07c4946ef@gitlab.mail> Ben Gamari pushed to branch wip/T19143 at Glasgow Haskell Compiler / GHC Commits: 77099a04 by Douglas Wilson at 2022-08-08T14:17:32+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - rts/include/Cmm.h Changes: ===================================== rts/include/Cmm.h ===================================== @@ -874,6 +874,7 @@ */ #define setCardsValue(arr, dst_off, n, value) \ W_ __start_card, __end_card, __cards, __dst_cards_p; \ + ASSERT(n != 0); \ __dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \ __start_card = mutArrPtrCardDown(dst_off); \ __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77099a04f8e6df0470437512a692494181e65eea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77099a04f8e6df0470437512a692494181e65eea You're receiving 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 Aug 11 15:51:55 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 11 Aug 2022 11:51:55 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] Fixes Message-ID: <62f5259bee197_142b495183840964b@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 8b0d0501 by Matthew Pickering at 2022-08-11T16:50:10+01:00 Fixes - - - - - 18 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Unit/Module/FatIface.hs - compiler/GHC/Unit/Module/Location.hs - testsuite/tests/driver/fat-iface/Makefile - testsuite/tests/driver/fat-iface/all.T - testsuite/tests/driver/fat-iface/fat001.stdout - testsuite/tests/driver/fat-iface/fat006.stdout - + testsuite/tests/driver/fat-iface/fat006a.stderr Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -663,7 +663,7 @@ backendForcesOptimization0 (Named NCG) = False backendForcesOptimization0 (Named LLVM) = False backendForcesOptimization0 (Named ViaC) = False backendForcesOptimization0 (Named Interpreter) = True -backendForcesOptimization0 (Named NoBackend) = False +backendForcesOptimization0 (Named NoBackend) = True -- | I don't understand exactly how this works. But if -- this flag is set *and* another condition is met, then ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -278,8 +278,8 @@ import System.IO import {-# SOURCE #-} GHC.Driver.Pipeline import Data.Time -import GHC.Utils.Trace -import System.IO.Unsafe +import System.IO.Unsafe ( unsafeInterleaveIO ) +import GHC.Iface.Env ( trace_if ) @@ -687,7 +687,7 @@ hsc_typecheck keep_rn mod_summary mb_rdr_module = do Nothing -> hscParse' mod_summary tc_result0 <- tcRnModule' mod_summary keep_rn' hpm if hsc_src == HsigFile - then do (iface, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 mod_summary + then do (iface, _) <- liftIO $ hscSimpleIface hsc_env Nothing tc_result0 mod_summary ioMsgMaybe $ hoistTcRnMessage $ tcRnMergeSignatures hsc_env hpm tc_result0 iface else return tc_result0 @@ -752,7 +752,7 @@ hscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts hscDesugar hsc_env mod_summary tc_result = runHsc hsc_env $ hscDesugar' (ms_location mod_summary) tc_result -hscDesugar' :: HasCallStack => ModLocation -> TcGblEnv -> Hsc ModGuts +hscDesugar' :: ModLocation -> TcGblEnv -> Hsc ModGuts hscDesugar' mod_location tc_result = do hsc_env <- getHscEnv ioMsgMaybe $ hoistDsMessage $ @@ -850,10 +850,11 @@ hscRecompStatus else -- Do need linkable do - -- 1. Just check whether we have ByteCode/object linkables and then + -- 1. Just check whether we have bytecode/object linkables and then -- we will decide if we need them or not. bc_linkable <- checkByteCode checked_iface mod_summary (homeMod_bytecode old_linkable) obj_linkable <- liftIO $ checkObjects lcl_dflags (homeMod_object old_linkable) mod_summary + trace_if (hsc_logger hsc_env) (vcat [text "BCO linkable", nest 2 (ppr bc_linkable), text "Object Linkable", ppr obj_linkable]) let just_bc = justBytecode <$> bc_linkable just_o = justObjects <$> obj_linkable @@ -949,7 +950,7 @@ checkByteCode iface mod_sum mb_old_linkable = loadByteCode :: ModIface -> ModSummary -> IO (MaybeValidated Linkable) loadByteCode iface mod_sum = do let - this_mod = ms_mod mod_sum + this_mod = ms_mod mod_sum if_date = fromJust $ ms_iface_date mod_sum case mi_extra_decls iface of Just extra_decls -> do @@ -963,8 +964,8 @@ loadByteCode iface mod_sum = do -- Knot tying! See Note [Knot-tying typecheckIface] -- See Note [ModDetails and --make mode] -initModDetails :: HscEnv -> ModSummary -> ModIface -> IO ModDetails -initModDetails hsc_env _mod_summary iface = +initModDetails :: HscEnv -> ModIface -> IO ModDetails +initModDetails hsc_env iface = fixIO $ \details' -> do let act hpt = addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details' emptyHomeModInfoLinkable) @@ -982,14 +983,18 @@ initFatIface hsc_env mod_iface details (LM utc_time this_mod uls) = LM utc_time go (FI fi) = do let act hpt = addToHpt hpt (moduleName $ mi_module mod_iface) (HomeModInfo mod_iface details emptyHomeModInfoLinkable) - types_var <- newIORef (md_types details) -- (extendTypeEnvList emptyTypeEnv ((map ATyCon tycons) ++ concatMap (implicitTyThings . ATyCon) tycons)) + types_var <- newIORef (md_types details) let kv = knotVarsFromModuleEnv (mkModuleEnv [(this_mod, types_var)]) let hsc_env' = hscUpdateHPT act hsc_env { hsc_type_env_vars = kv } core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckFatIface types_var fi -- MP: TODO: NoStubs defo wrong let cgi_guts = CgInteractiveGuts this_mod core_binds (typeEnvTyCons (md_types details)) NoStubs Nothing [] + -- The bytecode generation itself is lazy because otherwise even when doing + -- recompilation checking the bytecode will be generated (which slows things down a lot) + -- the laziness is OK because generateByteCode just depends on things already loaded + -- in the interface file. LoadedBCOs <$> (unsafeInterleaveIO $ do - pprTraceM "forcing" (ppr this_mod) + trace_if (hsc_logger hsc_env) (text "Generating ByteCode for" <+> (ppr this_mod)) generateByteCode hsc_env cgi_guts (fi_mod_location fi)) go ul = return ul @@ -1047,7 +1052,7 @@ See !5492 and #13586 -- HscRecomp in turn will carry the information required to compute a interface -- when passed the result of the code generator. So all this can and is done at -- the call site of the backend code gen if it is run. -hscDesugarAndSimplify :: HasCallStack => ModSummary +hscDesugarAndSimplify :: ModSummary -> FrontendResult -> Messages GhcMessage -> Maybe Fingerprint @@ -1099,18 +1104,34 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h hscs_old_iface_hash = mb_old_hash } - -- We are not generating code, so we can skip simplification + Just desugared_guts | gopt Opt_WriteFatInterface dflags -> do + -- If -fno-code is enabled (hence we fall through to this case) then + -- -O0 is implied, so this simplifier pass will be quite gentle. Running + -- the simplifier once is necessary before doing byte code generation + -- in order to inline data con wrappers. + plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result) + simplified_guts <- hscSimplify' plugins desugared_guts + (cg_guts, _) <- + liftIO $ hscTidy hsc_env simplified_guts + + (iface, _details) <- liftIO $ + hscSimpleIface hsc_env (Just $ cg_binds cg_guts) tc_result summary + + liftIO $ hscMaybeWriteIface logger dflags True iface mb_old_hash (ms_location summary) + + return $ HscUpdate iface + + + -- We are not generating code or writing a fat interface so we can skip simplification -- and generate a simple interface. _ -> do - --MP: TODO, we should be able to write a fat interface even when NoBackend is on (iface, _details) <- liftIO $ - hscSimpleIface hsc_env tc_result summary + hscSimpleIface hsc_env Nothing tc_result summary liftIO $ hscMaybeWriteIface logger dflags True iface mb_old_hash (ms_location summary) return $ HscUpdate iface - {- Note [Writing interface files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1716,16 +1737,18 @@ hscSimplify' plugins ds_result = do -- | Generate a striped down interface file, e.g. for boot files or when ghci -- generates interface files. See Note [simpleTidyPgm - mkBootModDetailsTc] hscSimpleIface :: HscEnv + -> Maybe CoreProgram -> TcGblEnv -> ModSummary -> IO (ModIface, ModDetails) -hscSimpleIface hsc_env tc_result summary - = runHsc hsc_env $ hscSimpleIface' tc_result summary +hscSimpleIface hsc_env mb_core_program tc_result summary + = runHsc hsc_env $ hscSimpleIface' mb_core_program tc_result summary -hscSimpleIface' :: TcGblEnv +hscSimpleIface' :: Maybe CoreProgram + -> TcGblEnv -> ModSummary -> Hsc (ModIface, ModDetails) -hscSimpleIface' tc_result summary = do +hscSimpleIface' mb_core_program tc_result summary = do hsc_env <- getHscEnv logger <- getLogger details <- liftIO $ mkBootModDetailsTc logger tc_result @@ -1733,7 +1756,7 @@ hscSimpleIface' tc_result summary = do new_iface <- {-# SCC "MkFinalIface" #-} liftIO $ - mkIfaceTc hsc_env safe_mode details summary tc_result + mkIfaceTc hsc_env safe_mode details summary mb_core_program tc_result -- And the answer is ... liftIO $ dumpIfaceStats hsc_env return (new_iface, details) @@ -1906,10 +1929,7 @@ generateFreshByteCode :: HscEnv -> ModLocation -> IO Linkable generateFreshByteCode hsc_env mod_name cgguts mod_location = do - -- MP: Not sure this is great to have this unsafeInterlaveIO here, it's definitely necessary - -- in the case of generating byte code from an interface but potentially leaky in general because - -- `cgguts` may not be so clean in memory as that which has just been loaded from an interface. - ul <- unsafeInterleaveIO $ generateByteCode hsc_env cgguts mod_location + ul <- generateByteCode hsc_env cgguts mod_location unlinked_time <- getCurrentTime let !linkable = LM unlinked_time (mkHomeModule (hsc_home_unit hsc_env) mod_name) ul return linkable ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -244,7 +244,7 @@ compileOne' mHscMessage let pipeline = hscPipeline pipe_env (setDumpPrefix pipe_env plugin_hsc_env, upd_summary, status) (iface, linkable) <- runPipeline (hsc_hooks hsc_env) pipeline -- See Note [ModDetails and --make mode] - details <- initModDetails plugin_hsc_env upd_summary iface + details <- initModDetails plugin_hsc_env iface linkable' <- traverse (initFatIface plugin_hsc_env iface details) (homeMod_bytecode linkable) return $! HomeModInfo iface details (linkable { homeMod_bytecode = linkable' }) @@ -765,7 +765,7 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do unlinked_time <- liftIO (liftIO getCurrentTime) final_unlinked <- DotO <$> use (T_MergeForeign pipe_env hsc_env o_fp fos) let !linkable = LM unlinked_time (ms_mod mod_sum) [final_unlinked] - -- If the backend step produced a bytecode linkable then use that rather than the object file linkable. + -- Add the object linkable to the potential bytecode linkable which was generated in HscBackend. return (mlinkable { homeMod_object = Just linkable }) return (miface, final_linkable) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2250,7 +2250,6 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "dynamic-too" (NoArg (setGeneralFlag Opt_BuildDynamicToo)) - ------- Keeping temporary files ------------------------------------- -- These can be singular (think ghc -c) or plural (think ghc --make) , make_ord_flag defGhcFlag "keep-hc-file" ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -148,7 +148,6 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do , mi_src_hash = src_hash } - -- | This performs a get action after reading the dictionary and symbol -- table. It is necessary to run this before trying to deserialise any -- Names or FastStrings. ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -1129,8 +1129,7 @@ pprModIface unit_state iface at ModIface{ mi_final_exts = exts } , case mi_extra_decls iface of Nothing -> empty Just eds -> text "extra-decls" - -- TODO: MP print better with structure - $$ vcat ([ppr bs | bs <- eds]) + $$ nest 2 (vcat ([ppr bs | bs <- eds])) , vcat (map ppr (mi_insts iface)) , vcat (map ppr (mi_fam_insts iface)) , vcat (map ppr (mi_rules iface)) ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -186,9 +186,10 @@ mkIfaceTc :: HscEnv -> SafeHaskellMode -- The safe haskell mode -> ModDetails -- gotten from mkBootModDetails, probably -> ModSummary + -> Maybe CoreProgram -> TcGblEnv -- Usages, deprecations, etc -> IO ModIface -mkIfaceTc hsc_env safe_mode mod_details mod_summary +mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program tc_result at TcGblEnv{ tcg_mod = this_mod, tcg_src = hsc_src, tcg_imports = imports, @@ -229,7 +230,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary docs <- extractDocs (ms_hspp_opts mod_summary) tc_result let partial_iface = mkIface_ hsc_env - this_mod [] hsc_src + this_mod (fromMaybe [] mb_program) hsc_src used_th deps rdr_env fix_env warns hpc_info (imp_trust_own_pkg imports) safe_mode usages ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Unit.Module.Warnings import GHC.Unit.Module.Deps import Control.Monad -import Data.List (sortBy, sort) +import Data.List (sortBy, sort, sortOn) import qualified Data.Map as Map import qualified Data.Set as Set import Data.Word (Word64) @@ -1201,9 +1201,14 @@ addFingerprints hsc_env iface0 sorted_decls = Map.elems $ Map.fromList $ [(getOccName d, e) | e@(_, d) <- decls_w_hashes] - -- TODO: MP implement sorting here + getOcc (IfGblTopBndr b) = getOccName b + getOcc (IfLclTopBndr fs _ _ _) = mkVarOccFS fs + + binding_key (IfaceNonRec b _) = IfaceNonRec (getOcc b) () + binding_key (IfaceRec bs) = IfaceRec (map (\(b, _) -> (getOcc b, ())) bs) + sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] - sorted_extra_decls = mi_extra_decls iface0 + sorted_extra_decls = sortOn binding_key <$> mi_extra_decls iface0 -- the flag hash depends on: -- - (some of) dflags ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -586,21 +586,15 @@ type IfaceBinding b = IfaceBindingX IfaceExpr b data IfaceBindingX r b = IfaceNonRec b r | IfaceRec [(b, r)] - deriving (Functor, Foldable, Traversable) + deriving (Functor, Foldable, Traversable, Ord, Eq) -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too -- It's used for *non-top-level* let/rec binders -- See Note [IdInfo on nested let-bindings] data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo -data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDetails | IfGblTopBndr IfaceTopBndr - - {- - IfTopBndr { top_bndr_name :: Either IfLclName IfaceTopBndr - , top_bndr_type :: IfaceType - , top_bndr_id_info :: IfaceIdInfo - , top_bndr_iface_details :: IfaceIdDetails - ]-} +data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDetails + | IfGblTopBndr IfaceTopBndr data IfaceMaybeRhs = IfUseUnfoldingRhs | IfRhs IfaceExpr ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -237,7 +237,7 @@ typecheckIface iface } } -typecheckFatIface :: IORef TypeEnv -> FatIface -> IfG [CoreBind] +typecheckFatIface :: IORef TypeEnv -> FatIface -> IfG [CoreBind] typecheckFatIface type_var (FatIface prepd_binding this_mod _) = initIfaceLcl this_mod (text "typecheckFatIface") NotBoot $ do tcTopIfaceBindings type_var prepd_binding ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -157,7 +157,7 @@ data Unlinked = DotO ObjFile -- ^ An object file (.o) | DotA FilePath -- ^ Static archive file (.a) | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) - | FI FatIface -- ^ Serialised core which we can turn into BCOs (or object files) + | FI FatIface -- ^ Serialised core which we can turn into BCOs (or object files), or used by some other backend | LoadedBCOs [Unlinked] -- ^ A list of BCOs, but hidden behind extra indirection to avoid -- being too strict. | BCOs CompiledByteCode ===================================== compiler/GHC/Unit/Module/FatIface.hs ===================================== @@ -1,17 +1,10 @@ module GHC.Unit.Module.FatIface where -import GHC.Prelude import GHC.Unit.Types (Module) import GHC.Unit.Module.Location import GHC.Iface.Syntax -import GHC.Utils.Binary data FatIface = FatIface { fi_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] , fi_module :: Module , fi_mod_location :: ModLocation } - - -instance Binary FatIface where - put_ bh (FatIface a b c) = put_ bh a >> put_ bh b >> put_ bh c - get bh = FatIface <$> get bh <*> get bh <*> get bh ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -13,7 +13,6 @@ where import GHC.Prelude import GHC.Unit.Types import GHC.Utils.Outputable -import GHC.Utils.Binary -- | Module Location -- @@ -69,21 +68,6 @@ data ModLocation } deriving Show -instance Binary ModLocation where - put_ bh (ModLocation a b c d e f) = do - put_ bh a - put_ bh b - put_ bh c - put_ bh d - put_ bh e - put_ bh f - get bh = ModLocation <$> get bh - <*> get bh - <*> get bh - <*> get bh - <*> get bh - <*> get bh - instance Outputable ModLocation where ppr = text . show ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -8,7 +8,7 @@ clean: rm -f *.hi *.hi-fat *.o fat001: clean - "$(TEST_HC)" $(TEST_HC_OPTS) -c Fat.hs -fwrite-fat-interface + "$(TEST_HC)" $(TEST_HC_OPTS) -c Fat.hs -fwrite-fat-interface -dno-typeable-binds test -f Fat.hi "$(TEST_HC)" $(TEST_HC_OPTS) --show-iface Fat.hi | grep -A3 extra-decls @@ -22,15 +22,15 @@ fat007: clean "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -ddump-bcos Fat.hs -# -fno-code -fwrite-fat-interface should not generate object files but should generate .hi-fat -# -fwrite-fat-interface also implies -fwrite-interface (you need both) - fat006: clean - "$(TEST_HC)" $(TEST_HC_OPTS) -c Fat.hs -fno-code -fwrite-fat-interface + "$(TEST_HC)" $(TEST_HC_OPTS) -c Fat.hs -dno-typeable-binds -fno-code -fwrite-fat-interface test -f Fat.hi "$(TEST_HC)" $(TEST_HC_OPTS) --show-iface Fat.hi | grep -A3 extra-decls test ! -f Fat.o +fat006a: clean + "$(TEST_HC)" $(TEST_HC_OPTS) -c Fat.hs -dno-typeable-binds -fno-code -fwrite-fat-interface -O2 + fat008: clean "$(TEST_HC)" $(TEST_HC_OPTS) FatTH.hs -fwrite-fat-interface -fprefer-byte-code echo >> "FatTH.hs" ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -1,7 +1,8 @@ test('fat001', [extra_files(['Fat.hs'])], makefile_test, ['fat001']) test('fat005', [extra_files(['Fat.hs']), filter_stdout_lines(r'= Proto-BCOs')], makefile_test, ['fat005']) -test('fat007', [extra_files(['Fat.hs'])], makefile_test, ['fat007']) test('fat006', [extra_files(['Fat.hs'])], makefile_test, ['fat006']) +test('fat006a', [extra_files(['Fat.hs'])], makefile_test, ['fat006a']) +test('fat007', [extra_files(['Fat.hs'])], makefile_test, ['fat007']) test('fat008', [unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat008']) test('fat009', [extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat009']) test('fat010', [extra_files(['THA.hs', 'THB.hs', 'THC.hs']), copy_files], makefile_test, ['fat010']) ===================================== testsuite/tests/driver/fat-iface/fat001.stdout ===================================== @@ -1,4 +1,4 @@ extra-decls -f = GHC.Types.C# 'f'# -a = GHC.Types.C# 'a'# -t = GHC.Types.C# 't'# + a = GHC.Types.C# 'a'# + f = GHC.Types.C# 'f'# + t = GHC.Types.C# 't'# ===================================== testsuite/tests/driver/fat-iface/fat006.stdout ===================================== @@ -1,4 +1,4 @@ extra-decls -trusted: none -require own pkg trusted: False -docs: + a = GHC.Types.C# 'a'# + f = GHC.Types.C# 'f'# + t = GHC.Types.C# 't'# ===================================== testsuite/tests/driver/fat-iface/fat006a.stderr ===================================== @@ -0,0 +1,3 @@ + +when making flags consistent: warning: + Optimization flags are incompatible with the no code generated; optimization flags ignored. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b0d05010591a0e5e01d4cffc2630768938ca753 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b0d05010591a0e5e01d4cffc2630768938ca753 You're receiving 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 Aug 11 17:03:45 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 Aug 2022 13:03:45 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f53671da1a8_142b495215c4180af@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: d6c553a6 by Ben Gamari at 2022-08-11T13:03:30-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,63 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +904,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2023,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2034,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,195 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * In general, we run finalizers in the reverse order of the associated + * initializers. That is to say, e.g., .init_array entries are run from first + * to last entry and therefore .fini_array entries are run from last-to-first. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + // .fini_array finalizers are run backwards + for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,28 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1594,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2128,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6c553a627db0dfe69ce9ea25ad2fb6190738314 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6c553a627db0dfe69ce9ea25ad2fb6190738314 You're receiving 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 Aug 8 03:50:25 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 23:50:25 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 22 commits: compiler: Eliminate two uses of foldr in favor of foldl' Message-ID: <62f08801e11d8_25b01650d5c375540@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - d43cdc7e by Ben Gamari at 2022-08-07T23:35:29-04:00 gitlab-ci: Fix a few unbound variable issues - - - - - 21409a1d by Ben Gamari at 2022-08-07T23:35:29-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - e48399b3 by Ben Gamari at 2022-08-07T23:39:55-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 4d6cb626 by Ben Gamari at 2022-08-07T23:40:24-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 17697399 by Ben Gamari at 2022-08-07T23:41:06-04:00 XXX: Bump up freebsd job - - - - - 7a3f8aad by Ben Gamari at 2022-08-07T23:49:49-04:00 gitlab-ci: Use cabal-install-3.6.2.0 on FreeBSD - - - - - 640f6978 by Ben Gamari at 2022-08-07T23:50:01-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/StgToCmm/Prim.hs - distrib/configure.ac.in - docs/users_guide/9.6.1-notes.rst - hadrian/bindist/Makefile - + hadrian/bindist/config.mk.in - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - libraries/base/GHC/Conc.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/Conc/Sync.hs-boot - libraries/base/GHC/Weak/Finalize.hs - libraries/base/changelog.md - libraries/base/tests/all.T - + libraries/base/tests/listThreads.hs - + libraries/base/tests/listThreads.stdout - libraries/ghc-prim/changelog.md - m4/fp_find_cxx_std_lib.m4 - rts/Heap.c - rts/Linker.c - rts/PrimOps.cmm - rts/RtsStartup.c - rts/RtsSymbols.c - rts/Schedule.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48d748a26f71be43d6bd60db01a99b2435490cfd...640f6978e1cd13136bd6360e38f94e2d528b8b85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48d748a26f71be43d6bd60db01a99b2435490cfd...640f6978e1cd13136bd6360e38f94e2d528b8b85 You're receiving 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 Aug 9 04:21:26 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 00:21:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: gitlab-ci: Don't use coreutils on Darwin Message-ID: <62f1e0c6b8219_182c4e4e0ac57937@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b81fecc6 by Ben Gamari at 2022-08-09T00:21:08-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - a25d58f5 by Ben Gamari at 2022-08-09T00:21:08-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 39b26877 by Ben Gamari at 2022-08-09T00:21:08-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - ae347f59 by Krzysztof Gogolewski at 2022-08-09T00:21:09-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 18 changed files: - .gitlab/darwin/toolchain.nix - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Unit/Types.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - + mk/install_script.sh - testsuite/tests/linters/notes.stdout Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== compiler/GHC/Cmm.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Cmm ( module GHC.Cmm.Expr, -- * Pretty-printing - pprCmms, pprCmmGroup, pprSection, pprStatic + pprCmmGroup, pprSection, pprStatic ) where import GHC.Prelude @@ -379,12 +379,6 @@ pprBBlock (BasicBlock ident stmts) = -- -- These conventions produce much more readable Cmm output. -pprCmms :: (OutputableP Platform info, OutputableP Platform g) - => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc -pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms)) - where - separator = space $$ text "-------------------" $$ space - pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g) => Platform -> GenCmmGroup d info g -> SDoc pprCmmGroup platform tops ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -294,9 +294,6 @@ data CLabel instance Show CLabel where show = showPprUnsafe . pprDebugCLabel genericPlatform -instance Outputable CLabel where - ppr = text . show - data ModuleLabelKind = MLK_Initializer String | MLK_InitializerArray @@ -1412,19 +1409,19 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] AsmStyle | use_leading_underscores -> pp_cSEP <> doc _ -> doc - tempLabelPrefixOrUnderscore :: Platform -> SDoc - tempLabelPrefixOrUnderscore platform = case sty of + tempLabelPrefixOrUnderscore :: SDoc + tempLabelPrefixOrUnderscore = case sty of AsmStyle -> asmTempLabelPrefix platform CStyle -> char '_' in case lbl of LocalBlockLabel u -> case sty of - AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u + AsmStyle -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u + CStyle -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u AsmTempLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u AsmTempDerivedLabel l suf -> asmTempLabelPrefix platform @@ -1474,7 +1471,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CStyle -> ppr name <> ppIdFlavor flavor SRTLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt" RtsLabel (RtsApFast (NonDetFastString str)) -> maybe_underscore $ ftext str <> text "_fast" @@ -1514,7 +1511,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr" LargeBitmapLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') -- until that gets resolved we'll just force them to start ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -50,14 +50,14 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock config top_info) blocks) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl platform lbl Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ -- pprProcAlignment config $$ (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' + then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain @@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> ppr info_lbl + <+> pdoc platform info_lbl <+> char '-' - <+> ppr (mkDeadStripPreventer info_lbl) + <+> pdoc platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -87,9 +87,6 @@ pprAlignForSection _platform _seg -- .balign is stable, whereas .align is platform dependent. = text "\t.balign 8" -- always 8 -instance Outputable Instr where - ppr = pprInstr genericPlatform - -- | Print section header and appropriate alignment for that section. -- -- This one will emit the header: @@ -118,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel asmLbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -138,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel info_lbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' else empty) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -235,7 +232,7 @@ pprImm _ (ImmInt i) = int i pprImm _ (ImmInteger i) = integer i pprImm p (ImmCLbl l) = pdoc p l pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i -pprImm _ (ImmLit s) = s +pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! pprImm _ (ImmFloat f) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -59,7 +59,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -67,14 +67,8 @@ data Imm | ImmConstantDiff Imm Imm deriving (Eq, Show) -instance Show SDoc where - show = showPprUnsafe . ppr - -instance Eq SDoc where - lhs == rhs = show lhs == show rhs - strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do let code dst = toOL [ LD II32 dst tocAddr ] - tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]")) + tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]") return (Any II32 code) | target32Bit platform = do reg <- getPicBaseNat $ archWordFormat (target32Bit platform) ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -240,7 +240,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/PPC/Regs.hs ===================================== @@ -133,7 +133,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -147,7 +147,7 @@ data Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -432,7 +432,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -55,7 +55,6 @@ import GHC.Platform.Reg.Class import GHC.Cmm import GHC.Cmm.CLabel ( CLabel ) -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -111,7 +110,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -119,7 +118,7 @@ data Imm | ImmConstantDiff Imm Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -363,7 +363,7 @@ emitTickyCounter cloType tickee Just (CgIdInfo { cg_lf = cg_lf }) | isLFThunk cg_lf -> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf - _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -- | -- #name_types# @@ -282,24 +281,9 @@ pprOccName (OccName sp occ) = getPprStyle $ \ sty -> if codeStyle sty then ztext (zEncodeFS occ) - else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) - where - pp_occ = sdocOption sdocSuppressUniques $ \case - True -> text (strip_th_unique (unpackFS occ)) - False -> ftext occ - - -- See Note [Suppressing uniques in OccNames] - strip_th_unique ('[' : c : _) | isAlphaNum c = [] - strip_th_unique (c : cs) = c : strip_th_unique cs - strip_th_unique [] = [] + else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) {- -Note [Suppressing uniques in OccNames] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is a hack to de-wobblify the OccNames that contain uniques from -Template Haskell that have been turned into a string in the OccName. -See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs" - ************************************************************************ * * \subsection{Construction} ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -207,7 +207,7 @@ pprModule mod@(Module p n) = getPprStyle doc | qualModule sty mod = case p of HoleUnit -> angleBrackets (pprModuleName n) - _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n + _ -> ppr p <> char ':' <> pprModuleName n | otherwise = pprModuleName n ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -83,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -230,12 +195,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -44,7 +44,6 @@ ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-bo ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] -ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell] ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f8f6678fbf3686fc6ffc73cbf3db9b485ef53ee...ae347f59f5d3885cdba7f4542872c37ef7bc5c59 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f8f6678fbf3686fc6ffc73cbf3db9b485ef53ee...ae347f59f5d3885cdba7f4542872c37ef7bc5c59 You're receiving 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 Aug 11 18:09:14 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 Aug 2022 14:09:14 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f545ca4eaab_142b495217044529@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: 1ed2f183 by Ben Gamari at 2022-08-11T14:09:00-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,63 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +904,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2023,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2034,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,195 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * In general, we run finalizers in the reverse order of the associated + * initializers. That is to say, e.g., .init_array entries are run from first + * to last entry and therefore .fini_array entries are run from last-to-first. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + continue; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + continue; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + // .fini_array finalizers are run backwards + for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,28 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = 0; + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->init = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->fini = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1594,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2128,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ed2f1838489227400e0890e7f6118fa109fe725 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ed2f1838489227400e0890e7f6118fa109fe725 You're receiving 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 Aug 8 21:19:35 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 17:19:35 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: dataToTag#: Skip runtime tag check if argument is infered tagged Message-ID: <62f17de7acb4a_25b0164c07c615182@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 29da2923 by Ben Gamari at 2022-08-08T17:19:14-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - 9839ea34 by Ben Gamari at 2022-08-08T17:19:14-04:00 Bump process submodule - - - - - 6c702af0 by Ben Gamari at 2022-08-08T17:19:15-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - b5511288 by Ben Gamari at 2022-08-08T17:19:15-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - 37ece3c6 by Ben Gamari at 2022-08-08T17:19:15-04:00 testsuite: Add test for #21962 - - - - - 17 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Expr.hs - docs/users_guide/bugs.rst - libraries/process - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/Cmm.h - rts/include/stg/MiscClosures.h - + testsuite/tests/array/should_run/T21962.hs - testsuite/tests/array/should_run/all.T - + testsuite/tests/codeGen/should_compile/T21710a.hs - + testsuite/tests/codeGen/should_compile/T21710a.stderr - testsuite/tests/codeGen/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -564,15 +565,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${CROSS_TARGET:-}" ]; then + args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" ) + fi + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} + +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +617,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +640,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +806,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/gen_ci.hs ===================================== @@ -116,6 +116,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +159,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } + llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] + ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] -- | The hadrian flavour string we are going to use for this build @@ -597,7 +611,8 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - + , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -769,10 +784,12 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -358,6 +416,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1261,6 +1378,67 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1864,6 +2042,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3680,6 +3918,66 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -20,6 +20,7 @@ where import GHC.Prelude +import GHC.Builtin.PrimOps ( PrimOp(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply @@ -346,6 +347,19 @@ fvArgs args = do type IsScrut = Bool +rewriteArgs :: [StgArg] -> RM [StgArg] +rewriteArgs = mapM rewriteArg +rewriteArg :: StgArg -> RM StgArg +rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v +rewriteArg (lit at StgLitArg{}) = return lit + +-- Attach a tagSig if it's tagged +rewriteId :: Id -> RM Id +rewriteId v = do + is_tagged <- isTagged v + if is_tagged then return $! setIdTagSig v (TagSig TagProper) + else return v + rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr rewriteExpr _ (e at StgCase {}) = rewriteCase e rewriteExpr _ (e at StgLet {}) = rewriteLet e @@ -355,8 +369,11 @@ rewriteExpr _ e@(StgConApp {}) = rewriteConApp e rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e rewriteExpr _ (StgLit lit) = return $! (StgLit lit) +rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do + (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) + rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ @@ -415,6 +432,7 @@ rewriteApp True (StgApp f []) = do -- isTagged looks at more than the result of our analysis. -- So always update here if useful. let f' = if f_tagged + -- TODO: We might consisder using a subst env instead of setting the sig only for select places. then setIdTagSig f (TagSig TagProper) else f return $! StgApp f' [] ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -76,6 +76,8 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = -- dataToTag# :: a -> Int# -- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold +-- TODO: There are some more optimization ideas for this code path +-- in #21710 cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do platform <- getPlatform emitComment (mkFastString "dataToTag#") @@ -92,15 +94,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do -- the constructor index is too large to fit in the pointer and therefore -- we must look in the info table. See Note [Tagging big families]. - slow_path <- getCode $ do - tmp <- newTemp (bWord platform) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - profile <- getProfile - align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig - emitAssign (CmmLocal result_reg) - $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) - - fast_path <- getCode $ do + (fast_path :: CmmAGraph) <- getCode $ do -- Return the constructor index from the pointer tag return_ptr_tag <- getCode $ do emitAssign (CmmLocal result_reg) @@ -113,8 +107,22 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do $ getConstrTag profile align_check (cmmUntag platform amode) emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False) - - emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) + -- If we know the argument is already tagged there is no need to generate code to evaluate it + -- so we skip straight to the fast path. If we don't know if there is a tag we take the slow + -- path which evaluates the argument before fetching the tag. + case (idTagSig_maybe a) of + Just sig + | isTaggedSig sig + -> emit fast_path + _ -> do + slow_path <- getCode $ do + tmp <- newTemp (bWord platform) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + profile <- getProfile + align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig + emitAssign (CmmLocal result_reg) + $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) + emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) emitReturn [CmmReg $ CmmLocal result_reg] ===================================== docs/users_guide/bugs.rst ===================================== @@ -115,6 +115,10 @@ Lexical syntax varid → small {idchar} ⟨reservedid⟩ conid → large {idchar} +- GHC allows redundant parantheses around the function name in the `funlhs` part of declarations. + That is GHC will succeed in parsing a declaration like `((f)) x = ` for any number + of parantheses around `f`. + .. _infelicities-syntax: Context-free syntax ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 7a7431a0ef586c0f1e602e382398b988c699dfc2 +Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 ===================================== rts/PrimOps.cmm ===================================== @@ -350,6 +350,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; + /* Ensure that the card array is initialized */ + if (n != 0) { + setCardsValue(arr, 0, n, 0); + } + // Initialise all elements of the array with the value in R2 p = arr + SIZEOF_StgMutArrPtrs; for: @@ -2801,21 +2806,6 @@ stg_getApStackValzh ( P_ ap_stack, W_ offset ) } } -// Write the cost center stack of the first argument on stderr; return -// the second. Possibly only makes sense for already evaluated -// things? -stg_traceCcszh ( P_ obj, P_ ret ) -{ - W_ ccs; - -#if defined(PROFILING) - ccs = StgHeader_ccs(UNTAG(obj)); - ccall fprintCCS_stderr(ccs "ptr"); -#endif - - jump stg_ap_0_fast(ret); -} - stg_getSparkzh () { W_ spark; ===================================== rts/RtsSymbols.c ===================================== @@ -1015,7 +1015,6 @@ extern char **environ; SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(enabled_capabilities) \ - SymI_HasDataProto(stg_traceCcszh) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ ===================================== rts/include/Cmm.h ===================================== @@ -870,10 +870,11 @@ /* * Set the cards in the array pointed to by arr for an * update to n elements, starting at element dst_off to value (0 to indicate - * clean, 1 to indicate dirty). + * clean, 1 to indicate dirty). n must be non-zero. */ #define setCardsValue(arr, dst_off, n, value) \ W_ __start_card, __end_card, __cards, __dst_cards_p; \ + ASSERT(n != 0); \ __dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \ __start_card = mutArrPtrCardDown(dst_off); \ __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -566,7 +566,6 @@ RTS_FUN_DECL(stg_numSparkszh); RTS_FUN_DECL(stg_noDuplicatezh); -RTS_FUN_DECL(stg_traceCcszh); RTS_FUN_DECL(stg_clearCCSzh); RTS_FUN_DECL(stg_traceEventzh); RTS_FUN_DECL(stg_traceBinaryEventzh); ===================================== testsuite/tests/array/should_run/T21962.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.IO +import GHC.Exts + +main :: IO () +main = do + IO $ \s0 -> case newArray# 0# () s0 of (# s1, arr #) -> (# s1, () #) ===================================== testsuite/tests/array/should_run/all.T ===================================== @@ -23,3 +23,4 @@ test('arr017', when(fast(), skip), compile_and_run, ['']) test('arr018', when(fast(), skip), compile_and_run, ['']) test('arr019', normal, compile_and_run, ['']) test('arr020', normal, compile_and_run, ['']) +test('T21962', normal, compile_and_run, ['']) ===================================== testsuite/tests/codeGen/should_compile/T21710a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# OPTIONS_GHC -O #-} + +module M where + +import GHC.Exts + +data E = A | B | C | D | E + +foo x = + case x of + A -> 2# + B -> 42# + -- In this branch we already now `x` is evaluated, so we shouldn't generate an extra `call` for it. + _ -> dataToTag# x ===================================== testsuite/tests/codeGen/should_compile/T21710a.stderr ===================================== @@ -0,0 +1,446 @@ + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'E2_bytes" { + M.$tc'E2_bytes: + I8[] "'E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'D2_bytes" { + M.$tc'D2_bytes: + I8[] "'D" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'C2_bytes" { + M.$tc'C2_bytes: + I8[] "'C" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'B2_bytes" { + M.$tc'B2_bytes: + I8[] "'B" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'A3_bytes" { + M.$tc'A3_bytes: + I8[] "'A" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tcE2_bytes" { + M.$tcE2_bytes: + I8[] "E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule2_bytes" { + M.$trModule2_bytes: + I8[] "M" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule4_bytes" { + M.$trModule4_bytes: + I8[] "main" + }] + + + +==================== Output Cmm ==================== +[M.foo_entry() { // [R2] + { info_tbls: [(cBa, + label: block_cBa_info + rep: StackRep [] + srt: Nothing), + (cBi, + label: M.foo_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cBi: // global + if ((Sp + -8) < SpLim) (likely: False) goto cBj; else goto cBk; // CmmCondBranch + cBj: // global + R1 = M.foo_closure; // CmmAssign + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall + cBk: // global + I64[Sp - 8] = cBa; // CmmStore + R1 = R2; // CmmAssign + Sp = Sp - 8; // CmmAssign + if (R1 & 7 != 0) goto cBa; else goto cBb; // CmmCondBranch + cBb: // global + call (I64[R1])(R1) returns to cBa, args: 8, res: 8, upd: 8; // CmmCall + cBa: // global + _cBh::P64 = R1 & 7; // CmmAssign + if (_cBh::P64 != 1) goto uBz; else goto cBf; // CmmCondBranch + uBz: // global + if (_cBh::P64 != 2) goto cBe; else goto cBg; // CmmCondBranch + cBe: // global + // dataToTag# + _cBn::P64 = R1 & 7; // CmmAssign + if (_cBn::P64 == 7) (likely: False) goto cBs; else goto cBr; // CmmCondBranch + cBs: // global + _cBo::I64 = %MO_UU_Conv_W32_W64(I32[I64[R1 & (-8)] - 4]); // CmmAssign + goto cBq; // CmmBranch + cBr: // global + _cBo::I64 = _cBn::P64 - 1; // CmmAssign + goto cBq; // CmmBranch + cBq: // global + R1 = _cBo::I64; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBg: // global + R1 = 42; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBf: // global + R1 = 2; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }, + section ""data" . M.foo_closure" { + M.foo_closure: + const M.foo_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule3_closure" { + M.$trModule3_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule4_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule1_closure" { + M.$trModule1_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule_closure" { + M.$trModule_closure: + const GHC.Types.Module_con_info; + const M.$trModule3_closure+1; + const M.$trModule1_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE1_closure" { + M.$tcE1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tcE2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE_closure" { + M.$tcE_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tcE1_closure+1; + const GHC.Types.krep$*_closure+5; + const 10475418246443540865; + const 12461417314693222409; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A1_closure" { + M.$tc'A1_closure: + const GHC.Types.KindRepTyConApp_con_info; + const M.$tcE_closure+1; + const GHC.Types.[]_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A2_closure" { + M.$tc'A2_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'A3_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A_closure" { + M.$tc'A_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'A2_closure+1; + const M.$tc'A1_closure+1; + const 10991425535368257265; + const 3459663971500179679; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B1_closure" { + M.$tc'B1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'B2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B_closure" { + M.$tc'B_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'B1_closure+1; + const M.$tc'A1_closure+1; + const 13038863156169552918; + const 13430333535161531545; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C1_closure" { + M.$tc'C1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'C2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C_closure" { + M.$tc'C_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'C1_closure+1; + const M.$tc'A1_closure+1; + const 8482817676735632621; + const 8146597712321241387; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D1_closure" { + M.$tc'D1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'D2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D_closure" { + M.$tc'D_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'D1_closure+1; + const M.$tc'A1_closure+1; + const 7525207739284160575; + const 13746130127476219356; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E1_closure" { + M.$tc'E1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'E2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E_closure" { + M.$tc'E_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'E1_closure+1; + const M.$tc'A1_closure+1; + const 6748545530683684316; + const 10193016702094081137; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.A_closure" { + M.A_closure: + const M.A_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.B_closure" { + M.B_closure: + const M.B_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.C_closure" { + M.C_closure: + const M.C_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.D_closure" { + M.D_closure: + const M.D_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.E_closure" { + M.E_closure: + const M.E_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""relreadonly" . M.E_closure_tbl" { + M.E_closure_tbl: + const M.A_closure+1; + const M.B_closure+2; + const M.C_closure+3; + const M.D_closure+4; + const M.E_closure+5; + }] + + + +==================== Output Cmm ==================== +[M.A_con_entry() { // [] + { info_tbls: [(cC5, + label: M.A_con_info + rep: HeapRep 1 nonptrs { Con {tag: 0 descr:"main:M.A"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cC5: // global + R1 = R1 + 1; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.B_con_entry() { // [] + { info_tbls: [(cCa, + label: M.B_con_info + rep: HeapRep 1 nonptrs { Con {tag: 1 descr:"main:M.B"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCa: // global + R1 = R1 + 2; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.C_con_entry() { // [] + { info_tbls: [(cCf, + label: M.C_con_info + rep: HeapRep 1 nonptrs { Con {tag: 2 descr:"main:M.C"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCf: // global + R1 = R1 + 3; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.D_con_entry() { // [] + { info_tbls: [(cCk, + label: M.D_con_info + rep: HeapRep 1 nonptrs { Con {tag: 3 descr:"main:M.D"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCk: // global + R1 = R1 + 4; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.E_con_entry() { // [] + { info_tbls: [(cCp, + label: M.E_con_info + rep: HeapRep 1 nonptrs { Con {tag: 4 descr:"main:M.E"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCp: // global + R1 = R1 + 5; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -108,3 +108,4 @@ test('T18614', normal, compile, ['']) test('mk-big-obj', [unless(opsys('mingw32'), skip), pre_cmd('$PYTHON mk-big-obj.py > mk-big-obj.c')], multimod_compile, ['mk-big-obj.c', '-c -v0 -no-hs-main']) +test('T21710a', [ only_ways(['optasm']), when(wordsize(32), skip), grep_errmsg('(call)',[1]) ], compile, ['-ddump-cmm -dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5076c99beaf8d935937718d8d10037596ce5af2e...37ece3c67a9a75717d1f5be942d1f831df64994a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5076c99beaf8d935937718d8d10037596ce5af2e...37ece3c67a9a75717d1f5be942d1f831df64994a You're receiving 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 Aug 10 04:52:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 00:52:22 -0400 Subject: [Git][ghc/ghc][wip/T21976] hadrian: Don't attempt to install documentation if doc/ doesn't exist Message-ID: <62f33986e9e5f_d27044b7bc778f5@gitlab.mail> Ben Gamari pushed to branch wip/T21976 at Glasgow Haskell Compiler / GHC Commits: 3fd2b56c by Ben Gamari at 2022-08-10T00:52:17-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -184,10 +184,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`";' \ + sh '{}' ';' \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fd2b56c0e3432fe94b3b9e30cf8a1b2fd740553 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fd2b56c0e3432fe94b3b9e30cf8a1b2fd740553 You're receiving 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 Aug 9 20:41:02 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 16:41:02 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/nr/typed-wasm-control-flow Message-ID: <62f2c65e73041_182c4e4e0ac365216@gitlab.mail> Norman Ramsey deleted branch wip/nr/typed-wasm-control-flow 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 Aug 8 23:40:12 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 19:40:12 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts: Ensure that Array# card arrays are initialized Message-ID: <62f19edc3234f_25b0164bff064272@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - 4 changed files: - rts/PrimOps.cmm - rts/include/Cmm.h - + testsuite/tests/array/should_run/T21962.hs - testsuite/tests/array/should_run/all.T Changes: ===================================== rts/PrimOps.cmm ===================================== @@ -350,6 +350,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; + /* Ensure that the card array is initialized */ + if (n != 0) { + setCardsValue(arr, 0, n, 0); + } + // Initialise all elements of the array with the value in R2 p = arr + SIZEOF_StgMutArrPtrs; for: ===================================== rts/include/Cmm.h ===================================== @@ -870,10 +870,11 @@ /* * Set the cards in the array pointed to by arr for an * update to n elements, starting at element dst_off to value (0 to indicate - * clean, 1 to indicate dirty). + * clean, 1 to indicate dirty). n must be non-zero. */ #define setCardsValue(arr, dst_off, n, value) \ W_ __start_card, __end_card, __cards, __dst_cards_p; \ + ASSERT(n != 0); \ __dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \ __start_card = mutArrPtrCardDown(dst_off); \ __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \ ===================================== testsuite/tests/array/should_run/T21962.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.IO +import GHC.Exts + +main :: IO () +main = do + IO $ \s0 -> case newArray# 0# () s0 of (# s1, arr #) -> (# s1, () #) ===================================== testsuite/tests/array/should_run/all.T ===================================== @@ -23,3 +23,4 @@ test('arr017', when(fast(), skip), compile_and_run, ['']) test('arr018', when(fast(), skip), compile_and_run, ['']) test('arr019', normal, compile_and_run, ['']) test('arr020', normal, compile_and_run, ['']) +test('T21962', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae707762335dabe2bb7e40639fd2ab2c7d3234fd...e5ceff56a6f11e4adc17a7cc05645b3e3a66ab97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae707762335dabe2bb7e40639fd2ab2c7d3234fd...e5ceff56a6f11e4adc17a7cc05645b3e3a66ab97 You're receiving 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 Aug 9 11:23:51 2022 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 09 Aug 2022 07:23:51 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Fix EMSDK configure condition Message-ID: <62f243c74c037_182c4e5065411512b@gitlab.mail> Josh Meredith pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: b39b3262 by Josh Meredith at 2022-08-09T11:23:42+00:00 Fix EMSDK configure condition - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -351,9 +351,12 @@ then AC_ARG_VAR(EMSDK,[Use as the full path to Emscripten. [default=autodetect]]) AC_ARG_VAR(EMSDK_LLVM,[Use as the full path to Emscripten LLVM. [default=autodetect]]) + AC_ARG_VAR(EMSDK_BIN,[Use as the full path to Emscripten binary folder. [default=autodetect]]) if test "$EMSDK" != "" ; then echo "Using emsdk: $EMSDK" + elif test "$EMSDK_LLVM" != "" && "$EMSDK_BIN" != "" ; then + echo "Using manually defined emsdk LLVM and bin." else echo -e "Error: Could not find Emscripten SDK.\nCheck the EMSDK environment variable." exit 1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b39b3262ab0e37bfadebf8dd58ba367350e71cfa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b39b3262ab0e37bfadebf8dd58ba367350e71cfa You're receiving 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 Aug 8 03:52:58 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 23:52:58 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 2 commits: gitlab-ci: XXX temporary GHC bindist on FreeBSD Message-ID: <62f0889a3051e_25b0164c0543761c2@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 532da1a5 by Ben Gamari at 2022-08-07T23:51:56-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - 0135b58c by Ben Gamari at 2022-08-07T23:52:07-04:00 Update jobs.yaml - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -278,6 +278,9 @@ function fetch_ghc() { start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + if "$(uname)" = "FreeBSD"; then + url="http://home.smart-cactus.org/~ben/ghc/ghc-9.4.1-x86_64-portbld-freebsd.tar.xz" + fi info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" ===================================== .gitlab/gen_ci.hs ===================================== @@ -306,7 +306,7 @@ opsysVariables _ FreeBSD13 = mconcat -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.2.2" + , "GHC_VERSION" =: "9.4.1" , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = ===================================== .gitlab/jobs.yaml ===================================== @@ -586,7 +586,7 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ "x86_64-freebsd13" ], @@ -594,9 +594,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL": "/usr/local/bin/cabal", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" @@ -2095,7 +2095,7 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ "x86_64-freebsd13" ], @@ -2103,9 +2103,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL": "/usr/local/bin/cabal", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "TEST_ENV": "x86_64-freebsd13-release", @@ -3015,7 +3015,7 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ "x86_64-freebsd13" ], @@ -3023,9 +3023,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL": "/usr/local/bin/cabal", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "TEST_ENV": "x86_64-freebsd13-validate" } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/640f6978e1cd13136bd6360e38f94e2d528b8b85...0135b58c04d5d3a891bf452007a08f94e6a144a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/640f6978e1cd13136bd6360e38f94e2d528b8b85...0135b58c04d5d3a891bf452007a08f94e6a144a2 You're receiving 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 Aug 11 12:20:53 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 11 Aug 2022 08:20:53 -0400 Subject: [Git][ghc/ghc][wip/andreask/infer_exprs] Tag inference: Fix #21954 by retaining tagsigs of vars in function position. Message-ID: <62f4f425d802b_142b49517c0363889@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer_exprs at Glasgow Haskell Compiler / GHC Commits: b0a70269 by Andreas Klebinger at 2022-08-11T14:20:23+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 4 changed files: - compiler/GHC/Stg/InferTags/Rewrite.hs - testsuite/tests/simplStg/should_compile/all.T - + testsuite/tests/simplStg/should_compile/inferTags002.hs - + testsuite/tests/simplStg/should_compile/inferTags002.stderr Changes: ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -336,7 +336,7 @@ rewriteRhs (_id, _tagSig) (StgRhsCon ccs con cn ticks args) = {-# SCC rewriteRhs rewriteRhs _binding (StgRhsClosure fvs ccs flag args body) = do withBinders NotTopLevel args $ withClosureLcls fvs $ - StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr False body + StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr body -- return (closure) fvArgs :: [StgArg] -> RM DVarSet @@ -345,40 +345,36 @@ fvArgs args = do -- pprTraceM "fvArgs" (text "args:" <> ppr args $$ text "lcls:" <> pprVarSet (fv_lcls) (braces . fsep . map ppr) ) return $ mkDVarSet [ v | StgVarArg v <- args, elemVarSet v fv_lcls] -type IsScrut = Bool - rewriteArgs :: [StgArg] -> RM [StgArg] rewriteArgs = mapM rewriteArg rewriteArg :: StgArg -> RM StgArg rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v rewriteArg (lit at StgLitArg{}) = return lit --- Attach a tagSig if it's tagged rewriteId :: Id -> RM Id rewriteId v = do is_tagged <- isTagged v if is_tagged then return $! setIdTagSig v (TagSig TagProper) else return v -rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr -rewriteExpr _ (e at StgCase {}) = rewriteCase e -rewriteExpr _ (e at StgLet {}) = rewriteLet e -rewriteExpr _ (e at StgLetNoEscape {}) = rewriteLetNoEscape e -rewriteExpr isScrut (StgTick t e) = StgTick t <$!> rewriteExpr isScrut e -rewriteExpr _ e@(StgConApp {}) = rewriteConApp e - -rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e -rewriteExpr _ (StgLit lit) = return $! (StgLit lit) -rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do +rewriteExpr :: InferStgExpr -> RM TgStgExpr +rewriteExpr (e at StgCase {}) = rewriteCase e +rewriteExpr (e at StgLet {}) = rewriteLet e +rewriteExpr (e at StgLetNoEscape {}) = rewriteLetNoEscape e +rewriteExpr (StgTick t e) = StgTick t <$!> rewriteExpr e +rewriteExpr e@(StgConApp {}) = rewriteConApp e +rewriteExpr e@(StgApp {}) = rewriteApp e +rewriteExpr (StgLit lit) = return $! (StgLit lit) +rewriteExpr (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty -rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) +rewriteExpr (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ pure StgCase <*> - rewriteExpr True scrut <*> + rewriteExpr scrut <*> pure (fst bndr) <*> pure alt_type <*> mapM rewriteAlt alts @@ -388,7 +384,7 @@ rewriteCase _ = panic "Impossible: nodeCase" rewriteAlt :: InferStgAlt -> RM TgStgAlt rewriteAlt alt at GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs} = withBinders NotTopLevel bndrs $ do - !rhs' <- rewriteExpr False rhs + !rhs' <- rewriteExpr rhs return $! alt {alt_bndrs = map fst bndrs, alt_rhs = rhs'} rewriteLet :: InferStgExpr -> RM TgStgExpr @@ -396,7 +392,7 @@ rewriteLet (StgLet xt bind expr) = do (!bind') <- rewriteBinds NotTopLevel bind withBind NotTopLevel bind $ do -- pprTraceM "withBindLet" (ppr $ bindersOfX bind) - !expr' <- rewriteExpr False expr + !expr' <- rewriteExpr expr return $! (StgLet xt bind' expr') rewriteLet _ = panic "Impossible" @@ -404,7 +400,7 @@ rewriteLetNoEscape :: InferStgExpr -> RM TgStgExpr rewriteLetNoEscape (StgLetNoEscape xt bind expr) = do (!bind') <- rewriteBinds NotTopLevel bind withBind NotTopLevel bind $ do - !expr' <- rewriteExpr False expr + !expr' <- rewriteExpr expr return $! (StgLetNoEscape xt bind' expr') rewriteLetNoEscape _ = panic "Impossible" @@ -424,19 +420,12 @@ rewriteConApp (StgConApp con cn args tys) = do rewriteConApp _ = panic "Impossible" --- Special case: Expressions like `case x of { ... }` -rewriteApp :: IsScrut -> InferStgExpr -> RM TgStgExpr -rewriteApp True (StgApp f []) = do - -- pprTraceM "rewriteAppScrut" (ppr f) - f_tagged <- isTagged f - -- isTagged looks at more than the result of our analysis. - -- So always update here if useful. - let f' = if f_tagged - -- TODO: We might consisder using a subst env instead of setting the sig only for select places. - then setIdTagSig f (TagSig TagProper) - else f +-- Special case: Atomic binders, usually in a case context like `case f of ...`. +rewriteApp :: InferStgExpr -> RM TgStgExpr +rewriteApp (StgApp f []) = do + f' <- rewriteId f return $! StgApp f' [] -rewriteApp _ (StgApp f args) +rewriteApp (StgApp f args) -- pprTrace "rewriteAppOther" (ppr f <+> ppr args) False -- = undefined | Just marks <- idCbvMarks_maybe f @@ -457,8 +446,8 @@ rewriteApp _ (StgApp f args) cbvArgIds = [x | StgVarArg x <- map fstOf3 cbvArgInfo] :: [Id] mkSeqs args cbvArgIds (\cbv_args -> StgApp f cbv_args) -rewriteApp _ (StgApp f args) = return $ StgApp f args -rewriteApp _ _ = panic "Impossible" +rewriteApp (StgApp f args) = return $ StgApp f args +rewriteApp _ = panic "Impossible" -- `mkSeq` x x' e generates `case x of x' -> e` -- We could also substitute x' for x in e but that's so rarely beneficial ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -11,3 +11,5 @@ setTestOpts(f) test('T13588', [ grep_errmsg('case') ] , compile, ['-dverbose-stg2stg -fno-worker-wrapper']) test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typeable-binds']) +test('inferTags002', [ only_ways(['optasm']), grep_errmsg('(stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) +test('inferTags002', [ grep_errmsg('(stg_ap_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) ===================================== testsuite/tests/simplStg/should_compile/inferTags002.hs ===================================== @@ -0,0 +1,7 @@ +module M where + +data T a = MkT !Bool !a + +-- The rhs of the case alternative should not result in a call std_ap_0_fast. +f x = case x of + MkT y z -> z ===================================== testsuite/tests/simplStg/should_compile/inferTags002.stderr ===================================== @@ -0,0 +1,171 @@ + +==================== Output Cmm ==================== +[M.$WMkT_entry() { // [R3, R2] + { info_tbls: [(cym, + label: block_cym_info + rep: StackRep [False] + srt: Nothing), + (cyp, + label: M.$WMkT_info + rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } + srt: Nothing), + (cys, + label: block_cys_info + rep: StackRep [False] + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cyp: // global + if ((Sp + -16) < SpLim) (likely: False) goto cyv; else goto cyw; + cyv: // global + R1 = M.$WMkT_closure; + call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; + cyw: // global + I64[Sp - 16] = cym; + R1 = R2; + P64[Sp - 8] = R3; + Sp = Sp - 16; + if (R1 & 7 != 0) goto cym; else goto cyn; + cyn: // global + call (I64[R1])(R1) returns to cym, args: 8, res: 8, upd: 8; + cym: // global + I64[Sp] = cys; + _sy8::P64 = R1; + R1 = P64[Sp + 8]; + P64[Sp + 8] = _sy8::P64; + call stg_ap_0_fast(R1) returns to cys, args: 8, res: 8, upd: 8; + cys: // global + Hp = Hp + 24; + if (Hp > HpLim) (likely: False) goto cyA; else goto cyz; + cyA: // global + HpAlloc = 24; + call stg_gc_unpt_r1(R1) returns to cys, args: 8, res: 8, upd: 8; + cyz: // global + I64[Hp - 16] = M.MkT_con_info; + P64[Hp - 8] = P64[Sp + 8]; + P64[Hp] = R1; + R1 = Hp - 15; + Sp = Sp + 16; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }, + section ""data" . M.$WMkT_closure" { + M.$WMkT_closure: + const M.$WMkT_info; + }] + + + +==================== Output Cmm ==================== +[M.f_entry() { // [R2] + { info_tbls: [(cyK, + label: block_cyK_info + rep: StackRep [] + srt: Nothing), + (cyN, + label: M.f_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cyN: // global + if ((Sp + -8) < SpLim) (likely: False) goto cyO; else goto cyP; + cyO: // global + R1 = M.f_closure; + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; + cyP: // global + I64[Sp - 8] = cyK; + R1 = R2; + Sp = Sp - 8; + if (R1 & 7 != 0) goto cyK; else goto cyL; + cyL: // global + call (I64[R1])(R1) returns to cyK, args: 8, res: 8, upd: 8; + cyK: // global + R1 = P64[R1 + 15]; + Sp = Sp + 8; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }, + section ""data" . M.f_closure" { + M.f_closure: + const M.f_info; + }] + + + +==================== Output Cmm ==================== +[M.MkT_entry() { // [R3, R2] + { info_tbls: [(cz1, + label: block_cz1_info + rep: StackRep [False] + srt: Nothing), + (cz4, + label: M.MkT_info + rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } + srt: Nothing), + (cz7, + label: block_cz7_info + rep: StackRep [False] + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cz4: // global + if ((Sp + -16) < SpLim) (likely: False) goto cza; else goto czb; + cza: // global + R1 = M.MkT_closure; + call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; + czb: // global + I64[Sp - 16] = cz1; + R1 = R2; + P64[Sp - 8] = R3; + Sp = Sp - 16; + if (R1 & 7 != 0) goto cz1; else goto cz2; + cz2: // global + call (I64[R1])(R1) returns to cz1, args: 8, res: 8, upd: 8; + cz1: // global + I64[Sp] = cz7; + _tyf::P64 = R1; + R1 = P64[Sp + 8]; + P64[Sp + 8] = _tyf::P64; + call stg_ap_0_fast(R1) returns to cz7, args: 8, res: 8, upd: 8; + cz7: // global + Hp = Hp + 24; + if (Hp > HpLim) (likely: False) goto czf; else goto cze; + czf: // global + HpAlloc = 24; + call stg_gc_unpt_r1(R1) returns to cz7, args: 8, res: 8, upd: 8; + cze: // global + I64[Hp - 16] = M.MkT_con_info; + P64[Hp - 8] = P64[Sp + 8]; + P64[Hp] = R1; + R1 = Hp - 15; + Sp = Sp + 16; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }, + section ""data" . M.MkT_closure" { + M.MkT_closure: + const M.MkT_info; + }] + + + +==================== Output Cmm ==================== +[M.MkT_con_entry() { // [] + { info_tbls: [(czl, + label: M.MkT_con_info + rep: HeapRep 2 ptrs { Con {tag: 0 descr:"main:M.MkT"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + czl: // global + R1 = R1 + 1; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }] + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0a70269bf0a9e8959c3a3984dc966555cd84729 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0a70269bf0a9e8959c3a3984dc966555cd84729 You're receiving 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 Aug 8 23:39:36 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 19:39:36 -0400 Subject: [Git][ghc/ghc][master] 3 commits: gitlab-ci: Introduce validation job for aarch64 cross-compilation Message-ID: <62f19eb834346_25b0164c054639183@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - libraries/process Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -564,15 +565,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${CROSS_TARGET:-}" ]; then + args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" ) + fi + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} + +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +617,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +640,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +806,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/gen_ci.hs ===================================== @@ -116,6 +116,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +159,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } + llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] + ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] -- | The hadrian flavour string we are going to use for this build @@ -597,7 +611,8 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - + , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -774,6 +789,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -1378,6 +1378,67 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3857,6 +3918,66 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 7a7431a0ef586c0f1e602e382398b988c699dfc2 +Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5765e13370634979eb6a0d9f67aa9afa797bee46...ae707762335dabe2bb7e40639fd2ab2c7d3234fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5765e13370634979eb6a0d9f67aa9afa797bee46...ae707762335dabe2bb7e40639fd2ab2c7d3234fd You're receiving 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 Aug 8 23:45:50 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 08 Aug 2022 19:45:50 -0400 Subject: [Git][ghc/ghc][wip/T21623] 2 commits: More wibbles. Maybe can build stage2 Message-ID: <62f1a02eb2bc6_25b0164c07c64291b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: e0abd4f7 by Simon Peyton Jones at 2022-08-06T23:12:30+01:00 More wibbles. Maybe can build stage2 - - - - - ffe327ee by Simon Peyton Jones at 2022-08-09T00:46:05+01:00 Make FuNCo a thing by itself - - - - - 30 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.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/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Ppr.hs-boot - 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 - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b83e23147f128f958d99f916ade2ef4f4c4e76b...ffe327ee9f0ec8b5196560841521851af53d4893 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b83e23147f128f958d99f916ade2ef4f4c4e76b...ffe327ee9f0ec8b5196560841521851af53d4893 You're receiving 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 Aug 8 03:58:01 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 23:58:01 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 7 commits: rts/linker: Resolve iconv_* on FreeBSD Message-ID: <62f089c9d5e09_25b0164bff0377310@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: aeff4cb7 by Ben Gamari at 2022-08-07T23:57:54-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 987a19e8 by Ben Gamari at 2022-08-07T23:57:54-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 3e97d848 by Ben Gamari at 2022-08-07T23:57:54-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 720a8bfb by Ben Gamari at 2022-08-07T23:57:54-04:00 XXX: Bump up freebsd job - - - - - 5ec8e9b2 by Ben Gamari at 2022-08-07T23:57:54-04:00 gitlab-ci: Use cabal-install-3.6.2.0 on FreeBSD - - - - - aba49071 by Ben Gamari at 2022-08-07T23:57:54-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - 9de048a2 by Ben Gamari at 2022-08-07T23:57:54-04:00 Update jobs.yaml - - - - - 5 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - m4/fp_find_cxx_std_lib.m4 - rts/Linker.c Changes: ===================================== .gitlab/ci.sh ===================================== @@ -279,6 +279,9 @@ function fetch_ghc() { start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + if "$(uname)" = "FreeBSD"; then + url="http://home.smart-cactus.org/~ben/ghc/ghc-9.4.1-x86_64-portbld-freebsd.tar.xz" + fi info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" @@ -326,8 +329,7 @@ function fetch_cabal() { case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + cabal_url="$base_url/cabal-install-$v-x86_64-freebsd.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,15 +299,15 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "GHC_VERSION" =: "9.4.1" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , modifyJobs (\x -> x {jobStage = "quick-build"}) $ allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) ===================================== .gitlab/jobs.yaml ===================================== @@ -541,7 +541,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +551,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +560,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -586,19 +586,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2050,7 +2050,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2060,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2069,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2095,20 +2095,20 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2970,7 +2970,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +2980,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +2989,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3015,19 +3015,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a17b223015c09dfadcd6240d3884bdbf406769af...9de048a2aab2fe24fb5236642c3d6b149242d1eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a17b223015c09dfadcd6240d3884bdbf406769af...9de048a2aab2fe24fb5236642c3d6b149242d1eb You're receiving 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 Aug 8 03:56:01 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 23:56:01 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 8 commits: gitlab-ci: Fix a few unbound variable issues Message-ID: <62f08951bf73c_25b0164d24c3767f@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 83b04aa1 by Ben Gamari at 2022-08-07T23:55:54-04:00 gitlab-ci: Fix a few unbound variable issues - - - - - 8bd74cab by Ben Gamari at 2022-08-07T23:55:54-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5992d7d4 by Ben Gamari at 2022-08-07T23:55:54-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 79330091 by Ben Gamari at 2022-08-07T23:55:54-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 6350a914 by Ben Gamari at 2022-08-07T23:55:54-04:00 XXX: Bump up freebsd job - - - - - 014906da by Ben Gamari at 2022-08-07T23:55:54-04:00 gitlab-ci: Use cabal-install-3.6.2.0 on FreeBSD - - - - - fa73c484 by Ben Gamari at 2022-08-07T23:55:54-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - a17b2230 by Ben Gamari at 2022-08-07T23:55:54-04:00 Update jobs.yaml - - - - - 5 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - m4/fp_find_cxx_std_lib.m4 - rts/Linker.c Changes: ===================================== .gitlab/ci.sh ===================================== @@ -271,14 +271,16 @@ function setup() { } function fetch_ghc() { - if [ ! -e "$GHC" ]; then - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then + if [ -z "${GHC:-}" ]; then + if [[ -z "${GHC_VERSION:-}" ]]; then fail "neither GHC nor GHC_VERSION are not set" fi start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + if "$(uname)" = "FreeBSD"; then + url="http://home.smart-cactus.org/~ben/ghc/ghc-9.4.1-x86_64-portbld-freebsd.tar.xz" + fi info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" @@ -296,12 +298,11 @@ function fetch_ghc() { rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz end_section "fetch GHC" fi - } function fetch_cabal() { - if [ ! -e "$CABAL" ]; then - local v="$CABAL_INSTALL_VERSION" + if [ -z "${CABAL:-}" ]; then + local v="${CABAL_INSTALL_VERSION:-}" if [[ -z "$v" ]]; then fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" fi @@ -326,8 +327,7 @@ function fetch_cabal() { case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + cabal_url="$base_url/cabal-install-$v-x86_64-freebsd.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,15 +299,15 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "GHC_VERSION" =: "9.4.1" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , modifyJobs (\x -> x {jobStage = "quick-build"}) $ allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) ===================================== .gitlab/jobs.yaml ===================================== @@ -541,7 +541,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +551,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +560,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -586,19 +586,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2050,7 +2050,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2060,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2069,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2095,20 +2095,20 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2970,7 +2970,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +2980,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +2989,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3015,19 +3015,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0135b58c04d5d3a891bf452007a08f94e6a144a2...a17b223015c09dfadcd6240d3884bdbf406769af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0135b58c04d5d3a891bf452007a08f94e6a144a2...a17b223015c09dfadcd6240d3884bdbf406769af You're receiving 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 Aug 11 03:05:57 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 23:05:57 -0400 Subject: [Git][ghc/ghc][wip/T21986] gitlab-ci: Don't allow FreeBSD job to fail Message-ID: <62f472155103_142b49517fc2514aa@gitlab.mail> Ben Gamari pushed to branch wip/T21986 at Glasgow Haskell Compiler / GHC Commits: 6eb0088e by Ben Gamari at 2022-08-10T23:05:50-04:00 gitlab-ci: Don't allow FreeBSD job to fail - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -785,7 +785,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) + , addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) ===================================== .gitlab/jobs.yaml ===================================== @@ -664,7 +664,7 @@ ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "8 weeks", "paths": [ @@ -2296,7 +2296,7 @@ ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "1 year", "paths": [ @@ -3218,7 +3218,7 @@ ".gitlab/ci.sh clean", "cat ci_timings" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "2 weeks", "paths": [ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6eb0088ed9deea84677fb57e8c8a3c7dcf54d7a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6eb0088ed9deea84677fb57e8c8a3c7dcf54d7a8 You're receiving 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 Aug 8 14:26:15 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 10:26:15 -0400 Subject: [Git][ghc/ghc][wip/bindist-install] 3 commits: hadrian: Fix bindist installation on Darwin Message-ID: <62f11d071f9c0_25b0164bfdc50457@gitlab.mail> Ben Gamari pushed to branch wip/bindist-install at Glasgow Haskell Compiler / GHC Commits: 4e8be0b4 by Ben Gamari at 2022-08-08T10:26:09-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 24e14ff8 by Ben Gamari at 2022-08-08T10:26:09-04:00 hadrian: Drop diagnostics output from bindist installation - - - - - db6501e9 by Ben Gamari at 2022-08-08T10:26:09-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 2 changed files: - .gitlab/darwin/toolchain.nix - hadrian/bindist/Makefile Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== hadrian/bindist/Makefile ===================================== @@ -39,11 +39,10 @@ endif # of program names. For hadrian build this will work as programs have a # consistent naming procedure. define installscript - echo "installscript $1 -> $2" @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ + $(CP) -RP 'wrappers/$1' '$2' ; \ + else \ + rm -f '$2' && \ $(CREATE_SCRIPT) '$2' && \ echo "#!$(SHELL)" >> '$2' && \ echo "exedir=\"$4\"" >> '$2' && \ @@ -57,7 +56,7 @@ define installscript cat 'wrappers/$1' >> '$2' && \ $(EXECUTABLE_FILE) '$2' ; \ fi - @echo "$1 installed to $2" + @echo "$1 installed to $2"; endef # patchpackageconf View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e47fb9b0932848b5cb986b6274756e762db165a1...db6501e91553278ff80889fedf17dff1f2b6c957 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e47fb9b0932848b5cb986b6274756e762db165a1...db6501e91553278ff80889fedf17dff1f2b6c957 You're receiving 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 Aug 10 08:27:17 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 Aug 2022 04:27:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/unfolding-leaks Message-ID: <62f36be5729a_d27044b8201702fe@gitlab.mail> Matthew Pickering pushed new branch wip/unfolding-leaks at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/unfolding-leaks You're receiving 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 Aug 8 01:35:04 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 21:35:04 -0400 Subject: [Git][ghc/ghc][wip/cross-ci] gitlab-ci: Add basic support for cross-compiler testiing Message-ID: <62f06848838ef_25b0164bfa03699e4@gitlab.mail> Ben Gamari pushed to branch wip/cross-ci at Glasgow Haskell Compiler / GHC Commits: e9e6597f by Ben Gamari at 2022-08-07T21:34:57-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -564,15 +565,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${target_triple:-}" ]; then + args+=( "--target=$target_triple" "--host=$target_triple" ) + fi + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} + +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +617,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + run $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +640,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +806,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/gen_ci.hs ===================================== @@ -117,6 +117,7 @@ data BuildConfig , withAssertions :: Bool , withNuma :: Bool , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -159,6 +160,7 @@ vanilla = BuildConfig , withAssertions = False , withNuma = False , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -189,8 +191,13 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } -crossConfig :: String -> BuildConfig -crossConfig triple = vanilla { crossTarget = Just triple } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -605,6 +612,7 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -780,7 +788,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) - , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu") + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L/usr/aarch64-linux-gnu")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -1316,6 +1316,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L/usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" @@ -3795,6 +3796,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L/usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9e6597fcdc21fd3434b1d509aa422ee69a137cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9e6597fcdc21fd3434b1d509aa422ee69a137cf You're receiving 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 Aug 10 08:25:11 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 Aug 2022 04:25:11 -0400 Subject: [Git][ghc/ghc][wip/wither-eq1-and-friends] 40 commits: Improve BUILD_PAP comments Message-ID: <62f36b671c860_d270451a7c16842d@gitlab.mail> Matthew Pickering pushed to branch wip/wither-eq1-and-friends at Glasgow Haskell Compiler / GHC Commits: e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - d4b6fddb by John Ericson at 2022-08-10T08:25:08+00:00 Relax instances for Functor combinators; put superclass on Class1 to make non-breaking The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToCmm/Closure.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0fc88263659188b0195e64e0a13478ea185273e...d4b6fddba81edb62f4496d55c89781355a9f35a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0fc88263659188b0195e64e0a13478ea185273e...d4b6fddba81edb62f4496d55c89781355a9f35a4 You're receiving 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 Aug 8 12:04:55 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 08 Aug 2022 08:04:55 -0400 Subject: [Git][ghc/ghc][wip/andreask/keep-auto-rules-note] 33 commits: Add a note about about W/W for unlifting strict arguments Message-ID: <62f0fbe783c8f_25b0164c040459536@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/keep-auto-rules-note at Glasgow Haskell Compiler / GHC Commits: fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - de465b03 by Andreas Klebinger at 2022-08-08T12:04:53+00:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/CostCentre.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Types/Unique/DFM.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ee2d509455f01645819f06dbe2c1ba69d8b6e16...de465b0365537d525344214893f0b77ca4db758f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ee2d509455f01645819f06dbe2c1ba69d8b6e16...de465b0365537d525344214893f0b77ca4db758f You're receiving 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 Aug 12 20:05:51 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Fri, 12 Aug 2022 16:05:51 -0400 Subject: [Git][ghc/ghc][wip/21611-move-corem] 103 commits: testsuite: Correctly set withNativeCodeGen Message-ID: <62f6b29fdc688_3d8149489046888bc@gitlab.mail> Dominik Peteler pushed to branch wip/21611-move-corem at Glasgow Haskell Compiler / GHC Commits: 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - 45c81d56 by Dominik Peteler at 2022-08-12T19:07:02+02:00 Move CoreM to GHC.Plugins.Monad Removes the uses of CoreM in the Specialise, SpecConstr and CallerCC pass. Since CoreM is now only used by Core2core plugins within the Core pipeline the monad got moved to an own module. Additionally CoreToDo and related types got moved to an own module GHC.Core.Opt.Pipeline.Types. Moved the remaining code from GHC.Core.Opt.Monad to GHC.Core.Opt.Utils. GHC.Core.Opt.{SpecConstr,CallerCC} got proper configs / the usual treatment. Split out GHC.Core.Opt.CallerCC.Filter to avoid hs-boot. Removed explicit PrintUnqualified argument from `endPassIO` Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep Fixes #21611. - - - - - d8f2c89c by Dominik Peteler at 2022-08-12T19:07:22+02:00 Removed CoreM uses from GHC.Core.Lint - - - - - 030abdf3 by Dominik Peteler at 2022-08-12T19:50:31+02:00 Purified GHC.Core.LateCC.addLateCostCentres * GHC.Driver.Config.Core.Lint: * Removed: endPass * Renamed: endPassHscEnvIO -> endPass * Moved GHC.Core.Opt.Pipeline.initLintAnnotationsConfig to GHC.Driver.Config.Core.Lint - - - - - c679839e by Dominik Peteler at 2022-08-12T19:52:09+02:00 Run the CoreToDo interpreter in an own monad `SimplCountM` This monad is just `StateT SimplCount IO` wrapped in a newtype. This way we get rid of some `Core.Opt.Pipeline` boilerplate. It lives in GHC.Core.Opt.Counting and `Tick` and `SimplCount` got moved there as well. Also: * GHC.Core.Opt.Pipeline.runCorePasses: Take logger service as an argument - - - - - 96a93ec7 by Dominik Peteler at 2022-08-12T19:56:41+02:00 Removed references to driver from Specialise pass - - - - - 9190afd3 by Dominik Peteler at 2022-08-12T19:56:57+02:00 Split `Core.EndPass` from `Core.Lint` This better sepates concerns (linting is domain layer, end pass diagnostics is application later), and `Core.Lint` is a huge module to boot. - - - - - 47e3ee6e by Dominik Peteler at 2022-08-12T19:56:58+02:00 Get rid of `CoreDesugar`, `CoreDesugarOpt`, `CoreTidy`, `CorePrep` Those are not Core -> Core passes and so they don't belong in that sum type. Also cleaned up a bit: * Removed 'GHC.Driver.Config.Core.Lint.lintCoreBindings' It was dead code. * Removed 'GHC.Driver.Config.Core.Lint.lintPassResult' It run the actual linting and therefore it didn't belong to the GHC.Driver.Config namespace. As it was used only once the definition got inlined. * GHC.Core.Lint: Renamed lintPassResult' to lintPassResult. Also renamed lintCoreBindings' to lintCoreBindings. * GHC.Driver.Config.Core.Lint: Stick to the defaults when initializing the config records. * GHC.Driver.Config.Core.EndPass: Inlined `endPass` * GHC.Driver.Config.Core.EndPass: Removed `endPassLintFlags` as it was never used - - - - - 5eb1565a by Dominik Peteler at 2022-08-12T19:56:58+02:00 Simplified initSimplifyOpts - - - - - e3cb1872 by Dominik Peteler at 2022-08-12T19:56:59+02:00 Adjusted tests - - - - - a2b3dea8 by Dominik Peteler at 2022-08-12T19:57:00+02:00 Removed RuleBase from getCoreToDo - - - - - ad503c28 by Dominik Peteler at 2022-08-12T19:57:01+02:00 Purified initSpecialiseOpts Also pass the rule bases and the visible orphan modules as arguments to the Specialise pass. - - - - - 1b1b55fe by Dominik Peteler at 2022-08-12T20:13:10+02:00 Simplified CoreToDo interpreter a bit - - - - - 07d28507 by Dominik Peteler at 2022-08-12T20:16:30+02:00 Config records of some Core passes are now provided by CoreToDo * CoreAddCallerCcs * CoreAddLateCcs * CoreDoFloatInwards * CoreLiberateCase * CoreDoSpecConstr - - - - - 5305b332 by Dominik Peteler at 2022-08-12T20:31:09+02:00 Move Core pipeline to the driver * Moved `getCoreToDo` to an own module GHC.Driver.Config.Core.Opt * Moved the remaining part of GHC.Core.Opt.Pipeline to a new module GHC.Driver.Core.Opt * Renamed GHC.Core.Opt.Pipeline.Types to GHC.Core.Opt.Config - - - - - 85b7d7a2 by Dominik Peteler at 2022-08-12T20:32:12+02:00 Fixed tests - - - - - 7441add1 by Dominik Peteler at 2022-08-12T20:32:12+02:00 Fixed note - - - - - ff355a1e by John Ericson at 2022-08-12T20:32:13+02:00 Add some haddocks - - - - - 7a49eae8 by John Ericson at 2022-08-12T20:32:14+02:00 Move `core2core` to `GHC.Driver.Main` This "pushes up" the planning vs execution split, by not combining the two until a further downstream module. That helps encourage this separation we are very much fans of. Also deduplicate some logic with `liftCoreMToSimplCountM`, which abstracts over a number of details to eliminate a `CoreM` to a `SimpleCountM`. It might be a bit too opinionated at the moment, in which case we will think about how to shuffle some things around. In addition, deduplicate `simplMask`, which is indeed sketchy thing to export, but we can deal with that later. - - - - - 51811dd3 by John Ericson at 2022-08-12T20:32:15+02:00 Factor out `readRuleEnv` into its own module nad give haddocks Might end up up recombining this but its good separation of concerns for now. - - - - - 13469dc2 by John Ericson at 2022-08-12T22:05:02+02:00 Quick and dirty chop up modules once again I decided my earlier recommendation to mmhat was not quite write. It was the one I implemented too. So through this together real quick and dirty. We can make it nicer afterwords Things that are not yet nice: - `CoreOptEnv` is a grab bag of junk. Of course, it is merely reifying how was were accessing `HscEnv` before --- also rather junky! So maybe it cannot totally be improved. But it would be good to go over bits and ask / make issues (like #21926) that would help us clean up later. - Logging tricks for annotations linting is broken from the planning vs execution separation. We'll need to "delay that part of planning too. Can hack it up with more higher order function tricks, might be also a good oppertunity to rethink what should go in which config. - Some of the per-pass config records require info that isn't available at planning time. I hacked up up with functions in `CoreToDo` but we could do better. Conversely, per #21926, perhaps we *should* include the module name in the config after all, since we know it from downsweep before upsweep begins. - `GHC.Driver.Core.Rules` could just go inside `GHC.Driver.Core.Opt`. - - - - - ebf9f9bf by John Ericson at 2022-08-12T22:05:17+02:00 Split `GHC.Core.Opt.Utils` Half of it was domain layer (float out switches) but the other half was infrastructure / driver (annotations). - - - - - a8ca75b5 by Dominik Peteler at 2022-08-12T22:05:18+02:00 Fixed tests - - - - - c4ec3469 by Dominik Peteler at 2022-08-12T22:05:19+02:00 Better configuration of Core lint debug options - - - - - 0334aed1 by Dominik Peteler at 2022-08-12T22:05:20+02:00 Configuration record for rule check pass - - - - - 6c569c6a by Dominik Peteler at 2022-08-12T22:05:21+02:00 Renamed dmdAnal to demandAnalysis and moved it to GHC.Core.Opt.DmdAnal - - - - - 60d067db by Dominik Peteler at 2022-08-12T22:05:22+02:00 Fix tests - - - - - 5dbb4897 by Dominik Peteler at 2022-08-12T22:05:22+02:00 Added environment for worker/wrapper pass - - - - - 34a9297e by Dominik Peteler at 2022-08-12T22:05:23+02:00 Refactored configuration of Specialise pass again Also removed GHC.Core.Opt.Specialise.Config again. We may introduce separate *.Config modules for the passes once we had a look at the module graph and decide whether the addition of these modules is justified. - - - - - 362f2e6d by Dominik Peteler at 2022-08-12T22:05:24+02:00 Removed GHC.Driver.Core.Rules - - - - - 61b54d07 by Dominik Peteler at 2022-08-12T22:05:25+02:00 Removed CoreDoNothing and CoreDoPasses Rewrote the getCoreToDo function using a Writer monad. This makes these data constructors superfluous. - - - - - 81035033 by Dominik Peteler at 2022-08-12T22:05:26+02:00 Renamed endPassIO to endPass - - - - - 07fd40e0 by Dominik Peteler at 2022-08-12T22:05:26+02:00 Renamed hscSimplify/hscSimplify' to optimizeCoreIO/optimizeCoreHsc - - - - - 1345169f by Dominik Peteler at 2022-08-12T22:05:27+02:00 Run simplifyPgm in SimplCountM - - - - - 5af6eb11 by Dominik Peteler at 2022-08-12T22:05:28+02:00 Added note on the architecture of the Core optimizer - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Data.hs - + compiler/GHC/Core.hs-boot - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - + compiler/GHC/Core/EndPass.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/375910d6e279ca29f07782b8b0f90051a950f06c...5af6eb1172804ac05d7f5b0b0f7151e64df14fb9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/375910d6e279ca29f07782b8b0f90051a950f06c...5af6eb1172804ac05d7f5b0b0f7151e64df14fb9 You're receiving 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 Aug 9 19:40:54 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 15:40:54 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/TerrorJack/wasm-ncg-4 Message-ID: <62f2b84612c7_182c4e4e55c3558fb@gitlab.mail> Norman Ramsey deleted branch wip/TerrorJack/wasm-ncg-4 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 Aug 8 21:30:59 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Mon, 08 Aug 2022 17:30:59 -0400 Subject: [Git][ghc/ghc][wip/nr/typed-wasm-control-flow] 9 commits: first steps toward a type checker for WebAssembly Message-ID: <62f180938a471_25b0164bfa06203bf@gitlab.mail> Norman Ramsey pushed to branch wip/nr/typed-wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: 94f2ed0b by Norman Ramsey at 2022-08-05T19:11:14-04:00 first steps toward a type checker for WebAssembly - - - - - 4643e751 by Norman Ramsey at 2022-08-08T15:13:44-04:00 add type signatures; apply hlint - - - - - 1db49958 by Norman Ramsey at 2022-08-08T15:14:04-04:00 snapshot prototype validator - - - - - cbc6fe77 by Norman Ramsey at 2022-08-08T15:14:39-04:00 remove deprecated quote mark - - - - - e9e1d0dd by Norman Ramsey at 2022-08-08T15:14:52-04:00 clean up main test file - - - - - 48569247 by Norman Ramsey at 2022-08-08T15:17:28-04:00 about-face on validation - - - - - 7ce4fa23 by Norman Ramsey at 2022-08-08T15:17:28-04:00 add README to test suite - - - - - 5467c9c9 by Norman Ramsey at 2022-08-08T17:30:30-04:00 deal with new compiler warnings - - - - - 4e5da206 by Norman Ramsey at 2022-08-08T17:30:41-04:00 add draft emitter for typed wasm - - - - - 6 changed files: - + compiler/GHC/Wasm/Builder.hs - compiler/GHC/Wasm/ControlFlow.hs - compiler/GHC/Wasm/ControlFlow/FromCmm.hs - compiler/ghc.cabal.in - + testsuite/tests/wasm/should_run/control-flow/README.md - testsuite/tests/wasm/should_run/control-flow/WasmControlFlow.hs Changes: ===================================== compiler/GHC/Wasm/Builder.hs ===================================== @@ -0,0 +1,75 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} + +module GHC.Wasm.Builder + ( toIndented + , MyExpr(..), MyActions(..) + ) +where + +-- early rough draft of emitter from WebAssembly to clang .s code + +import GHC.Prelude + +import Data.ByteString.Builder (Builder) +import Data.List (intersperse) +import Data.Monoid + +import qualified Data.ByteString.Builder as BS + +import GHC.Utils.Panic + +import GHC.Wasm.ControlFlow hiding ((<>)) + +defaultIndent :: Builder +defaultIndent = " " + +toIndented :: WasmControl MyActions MyExpr pre post -> Builder +toIndented s = printWithIndent mempty s <> "\n" + +wasmFunctionType :: WasmFunctionType pre post -> Builder +wasmFunctionType (WasmFunctionType TypeListNil TypeListNil) = "" +wasmFunctionType (WasmFunctionType TypeListNil (TypeListCons t TypeListNil)) = tagBuilder t +wasmFunctionType _ = panic "function type needs to be externalized" + +tagBuilder :: WasmTypeTag a -> Builder +tagBuilder TagI32 = "i32" +tagBuilder TagF32 = "f32" + + +printWithIndent :: Builder -> WasmControl MyActions MyExpr pre post -> Builder +printWithIndent indent s = print s + where print, outdent :: WasmControl MyActions MyExpr pre post -> Builder + newline :: Builder -> Builder -> Builder + (<+>) :: Builder -> Builder -> Builder + ty = wasmFunctionType + + print (WasmFallthrough `WasmSeq` s) = print s + print (s `WasmSeq` WasmFallthrough) = print s + print (WasmIfTop t s WasmFallthrough) = + "br_if" <+> ty t `newline` outdent s `newline` "end_if" + print (WasmIfTop t WasmFallthrough s) = + "br_if" <+> ty t `newline` "else" `newline` outdent s `newline` "end_if" + + print (WasmPush _ _) = "i32.const 42" + print (WasmBlock t s) = "block" <+> ty t `newline` outdent s `newline` "end_block" + print (WasmLoop t s) = "loop" <+> ty t `newline` outdent s `newline` "end_loop" + print (WasmIfTop t ts fs) = "if" <+> ty t `newline` outdent ts `newline` + "else" `newline` outdent fs `newline` "end_if" + print (WasmBr l) = "br" <+> BS.intDec l + print (WasmBrTable e _ ts t) = + myExpr e `newline` "br_table {" <+> + mconcat (intersperse ", " [BS.intDec i | i <- ts <> [t]]) <+> + "}" + print (WasmReturnTop _) = "return" + print (WasmActions as) = myActions as + print (s `WasmSeq` s') = print s `newline` print s' + + newline s s' = s <> "\n" <> indent <> s' + outdent s = defaultIndent <> printWithIndent (indent <> defaultIndent) s + s <+> s' = s <> " " <> s' + + +newtype MyExpr = MyExpr { myExpr :: Builder } + +newtype MyActions = MyActions { myActions :: Builder } ===================================== compiler/GHC/Wasm/ControlFlow.hs ===================================== @@ -56,7 +56,7 @@ Description : Representation of control-flow portion of the WebAssembly instruct data TypeList :: [WasmType] -> Type where TypeListNil :: TypeList '[] - TypeListCons :: WasmTypeTag t -> TypeList ts -> TypeList (t ': ts) + TypeListCons :: WasmTypeTag t -> TypeList ts -> TypeList (t : ts) data WasmFunctionType pre post = WasmFunctionType { ft_pops :: TypeList pre @@ -66,10 +66,11 @@ data WasmFunctionType pre post = type Push t = WasmFunctionType '[] '[t] data WasmType = I32 | F32 -- more could be added + deriving (Eq, Show) data WasmTypeTag :: WasmType -> Type where - TagI32 :: WasmTypeTag I32 - TagF32 :: WasmTypeTag F32 + TagI32 :: WasmTypeTag 'I32 + TagF32 :: WasmTypeTag 'F32 data WasmControl :: Type -> Type -> [WasmType] -> [WasmType] -> Type where @@ -84,7 +85,7 @@ data WasmControl :: Type -> Type -> [WasmType] -> [WasmType] -> Type where WasmIfTop :: WasmFunctionType pre post -> WasmControl s e pre post -> WasmControl s e pre post - -> WasmControl s e (I32 ': pre) post + -> WasmControl s e ('I32 ': pre) post WasmBr :: Int -> WasmControl s e dropped destination -- not typechecked WasmFallthrough :: WasmControl s e dropped destination ===================================== compiler/GHC/Wasm/ControlFlow/FromCmm.hs ===================================== @@ -21,7 +21,6 @@ import GHC.Prelude hiding (succ) import Data.Function import Data.List (sortBy) ---import Data.Semigroup import qualified Data.Tree as Tree import GHC.Cmm @@ -161,6 +160,9 @@ structuredControl :: forall expr stmt . structuredControl platform txExpr txBlock g = doTree returns dominatorTree emptyContext where + gwd :: GraphWithDominators CmmNode + gwd = graphWithDominators g + dominatorTree :: Tree.Tree CfgNode-- Dominator tree in which children are sorted -- with highest reverse-postorder number first dominatorTree = fmap blockLabeled $ sortTree $ gwdDominatorTree gwd @@ -180,9 +182,9 @@ structuredControl platform txExpr txBlock g = where selectedChildren = case lastNode x of CmmSwitch {} -> children -- N.B. Unlike `if`, translation of Switch uses only labels. - _ -> filter hasMergeRoot $ children + _ -> filter hasMergeRoot children loopContext = LoopHeadedBy (entryLabel x) `inside` - (context `withFallthrough` (entryLabel x)) + (context `withFallthrough` entryLabel x) hasMergeRoot = isMergeNode . Tree.rootLabel nodeWithin fty x (y_n:ys) (Just zlabel) context = @@ -227,11 +229,13 @@ structuredControl platform txExpr txBlock g = | otherwise = doTree fty (subtreeAt to) context -- inline the code here where i = index to (enclosing context) + generatesIf :: CmmBlock -> Bool generatesIf x = case flowLeaving platform x of Conditional {} -> True _ -> False ---- everything else is utility functions + treeEntryLabel :: Tree.Tree CfgNode -> Label treeEntryLabel = entryLabel . Tree.rootLabel sortTree :: Tree.Tree Label -> Tree.Tree Label @@ -252,6 +256,7 @@ structuredControl platform txExpr txBlock g = dominates :: Label -> Label -> Bool -- Domination relation (not just immediate domination) + blockmap :: LabelMap CfgNode GMany NothingO blockmap NothingO = g_graph g blockLabeled l = findLabelIn l blockmap @@ -268,12 +273,13 @@ structuredControl platform txExpr txBlock g = isMergeLabel l = setMember l mergeBlockLabels isMergeNode = isMergeLabel . entryLabel + isBackward :: Label -> Label -> Bool isBackward from to = rpnum to <= rpnum from -- self-edge counts as a backward edge subtreeAt label = findLabelIn label subtrees subtrees :: LabelMap (Tree.Tree CfgNode) subtrees = addSubtree mapEmpty dominatorTree - where addSubtree map (t@(Tree.Node root children)) = + where addSubtree map t@(Tree.Node root children) = foldl addSubtree (mapInsert (entryLabel root) t map) children mergeBlockLabels :: LabelSet @@ -297,19 +303,19 @@ structuredControl platform txExpr txBlock g = | otherwise = addToList (from :) to pm isLoopHeader = isHeaderLabel . entryLabel - isHeaderLabel = \l -> setMember l headers -- loop headers + isHeaderLabel = (`setMember` headers) -- loop headers where headers :: LabelSet headers = foldMap headersPointedTo blockmap headersPointedTo block = setFromList [label | label <- successors block, dominates label (entryLabel block)] + index :: Label -> [ContainingSyntax] -> Int index _ [] = panic "destination label not in evaluation context" index label (frame : context) | label `matchesFrame` frame = 0 | otherwise = 1 + index label context - gwd = graphWithDominators g rpnum = gwdRPNumber gwd dominates lbl blockname = lbl == blockname || dominatorsMember lbl (gwdDominatorsOf gwd blockname) ===================================== compiler/ghc.cabal.in ===================================== @@ -805,6 +805,7 @@ Library GHC.Utils.Ppr.Colour GHC.Utils.TmpFs GHC.Utils.Trace + GHC.Wasm.Builder GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== testsuite/tests/wasm/should_run/control-flow/README.md ===================================== @@ -0,0 +1,12 @@ +Tests the basic infrastructure used to translate Cmm control flow to WebAssembly control flow: + + - Check a Cmm control-flow graph to see if it is reducible. + + - Convert an irreducible control-flow graph to an equivalent reducible control-flow graph. + + - Interpret both Cmm control-flow graphs and WebAssembly programs using a stream of bits to determine the direction of each conditional and `switch`. Confirm that source and target programs take the same actions and make the same decisions. + +The tests dump a lot of information about the code under test, including the number of execution paths tested. Samples in `WasmControlFlow.stdout`. + +The source codes for the tested control-flow graphs are written in a mix of Haskell and Cmm; they are found in directory `src`. + ===================================== testsuite/tests/wasm/should_run/control-flow/WasmControlFlow.hs ===================================== @@ -1,9 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} - - module Main where import Control.Monad @@ -38,14 +32,6 @@ import LoadCmmGroup import RunCmm import RunWasm -data TestMode = ReducibilityTest | SplittingTest | TranslationTest - -testMode :: String -> TestMode -testMode s = case s of "-r" -> ReducibilityTest - "-s" -> SplittingTest - "-t" -> TranslationTest - _ -> error "mode should be -r or -t" - main :: IO () main = do libdir : modeString : files <- getArgs @@ -61,40 +47,6 @@ main = do liftIO $ do codes <- mapM (allTests $ targetPlatform dflags) (zip files groups) exitWith $ foldl combineExits exitZero codes -{- - labeled_groups = [(path, group) - | (path, groups) <- zip files groups, group <- groups] - run :: (CmmGraph -> IO a) -> IO [(FilePath, a)] - run f = concat <$> - mapM (fmap unroll . concatMapGraphs platform (const f)) labeled_groups - runGrouped :: (CmmGraph -> IO a) -> IO [(FilePath, [a])] - runGrouped f = - mergeLike <$> mapM (concatMapGraphs platform (const f)) labeled_groups - unroll :: (FilePath, [a]) -> [(FilePath, a)] - unroll (path, as) = [(path, a) | a <- as] - mergeLike :: [(FilePath, [a])] -> [(FilePath, [a])] - mergeLike pairs = - [(path, matching path) | path <- nub (map fst pairs)] - where matching path = [a | (path', as) <- pairs, path == path', a <- as] - liftIO $ case testMode modeString of - ReducibilityTest -> do - analyses <- runGrouped (return . reducibility . graphWithDominators) - let dump (path, results) = do - putStr $ path ++ ": " - case (number (== Reducible), number (== Irreducible)) of - (0, 0) -> putStrLn $ "no code" - (0, n) -> putStrLn $ show n ++ " irreducible" - (n, 0) -> putStrLn $ show n ++ " reducible" - (r, i) -> putStrLn $ show r ++ " reducible, " ++ show i ++ " irreducible" - where number p = length $ filter p $ results - mapM_ dump analyses - SplittingTest -> do - reductions <- run testNodeSplitting - mutilations <- run (return . testGraphMutilation) - results <- liftM2 (++) (mapM (analyze isIdentical) reductions) - (mapM (analyze isDifferent) mutilations) - exitWith $ foldl combineExits exitZero results --} allTests :: Platform -> (FilePath, [CmmGroup]) -> IO ExitCode allTests platform (path, groups) = @@ -104,7 +56,15 @@ allTests platform (path, groups) = tests :: [Platform -> (FilePath, [CmmGroup]) -> IO ExitCode] tests = [reducibilityTest, splittingTest, translationTest] -reducibilityTest, splittingTest, translationTest :: Platform -> (FilePath, [CmmGroup]) -> IO ExitCode +reducibilityTest, splittingTest, translationTest + :: Platform -> (FilePath, [CmmGroup]) -> IO ExitCode + + + + +---------------------------------------------------------------- + +-- | Counts the number of reducible and irreducible CFGs in each group reducibilityTest platform (path, groups) = do analyses <- runGrouped (return . reducibility . graphWithDominators) platform groups @@ -121,54 +81,20 @@ reducibilityTest platform (path, groups) = do dump analyses return exitZero +---------------------------------------------------------------- + +-- Convert each input graph to a reducible graph via node splitting, +-- run control-flow--path tests to confirm they behave the same. +-- Run similar tests that compare each graph with a mutilated version, +-- to confirm that the tests do in fact detect when graphs are different. + splittingTest platform (path, groups) = do reductions <- catMaybes <$> runGrouped testNodeSplitting platform groups mutilations <- runGrouped (return . testGraphMutilation path) platform groups codes <- liftM2 (++) (mapM (analyze "node splitting" path isIdentical) reductions) - (mapM (analyze "mutilation" path isDifferent) mutilations) + (mapM (analyze "mutilation" path isDifferent) mutilations) return $ foldl combineExits exitZero codes -translationTest platform (path, groups) = do - txs <- runGrouped (testTranslation platform) platform groups - codes <- mapM (analyze "WebAssembly translation" path isIdentical) txs - return $ foldl combineExits exitZero codes - - - - -runGrouped :: (CmmGraph -> IO a) -> Platform -> [CmmGroup] -> IO [a] -runGrouped f platform groups = concat <$> mapM (concatMapGraphs platform (const f)) groups - -concatMapGraphs :: Monad m - => Platform - -> (Platform -> CmmGraph -> m a) - -> CmmGroup - -> m [a] -concatMapGraphs platform f group = - catMaybes <$> mapM (decl . cmmCfgOptsProc False) group - where decl (CmmData {}) = return Nothing - decl (CmmProc _h _entry _registers graph) = - do a <- f platform graph - return $ Just a - -count :: [a] -> String -> String -count xs thing = case length xs of - 1 -> "1 " ++ thing - n -> show n ++ " " ++ thing ++ "s" - - -data Outcome = Identical { npaths :: Int } - | Different { different :: [(Trace, Trace)], nsame :: Int } -type Trace = [Event Stmt Expr] - -isDifferent, isIdentical :: Outcome -> Bool - -isDifferent (Different {}) = True -isDifferent _ = False - -isIdentical (Identical {}) = True -isIdentical _ = False - testNodeSplitting :: CmmGraph -> IO (Maybe Outcome) testNodeSplitting original_graph = do reducible_graph <- fmap gwd_graph $ runUniqSM $ @@ -184,38 +110,57 @@ testGraphMutilation :: FilePath -> CmmGraph -> Outcome testGraphMutilation path graph = compareWithEntropy (runcfg graph) (runcfg $ mutilate path graph) $ cfgEntropy graph +-- | Changes the graph's entry point to one of the entry point's successors. +-- Panics if the input graph has only one block. +mutilate :: FilePath -> CmmGraph -> CmmGraph +mutilate path g = + case filter (/= entry_label) $ successors entry_block of + (lbl:_) -> CmmGraph lbl (g_graph g) + [] -> error $ "cannot mutilate control-flow graph in file " ++ path + where entry_label = g_entry g + entry_block = mapFindWithDefault (error "no entry block") entry_label $ graphMap g + +---------------------------------------------------------------- + +-- Translate each input graph to WebAssembly, then run +-- control-flow--path tests to confirm the translation behaves the +-- same as the original. + +translationTest platform (path, groups) = do + txs <- runGrouped (testTranslation platform) platform groups + codes <- mapM (analyze "WebAssembly translation" path isIdentical) txs + return $ foldl combineExits exitZero codes + testTranslation :: Platform -> CmmGraph -> IO Outcome testTranslation platform big_switch_graph = do real_graph <- runUniqSM $ cmmImplementSwitchPlans platform big_switch_graph reducible_graph <- fmap gwd_graph $ runUniqSM $ asReducible $ graphWithDominators real_graph - let wasm = structuredControlIncludingNonTail platform expr stmt reducible_graph + let wasm = structuredControl platform expr stmt reducible_graph return $ compareWithEntropy (runcfg real_graph) (runwasm wasm) $ cfgEntropy reducible_graph - where structuredControlIncludingNonTail = structuredControl -- XXX -runcfg :: CmmGraph -> BitConsumer Stmt Expr () -runcfg = evalGraph stmt expr +---------------------------------------------------------------- -runwasm :: WasmControl Stmt Expr pre post -> BitConsumer Stmt Expr () -runwasm = evalWasm +-- Outcomes of comparisons -runUniqSM :: UniqSM a -> IO a -runUniqSM m = do - us <- mkSplitUniqSupply 'g' - return (initUs_ us m) +data Outcome = Identical { npaths :: Int } + | Different { different :: [(Trace, Trace)], nsame :: Int } +type Trace = [Event Stmt Expr] -type Entropy = [[Bool]] +isDifferent, isIdentical :: Outcome -> Bool + +isDifferent (Different {}) = True +isDifferent _ = False + +isIdentical (Identical {}) = True +isIdentical _ = False ---------------------------------------------------------------- -mutilate :: FilePath -> CmmGraph -> CmmGraph -mutilate path g = - case filter (/= entry_label) $ successors entry_block of - (lbl:_) -> CmmGraph lbl (g_graph g) - [] -> error $ "cannot mutilate control-flow graph in file " ++ path - where entry_label = g_entry g - entry_block = mapFindWithDefault (error "no entry block") entry_label $ graphMap g +-- Comparisons of execution paths + +type Entropy = [[Bool]] compareWithEntropy :: BitConsumer Stmt Expr () -> BitConsumer Stmt Expr () @@ -247,19 +192,6 @@ compareRuns a b bits = cfgEntropy :: CmmGraph -> Entropy cfgEntropy = map traceBits . cmmPaths -unimp :: String -> a -unimp s = error $ s ++ " not implemented" - ----------------------------------------------------------------- - -combineExits :: ExitCode -> ExitCode -> ExitCode -exitZero :: ExitCode - -exitZero = ExitSuccess -combineExits ExitSuccess e = e -combineExits e _ = e - - analyze :: String -> FilePath -> (Outcome -> Bool) -> Outcome -> IO ExitCode analyze what path isGood outcome = do putStrLn $ display $ path ++ ", " ++ what ++ ": " ++ case outcome of @@ -275,3 +207,49 @@ analyze what path isGood outcome = do return $ ExitFailure 1 where display s = if isGood outcome then s ++ ", as expected" else "(FAULT!) " ++ s + +---------------------------------------------------------------- + +-- Other test-running infrastructure + +runGrouped :: (CmmGraph -> IO a) -> Platform -> [CmmGroup] -> IO [a] +runGrouped f platform groups = concat <$> mapM (concatMapGraphs platform (const f)) groups + +concatMapGraphs :: Monad m + => Platform + -> (Platform -> CmmGraph -> m a) + -> CmmGroup + -> m [a] +concatMapGraphs platform f group = + catMaybes <$> mapM (decl . cmmCfgOptsProc False) group + where decl (CmmData {}) = return Nothing + decl (CmmProc _h _entry _registers graph) = + do a <- f platform graph + return $ Just a + +count :: [a] -> String -> String +count xs thing = case length xs of + 1 -> "1 " ++ thing + n -> show n ++ " " ++ thing ++ "s" + +runcfg :: CmmGraph -> BitConsumer Stmt Expr () +runcfg = evalGraph stmt expr + +runwasm :: WasmControl Stmt Expr pre post -> BitConsumer Stmt Expr () +runwasm = evalWasm + +runUniqSM :: UniqSM a -> IO a +runUniqSM m = do + us <- mkSplitUniqSupply 'g' + return (initUs_ us m) + +---------------------------------------------------------------- + +-- ExitCode as monoid + +combineExits :: ExitCode -> ExitCode -> ExitCode +exitZero :: ExitCode + +exitZero = ExitSuccess +combineExits ExitSuccess e = e +combineExits e _ = e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/961ad4583a6aa038da16948b1016279a3706d91c...4e5da2060be0daed39f4d8f6e4060e87a9474fe5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/961ad4583a6aa038da16948b1016279a3706d91c...4e5da2060be0daed39f4d8f6e4060e87a9474fe5 You're receiving 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 Aug 9 17:22:05 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 Aug 2022 13:22:05 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21986 Message-ID: <62f297bd50681_182c4e506182864b8@gitlab.mail> Ben Gamari pushed new branch wip/T21986 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21986 You're receiving 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 Aug 8 03:59:16 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 23:59:16 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 2 commits: gitlab-ci: XXX temporary GHC bindist on FreeBSD Message-ID: <62f08a14727e3_25b01650d5c377987@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: d3cfeb91 by Ben Gamari at 2022-08-07T23:59:10-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - 5499e3dd by Ben Gamari at 2022-08-07T23:59:10-04:00 Update jobs.yaml - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -279,6 +279,9 @@ function fetch_ghc() { start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + if [ "$(uname)" = "FreeBSD" ]; then + url="http://home.smart-cactus.org/~ben/ghc/ghc-9.4.1-x86_64-portbld-freebsd.tar.xz" + fi info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" ===================================== .gitlab/gen_ci.hs ===================================== @@ -306,7 +306,7 @@ opsysVariables _ FreeBSD13 = mconcat -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.2.2" + , "GHC_VERSION" =: "9.4.1" , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = ===================================== .gitlab/jobs.yaml ===================================== @@ -586,7 +586,7 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ "x86_64-freebsd13" ], @@ -594,9 +594,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL": "/usr/local/bin/cabal", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" @@ -2095,7 +2095,7 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ "x86_64-freebsd13" ], @@ -2103,9 +2103,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL": "/usr/local/bin/cabal", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "TEST_ENV": "x86_64-freebsd13-release", @@ -3015,7 +3015,7 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ "x86_64-freebsd13" ], @@ -3023,9 +3023,9 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL": "/usr/local/bin/cabal", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "TEST_ENV": "x86_64-freebsd13-validate" } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9de048a2aab2fe24fb5236642c3d6b149242d1eb...5499e3dd91f2485a3b2e7cf735f9b76bcc8a3fc0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9de048a2aab2fe24fb5236642c3d6b149242d1eb...5499e3dd91f2485a3b2e7cf735f9b76bcc8a3fc0 You're receiving 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 Aug 10 22:30:34 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 10 Aug 2022 18:30:34 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble Message-ID: <62f4318a9eb95_142b4952170226875@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 78ba2dc1 by Simon Peyton Jones at 2022-08-10T23:30:50+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/TyCo/FVs.hs Changes: ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -673,8 +673,8 @@ almost_devoid_co_var_of_co (AppCo 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) -almost_devoid_co_var_of_co (FunCo o_ w co1 co2) cv - = almost_devoid_co_var_of_co w cv +almost_devoid_co_var_of_co (FunCo _ w co1 co2) cv + = almost_devoid_co_var_of_co w cv && almost_devoid_co_var_of_co co1 cv && almost_devoid_co_var_of_co co2 cv almost_devoid_co_var_of_co (CoVarCo v) cv = v /= cv View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78ba2dc1964221f0c2129a309e18cec76956763e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78ba2dc1964221f0c2129a309e18cec76956763e You're receiving 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 Aug 8 04:02:23 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 00:02:23 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] fix Message-ID: <62f08acf23304_25b0164d24c3785ae@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 265ccfd7 by Ben Gamari at 2022-08-08T00:02:17-04:00 fix - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -290,7 +290,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/265ccfd74d75686c0ff8e3328c207e2da4640aa2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/265ccfd74d75686c0ff8e3328c207e2da4640aa2 You're receiving 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 Aug 11 22:59:52 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 Aug 2022 18:59:52 -0400 Subject: [Git][ghc/ghc][wip/T21623] 84 commits: Remove TCvSubst and use Subst for both term and type-level subst Message-ID: <62f589e82094d_3d8149488a0310476@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - 5dc9eb6e by Simon Peyton Jones at 2022-08-11T23:47:46+01:00 Start work Not ready for review - - - - - 97e13b29 by Simon Peyton Jones at 2022-08-11T23:47:47+01:00 More progress - - - - - 66713709 by Simon Peyton Jones at 2022-08-11T23:47:47+01:00 Wibbles - - - - - 95444fd7 by Simon Peyton Jones at 2022-08-11T23:49:21+01:00 Stage1 compiles - - - - - 3abce106 by Simon Peyton Jones at 2022-08-11T23:49:21+01:00 More wibbles - - - - - 023ebb78 by Simon Peyton Jones at 2022-08-11T23:57:51+01:00 More wibbles - - - - - 5ed38abc by Simon Peyton Jones at 2022-08-11T23:57:52+01:00 More -- almost working - - - - - 4d1713ef by Simon Peyton Jones at 2022-08-11T23:57:52+01:00 Comments - - - - - ffe7366e by Simon Peyton Jones at 2022-08-11T23:59:09+01:00 Wibbles - - - - - 5d34a19d by Simon Peyton Jones at 2022-08-11T23:59:09+01:00 Wibbles - - - - - dde7c686 by Simon Peyton Jones at 2022-08-11T23:59:09+01:00 Wibble inlineId - - - - - d44a9f03 by Simon Peyton Jones at 2022-08-11T23:59:10+01:00 Wibbles - - - - - 51b3e105 by Simon Peyton Jones at 2022-08-11T23:59:10+01:00 Infinite loop somewhere - - - - - 8fb069a7 by Simon Peyton Jones at 2022-08-12T00:00:17+01:00 More wibbles. Maybe can build stage2 - - - - - 9d7940aa by Simon Peyton Jones at 2022-08-12T00:00:17+01:00 Make FuNCo a thing by itself - - - - - 4006e8f4 by Simon Peyton Jones at 2022-08-12T00:00:17+01:00 Wibble - - - - - 338e8f53 by Simon Peyton Jones at 2022-08-12T00:00:17+01:00 Wibble - - - - - 64e93c62 by Simon Peyton Jones at 2022-08-12T00:00:17+01:00 Wibbles - - - - - 4f8db35f by Simon Peyton Jones at 2022-08-12T00:00:17+01:00 Fix OptCoercion - - - - - 29 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Data.hs - + compiler/GHC/Core.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a627d70efac1e88eb0d4fc2b4996d2aa60e042de...4f8db35fd548f3851d828450fcf68ab5d78e4072 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a627d70efac1e88eb0d4fc2b4996d2aa60e042de...4f8db35fd548f3851d828450fcf68ab5d78e4072 You're receiving 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 Aug 9 18:32:09 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 Aug 2022 14:32:09 -0400 Subject: [Git][ghc/ghc][wip/telser/docs-extension-status] 214 commits: Mark AArch64/Darwin as requiring sign-extension Message-ID: <62f2a829a694a_182c4e50668333020@gitlab.mail> Ben Gamari pushed to branch wip/telser/docs-extension-status at Glasgow Haskell Compiler / GHC Commits: 57a5f88c by Ben Gamari at 2022-06-28T03:24:24-04:00 Mark AArch64/Darwin as requiring sign-extension Apple's AArch64 ABI requires that the caller sign-extend small integer arguments. Set platformCConvNeedsExtension to reflect this fact. Fixes #21773. - - - - - df762ae9 by Ben Gamari at 2022-06-28T03:24:24-04:00 -ddump-llvm shouldn't imply -fllvm Previously -ddump-llvm would change the backend used, which contrasts with all other dump flags. This is quite surprising and cost me quite a bit of time. Dump flags should not change compiler behavior. Fixes #21776. - - - - - 70f0c1f8 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Re-format argument handling logic Previously there were very long, hard to parse lines. Fix this. - - - - - 696d64c3 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Sign-extend narrow C arguments The AArch64/Darwin ABI requires that function arguments narrower than 32-bits must be sign-extended by the caller. We neglected to do this, resulting in #20735. Fixes #20735. - - - - - c006ac0d by Ben Gamari at 2022-06-28T03:24:24-04:00 testsuite: Add test for #20735 - - - - - 16b9100c by Ben Gamari at 2022-06-28T03:24:59-04:00 integer-gmp: Fix cabal file Evidently fields may not come after sections in a cabal file. - - - - - 03cc5d02 by Sergei Trofimovich at 2022-06-28T15:20:45-04:00 ghc.mk: fix 'make install' (`mk/system-cxx-std-lib-1.0.conf.install` does not exist) before the change `make install` was failing as: ``` "mv" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc-stage2" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc" make[1]: *** No rule to make target 'mk/system-cxx-std-lib-1.0.conf.install', needed by 'install_packages'. Stop. ``` I think it's a recent regression caused by 0ef249aa where `system-cxx-std-lib-1.0.conf` is created (somewhat manually), but not the .install varianlt of it. The fix is to consistently use `mk/system-cxx-std-lib-1.0.conf` everywhere. Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/21784 - - - - - eecab8f9 by Simon Peyton Jones at 2022-06-28T15:21:21-04:00 Comments only, about join points This MR just adds some documentation about why casts destroy join points, following #21716. - - - - - 251471e7 by Matthew Pickering at 2022-06-28T19:02:41-04:00 Cleanup BuiltInSyntax vs UserSyntax There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302 - - - - - 0e22f16c by Ben Gamari at 2022-06-28T19:03:16-04:00 template-haskell: Bump version to 2.19.0.0 Bumps text and exceptions submodules due to bounds. - - - - - bbe6f10e by Emily Bourke at 2022-06-29T08:23:13+00:00 Tiny tweak to `IOPort#` documentation The exclamation mark and bracket don’t seem to make sense here. I’ve looked through the history, and I don’t think they’re deliberate – possibly a copy-and-paste error. - - - - - 70e47489 by Dominik Peteler at 2022-06-29T19:26:31-04:00 Remove `CoreOccurAnal` constructor of the `CoreToDo` type It was dead code since the last occurence in an expression context got removed in 71916e1c018dded2e68d6769a2dbb8777da12664. - - - - - d0722170 by nineonine at 2022-07-01T08:15:56-04:00 Fix panic with UnliftedFFITypes+CApiFFI (#14624) When declaring foreign import using CAPI calling convention, using unlifted unboxed types would result in compiler panic. There was an attempt to fix the situation in #9274, however it only addressed some of the ByteArray cases. This patch fixes other missed cases for all prims that may be used as basic foreign types. - - - - - eb043148 by Douglas Wilson at 2022-07-01T08:16:32-04:00 rts: gc stats: account properly for copied bytes in sequential collections We were not updating the [copied,any_work,scav_find_work, max_n_todo_overflow] counters during sequential collections. As well, we were double counting for parallel collections. To fix this we add an `else` clause to the `if (is_par_gc())`. The par_* counters do not need to be updated in the sequential case because they must be 0. - - - - - f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow Enabling `-fhpc` or `-finfo-table-map` would case a tick to end up between the appliation of `neg` to its argument. This defeated the special logic which looks for `NegApp ... (HsOverLit` to warn about possible overflow if a user writes a negative literal (without out NegativeLiterals) in their code. Fixes #21701 - - - - - f25c8d03 by Matthew Pickering at 2022-07-01T19:22:31-04:00 ci: Fix definition of slow-validate flavour (so that -dlint) is passed In this embarassing sequence of events we were running slow-validate without -dlint. - - - - - bf7991b0 by Mike Pilgrem at 2022-07-02T10:12:04-04:00 Identify the extistence of the `runhaskell` command and that it is equivalent to the `runghc` command. Add an entry to the index for `runhaskell`. See https://gitlab.haskell.org/ghc/ghc/-/issues/21411 - - - - - 9e79f6d0 by Simon Jakobi at 2022-07-02T10:12:39-04:00 Data.Foldable1: Remove references to Foldable-specific note ...as discussed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8495#note_439455. - - - - - 3a8970ac by romes at 2022-07-03T14:11:31-04:00 TTG: Move HsModule to L.H.S Move the definition of HsModule defined in GHC.Hs to Language.Haskell.Syntax with an added TTG parameter and corresponding extension fields. This is progress towards having the haskell-syntax package, as described in #21592 - - - - - f9f80995 by romes at 2022-07-03T14:11:31-04:00 TTG: Move ImpExp client-independent bits to L.H.S.ImpExp Move the GHC-independent definitions from GHC.Hs.ImpExp to Language.Haskell.Syntax.ImpExp with the required TTG extension fields such as to keep the AST independent from GHC. This is progress towards having the haskell-syntax package, as described in #21592 Bumps haddock submodule - - - - - c43dbac0 by romes at 2022-07-03T14:11:31-04:00 Refactor ModuleName to L.H.S.Module.Name ModuleName used to live in GHC.Unit.Module.Name. In this commit, the definition of ModuleName and its associated functions are moved to Language.Haskell.Syntax.Module.Name according to the current plan towards making the AST GHC-independent. The instances for ModuleName for Outputable, Uniquable and Binary were moved to the module in which the class is defined because these instances depend on GHC. The instance of Eq for ModuleName is slightly changed to no longer depend on unique explicitly and instead uses FastString's instance of Eq. - - - - - 2635c6f2 by konsumlamm at 2022-07-03T14:12:11-04:00 Expand `Ord` instance for `Down` Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/23#issuecomment-1172932610 - - - - - 36fba0df by Anselm Schüler at 2022-07-04T05:06:42+00:00 Add applyWhen to Data.Function per CLC prop Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/71#issuecomment-1165830233 - - - - - 3b13aab1 by Matthew Pickering at 2022-07-04T15:15:00-04:00 hadrian: Don't read package environments in ghc-stage1 wrapper The stage1 compiler may be on the brink of existence and not have even a working base library. You may have installed packages globally with a similar stage2 compiler which will then lead to arguments such as --show-iface not even working because you are passing too many package flags. The solution is simple, don't read these implicit files. Fixes #21803 - - - - - aba482ea by Andreas Klebinger at 2022-07-04T17:55:55-04:00 Ticky:Make json info a separate field. Fixes #21233 - - - - - 74f3867d by Matthew Pickering at 2022-07-04T17:56:30-04:00 Add docs:<pkg> command to hadrian to build docs for just one package - - - - - 418afaf1 by Matthew Pickering at 2022-07-04T17:56:30-04:00 upload-docs: propagate publish correctly in upload_sdist - - - - - ed793d7a by Matthew Pickering at 2022-07-04T17:56:30-04:00 docs-upload: Fix upload script when no packages are listed - - - - - d002c6e0 by Matthew Pickering at 2022-07-04T17:56:30-04:00 hadrian: Add --haddock-base-url option for specifying base-url when generating docs The motiviation for this flag is to be able to produce documentation which is suitable for uploading for hackage, ie, the cross-package links work correctly. There are basically three values you want to set this to: * off - default, base_url = ../%pkg% which works for local browsing * on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload * on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation. The `%pkg%` string is a template variable which is replaced with the package identifier for the relevant package. This is one step towards fixing #21749 - - - - - 41eb749a by Matthew Pickering at 2022-07-04T17:56:31-04:00 Add nightly job for generating docs suitable for hackage upload - - - - - 620ee7ed by Matthew Pickering at 2022-07-04T17:57:05-04:00 ghci: Support :set prompt in multi repl This adds supports for various :set commands apart from `:set <FLAG>` in multi repl, this includes `:set prompt` and so-on. Fixes #21796 - - - - - b151b65e by Matthew Pickering at 2022-07-05T16:32:31-04:00 Vendor filepath inside template-haskell Adding filepath as a dependency of template-haskell means that it can't be reinstalled if any build-plan depends on template-haskell. This is a temporary solution for the 9.4 release. A longer term solution is to split-up the template-haskell package into the wired-in part and a non-wired-in part which can be reinstalled. This was deemed quite risky on the 9.4 release timescale. Fixes #21738 - - - - - c9347ecf by John Ericson at 2022-07-05T16:33:07-04:00 Factor fields of `CoreDoSimplify` into separate data type This avoids some partiality. The work @mmhat is doing cleaning up and modularizing `Core.Opt` will build on this nicely. - - - - - d0e74992 by Eric Lindblad at 2022-07-06T01:35:48-04:00 https urls - - - - - 803e965c by Eric Lindblad at 2022-07-06T01:35:48-04:00 options and typos - - - - - 5519baa5 by Eric Lindblad at 2022-07-06T01:35:48-04:00 grammar - - - - - 4ddc1d3e by Eric Lindblad at 2022-07-06T01:35:48-04:00 sources - - - - - c95c2026 by Matthew Pickering at 2022-07-06T01:35:48-04:00 Fix lint warnings in bootstrap.py - - - - - 86ced2ad by romes at 2022-07-06T01:36:23-04:00 Restore Eq instance of ImportDeclQualifiedStyle Fixes #21819 - - - - - 3547e264 by romes at 2022-07-06T13:50:27-04:00 Prune L.H.S modules of GHC dependencies Move around datatypes, functions and instances that are GHC-specific out of the `Language.Haskell.Syntax.*` modules to reduce the GHC dependencies in them -- progressing towards #21592 Creates a module `Language.Haskell.Syntax.Basic` to hold basic definitions required by the other L.H.S modules (and don't belong in any of them) - - - - - e4eea07b by romes at 2022-07-06T13:50:27-04:00 TTG: Move CoreTickish out of LHS.Binds Remove the `[CoreTickish]` fields from datatype `HsBindLR idL idR` and move them to the extension point instance, according to the plan outlined in #21592 to separate the base AST from the GHC specific bits. - - - - - acc1816b by romes at 2022-07-06T13:50:27-04:00 TTG for ForeignImport/Export Add a TTG parameter to both `ForeignImport` and `ForeignExport` and, according to #21592, move the GHC-specific bits in them and in the other AST data types related to foreign imports and exports to the TTG extension point. - - - - - 371c5ecf by romes at 2022-07-06T13:50:27-04:00 TTG for HsTyLit Add TTG parameter to `HsTyLit` to move the GHC-specific `SourceText` fields to the extension point and out of the base AST. Progress towards #21592 - - - - - fd379d1b by romes at 2022-07-06T13:50:27-04:00 Remove many GHC dependencies from L.H.S Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC imports according to the plan in the linked issue. Moves more GHC-specific declarations to `GHC.*` and brings more required GHC-independent declarations to `Language.Haskell.Syntax.*` (extending e.g. `Language.Haskell.Syntax.Basic`). Progress towards #21592 Bump haddock submodule for !8308 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - c5415bc5 by Alan Zimmerman at 2022-07-06T13:50:27-04:00 Fix exact printing of the HsRule name Prior to this branch, the HsRule name was XRec pass (SourceText,RuleName) and there is an ExactPrint instance for (SourceText, RuleName). The SourceText has moved to a different location, so synthesise the original to trigger the correct instance when printing. We need both the SourceText and RuleName when exact printing, as it is possible to have a NoSourceText variant, in which case we fall back to the FastString. - - - - - 665fa5a7 by Matthew Pickering at 2022-07-06T13:51:03-04:00 driver: Fix issue with module loops and multiple home units We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 - - - - - bbcaba6a by Andreas Klebinger at 2022-07-06T13:51:39-04:00 Remove a bogus #define from ClosureMacros.h - - - - - fa59223b by Tamar Christina at 2022-07-07T23:23:57-04:00 winio: make consoleReadNonBlocking not wait for any events at all. - - - - - 42c917df by Adam Sandberg Ericsson at 2022-07-07T23:24:34-04:00 rts: allow NULL to be used as an invalid StgStablePtr - - - - - 3739e565 by Andreas Schwab at 2022-07-07T23:25:10-04:00 RTS: Add stack marker to StgCRunAsm.S Every object file must be properly marked for non-executable stack, even if it contains no code. - - - - - a889bc05 by Ben Gamari at 2022-07-07T23:25:45-04:00 Bump unix submodule Adds `config.sub` to unix's `.gitignore`, fixing #19574. - - - - - 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode The most egrarious thing this fixes is the report about the total number of loaded modules after starting a session. Ticket #20889 - - - - - fc183c90 by Matthew Pickering at 2022-07-09T11:11:58-04:00 Enable :edit command in ghci multi-mode. This works after the last change to isLoaded. Ticket #20888 - - - - - 46050534 by Simon Peyton Jones at 2022-07-09T11:12:34-04:00 Fix a scoping bug in the Specialiser In the call to `specLookupRule` in `already_covered`, in `specCalls`, we need an in-scope set that includes the free vars of the arguments. But we simply were not guaranteeing that: did not include the `rule_bndrs`. Easily fixed. I'm not sure how how this bug has lain for quite so long without biting us. Fixes #21828. - - - - - 6e8d9056 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Edit Note [idArity varies independently of dmdTypeDepth] ...and refer to it in GHC.Core.Lint.lintLetBind. Fixes #21452 - - - - - 89ba4655 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Tiny documentation wibbles (comments only) - - - - - 61a46c6d by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix readme - - - - - 61babb5e by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix bootstrap - - - - - 8b417ad5 by Eric Lindblad at 2022-07-13T08:28:29-04:00 tarball - - - - - e9d9f078 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Fix scopes for deriving clauses and instance signatures (#18425) - - - - - c4989131 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Record location of filled in default method bindings This is useful for hie files to reconstruct the evidence that default methods depend on. - - - - - 9c52e7fc by Zubin Duggal at 2022-07-13T14:00:18-04:00 testsuite: Factor out common parts from hiefile tests - - - - - 6a9e4493 by sheaf at 2022-07-13T14:00:56-04:00 Hadrian: update documentation of settings The documentation for key-value settings was a bit out of date. This patch updates it to account for `cabal.configure.opts` and `hsc2hs.run.opts`. The user-settings document was also re-arranged, to make the key-value settings more prominent (as it doesn't involve changing the Hadrian source code, and thus doesn't require any recompilation of Hadrian). - - - - - a2f142f8 by Zubin Duggal at 2022-07-13T20:43:32-04:00 Fix potential space leak that arise from ModuleGraphs retaining references to previous ModuleGraphs, in particular the lazy `mg_non_boot` field. This manifests in `extendMG`. Solution: Delete `mg_non_boot` as it is only used for `mgLookupModule`, which is only called in two places in the compiler, and should only be called at most once for every home unit: GHC.Driver.Make: mainModuleSrcPath :: Maybe String mainModuleSrcPath = do ms <- mgLookupModule mod_graph (mainModIs hue) ml_hs_file (ms_location ms) GHCI.UI: listModuleLine modl line = do graph <- GHC.getModuleGraph let this = GHC.mgLookupModule graph modl Instead `mgLookupModule` can be a linear function that looks through the entire list of `ModuleGraphNodes` Fixes #21816 - - - - - dcf8b30a by Ben Gamari at 2022-07-13T20:44:08-04:00 rts: Fix AdjustorPool bitmap manipulation Previously the implementation of bitmap_first_unset assumed that `__builtin_clz` would accept `uint8_t` however it apparently rather extends its argument to `unsigned int`. To fix this we simply revert to a naive implementation since handling the various corner cases with `clz` is quite tricky. This should be fine given that AdjustorPool isn't particularly hot. Ideally we would have a single, optimised bitmap implementation in the RTS but I'll leave this for future work. Fixes #21838. - - - - - ad8f3e15 by Luite Stegeman at 2022-07-16T07:20:36-04:00 Change GHCi bytecode return convention for unlifted datatypes. This changes the bytecode return convention for unlifted algebraic datatypes to be the same as for lifted types, i.e. ENTER/PUSH_ALTS instead of RETURN_UNLIFTED/PUSH_ALTS_UNLIFTED Fixes #20849 - - - - - 5434d1a3 by Colten Webb at 2022-07-16T07:21:15-04:00 Compute record-dot-syntax types Ensures type information for record-dot-syntax is included in HieASTs. See #21797 - - - - - 89d169ec by Colten Webb at 2022-07-16T07:21:15-04:00 Add record-dot-syntax test - - - - - 4beb9f3c by Ben Gamari at 2022-07-16T07:21:51-04:00 Document RuntimeRep polymorphism limitations of catch#, et al As noted in #21868, several primops accepting continuations producing RuntimeRep-polymorphic results aren't nearly as polymorphic as their types suggest. Document this limitation and adapt the `UnliftedWeakPtr` test to avoid breaking this limitation in `keepAlive#`. - - - - - 4ef1c65d by Ben Gamari at 2022-07-16T07:21:51-04:00 Make keepAlive# out-of-line This is a naive approach to fixing the unsoundness noticed in #21708. Specifically, we remove the lowering of `keepAlive#` via CorePrep and instead turn it into an out-of-line primop. This is simple, inefficient (since the continuation must now be heap allocated), but good enough for 9.4.1. We will revisit this (particiularly via #16098) in a future release. Metric Increase: T4978 T7257 T9203 - - - - - 1bbff35d by Greg Steuck at 2022-07-16T07:22:29-04:00 Suppress extra output from configure check for c++ libraries - - - - - 3acbd7ad by Ben Gamari at 2022-07-16T07:23:04-04:00 rel-notes: Drop mention of #21745 fix Since we have backported the fix to 9.4.1. - - - - - b27c2774 by Dominik Peteler at 2022-07-16T07:23:43-04:00 Align the behaviour of `dopt` and `log_dopt` Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861 - - - - - 28347d71 by Douglas Wilson at 2022-07-16T13:25:06-04:00 rts: forkOn context switches the target capability Fixes #21824 - - - - - f1c44991 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Eliminate orphan Outputable instances Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and `OutputableP` instances for the Cmm AST. This makes it significantly easier to use the Cmm pretty-printers in tracing output without incurring module import cycles. - - - - - f2e5e763 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Move toBlockList to GHC.Cmm - - - - - fa092745 by Ben Gamari at 2022-07-16T13:25:41-04:00 compiler: Add haddock sections to GHC.Utils.Panic - - - - - 097759f9 by Ben Gamari at 2022-07-16T13:26:17-04:00 configure: Don't override Windows CXXFLAGS At some point we used the clang distribution from msys2's `MINGW64` environment for our Windows toolchain. This defaulted to using libgcc and libstdc++ for its runtime library. However, we found for a variety of reasons that compiler-rt, libunwind, and libc++ were more reliable, consequently we explicitly overrode the CXXFLAGS to use these. However, since then we have switched to use the `CLANG64` packaging, which default to these already. Consequently we can drop these arguments, silencing some redundant argument warnings from clang. Fixes #21669. - - - - - e38a2684 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Check that there are no NULL ctors - - - - - 616365b0 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Introduce support for invoking finalizers on unload Addresses #20494. - - - - - cdd3be20 by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add T20494 - - - - - 03c69d8d by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Rename finit field to fini fini is short for "finalizer", which does not contain a "t". - - - - - 033580bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Refactor handling of oc->info Previously we would free oc->info after running initializers. However, we can't do this is we want to also run finalizers. Moreover, freeing oc->info so early was wrong for another reason: we will need it in order to unregister the exception tables (see the call to `RtlDeleteFunctionTable`). In service of #20494. - - - - - f17912e4 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Add finalization support This implements #20494 for the PEi386 linker. Happily, this also appears to fix `T9405`, resolving #21361. - - - - - 2cd75550 by Ben Gamari at 2022-07-16T23:50:36-04:00 Loader: Implement gnu-style -l:$path syntax Gnu ld allows `-l` to be passed an absolute file path, signalled by a `:` prefix. Implement this in the GHC's loader search logic. - - - - - 5781a360 by Ben Gamari at 2022-07-16T23:50:36-04:00 Statically-link against libc++ on Windows Unfortunately on Windows we have no RPATH-like facility, making dynamic linking extremely fragile. Since we cannot assume that the user will add their GHC installation to `$PATH` (and therefore their DLL search path) we cannot assume that the loader will be able to locate our `libc++.dll`. To avoid this, we instead statically link against `libc++.a` on Windows. Fixes #21435. - - - - - 8e2e883b by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Ensure that all .ctors/.dtors sections are run It turns out that PE objects may have multiple `.ctors`/`.dtors` sections but the RTS linker had assumed that there was only one. Fix this. Fixes #21618. - - - - - fba04387 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Respect dtor/ctor priority Previously we would run constructors and destructors in arbitrary order despite explicit priorities. Fixes #21847. - - - - - 1001952f by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add test for #21618 and #21847 - - - - - 6f3816af by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Fix exception unwind unregistration RtlDeleteFunctionTable expects a pointer to the .pdata section yet we passed it the .xdata section. Happily, this fixes #21354. - - - - - d9bff44c by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Drop dead code - - - - - d161e6bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Use section flags to identify initializers - - - - - fbb17110 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Introduce finalizer support - - - - - 5b0ed8a8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Use system-cxx-std-lib instead of config.stdcxx_impl - - - - - 6c476e1a by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker/Elf: Work around GCC 6 init/fini behavior It appears that GCC 6t (at least on i386) fails to give init_array/fini_array sections the correct SHT_INIT_ARRAY/SHT_FINI_ARRAY section types, instead marking them as SHT_PROGBITS. This caused T20494 to fail on Debian. - - - - - 5f8203b8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Mark T13366Cxx as unbroken on Darwin - - - - - 1fd2f851 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Fix resolution of __dso_handle on Darwin Darwin expects a leading underscore. - - - - - a2dc00f3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Clean up section kinds - - - - - aeb1a7c3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Ensure that __cxa_finalize is called on code unload - - - - - 028f081e by Ben Gamari at 2022-07-16T23:51:12-04:00 testsuite: Fix T11829 on Centos 7 It appears that Centos 7 has a more strict C++ compiler than most distributions since std::runtime_error is defined in <stdexcept> rather than <exception>. In T11829 we mistakenly imported the latter. - - - - - a10584e8 by Ben Gamari at 2022-07-17T22:30:32-04:00 hadrian: Rename documentation directories for consistency with make * Rename `docs` to `doc` * Place pdf documentation in `doc/` instead of `doc/pdfs/` Fixes #21164. - - - - - b27c5947 by Anselm Schüler at 2022-07-17T22:31:11-04:00 Fix incorrect proof of applyWhen’s properties - - - - - eb031a5b by Matthew Pickering at 2022-07-18T08:04:47-04:00 hadrian: Add multi:<pkg> and multi targets for starting a multi-repl This patch adds support to hadrian for starting a multi-repl containing all the packages which stage0 can build. In particular, there is the new user-facing command: ``` ./hadrian/ghci-multi ``` which when executed will start a multi-repl containing the `ghc` package and all it's dependencies. This is implemented by two new hadrian targets: ``` ./hadrian/build multi:<pkg> ``` Construct the arguments for a multi-repl session where the top-level package is <pkg>. For example, `./hadrian/ghci-multi` is implemented using `multi:ghc` target. There is also the `multi` command which constructs a repl for everything in stage0 which we can build. - - - - - 19e7cac9 by Eric Lindblad at 2022-07-18T08:05:27-04:00 changelog typo - - - - - af6731a4 by Eric Lindblad at 2022-07-18T08:05:27-04:00 typos - - - - - 415468fe by Simon Peyton Jones at 2022-07-18T16:36:54-04:00 Refactor SpecConstr to use treat bindings uniformly This patch, provoked by #21457, simplifies SpecConstr by treating top-level and nested bindings uniformly (see the new scBind). * Eliminates the mysterious scTopBindEnv * Refactors scBind to handle top-level and nested definitions uniformly. * But, for now at least, continues the status quo of not doing SpecConstr for top-level non-recursive bindings. (In contrast we do specialise nested non-recursive bindings, although the original paper did not; see Note [Local let bindings].) I tried the effect of specialising top-level non-recursive bindings (which is now dead easy to switch on, unlike before) but found some regressions, so I backed off. See !8135. It's a pure refactoring. I think it'll do a better job in a few cases, but there is no regression test. - - - - - d4d3fe6e by Andreas Klebinger at 2022-07-18T16:37:29-04:00 Rule matching: Don't compute the FVs if we don't look at them. - - - - - 5f907371 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 White space only in FamInstEnv - - - - - ae3b3b62 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make transferPolyIdInfo work for CPR I don't know why this hasn't bitten us before, but it was plain wrong. - - - - - 9bdfdd98 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Inline mapAccumLM This function is called in inner loops in the compiler, and it's overloaded and higher order. Best just to inline it. This popped up when I was looking at something else. I think perhaps GHC is delicately balanced on the cusp of inlining this automatically. - - - - - d0b806ff by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make SetLevels honour floatConsts This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though. - - - - - d1c25a48 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Refactor wantToUnboxArg a bit * Rename GHC.Core.Opt.WorkWrap.Utils.wantToUnboxArg to canUnboxArg and similarly wantToUnboxResult to canUnboxResult. * Add GHC.Core.Opt.DmdAnal.wantToUnboxArg as a wrapper for the (new) GHC.Core.Opt.WorkWrap.Utils.canUnboxArg, avoiding some yukky duplication. I decided it was clearer to give it a new data type for its return type, because I nedeed the FD_RecBox case which was not otherwise readiliy expressible. * Add dcpc_args to WorkWrap.Utils.DataConPatContext for the payload * Get rid of the Unlift constructor of UnboxingDecision, eliminate two panics, and two arguments to canUnboxArg (new name). Much nicer now. - - - - - 6d8a715e by Teo Camarasu at 2022-07-18T16:38:44-04:00 Allow running memInventory when the concurrent nonmoving gc is enabled If the nonmoving gc is enabled and we are using a threaded RTS, we now try to grab the collector mutex to avoid memInventory and the collection racing. Before memInventory was disabled. - - - - - aa75bbde by Ben Gamari at 2022-07-18T16:39:20-04:00 gitignore: don't ignore all aclocal.m4 files While GHC's own aclocal.m4 is generated by the aclocal tool, other packages' aclocal.m4 are committed in the repository. Previously `.gitignore` included an entry which covered *any* file named `aclocal.m4`, which lead to quite some confusion (e.g. see #21740). Fix this by modifying GHC's `.gitignore` to only cover GHC's own `aclocal.m4`. - - - - - 4b98c5ce by Boris Lykah at 2022-07-19T02:34:12-04:00 Add mapAccumM, forAccumM to Data.Traversable Approved by Core Libraries Committee in https://github.com/haskell/core-libraries-committee/issues/65#issuecomment-1186275433 - - - - - bd92182c by Ben Gamari at 2022-07-19T02:34:47-04:00 configure: Use AC_PATH_TOOL to detect tools Previously we used AC_PATH_PROG which, as noted by #21601, does not look for tools with a target prefix, breaking cross-compilation. Fixes #21601. - - - - - e8c07aa9 by Matthew Pickering at 2022-07-19T10:07:53-04:00 driver: Fix implementation of -S We were failing to stop before running the assembler so the object file was also created. Fixes #21869 - - - - - e2f0094c by Ben Gamari at 2022-07-19T10:08:28-04:00 rts/ProfHeap: Ensure new Censuses are zeroed When growing the Census array ProfHeap previously neglected to zero the new part of the array. Consequently `freeEra` would attempt to free random words that often looked suspiciously like pointers. Fixes #21880. - - - - - 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - de0b4a7d by Trevis Elser at 2022-08-09T18:32:04+00:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/upload_ghc_libs.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/Dataflow/Graph.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - − compiler/GHC/Cmm/Ppr.hs - − compiler/GHC/Cmm/Ppr/Decl.hs - − compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - + compiler/GHC/Cmm/Reg.hs - compiler/GHC/Cmm/Sink.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b437a4a228b3c267c0b5968d390f898b80b7c513...de0b4a7d752c6af009ac2a34a14ccef76cc65f4d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b437a4a228b3c267c0b5968d390f898b80b7c513...de0b4a7d752c6af009ac2a34a14ccef76cc65f4d You're receiving 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 Aug 10 21:26:41 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 17:26:41 -0400 Subject: [Git][ghc/ghc][wip/T21847] Deleted 1 commit: testsuite: Mark encoding004 as broken on FreeBSD Message-ID: <62f422918e168_142b49517fc214934@gitlab.mail> Ben Gamari pushed to branch wip/T21847 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: 47c1d629 by Ben Gamari at 2022-08-10T17:23:43-04:00 testsuite: Mark encoding004 as broken on FreeBSD Due to #22003. - - - - - 1 changed file: - libraries/base/tests/IO/all.T Changes: ===================================== libraries/base/tests/IO/all.T ===================================== @@ -115,7 +115,7 @@ test('encoding001', [], compile_and_run, ['']) test('encoding002', normal, compile_and_run, ['']) test('encoding003', normal, compile_and_run, ['']) -test('encoding004', extra_files(['encoded-data/']), compile_and_run, ['']) +test('encoding004', [when(opsys('freebsd'), expect_broken(22003)), extra_files(['encoded-data/'])], compile_and_run, ['']) test('encoding005', normal, compile_and_run, ['']) test('environment001', [], makefile_test, ['environment001-test']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47c1d6294775d5b5a5d5b4ec26c10f460d265dc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47c1d6294775d5b5a5d5b4ec26c10f460d265dc4 You're receiving 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 Aug 10 21:24:06 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 17:24:06 -0400 Subject: [Git][ghc/ghc][wip/T21847] 2 commits: rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f421f68698e_142b495215c2140f7@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: 53ed70a1 by Ben Gamari at 2022-08-10T17:23:39-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 47c1d629 by Ben Gamari at 2022-08-10T17:23:43-04:00 testsuite: Mark encoding004 as broken on FreeBSD Due to #22003. - - - - - 8 changed files: - libraries/base/tests/IO/all.T - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== libraries/base/tests/IO/all.T ===================================== @@ -115,7 +115,7 @@ test('encoding001', [], compile_and_run, ['']) test('encoding002', normal, compile_and_run, ['']) test('encoding003', normal, compile_and_run, ['']) -test('encoding004', extra_files(['encoded-data/']), compile_and_run, ['']) +test('encoding004', [when(opsys('freebsd'), expect_broken(22003)), extra_files(['encoded-data/'])], compile_and_run, ['']) test('encoding005', normal, compile_and_run, ['']) test('environment001', [], makefile_test, ['environment001-test']) ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,64 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +905,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2024,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2035,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &&prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1c862d7ec9938950b278b8dd840e13a481d1891...47c1d6294775d5b5a5d5b4ec26c10f460d265dc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1c862d7ec9938950b278b8dd840e13a481d1891...47c1d6294775d5b5a5d5b4ec26c10f460d265dc4 You're receiving 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 Aug 10 21:26:13 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 17:26:13 -0400 Subject: [Git][ghc/ghc][wip/T21986] 2 commits: testsuite: Mark encoding004 as broken on FreeBSD Message-ID: <62f422752eb12_142b4951838214480@gitlab.mail> Ben Gamari pushed to branch wip/T21986 at Glasgow Haskell Compiler / GHC Commits: 2d936b7d by Ben Gamari at 2022-08-10T17:25:37-04:00 testsuite: Mark encoding004 as broken on FreeBSD Due to #22003. - - - - - 79360482 by Ben Gamari at 2022-08-10T17:25:58-04:00 rts/linker: Fix non-prototype declaration warnings - - - - - 2 changed files: - libraries/base/tests/IO/all.T - rts/Linker.c Changes: ===================================== libraries/base/tests/IO/all.T ===================================== @@ -115,7 +115,7 @@ test('encoding001', [], compile_and_run, ['']) test('encoding002', normal, compile_and_run, ['']) test('encoding003', normal, compile_and_run, ['']) -test('encoding004', extra_files(['encoded-data/']), compile_and_run, ['']) +test('encoding004', [when(opsys('freebsd'), expect_broken(22003)), extra_files(['encoded-data/'])], compile_and_run, ['']) test('encoding005', normal, compile_and_run, ['']) test('environment001', [], makefile_test, ['environment001-test']) ===================================== rts/Linker.c ===================================== @@ -99,12 +99,12 @@ */ #if defined(freebsd_HOST_OS) -extern void iconvctl(); -extern void iconv_open_into(); -extern void iconv_open(); -extern void iconv_close(); -extern void iconv_canonicalize(); -extern void iconv(); +extern void iconvctl(void); +extern void iconv_open_into(void); +extern void iconv_open(void); +extern void iconv_close(void); +extern void iconv_canonicalize(void); +extern void iconv(void); #endif /* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62839fbdb0fc50d07c0b5c9edff633bc8c407bd0...793604823a7a00677816ee6fe9ef83ac3765fc21 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62839fbdb0fc50d07c0b5c9edff633bc8c407bd0...793604823a7a00677816ee6fe9ef83ac3765fc21 You're receiving 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 Aug 8 04:08:53 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 00:08:53 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] cabal Message-ID: <62f08c554f118_25b0164c158379167@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: aec045a4 by Ben Gamari at 2022-08-08T00:08:46-04:00 cabal - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -328,8 +328,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - cabal_url="$base_url/cabal-install-$v-x86_64-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aec045a42034e38bf3625e97a4eb110abaa21674 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aec045a42034e38bf3625e97a4eb110abaa21674 You're receiving 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 Aug 9 19:48:05 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 15:48:05 -0400 Subject: [Git][ghc/ghc][wip/nr/wasm-control-flow] 2 commits: add the two key graph modules from Martin Erwig's FGL Message-ID: <62f2b9f5eb6df_182c4e506b835605b@gitlab.mail> Norman Ramsey pushed to branch wip/nr/wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: 3670bad8 by Norman Ramsey at 2022-08-09T15:46:39-04: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. - - - - - e523867d by Norman Ramsey at 2022-08-09T15:47:16-04:00 add new modules for reducibility and WebAssembly translation also includes an emitter for GNU assembler code and some regression tests - - - - - 30 changed files: - + compiler/GHC/Cmm/Reducibility.hs - + compiler/GHC/Data/Graph/Collapse.hs - + compiler/GHC/Data/Graph/Inductive/Graph.hs - + compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs - + compiler/GHC/Wasm/ControlFlow.hs - + compiler/GHC/Wasm/ControlFlow/FromCmm.hs - + compiler/GHC/Wasm/ControlFlow/ToAsm.hs - compiler/ghc.cabal.in - testsuite/tests/linters/notes.stdout - + 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c430e47069cef278914f48ee671dbc70d8965737...e523867ddfb385fb0dc4a65e2fc7c06d4dbe4ac6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c430e47069cef278914f48ee671dbc70d8965737...e523867ddfb385fb0dc4a65e2fc7c06d4dbe4ac6 You're receiving 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 Aug 12 18:54:57 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 12 Aug 2022 14:54:57 -0400 Subject: [Git][ghc/ghc][wip/andreask/infer_exprs] Adjust regex Message-ID: <62f6a20187530_3d8149489a4680899@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer_exprs at Glasgow Haskell Compiler / GHC Commits: d04a6a55 by Andreas Klebinger at 2022-08-12T20:54:35+02:00 Adjust regex - - - - - 1 changed file: - testsuite/tests/simplStg/should_compile/all.T Changes: ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -11,4 +11,4 @@ setTestOpts(f) test('T13588', [ grep_errmsg('case') ] , compile, ['-dverbose-stg2stg -fno-worker-wrapper']) test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typeable-binds']) -test('inferTags002', [ only_ways(['optasm']), grep_errmsg('(stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) +test('inferTags002', [ only_ways(['optasm']), grep_errmsg('(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d04a6a5586785f52ed48fd5545e553e008f2165c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d04a6a5586785f52ed48fd5545e553e008f2165c You're receiving 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 Aug 7 23:28:39 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 19:28:39 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] system-cxx-std-lib: Add support for FreeBSD libcxxrt Message-ID: <62f04aa7f3f45_25b0164bfa0356513@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: ee7b62bf by Ben Gamari at 2022-08-07T19:28:20-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 1 changed file: - m4/fp_find_cxx_std_lib.m4 Changes: ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + AC_MSG_CHECKING([libraries necessary to link against C++ standard library]) + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + if "$CC" -o actest actest.o $$1; then + CXX_STD_LIB_LIBS="$$3" + p="`"$CXX" --print-file-name $$2`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,24 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([$$3]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee7b62bfa6ff3823c55ce422b24f0ee8f943168a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee7b62bfa6ff3823c55ce422b24f0ee8f943168a You're receiving 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 Aug 7 22:18:26 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 18:18:26 -0400 Subject: [Git][ghc/ghc][wip/bindist-install] 22 commits: Improve BUILD_PAP comments Message-ID: <62f03a3285a13_25b0164c15835089d@gitlab.mail> Ben Gamari pushed to branch wip/bindist-install at Glasgow Haskell Compiler / GHC Commits: e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - d0613678 by Ben Gamari at 2022-08-07T18:15:09-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/CostCentre.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Utils/Misc.hs - distrib/configure.ac.in - docs/users_guide/9.6.1-notes.rst - docs/users_guide/debugging.rst - docs/users_guide/profiling.rst - hadrian/bindist/Makefile - + hadrian/bindist/config.mk.in - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - libraries/base/GHC/Conc.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/119ee22dd09d8977de67939de7324af941ae7196...d0613678fd502fdef86f7729fb450f16100862ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/119ee22dd09d8977de67939de7324af941ae7196...d0613678fd502fdef86f7729fb450f16100862ea You're receiving 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 Aug 8 19:15:01 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 15:15:01 -0400 Subject: [Git][ghc/ghc][wip/bindist-install] hih Message-ID: <62f160b51675_25b0164bfdc58044b@gitlab.mail> Ben Gamari pushed to branch wip/bindist-install at Glasgow Haskell Compiler / GHC Commits: d3fdbb04 by Ben Gamari at 2022-08-08T15:13:25-04:00 hih - - - - - 4 changed files: - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - + mk/install_script.sh Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -23,42 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - @echo "$1 installed to $2"; - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -RP 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -229,12 +193,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) .`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -119,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3fdbb04c35a250c36d3c9aa6263fde851abb2ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3fdbb04c35a250c36d3c9aa6263fde851abb2ad You're receiving 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 Aug 9 03:27:19 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 23:27:19 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] gitlab-ci: Bump to use freebsd13 runners Message-ID: <62f1d4175c47_182c4e506544801d@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: f83bae95 by Ben Gamari at 2022-08-08T23:27:12-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +290,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +328,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,7 +299,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,7 +307,7 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) ===================================== .gitlab/jobs.yaml ===================================== @@ -658,7 +658,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -668,7 +668,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -677,7 +677,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -705,17 +705,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2227,7 +2227,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2237,7 +2237,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2246,7 +2246,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2274,18 +2274,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -3147,7 +3147,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3157,7 +3157,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -3166,7 +3166,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3194,17 +3194,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f83bae956a46495fb6217b9fb666384ad864ffd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f83bae956a46495fb6217b9fb666384ad864ffd5 You're receiving 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 Aug 10 20:22:23 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 16:22:23 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f4137fc344e_142b49517c01968a2@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: f67e9c74 by Ben Gamari at 2022-08-10T16:22:11-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -852,8 +851,55 @@ ocGetNames_ELF ( ObjectCode* oc ) + shdr[i].sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + const char *sh_name = oc->sections[i].info->name; + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + } if (shdr[i].sh_type != SHT_SYMTAB) continue; @@ -1971,62 +2017,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2028,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &&prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f67e9c7484fbb1d76515125a31c65a9be53e599c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f67e9c7484fbb1d76515125a31c65a9be53e599c You're receiving 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 Aug 8 14:40:40 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 08 Aug 2022 10:40:40 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Doc Message-ID: <62f12068cf2cf_25b0164bfdc5049df@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 649f0fea by Sylvain Henry at 2022-08-08T16:43:24+02:00 Doc - - - - - 7 changed files: - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs Changes: ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -16,12 +16,12 @@ -- Stability : experimental -- -- --- TODO: Write my description! +-- Module that deals with expression application in JavaScript. In some cases we +-- rely on pre-generated functions that are bundled with the RTS (see rtsApply). ----------------------------------------------------------------------------- module GHC.StgToJS.Apply ( genApp - , mkApplyArr , rtsApply ) where @@ -68,8 +68,28 @@ import qualified Data.Bits as Bits import Data.Monoid import Data.Array +-- | Pre-generated functions for fast Apply. +-- These are bundled with the RTS. +rtsApply :: StgToJSConfig -> JStat +rtsApply cfg = BlockStat $ + map (uncurry (stackApply cfg)) applySpec + ++ map (uncurry (fastApply cfg)) applySpec + ++ map (pap cfg) specPap + ++ [ mkApplyArr + , genericStackApply cfg + , genericFastApply cfg + , zeroApply cfg + , updates cfg + , papGen cfg + , moveRegs2 + , selectors cfg + ] + --- | Generate an application of some args to an Id +-- | Generate an application of some args to an Id. +-- +-- The case where args is null is common as it's used to generate the evaluation +-- code for an Id. genApp :: HasDebugCallStack => ExprCtx @@ -89,6 +109,10 @@ genApp ctx i args -- , matchVarName "ghcjs-prim" "GHCJS.Prim" "unsafeUnpackJSStringUtf8##" i = -- (,ExprInline Nothing) . (|=) top . app "h$decodeUtf8z" <$> genIds v + -- Case: unpackCStringAppend# "some string"# str + -- + -- Generates h$appendToHsStringA(str, "some string"), which has a faster + -- decoding loop. | [StgLitArg (LitString bs), x] <- args , [top] <- concatMap typex_expr (ctxTarget ctx) , getUnique i == unpackCStringAppendIdKey @@ -120,12 +144,27 @@ genApp ctx i args , [top] <- concatMap typex_expr (ctxTarget ctx) = return (top |= null_, ExprInline Nothing) + -- unboxed tuple or strict type: return fields individually | [] <- args , isUnboxedTupleType (idType i) || isStrictType (idType i) = do - a <- assignCoerce1 (ctxTarget ctx) . (alignIdExprs i) <$> genIds i + a <- storeIdFields i (ctxTarget ctx) return (a, ExprInline Nothing) + -- Handle alternative heap object representation: in some cases, a heap + -- object is not represented as a JS object but directly as a number or a + -- string. I.e. only the payload is stored because the box isn't useful. + -- It happens for "Int Int#" for example: no need to box the Int# in JS. + -- + -- We must check that: + -- - the object is subject to the optimization (cf isUnboxable predicate) + -- - we know that it is already evaluated (cf ctxIsEvaluated), otherwise we + -- need to evaluate it properly first. + -- + -- In which case we generate a dynamic check (using isObject) that either: + -- - returns the payload of the heap object, if it uses the generic heap + -- object representation + -- - returns the object directly, otherwise | [] <- args , [vt] <- idVt i , isUnboxable vt @@ -140,10 +179,13 @@ genApp ctx i args ) _ -> panic "genApp: invalid size" + -- case of Id without args and known to be already evaluated: return fields + -- individually | [] <- args , ctxIsEvaluated ctx i || isStrictId i = do - a <- assignCoerce1 (ctxTarget ctx) . (alignIdExprs i) <$> genIds i + a <- storeIdFields i (ctxTarget ctx) + -- optional runtime assert for detecting unexpected thunks (unevaluated) settings <- getSettings let ww = case concatMap typex_expr (ctxTarget ctx) of [t] | csAssertRts settings -> @@ -153,6 +195,11 @@ genApp ctx i args _ -> mempty return (a `mappend` ww, ExprInline Nothing) + + -- Case: "newtype" datacon wrapper + -- + -- If the wrapped argument is known to be already evaluated, then we don't + -- need to enter it. | DataConWrapId dc <- idDetails i , isNewTyCon (dataConTyCon dc) = do @@ -168,23 +215,36 @@ genApp ctx i args else return (returnS (app "h$e" [ai]), ExprCont) _ -> panic "genApp: invalid size" + -- no args and Id can't be a function: just enter it | [] <- args , idFunRepArity i == 0 , not (might_be_a_function (idType i)) = do - ii <- enterId - return (returnS (app "h$e" [ii]), ExprCont) - + enter_id <- genArg (StgVarArg i) >>= + \case + [x] -> return x + xs -> pprPanic "genApp: unexpected multi-var argument" + (vcat [ppr (length xs), ppr i]) + return (returnS (app "h$e" [enter_id]), ExprCont) + + -- fully saturated global function: + -- - deals with arguments + -- - jumps into the function | n <- length args , n /= 0 , idFunRepArity i == n - , not (isLocalId i) + , not (isLocalId i) -- FIXME (Sylvain 2022-08): why are we testing this here and not in the oversaturated case below? , isStrictId i = do as' <- concatMapM genArg args - jmp <- jumpToII i as' =<< r1 + is <- assignAll jsRegsFromR1 <$> genIds i + jmp <- jumpToII i as' is return (jmp, ExprCont) + -- oversaturated function: + -- - push continuation with extra args + -- - deals with arguments + -- - jumps into the function | idFunRepArity i < length args , isStrictId i , idFunRepArity i > 0 @@ -192,25 +252,19 @@ genApp ctx i args let (reg,over) = splitAt (idFunRepArity i) args reg' <- concatMapM genArg reg pc <- pushCont over - jmp <- jumpToII i reg' =<< r1 + is <- assignAll jsRegsFromR1 <$> genIds i + jmp <- jumpToII i reg' is return (pc <> jmp, ExprCont) + -- generic apply: + -- - try to find a pre-generated apply function that matches + -- - use it if any + -- - otherwise use generic apply function h$ap_gen_fast | otherwise = do - jmp <- jumpToFast args =<< r1 + is <- assignAll jsRegsFromR1 <$> genIds i + jmp <- jumpToFast args is return (jmp, ExprCont) - where - enterId :: G JExpr - enterId = genArg (StgVarArg i) >>= - \case - [x] -> return x - xs -> pprPanic "genApp: unexpected multi-var argument" - (vcat [ppr (length xs), ppr i]) - - r1 :: G JStat - r1 = do - ids <- genIds i - return $ mconcat $ zipWith (\r u -> toJExpr r |= toJExpr u) (enumFrom R1) ids -- avoid one indirection for global ids -- fixme in many cases we can also jump directly to the entry for local? @@ -231,38 +285,40 @@ jumpToII i args afterLoad , returnS ei ] where - ra = mconcat . reverse $ zipWith (\r a -> toJExpr r |= a) (enumFrom R2) args + ra = mconcat . reverse $ zipWith (\r a -> r |= a) jsRegsFromR2 args +-- | Try to use a specialized pre-generated application function. +-- If there is none, use h$ap_gen_fast instead jumpToFast :: HasDebugCallStack => [StgArg] -> JStat -> G JStat jumpToFast as afterLoad = do regs <- concatMapM genArg as - (fun, spec) <- selectApply True (as,regs) + spec <- selectApply True as regs pure $ mconcat [ mconcat (ra regs) , afterLoad - , if spec - then returnS (ApplExpr fun []) - else returnS (ApplExpr fun [toJExpr (mkTag regs as)]) + , case spec of + Right fun -> returnS (ApplExpr fun []) + Left fun -> returnS (ApplExpr fun [toJExpr (mkTag regs as)]) ] where - ra regs = reverse $ zipWith (\r ex -> toJExpr r |= ex) (enumFrom R2) regs + ra regs = reverse $ zipWith (\r ex -> r |= ex) jsRegsFromR2 regs mkTag rs as = (length rs `Bits.shiftL` 8) Bits..|. length as --- find a specialized application path if there is one +-- | Find a specialized application function if there is one selectApply - :: Bool -- ^ true for fast apply, false for stack apply - -> ([StgArg], [JExpr]) -- ^ arguments - -> G (JExpr, Bool) -- ^ the function to call, true if specialized path -selectApply fast (args, as) = + :: Bool -- ^ true for fast apply, false for stack apply + -> [StgArg] -- ^ Raw arguments + -> [JExpr] -- ^ JS arguments + -> G (Either JExpr JExpr) -- ^ the function to call (Left for generic, Right for specialized) +selectApply fast args as = case specApply fast (length args) (length as) of - Just e -> return (e, True) - Nothing -> return (var $ "h$ap_gen" <> fastSuff, False) + Just e -> return (Right e) + Nothing -> return (Left (var $ "h$ap_gen" <> fastSuff)) where fastSuff | fast = "_fast" | otherwise = "" - -- specialized apply for these -- make sure that once you are in spec, you stay there applySpec :: [(Int,Int)] -- regs,arity @@ -317,62 +373,81 @@ mkApplyArr = mconcat assignPap p = var "h$paps" .! toJExpr p |= (var (mkFastString $ ("h$pap_" ++ show p))) +-- | Push a continuation on the stack +-- +-- First push the given args, then push an apply function (specialized if +-- possible, otherwise the generic h$ap_gen function). pushCont :: HasDebugCallStack => [StgArg] -> G JStat pushCont as = do as' <- concatMapM genArg as - (app, spec) <- selectApply False (as,as') - if spec - then push $ reverse $ app : as' - else push $ reverse $ app : mkTag as' as : as' + spec <- selectApply False as as' + case spec of + Right app -> push $ reverse $ app : as' + Left app -> push $ reverse $ app : mkTag as' as : as' where mkTag rs ns = toJExpr ((length rs `Bits.shiftL` 8) Bits..|. length ns) -rtsApply :: StgToJSConfig -> JStat -rtsApply cfg = BlockStat $ - map (uncurry (stackApply cfg)) applySpec - ++ map (uncurry (fastApply cfg)) applySpec - ++ map (pap cfg) specPap - ++ [ mkApplyArr - , genericStackApply cfg - , genericFastApply cfg - , zeroApply cfg - , updates cfg - , papGen cfg - , moveRegs2 - , selectors cfg - ] - --- generic stack apply that can do everything, but less efficiently --- on stack: tag: (regs << 8 | arity) --- fixme: set closure info of stack frame +-- | Generic stack apply function (h$ap_gen) that can do everything, but less +-- efficiently than other more specialized functions. +-- +-- Stack layout: +-- 0. tag: (regs << 8 | arity) +-- 1. args +-- +-- Regs: +-- R1 = closure to apply to +-- +-- FIXME: set closure info of stack frame genericStackApply :: StgToJSConfig -> JStat -genericStackApply s = - closure (ClosureInfo "h$ap_gen" (CIRegs 0 [PtrV]) "h$ap_gen" CILayoutVariable CIStackFrame mempty) - (jVar \cf -> - [ traceRts s (jString "h$ap_gen") - , cf |= closureEntry r1 - , SwitchStat (entryClosureType cf) - [ (toJExpr Thunk, profStat s pushRestoreCCS <> returnS cf) - , (toJExpr Fun, funCase cf (funArity' cf)) - , (toJExpr Pap, funCase cf (papArity r1)) - , (toJExpr Blackhole, push' s [r1, var "h$return"] - <> returnS (app "h$blockOnBlackhole" [r1])) - ] (appS "throw" [jString "h$ap_gen: unexpected closure type " + (entryClosureType cf)]) - ] - ) +genericStackApply cfg = + closure info $ jVar \cf -> + [ traceRts cfg (jString "h$ap_gen") + , cf |= closureEntry r1 + -- switch on closure type + , SwitchStat (entryClosureType cf) + [ (toJExpr Thunk , thunk_case cfg cf) + , (toJExpr Fun , fun_case cf (funArity' cf)) + , (toJExpr Pap , fun_case cf (papArity r1)) + , (toJExpr Blackhole, blackhole_case cfg) + ] + (default_case cf) + ] where - funCase c arity = jVar \myArity ar myAr myRegs regs newTag newAp p dat -> + -- info table for h$ap_gen + info = ClosureInfo + { ciVar = "h$ap_gen" + , ciRegs = CIRegs 0 [PtrV] -- closure to apply to + , ciName = "h$ap_gen" + , ciLayout = CILayoutVariable + , ciType = CIStackFrame + , ciStatic = mempty + } + + default_case cf = appS "throw" [jString "h$ap_gen: unexpected closure type " + + (entryClosureType cf)] + + thunk_case cfg cf = mconcat + [ profStat cfg pushRestoreCCS + , returnS cf + ] + + blackhole_case cfg = mconcat + [ push' cfg [r1, var "h$return"] + , returnS (app "h$blockOnBlackhole" [r1]) + ] + + fun_case c arity = jVar \myArity ar myAr myRegs regs newTag newAp p dat -> [ myArity |= stack .! (sp - 1) , ar |= mask8 arity , myAr |= mask8 myArity , myRegs |= myArity .>>. 8 - , traceRts s (jString "h$ap_gen: args: " + myAr + , traceRts cfg (jString "h$ap_gen: args: " + myAr + jString " regs: " + myRegs) , ifBlockS (myAr .===. ar) -- then - [ traceRts s (jString "h$ap_gen: exact") + [ traceRts cfg (jString "h$ap_gen: exact") , loop 0 (.<. myRegs) (\i -> appS "h$setReg" [i+2, stack .! (sp-2-i)] <> postIncrS i) @@ -383,40 +458,44 @@ genericStackApply s = [ ifBlockS (myAr .>. ar) --then [ regs |= arity .>>. 8 - , traceRts s (jString "h$ap_gen: oversat: arity: " + ar + , traceRts cfg (jString "h$ap_gen: oversat: arity: " + ar + jString " regs: " + regs) , loop 0 (.<. regs) - (\i -> traceRts s (jString "h$ap_gen: loading register: " + i) + (\i -> traceRts cfg (jString "h$ap_gen: loading register: " + i) <> appS "h$setReg" [i+2, stack .! (sp-2-i)] <> postIncrS i) , newTag |= ((myRegs-regs).<<.8).|.myAr - ar , newAp |= var "h$apply" .! newTag - , traceRts s (jString "h$ap_gen: next: " + (newAp .^ "n")) + , traceRts cfg (jString "h$ap_gen: next: " + (newAp .^ "n")) , ifS (newAp .===. var "h$ap_gen") ((sp |= sp - regs) <> (stack .! (sp - 1) |= newTag)) (sp |= sp - regs - 1) , stack .! sp |= newAp - , profStat s pushRestoreCCS + , profStat cfg pushRestoreCCS , returnS c ] -- else - [ traceRts s (jString "h$ap_gen: undersat") + [ traceRts cfg (jString "h$ap_gen: undersat") , p |= var "h$paps" .! myRegs , dat |= toJExpr [r1, ((arity .>>. 8)-myRegs)*256+ar-myAr] , loop 0 (.<. myRegs) (\i -> (dat .^ "push") `ApplStat` [stack .! (sp - i - 2)] <> postIncrS i) , sp |= sp - myRegs - 2 - , r1 |= initClosure s p dat jCurrentCCS + , r1 |= initClosure cfg p dat jCurrentCCS , returnStack ] ] ] -{- - generic fast apply: can handle anything (slowly) - signature tag in argument --} +-- | Generic fast apply function (h$ap_gen_fast) that can do everything, but less +-- efficiently than other more specialized functions. +-- +-- Signature tag in argument. Tag: (regs << 8 | arity) +-- +-- Regs: +-- R1 = closure to apply to +-- genericFastApply :: StgToJSConfig -> JStat genericFastApply s = TxtI "h$ap_gen_fast" ||= jLam \tag -> jVar \c -> @@ -512,7 +591,7 @@ genericFastApply s = ] where pushReg :: Int -> (JExpr, JStat) - pushReg r = (toJExpr (r-1), stack .! (sp - toJExpr (r - 2)) |= toJExpr (intToJSReg r)) + pushReg r = (toJExpr (r-1), stack .! (sp - toJExpr (r - 2)) |= jsReg r) pushArgs :: JExpr -> JExpr -> JStat pushArgs start end = @@ -548,7 +627,7 @@ stackApply s r n = ] (appS "throw" [toJExpr ("panic: " <> funcName <> ", unexpected closure type: ") + (entryClosureType c)]) ] - funExact c = popSkip' 1 (reverse $ take r (map toJExpr $ enumFrom R2)) <> returnS c + funExact c = popSkip' 1 (reverse $ take r jsRegsFromR2) <> returnS c stackArgs = map (\x -> stack .! (sp - toJExpr x)) [1..r] papCase :: JExpr -> JStat @@ -620,7 +699,7 @@ stackApply s r n = where loadRegs rs = SwitchStat rs switchAlts mempty where - switchAlts = map (\x -> (toJExpr x, toJExpr (intToJSReg (x+1)) |= stack .! (sp - toJExpr x))) [r,r-1..1] + switchAlts = map (\x -> (toJExpr x, jsReg (x+1) |= stack .! (sp - toJExpr x))) [r,r-1..1] {- stg_ap_r_n_fast is entered if a function of unknown arity @@ -634,7 +713,7 @@ fastApply s r n = func ||= toJExpr (JFunc myFunArgs body) myFunArgs = [] - regArgs = take r (enumFrom R2) + regArgs = take r jsRegsFromR2 mkAp :: Int -> Int -> [JExpr] mkAp n' r' = [ var . mkFastString $ "h$ap_" ++ show n' ++ "_" ++ show r' ] @@ -651,8 +730,8 @@ fastApply s r n = func ||= toJExpr (JFunc myFunArgs body) <> (farity |= funArity' c) <> funCase c farity) ,(toJExpr Pap, traceRts s (toJExpr (funName <> ": pap")) <> (arity |= papArity r1) <> funCase c arity) - ,(toJExpr Thunk, traceRts s (toJExpr (funName <> ": thunk")) <> push' s (reverse (map toJExpr $ take r (enumFrom R2)) ++ mkAp n r) <> profStat s pushRestoreCCS <> returnS c) - ,(toJExpr Blackhole, traceRts s (toJExpr (funName <> ": blackhole")) <> push' s (reverse (map toJExpr $ take r (enumFrom R2)) ++ mkAp n r) <> push' s [r1, var "h$return"] <> returnS (app "h$blockOnBlackhole" [r1]))] + ,(toJExpr Thunk, traceRts s (toJExpr (funName <> ": thunk")) <> push' s (reverse regArgs ++ mkAp n r) <> profStat s pushRestoreCCS <> returnS c) + ,(toJExpr Blackhole, traceRts s (toJExpr (funName <> ": blackhole")) <> push' s (reverse regArgs ++ mkAp n r) <> push' s [r1, var "h$return"] <> returnS (app "h$blockOnBlackhole" [r1]))] (appS "throw" [toJExpr (funName <> ": unexpected closure type: ") + entryClosureType c]) ] @@ -668,7 +747,7 @@ fastApply s r n = func ||= toJExpr (JFunc myFunArgs body) (traceRts s (toJExpr (funName <> ": oversat")) <> oversatCase c arity) -- else (traceRts s (toJExpr (funName <> ": undersat")) - <> mkPap s pap r1 (toJExpr n) (map toJExpr regArgs) + <> mkPap s pap r1 (toJExpr n) regArgs <> (r1 |= toJExpr pap) <> returnStack)) ] @@ -698,7 +777,7 @@ fastApply s r n = func ||= toJExpr (JFunc myFunArgs body) where saveRegs n = SwitchStat n switchAlts mempty where - switchAlts = map (\x -> (toJExpr x, stack .! (sp + toJExpr (r-x)) |= toJExpr (intToJSReg (x+2)))) [0..r-1] + switchAlts = map (\x -> (toJExpr x, stack .! (sp + toJExpr (r-x)) |= jsReg (x+2))) [0..r-1] zeroApply :: StgToJSConfig -> JStat zeroApply s = mconcat @@ -896,9 +975,9 @@ pap s r = closure (ClosureInfo funcName CIRegsUnknown funcName (CILayoutUnknown ] moveBy extra = SwitchStat extra (reverse $ map moveCase [1..maxReg-r-1]) mempty - moveCase m = (toJExpr m, toJExpr (intToJSReg (m+r+1)) |= toJExpr (intToJSReg (m+1))) + moveCase m = (toJExpr m, jsReg (m+r+1) |= jsReg (m+1)) loadOwnArgs d = mconcat $ map (\r -> - toJExpr (intToJSReg (r+1)) |= dField d (r+2)) [1..r] + jsReg (r+1) |= dField d (r+2)) [1..r] dField d n = SelExpr d (TxtI . mkFastString $ ('d':show (n-1))) -- Construct a generic PAP @@ -928,7 +1007,7 @@ papGen cfg = funcName = "h$pap_gen" loadOwnArgs d r = let prop n = d .^ ("d" <> mkFastString (show $ n+1)) - loadOwnArg n = (toJExpr n, toJExpr (intToJSReg (n+1)) |= prop n) + loadOwnArg n = (toJExpr n, jsReg (n+1) |= prop n) in SwitchStat r (map loadOwnArg [127,126..1]) mempty -- general utilities @@ -946,7 +1025,7 @@ moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch (n `Bits.shiftL` 8) Bits..|. m , mconcat (map (`moveRegFast` m) [n+1,n..2]) <> BreakStat Nothing {-[j| break; |]-}) - moveRegFast n m = toJExpr (intToJSReg (n+m)) |= toJExpr (intToJSReg n) + moveRegFast n m = jsReg (n+m) |= jsReg n -- fallback defaultCase n m = loop n (.>.0) (\i -> appS "h$setReg" [i+1+m, app "h$getReg" [i+1]] `mappend` postDecrS i) @@ -967,3 +1046,12 @@ initClosure cfg entry values ccs = , values ] +-- | Return an expression for every field of the given Id +getIdFields :: Id -> G [TypedExpr] +getIdFields i = assocIdExprs i <$> genIds i + +-- | Store fields of Id into the given target expressions +storeIdFields :: Id -> [TypedExpr] -> G JStat +storeIdFields i dst = do + fields <- getIdFields i + pure (assignCoerce1 dst fields) ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -49,6 +49,7 @@ isUnboxable DoubleV = True isUnboxable IntV = True -- includes Char# isUnboxable _ = False +-- | Number of slots occupied by a PrimRep data SlotCount = NoSlot | OneSlot @@ -58,15 +59,18 @@ data SlotCount instance Outputable SlotCount where ppr = text . show -varSize :: VarType -> Int -varSize = slotCount . varSlotCount - +-- | Return SlotCount as an Int slotCount :: SlotCount -> Int slotCount = \case NoSlot -> 0 OneSlot -> 1 TwoSlots -> 2 + +-- | Number of slots occupied by a value with the given VarType +varSize :: VarType -> Int +varSize = slotCount . varSlotCount + varSlotCount :: VarType -> SlotCount varSlotCount VoidV = NoSlot varSlotCount LongV = TwoSlots -- hi, low @@ -240,21 +244,25 @@ typePrimReps = typePrimRep . unwrapType primRepSize :: PrimRep -> SlotCount primRepSize p = varSlotCount (primRepVt p) --- | Assign values to each prim rep slot -alignPrimReps :: Outputable a => [PrimRep] -> [a] -> [(PrimRep, [a])] -alignPrimReps [] _ = [] -alignPrimReps (r:rs) vs = case (primRepSize r,vs) of - (NoSlot, xs) -> (r,[]) : alignPrimReps rs xs - (OneSlot, x:xs) -> (r,[x]) : alignPrimReps rs xs - (TwoSlots, x:y:xs) -> (r,[x,y]) : alignPrimReps rs xs - err -> pprPanic "alignPrimReps" (ppr err) - -alignIdPrimReps :: Outputable a => Id -> [a] -> [(PrimRep, [a])] -alignIdPrimReps i = alignPrimReps (idPrimReps i) - - -alignIdExprs :: Id -> [JExpr] -> [TypedExpr] -alignIdExprs i es = fmap (uncurry TypedExpr) (alignIdPrimReps i es) +-- | Associate the given values to each RrimRep in the given order, taking into +-- account the number of slots per PrimRep +assocPrimReps :: Outputable a => [PrimRep] -> [a] -> [(PrimRep, [a])] +assocPrimReps [] _ = [] +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 err) + +-- | Associate the given values to the Id's PrimReps, taking into account the +-- number of slots per PrimRep +assocIdPrimReps :: Outputable a => Id -> [a] -> [(PrimRep, [a])] +assocIdPrimReps i = assocPrimReps (idPrimReps i) + +-- | Associate the given JExpr to the Id's PrimReps, taking into account the +-- number of slots per PrimRep +assocIdExprs :: Id -> [JExpr] -> [TypedExpr] +assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) -- | Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as possible ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -62,7 +62,6 @@ import qualified Control.Monad.Trans.State.Strict as State import GHC.Data.FastString import qualified GHC.Data.List.SetOps as ListSetOps -import Data.Ord import Data.Monoid import Data.Maybe import Data.Function @@ -154,7 +153,7 @@ genBind ctx bndr = | snd (isInlineExpr (ctxEvaluatedIds ctx) expr) = do d <- declIds b tgt <- genIds b - let ctx' = ctx { ctxTarget = alignIdExprs b tgt } + let ctx' = ctx { ctxTarget = assocIdExprs b tgt } (j, _) <- genExpr ctx' expr return (Just (d <> j)) assign _b StgRhsCon{} = return Nothing @@ -289,12 +288,12 @@ genBody ctx i startReg args e = do la <- loadArgs startReg args lav <- verifyRuntimeReps args let ids :: [TypedExpr] - ids = -- take (resultSize args $ idType i) (map toJExpr $ enumFrom R1) + ids = -- take (resultSize args $ idType i) jsRegsFromR1 reverse . fst $ foldl' (\(rs, vs) (rep, size) -> let (vs0, vs1) = splitAt size vs in (TypedExpr rep vs0:rs,vs1)) - ([], map toJExpr $ enumFrom R1) + ([], jsRegsFromR1) (resultSize args $ idType i) (e, _r) <- genExpr (ctx { ctxTarget = ids }) e return $ la <> lav <> e <> returnStack @@ -341,7 +340,7 @@ resultSize [] t -- RuntimeRep. -- FIXME: Luite (2022,07): typeLevity_maybe can panic, doesn't the next case -- give us the right answer? - -- | Nothing <- typeLevity_maybe t' = [(LiftedRep, 1)] + -- Nothing <- typeLevity_maybe t' = [(LiftedRep, 1)] | otherwise = fmap (\p -> (p, slotCount (primRepSize p))) (typePrimReps t) where t' = unwrapType t @@ -521,7 +520,7 @@ genCase ctx bnd e at alts l | snd (isInlineExpr (ctxEvaluatedIds ctx) e) = withNewIdent $ \ccsVar -> do bndi <- genIdsI bnd let ctx' = ctxSetTop bnd - $ ctxSetTarget (alignIdExprs bnd (map toJExpr bndi)) + $ ctxSetTarget (assocIdExprs bnd (map toJExpr bndi)) $ ctx (ej, r) <- genExpr ctx' e let d = case r of @@ -547,7 +546,7 @@ genCase ctx bnd e at alts l | otherwise = do rj <- genRet (ctxAssertEvaluated bnd ctx) bnd at alts l let ctx' = ctxSetTop bnd - $ ctxSetTarget (alignIdExprs bnd (map toJExpr [R1 ..])) + $ ctxSetTarget (assocIdExprs bnd (map toJExpr [R1 ..])) $ ctx (ej, _r) <- genExpr ctx' e return (rj <> ej, ExprCont) @@ -733,7 +732,7 @@ normalizeBranches ctx brs (ExprInline Nothing, brs) where mkCont b = case branch_result b of - ExprInline{} -> b { branch_stat = branch_stat b <> assignAll (map toJExpr $ enumFrom R1) + ExprInline{} -> b { branch_stat = branch_stat b <> assignAll jsRegsFromR1 (concatMap typex_expr $ ctxTarget ctx) , branch_result = ExprCont } ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -332,7 +332,7 @@ genForeignCall ctx (CCall (CCallSpec ccTarget cconv safety)) t tgt args = do async | isJsCc = playInterruptible safety | otherwise = playInterruptible safety || playSafe safety - tgt' | async = take (length tgt) (map toJExpr $ enumFrom R1) + tgt' | async = take (length tgt) jsRegsFromR1 | otherwise = tgt wrapperPrefix = "ghczuwrapperZC" ===================================== compiler/GHC/StgToJS/Regs.hs ===================================== @@ -6,9 +6,14 @@ module GHC.StgToJS.Regs , sp , stack , r1, r2, r3, r4 + , regsFromR1 + , regsFromR2 + , jsRegsFromR1 + , jsRegsFromR2 , StgRet (..) , jsRegToInt , intToJSReg + , jsReg , maxReg , minReg ) @@ -107,18 +112,38 @@ jsRegToInt = (+1) . fromEnum intToJSReg :: Int -> StgReg intToJSReg r = toEnum (r - 1) +jsReg :: Int -> JExpr +jsReg r = toJExpr (intToJSReg r) + maxReg :: Int maxReg = jsRegToInt maxBound minReg :: Int minReg = jsRegToInt minBound + +-- | List of registers, starting from R1 +regsFromR1 :: [StgReg] +regsFromR1 = enumFrom R1 + +-- | List of registers, starting from R2 +regsFromR2 :: [StgReg] +regsFromR2 = tail regsFromR1 + +-- | List of registers, starting from R1 as JExpr +jsRegsFromR1 :: [JExpr] +jsRegsFromR1 = fmap toJExpr regsFromR1 + +-- | List of registers, starting from R2 as JExpr +jsRegsFromR2 :: [JExpr] +jsRegsFromR2 = tail jsRegsFromR1 + --------------------------------------------------- -- caches --------------------------------------------------- -- cache JExpr representing StgReg registers :: Array StgReg JExpr -registers = listArray (minBound, maxBound) (map regN (enumFrom R1)) +registers = listArray (minBound, maxBound) (map regN regsFromR1) where regN r | fromEnum r < 32 = var . mkFastString . ("h$"++) . map toLower . show $ r ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -51,7 +51,6 @@ import Data.Array import Data.Monoid import Data.Char (toLower, toUpper) import qualified Data.Bits as Bits -import qualified Data.Map as M ----------------------------------------------------------------------------- @@ -313,9 +312,9 @@ regGettersSetters = ] where getRegCases = - map (\r -> (toJExpr (jsRegToInt r) , returnS (toJExpr r))) (enumFrom R1) + map (\r -> (toJExpr (jsRegToInt r) , returnS (toJExpr r))) regsFromR1 setRegCases v = - map (\r -> (toJExpr (jsRegToInt r), (toJExpr r |= toJExpr v) <> returnS undefined_)) (enumFrom R1) + map (\r -> (toJExpr (jsRegToInt r), (toJExpr r |= toJExpr v) <> returnS undefined_)) regsFromR1 loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] @@ -329,8 +328,8 @@ loadRegs = mconcat $ map mkLoad [1..32] -- structure to hold the regs. Or perhaps we -- steal the indices from the registers array? -- Either way we can avoid allocating this - -- intermediate `enumFrom R1` list - args (reverse $ take n (enumFrom R1)) + -- intermediate `regsFromR1` list + args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) fun = JFunc args (mconcat assign) in fname ||= toJExpr fun @@ -343,7 +342,7 @@ assignRegs s xs | l <= 32 && not (csInlineLoadRegs s) = ApplStat (ValExpr (JVar $ assignRegs'!l)) (reverse xs) | otherwise = mconcat . reverse $ - zipWith (\r ex -> toJExpr r |= ex) (take l $ enumFrom R1) xs + zipWith (\r ex -> toJExpr r |= ex) (take l regsFromR1) xs where l = length xs ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -76,11 +76,11 @@ data StgToJSConfig = StgToJSConfig data ClosureInfo = ClosureInfo { ciVar :: FastString -- ^ object being infod - , ciRegs :: CIRegs -- ^ things in registers when this is the next closure to enter + , ciRegs :: CIRegs -- ^ things in registers when this is the next closure to enter , ciName :: FastString -- ^ friendly name for printing - , ciLayout :: CILayout -- ^ heap/stack layout of the object - , ciType :: CIType -- ^ type of the object, with extra info where required - , ciStatic :: CIStatic -- ^ static references of this object + , ciLayout :: CILayout -- ^ heap/stack layout of the object + , ciType :: CIType -- ^ type of the object, with extra info where required + , ciStatic :: CIStatic -- ^ static references of this object } deriving stock (Eq, Show, Generic) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/649f0fea423cd5d52316b9b16d5015093250f63f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/649f0fea423cd5d52316b9b16d5015093250f63f You're receiving 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 Aug 9 18:43:28 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 14:43:28 -0400 Subject: [Git][ghc/ghc][wip/nr/typed-wasm-control-flow] comment Message-ID: <62f2aad09a746_182c4e5067c33516@gitlab.mail> Norman Ramsey pushed to branch wip/nr/typed-wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: ccd67689 by Norman Ramsey at 2022-08-09T14:43:16-04:00 comment - - - - - 1 changed file: - compiler/GHC/Wasm/ControlFlow/ToAsm.hs Changes: ===================================== compiler/GHC/Wasm/ControlFlow/ToAsm.hs ===================================== @@ -35,6 +35,8 @@ wasmFunctionType :: WasmFunctionType pre post -> Builder wasmFunctionType (WasmFunctionType TypeListNil TypeListNil) = "void" wasmFunctionType (WasmFunctionType TypeListNil (TypeListCons t TypeListNil)) = tagBuilder t wasmFunctionType _ = panic "function type needs to be externalized" + -- Anything other then [] -> [], [] -> [t] needs to be put into a + -- type table and referred to by number. tagBuilder :: WasmTypeTag a -> Builder tagBuilder TagI32 = "i32" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd67689f965693ab1022c79c1f9de39bc02b793 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd67689f965693ab1022c79c1f9de39bc02b793 You're receiving 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 Aug 10 02:51:17 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 22:51:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Relax instances for Functor combinators; put superclass on Class1 to make non-breaking Message-ID: <62f31d258b3cb_d270451d244112e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 574e6532 by John Ericson at 2022-08-09T22:50:54-04:00 Relax instances for Functor combinators; put superclass on Class1 to make non-breaking The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 75a83bb0 by Douglas Wilson at 2022-08-09T22:50:58-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - a7c7ae9a by Douglas Wilson at 2022-08-09T22:50:58-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - 10 changed files: - libraries/base/Data/Functor/Classes.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Generics.hs - + testsuite/tests/concurrent/should_run/T21651.hs - + testsuite/tests/concurrent/should_run/T21651.stdout - testsuite/tests/concurrent/should_run/all.T - utils/haddock Changes: ===================================== libraries/base/Data/Functor/Classes.hs ===================================== @@ -1,7 +1,10 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE QuantifiedConstraints #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Classes @@ -91,8 +94,18 @@ import Text.Show (showListWith) -- | Lifting of the 'Eq' class to unary type constructors. -- +-- Any instance should be subject to the following law that canonicity +-- is preserved: +-- +-- @liftEq (==)@ = @(==)@ +-- +-- This class therefore represents the generalization of 'Eq' by +-- decomposing its main method into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class Eq1 f where +class (forall a. Eq a => Eq (f a)) => Eq1 f where -- | Lift an equality test through the type constructor. -- -- The function will usually be applied to an equality function, @@ -102,6 +115,10 @@ class Eq1 f where -- -- @since 4.9.0.0 liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool + default liftEq + :: (f ~ f' c, Eq2 f', Eq c) + => (a -> b -> Bool) -> f a -> f b -> Bool + liftEq = liftEq2 (==) -- | Lift the standard @('==')@ function through the type constructor. -- @@ -111,8 +128,18 @@ eq1 = liftEq (==) -- | Lifting of the 'Ord' class to unary type constructors. -- +-- Any instance should be subject to the following law that canonicity +-- is preserved: +-- +-- @liftCompare compare@ = 'compare' +-- +-- This class therefore represents the generalization of 'Ord' by +-- decomposing its main method into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class (Eq1 f) => Ord1 f where +class (Eq1 f, forall a. Ord a => Ord (f a)) => Ord1 f where -- | Lift a 'compare' function through the type constructor. -- -- The function will usually be applied to a comparison function, @@ -122,6 +149,10 @@ class (Eq1 f) => Ord1 f where -- -- @since 4.9.0.0 liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering + default liftCompare + :: (f ~ f' c, Ord2 f', Ord c) + => (a -> b -> Ordering) -> f a -> f b -> Ordering + liftCompare = liftCompare2 compare -- | Lift the standard 'compare' function through the type constructor. -- @@ -131,6 +162,22 @@ compare1 = liftCompare compare -- | Lifting of the 'Read' class to unary type constructors. -- +-- Any instance should be subject to the following laws that canonicity +-- is preserved: +-- +-- @liftReadsPrec readsPrec readList@ = 'readsPrec' +-- +-- @liftReadList readsPrec readList@ = 'readList' +-- +-- @liftReadPrec readPrec readListPrec@ = 'readPrec' +-- +-- @liftReadListPrec readPrec readListPrec@ = 'readListPrec' +-- +-- This class therefore represents the generalization of 'Read' by +-- decomposing it's methods into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface -- provided in the 'Read' type class, but it is recommended to implement -- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since @@ -145,7 +192,7 @@ compare1 = liftCompare compare -- For more information, refer to the documentation for the 'Read' class. -- -- @since 4.9.0.0 -class Read1 f where +class (forall a. Read a => Read (f a)) => Read1 f where {-# MINIMAL liftReadsPrec | liftReadPrec #-} -- | 'readsPrec' function for an application of the type constructor @@ -219,14 +266,30 @@ liftReadListPrecDefault rp rl = list (liftReadPrec rp rl) -- | Lifting of the 'Show' class to unary type constructors. -- +-- Any instance should be subject to the following laws that canonicity +-- is preserved: +-- +-- @liftShowsPrec showsPrec showList@ = 'showsPrec' +-- +-- @liftShowList showsPrec showList@ = 'showList' +-- +-- This class therefore represents the generalization of 'Show' by +-- decomposing it's methods into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class Show1 f where +class (forall a. Show a => Show (f a)) => Show1 f where -- | 'showsPrec' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument type. -- -- @since 4.9.0.0 liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS + default liftShowsPrec + :: (f ~ f' b, Show2 f', Show b) + => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS + liftShowsPrec = liftShowsPrec2 showsPrec showList -- | 'showList' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument type. @@ -248,7 +311,7 @@ showsPrec1 = liftShowsPrec showsPrec showList -- | Lifting of the 'Eq' class to binary type constructors. -- -- @since 4.9.0.0 -class Eq2 f where +class (forall a. Eq a => Eq1 (f a)) => Eq2 f where -- | Lift equality tests through the type constructor. -- -- The function will usually be applied to equality functions, @@ -268,7 +331,7 @@ eq2 = liftEq2 (==) (==) -- | Lifting of the 'Ord' class to binary type constructors. -- -- @since 4.9.0.0 -class (Eq2 f) => Ord2 f where +class (Eq2 f, forall a. Ord a => Ord1 (f a)) => Ord2 f where -- | Lift 'compare' functions through the type constructor. -- -- The function will usually be applied to comparison functions, @@ -302,7 +365,7 @@ compare2 = liftCompare2 compare compare -- For more information, refer to the documentation for the 'Read' class. -- -- @since 4.9.0.0 -class Read2 f where +class (forall a. Read a => Read1 (f a)) => Read2 f where {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-} -- | 'readsPrec' function for an application of the type constructor @@ -385,7 +448,7 @@ liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2) -- | Lifting of the 'Show' class to binary type constructors. -- -- @since 4.9.0.0 -class Show2 f where +class (forall a. Show a => Show1 (f a)) => Show2 f where -- | 'showsPrec' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument types. -- ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -32,7 +33,7 @@ import Data.Coerce (coerce) import Data.Data (Data) import Data.Type.Equality (TestEquality(..), (:~:)(..)) import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () infixr 9 `Compose` @@ -47,6 +48,17 @@ newtype Compose f g a = Compose { getCompose :: f (g a) } , Monoid -- ^ @since 4.16.0.0 ) +-- Instances of Prelude classes + +-- | @since 4.17.0.0 +deriving instance Eq (f (g a)) => Eq (Compose f g a) +-- | @since 4.17.0.0 +deriving instance Ord (f (g a)) => Ord (Compose f g a) +-- | @since 4.17.0.0 +deriving instance Read (f (g a)) => Read (Compose f g a) +-- | @since 4.17.0.0 +deriving instance Show (f (g a)) => Show (Compose f g a) + -- Instances of lifted Prelude classes -- | @since 4.9.0.0 @@ -77,27 +89,6 @@ instance (Show1 f, Show1 g) => Show1 (Compose f g) where sp' = liftShowsPrec sp sl sl' = liftShowList sp sl --- Instances of Prelude classes - --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where - (==) = eq1 - --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where - compare = compare1 - --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault - --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where - showsPrec = showsPrec1 - -- Functor instances -- | @since 4.9.0.0 ===================================== libraries/base/Data/Functor/Product.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Product @@ -28,7 +29,7 @@ import Control.Monad.Zip (MonadZip(mzipWith)) import Data.Data (Data) import Data.Functor.Classes import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () -- | Lifted product of functors. data Product f g a = Pair (f a) (g a) @@ -37,6 +38,15 @@ data Product f g a = Pair (f a) (g a) , Generic1 -- ^ @since 4.9.0.0 ) +-- | @since 4.17.0.0 +deriving instance (Eq (f a), Eq (g a)) => Eq (Product f g a) +-- | @since 4.17.0.0 +deriving instance (Ord (f a), Ord (g a)) => Ord (Product f g a) +-- | @since 4.17.0.0 +deriving instance (Read (f a), Read (g a)) => Read (Product f g a) +-- | @since 4.17.0.0 +deriving instance (Show (f a), Show (g a)) => Show (Product f g a) + -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2 @@ -59,25 +69,6 @@ instance (Show1 f, Show1 g) => Show1 (Product f g) where liftShowsPrec sp sl d (Pair x y) = showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) - where (==) = eq1 - --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where - compare = compare1 - --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault - --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where - showsPrec = showsPrec1 - -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Product f g) where fmap f (Pair x y) = Pair (fmap f x) (fmap f y) ===================================== libraries/base/Data/Functor/Sum.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Sum @@ -25,7 +26,7 @@ import Control.Applicative ((<|>)) import Data.Data (Data) import Data.Functor.Classes import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () -- | Lifted sum of functors. data Sum f g a = InL (f a) | InR (g a) @@ -34,6 +35,15 @@ data Sum f g a = InL (f a) | InR (g a) , Generic1 -- ^ @since 4.9.0.0 ) +-- | @since 4.17.0.0 +deriving instance (Eq (f a), Eq (g a)) => Eq (Sum f g a) +-- | @since 4.17.0.0 +deriving instance (Ord (f a), Ord (g a)) => Ord (Sum f g a) +-- | @since 4.17.0.0 +deriving instance (Read (f a), Read (g a)) => Read (Sum f g a) +-- | @since 4.17.0.0 +deriving instance (Show (f a), Show (g a)) => Show (Sum f g a) + -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2 @@ -64,22 +74,6 @@ instance (Show1 f, Show1 g) => Show1 (Sum f g) where liftShowsPrec sp sl d (InR y) = showsUnaryWith (liftShowsPrec sp sl) "InR" d y --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where - (==) = eq1 --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where - compare = compare1 --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where - showsPrec = showsPrec1 - -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Sum f g) where fmap f (InL x) = InL (fmap f x) ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Event.Thread -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) @@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, - threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) + threadStatus, writeTVar, newTVarIO, readTVar, retry, + throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, @@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM +import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) @@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () -closeFdWith close fd = do - eventManagerArray <- readIORef eventManager - let (low, high) = boundsIOArray eventManagerArray - mgrs <- flip mapM [low..high] $ \i -> do - Just (_,!mgr) <- readIOArray eventManagerArray i - return mgr - -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. - -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have - -- to use uninterruptible mask. - uninterruptibleMask_ $ do - tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd - cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables - close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) +closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys) + -- The array inside 'eventManager' can be swapped out at any time, see + -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by + -- checking the array bounds before and after. When such a swap has + -- happened we cleanup and try again + close_loop = do + eventManagerArray <- readIORef eventManager + let ema_bounds@(low, high) = boundsIOArray eventManagerArray + mgrs <- flip mapM [low..high] $ \i -> do + Just (_,!mgr) <- readIOArray eventManagerArray i + return mgr + + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. + -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have + -- to use uninterruptible mask. + join $ uninterruptibleMask_ $ do + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager + -- Here we exploit Note [The eventManager Array] + if new_ema_bounds /= ema_bounds + then do + -- the array has been modified. + -- mgrs still holds the right EventManagers, by the Note. + -- new_ema_bounds must be larger than ema_bounds, by the note. + -- return the MVars we took and try again + sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables + pure close_loop + else do + -- We surely have taken all the appropriate MVars. Even if the array + -- has been swapped, our mgrs is still correct. + -- Remove the Fd from all callback tables, close the Fd, and run all + -- callbacks. + cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables + close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) + pure (pure ()) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId - (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager - mmgr <- readIOArray eventManagerArray cap - return $ fmap snd mmgr + let r = boundsIOArray eventManagerArray + (cap, _) <- threadCapability t + -- It is possible that we've just increased the number of capabilities and the + -- new EventManager has not yet been constructed by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- Two options to proceed: + -- 1) return the EventManager for capability 0. This is guaranteed to exist, + -- and "shouldn't" cause any correctness issues. + -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, + -- because we must be on a brand capability and there must be a call to + -- 'ioManagerCapabilitiesChanged' pending. + -- + -- We take the second option, with the yield, judging it the most robust. + if not (inRange r cap) + then yield >> getSystemEventManager + else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do @@ -191,6 +229,22 @@ getSystemEventManager_ = do foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A mutable array holding the current EventManager for each capability +-- An entry is Nothing only while the eventmanagers are initialised, see +-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'. +-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality +-- 'cap'. +-- The array will be swapped with newer arrays when the number of capabilities +-- changes(via 'setNumCapabilities'). However: +-- * the size of the arrays will never decrease; and +-- * The 'EventManager's in the array are not replaced with other +-- 'EventManager' constructors. +-- +-- This is a similar strategy as the rts uses for it's +-- capabilities array (n_capabilities is the size of the array, +-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities @@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged = startIOManagerThread new_eventManagerArray -- update the event manager array reference: - writeIORef eventManager new_eventManagerArray + atomicWriteIORef eventManager new_eventManagerArray + -- We need an atomic write here because 'eventManager' is accessed + -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1480,6 +1480,15 @@ type Generically1 :: forall k. (k -> Type) -> (k -> Type) newtype Generically1 f a where Generically1 :: forall {k} f a. f a -> Generically1 @k f a +-- | @since 4.17.0.0 +instance (Generic1 f, Eq (Rep1 f a)) => Eq (Generically1 f a) where + Generically1 x == Generically1 y = from1 x == from1 y + Generically1 x /= Generically1 y = from1 x /= from1 y + +-- | @since 4.17.0.0 +instance (Generic1 f, Ord (Rep1 f a)) => Ord (Generically1 f a) where + Generically1 x `compare` Generically1 y = from1 x `compare` from1 y + -- | @since 4.17.0.0 instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where fmap :: (a -> a') -> (Generically1 f a -> Generically1 f a') ===================================== testsuite/tests/concurrent/should_run/T21651.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test is adapted from setnumcapabilities001. + +import GHC.Conc hiding (threadWaitRead, threadWaitWrite) +import GHC.Exts +import GHC.IO.Encoding +import System.Environment +import System.IO +import Control.Monad +import Text.Printf +import Data.Time.Clock +import Control.DeepSeq + +import System.Posix.IO +import System.Posix.Types +import Control.Concurrent +import Control.Exception + +passTheParcel :: Int -> IO (IO ()) +passTheParcel n = do + pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe + rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do + let + read = fdRead readfd $ fromIntegral 1 + write = fdWrite writefd + mv <- newEmptyMVar + tid <- forkIO $ let + loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do + threadWaitRead readfd + (s, _) <- read + threadWaitWrite writefd + write s + cleanup = do + closeFdWith closeFd readfd + closeFdWith closeFd writefd + putMVar mv () + in loop `finally` cleanup + pure (mv, tid) + + let + cleanup = do + killThread tid1 + forM_ rs $ \(mv, _) -> takeMVar mv + + fdWrite (snd p1) "a" + pure cleanup + + +main = do + setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale + [n,q,t,z] <- fmap (fmap read) getArgs + cleanup_ptp <- passTheParcel z + t <- forkIO $ do + forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do + setNumCapabilities m + threadDelay t + printf "%d\n" (nqueens q) + cleanup_ptp + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 + +nqueens :: Int -> Int +nqueens nq = length (pargen 0 []) + where + safe :: Int -> Int -> [Int] -> Bool + safe x d [] = True + safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l + + gen :: [[Int]] -> [[Int]] + gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] + + pargen :: Int -> [Int] -> [[Int]] + pargen n b + | n >= threshold = iterate gen [b] !! (nq - n) + | otherwise = concat bs + where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq + + threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x ===================================== testsuite/tests/concurrent/should_run/T21651.stdout ===================================== @@ -0,0 +1 @@ +14200 ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, ['']) test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2', 'nonmoving_thr']), + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), extra_run_opts('8 12 2000'), when(have_thread_sanitizer(), expect_broken(18808)), req_smp ], compile_and_run, ['']) +test('T21651', + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), + when(opsys('mingw32'),skip), # uses POSIX pipes + when(opsys('darwin'),extra_run_opts('8 12 2000 100')), + unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files + req_smp ], + compile_and_run, ['']) + test('hs_try_putmvar001', [ when(opsys('mingw32'),skip), # uses pthread APIs in the C code ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 7bd04379ada2d9ff1c406d258629f8abdf617b30 +Subproject commit 50bad2e761b57efd77fa8924866f3964f1e59f01 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55c4d9fc0a94e383da6460eab9d766dcf2878227...a7c7ae9a406bb2b87f9aa5566ccfe5fe371cfb08 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55c4d9fc0a94e383da6460eab9d766dcf2878227...a7c7ae9a406bb2b87f9aa5566ccfe5fe371cfb08 You're receiving 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 Aug 10 04:02:49 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 00:02:49 -0400 Subject: [Git][ghc/ghc][wip/armv7l-ci] 2 commits: gitlab-ci: Fix ARMv7 build Message-ID: <62f32de928994_d27044b7bc6637e@gitlab.mail> Ben Gamari pushed to branch wip/armv7l-ci at Glasgow Haskell Compiler / GHC Commits: 32499d8c by Ben Gamari at 2022-08-10T00:01:31-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 0ffb6714 by Ben Gamari at 2022-08-10T00:02:28-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -325,8 +325,15 @@ opsysVariables _ FreeBSD13 = mconcat ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -494,6 +501,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -514,6 +522,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -785,7 +795,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -232,7 +232,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -271,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -329,7 +332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -392,7 +395,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -451,7 +454,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -510,7 +513,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -529,7 +532,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -569,7 +575,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -628,7 +634,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -693,7 +699,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -754,7 +760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -816,7 +822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -878,7 +884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -938,7 +944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -997,7 +1003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1056,7 +1062,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1116,7 +1122,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1175,7 +1181,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1234,7 +1240,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1293,7 +1299,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1352,7 +1358,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1413,7 +1419,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1474,7 +1480,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1533,7 +1539,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1592,7 +1598,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1659,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1715,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1776,7 +1782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1831,7 +1837,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1890,7 +1896,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1953,7 +1959,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2017,7 +2023,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2077,7 +2083,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2137,7 +2143,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2156,8 +2162,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -2197,7 +2206,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2257,7 +2266,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2323,7 +2332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2385,7 +2394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2448,7 +2457,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2511,7 +2520,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2572,7 +2581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2632,7 +2641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2692,7 +2701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2752,7 +2761,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2812,7 +2821,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2874,7 +2883,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2936,7 +2945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2999,7 +3008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3055,7 +3064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3115,7 +3124,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3179,7 +3188,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3243,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3303,7 +3312,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3364,7 +3373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3425,7 +3434,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3484,7 +3493,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3543,7 +3552,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3601,7 +3610,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3660,7 +3669,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3718,7 +3727,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3776,7 +3785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3834,7 +3843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3893,7 +3902,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3953,7 +3962,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -4013,7 +4022,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4071,7 +4080,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4129,7 +4138,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -4189,7 +4198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4250,7 +4259,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4310,7 +4319,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4364,7 +4373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4422,7 +4431,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/857a0c3461b5368b96176089044f9eb5ba160686...0ffb67144fe8adad112b9fd04059892a2c8c20ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/857a0c3461b5368b96176089044f9eb5ba160686...0ffb67144fe8adad112b9fd04059892a2c8c20ab You're receiving 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 Aug 9 23:21:04 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 19:21:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: rts/linker: Resolve iconv_* on FreeBSD Message-ID: <62f2ebe0465f5_182c4e4e0ac377099@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 414b8125 by John Ericson at 2022-08-09T19:20:36-04:00 Relax instances for Functor combinators; put superclass on Class1 to make non-breaking The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - caa68a42 by Douglas Wilson at 2022-08-09T19:20:39-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 55c4d9fc by Douglas Wilson at 2022-08-09T19:20:39-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - 16 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Unfold.hs - libraries/base/Data/Functor/Classes.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Generics.hs - m4/fp_find_cxx_std_lib.m4 - rts/Linker.c - + testsuite/tests/concurrent/should_run/T21651.hs - + testsuite/tests/concurrent/should_run/T21651.stdout - testsuite/tests/concurrent/should_run/all.T - utils/haddock Changes: ===================================== .gitlab/ci.sh ===================================== @@ -207,6 +207,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -288,7 +291,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -326,9 +329,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -223,7 +223,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -242,7 +242,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -313,7 +313,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -321,7 +321,7 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -489,12 +489,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -512,8 +512,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -781,7 +781,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) ===================================== .gitlab/jobs.yaml ===================================== @@ -658,7 +658,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -668,7 +668,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -677,7 +677,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -705,17 +705,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2288,7 +2288,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2298,7 +2298,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2307,7 +2307,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2335,18 +2335,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -3208,7 +3208,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3218,7 +3218,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -3227,7 +3227,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3255,17 +3255,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -580,10 +580,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- Cost to allocate binding with given binder size_up_alloc bndr - | isTyVar bndr -- Doesn't exist at runtime - || isJoinId bndr -- Not allocated at all - || isUnliftedType (idType bndr) -- Doesn't live in heap - -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder) + | isTyVar bndr -- Doesn't exist at runtime + || isJoinId bndr -- Not allocated at all + || not (isBoxedType (idType bndr)) -- Doesn't live in heap = 0 | otherwise = 10 ===================================== libraries/base/Data/Functor/Classes.hs ===================================== @@ -1,7 +1,10 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE QuantifiedConstraints #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Classes @@ -91,8 +94,18 @@ import Text.Show (showListWith) -- | Lifting of the 'Eq' class to unary type constructors. -- +-- Any instance should be subject to the following law that canonicity +-- is preserved: +-- +-- @liftEq (==)@ = @(==)@ +-- +-- This class therefore represents the generalization of 'Eq' by +-- decomposing its main method into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class Eq1 f where +class (forall a. Eq a => Eq (f a)) => Eq1 f where -- | Lift an equality test through the type constructor. -- -- The function will usually be applied to an equality function, @@ -102,6 +115,10 @@ class Eq1 f where -- -- @since 4.9.0.0 liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool + default liftEq + :: (f ~ f' c, Eq2 f', Eq c) + => (a -> b -> Bool) -> f a -> f b -> Bool + liftEq = liftEq2 (==) -- | Lift the standard @('==')@ function through the type constructor. -- @@ -111,8 +128,18 @@ eq1 = liftEq (==) -- | Lifting of the 'Ord' class to unary type constructors. -- +-- Any instance should be subject to the following law that canonicity +-- is preserved: +-- +-- @liftCompare compare@ = 'compare' +-- +-- This class therefore represents the generalization of 'Ord' by +-- decomposing its main method into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class (Eq1 f) => Ord1 f where +class (Eq1 f, forall a. Ord a => Ord (f a)) => Ord1 f where -- | Lift a 'compare' function through the type constructor. -- -- The function will usually be applied to a comparison function, @@ -122,6 +149,10 @@ class (Eq1 f) => Ord1 f where -- -- @since 4.9.0.0 liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering + default liftCompare + :: (f ~ f' c, Ord2 f', Ord c) + => (a -> b -> Ordering) -> f a -> f b -> Ordering + liftCompare = liftCompare2 compare -- | Lift the standard 'compare' function through the type constructor. -- @@ -131,6 +162,22 @@ compare1 = liftCompare compare -- | Lifting of the 'Read' class to unary type constructors. -- +-- Any instance should be subject to the following laws that canonicity +-- is preserved: +-- +-- @liftReadsPrec readsPrec readList@ = 'readsPrec' +-- +-- @liftReadList readsPrec readList@ = 'readList' +-- +-- @liftReadPrec readPrec readListPrec@ = 'readPrec' +-- +-- @liftReadListPrec readPrec readListPrec@ = 'readListPrec' +-- +-- This class therefore represents the generalization of 'Read' by +-- decomposing it's methods into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface -- provided in the 'Read' type class, but it is recommended to implement -- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since @@ -145,7 +192,7 @@ compare1 = liftCompare compare -- For more information, refer to the documentation for the 'Read' class. -- -- @since 4.9.0.0 -class Read1 f where +class (forall a. Read a => Read (f a)) => Read1 f where {-# MINIMAL liftReadsPrec | liftReadPrec #-} -- | 'readsPrec' function for an application of the type constructor @@ -219,14 +266,30 @@ liftReadListPrecDefault rp rl = list (liftReadPrec rp rl) -- | Lifting of the 'Show' class to unary type constructors. -- +-- Any instance should be subject to the following laws that canonicity +-- is preserved: +-- +-- @liftShowsPrec showsPrec showList@ = 'showsPrec' +-- +-- @liftShowList showsPrec showList@ = 'showList' +-- +-- This class therefore represents the generalization of 'Show' by +-- decomposing it's methods into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class Show1 f where +class (forall a. Show a => Show (f a)) => Show1 f where -- | 'showsPrec' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument type. -- -- @since 4.9.0.0 liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS + default liftShowsPrec + :: (f ~ f' b, Show2 f', Show b) + => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS + liftShowsPrec = liftShowsPrec2 showsPrec showList -- | 'showList' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument type. @@ -248,7 +311,7 @@ showsPrec1 = liftShowsPrec showsPrec showList -- | Lifting of the 'Eq' class to binary type constructors. -- -- @since 4.9.0.0 -class Eq2 f where +class (forall a. Eq a => Eq1 (f a)) => Eq2 f where -- | Lift equality tests through the type constructor. -- -- The function will usually be applied to equality functions, @@ -268,7 +331,7 @@ eq2 = liftEq2 (==) (==) -- | Lifting of the 'Ord' class to binary type constructors. -- -- @since 4.9.0.0 -class (Eq2 f) => Ord2 f where +class (Eq2 f, forall a. Ord a => Ord1 (f a)) => Ord2 f where -- | Lift 'compare' functions through the type constructor. -- -- The function will usually be applied to comparison functions, @@ -302,7 +365,7 @@ compare2 = liftCompare2 compare compare -- For more information, refer to the documentation for the 'Read' class. -- -- @since 4.9.0.0 -class Read2 f where +class (forall a. Read a => Read1 (f a)) => Read2 f where {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-} -- | 'readsPrec' function for an application of the type constructor @@ -385,7 +448,7 @@ liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2) -- | Lifting of the 'Show' class to binary type constructors. -- -- @since 4.9.0.0 -class Show2 f where +class (forall a. Show a => Show1 (f a)) => Show2 f where -- | 'showsPrec' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument types. -- ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -32,7 +33,7 @@ import Data.Coerce (coerce) import Data.Data (Data) import Data.Type.Equality (TestEquality(..), (:~:)(..)) import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () infixr 9 `Compose` @@ -47,6 +48,17 @@ newtype Compose f g a = Compose { getCompose :: f (g a) } , Monoid -- ^ @since 4.16.0.0 ) +-- Instances of Prelude classes + +-- | @since 4.17.0.0 +deriving instance Eq (f (g a)) => Eq (Compose f g a) +-- | @since 4.17.0.0 +deriving instance Ord (f (g a)) => Ord (Compose f g a) +-- | @since 4.17.0.0 +deriving instance Read (f (g a)) => Read (Compose f g a) +-- | @since 4.17.0.0 +deriving instance Show (f (g a)) => Show (Compose f g a) + -- Instances of lifted Prelude classes -- | @since 4.9.0.0 @@ -77,27 +89,6 @@ instance (Show1 f, Show1 g) => Show1 (Compose f g) where sp' = liftShowsPrec sp sl sl' = liftShowList sp sl --- Instances of Prelude classes - --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where - (==) = eq1 - --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where - compare = compare1 - --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault - --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where - showsPrec = showsPrec1 - -- Functor instances -- | @since 4.9.0.0 ===================================== libraries/base/Data/Functor/Product.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Product @@ -28,7 +29,7 @@ import Control.Monad.Zip (MonadZip(mzipWith)) import Data.Data (Data) import Data.Functor.Classes import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () -- | Lifted product of functors. data Product f g a = Pair (f a) (g a) @@ -37,6 +38,15 @@ data Product f g a = Pair (f a) (g a) , Generic1 -- ^ @since 4.9.0.0 ) +-- | @since 4.17.0.0 +deriving instance (Eq (f a), Eq (g a)) => Eq (Product f g a) +-- | @since 4.17.0.0 +deriving instance (Ord (f a), Ord (g a)) => Ord (Product f g a) +-- | @since 4.17.0.0 +deriving instance (Read (f a), Read (g a)) => Read (Product f g a) +-- | @since 4.17.0.0 +deriving instance (Show (f a), Show (g a)) => Show (Product f g a) + -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2 @@ -59,25 +69,6 @@ instance (Show1 f, Show1 g) => Show1 (Product f g) where liftShowsPrec sp sl d (Pair x y) = showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) - where (==) = eq1 - --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where - compare = compare1 - --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault - --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where - showsPrec = showsPrec1 - -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Product f g) where fmap f (Pair x y) = Pair (fmap f x) (fmap f y) ===================================== libraries/base/Data/Functor/Sum.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Sum @@ -25,7 +26,7 @@ import Control.Applicative ((<|>)) import Data.Data (Data) import Data.Functor.Classes import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () -- | Lifted sum of functors. data Sum f g a = InL (f a) | InR (g a) @@ -34,6 +35,15 @@ data Sum f g a = InL (f a) | InR (g a) , Generic1 -- ^ @since 4.9.0.0 ) +-- | @since 4.17.0.0 +deriving instance (Eq (f a), Eq (g a)) => Eq (Sum f g a) +-- | @since 4.17.0.0 +deriving instance (Ord (f a), Ord (g a)) => Ord (Sum f g a) +-- | @since 4.17.0.0 +deriving instance (Read (f a), Read (g a)) => Read (Sum f g a) +-- | @since 4.17.0.0 +deriving instance (Show (f a), Show (g a)) => Show (Sum f g a) + -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2 @@ -64,22 +74,6 @@ instance (Show1 f, Show1 g) => Show1 (Sum f g) where liftShowsPrec sp sl d (InR y) = showsUnaryWith (liftShowsPrec sp sl) "InR" d y --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where - (==) = eq1 --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where - compare = compare1 --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where - showsPrec = showsPrec1 - -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Sum f g) where fmap f (InL x) = InL (fmap f x) ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Event.Thread -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) @@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, - threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) + threadStatus, writeTVar, newTVarIO, readTVar, retry, + throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, @@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM +import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) @@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () -closeFdWith close fd = do - eventManagerArray <- readIORef eventManager - let (low, high) = boundsIOArray eventManagerArray - mgrs <- flip mapM [low..high] $ \i -> do - Just (_,!mgr) <- readIOArray eventManagerArray i - return mgr - -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. - -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have - -- to use uninterruptible mask. - uninterruptibleMask_ $ do - tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd - cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables - close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) +closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys) + -- The array inside 'eventManager' can be swapped out at any time, see + -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by + -- checking the array bounds before and after. When such a swap has + -- happened we cleanup and try again + close_loop = do + eventManagerArray <- readIORef eventManager + let ema_bounds@(low, high) = boundsIOArray eventManagerArray + mgrs <- flip mapM [low..high] $ \i -> do + Just (_,!mgr) <- readIOArray eventManagerArray i + return mgr + + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. + -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have + -- to use uninterruptible mask. + join $ uninterruptibleMask_ $ do + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager + -- Here we exploit Note [The eventManager Array] + if new_ema_bounds /= ema_bounds + then do + -- the array has been modified. + -- mgrs still holds the right EventManagers, by the Note. + -- new_ema_bounds must be larger than ema_bounds, by the note. + -- return the MVars we took and try again + sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables + pure close_loop + else do + -- We surely have taken all the appropriate MVars. Even if the array + -- has been swapped, our mgrs is still correct. + -- Remove the Fd from all callback tables, close the Fd, and run all + -- callbacks. + cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables + close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) + pure (pure ()) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId - (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager - mmgr <- readIOArray eventManagerArray cap - return $ fmap snd mmgr + let r = boundsIOArray eventManagerArray + (cap, _) <- threadCapability t + -- It is possible that we've just increased the number of capabilities and the + -- new EventManager has not yet been constructed by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- Two options to proceed: + -- 1) return the EventManager for capability 0. This is guaranteed to exist, + -- and "shouldn't" cause any correctness issues. + -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, + -- because we must be on a brand capability and there must be a call to + -- 'ioManagerCapabilitiesChanged' pending. + -- + -- We take the second option, with the yield, judging it the most robust. + if not (inRange r cap) + then yield >> getSystemEventManager + else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do @@ -191,6 +229,22 @@ getSystemEventManager_ = do foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A mutable array holding the current EventManager for each capability +-- An entry is Nothing only while the eventmanagers are initialised, see +-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'. +-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality +-- 'cap'. +-- The array will be swapped with newer arrays when the number of capabilities +-- changes(via 'setNumCapabilities'). However: +-- * the size of the arrays will never decrease; and +-- * The 'EventManager's in the array are not replaced with other +-- 'EventManager' constructors. +-- +-- This is a similar strategy as the rts uses for it's +-- capabilities array (n_capabilities is the size of the array, +-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities @@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged = startIOManagerThread new_eventManagerArray -- update the event manager array reference: - writeIORef eventManager new_eventManagerArray + atomicWriteIORef eventManager new_eventManagerArray + -- We need an atomic write here because 'eventManager' is accessed + -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1480,6 +1480,15 @@ type Generically1 :: forall k. (k -> Type) -> (k -> Type) newtype Generically1 f a where Generically1 :: forall {k} f a. f a -> Generically1 @k f a +-- | @since 4.17.0.0 +instance (Generic1 f, Eq (Rep1 f a)) => Eq (Generically1 f a) where + Generically1 x == Generically1 y = from1 x == from1 y + Generically1 x /= Generically1 y = from1 x /= from1 y + +-- | @since 4.17.0.0 +instance (Generic1 f, Ord (Rep1 f a)) => Ord (Generically1 f a) where + Generically1 x `compare` Generically1 y = from1 x `compare` from1 y + -- | @since 4.17.0.0 instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where fmap :: (a -> a') -> (Generically1 f a -> Generically1 f a') ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== testsuite/tests/concurrent/should_run/T21651.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test is adapted from setnumcapabilities001. + +import GHC.Conc hiding (threadWaitRead, threadWaitWrite) +import GHC.Exts +import GHC.IO.Encoding +import System.Environment +import System.IO +import Control.Monad +import Text.Printf +import Data.Time.Clock +import Control.DeepSeq + +import System.Posix.IO +import System.Posix.Types +import Control.Concurrent +import Control.Exception + +passTheParcel :: Int -> IO (IO ()) +passTheParcel n = do + pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe + rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do + let + read = fdRead readfd $ fromIntegral 1 + write = fdWrite writefd + mv <- newEmptyMVar + tid <- forkIO $ let + loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do + threadWaitRead readfd + (s, _) <- read + threadWaitWrite writefd + write s + cleanup = do + closeFdWith closeFd readfd + closeFdWith closeFd writefd + putMVar mv () + in loop `finally` cleanup + pure (mv, tid) + + let + cleanup = do + killThread tid1 + forM_ rs $ \(mv, _) -> takeMVar mv + + fdWrite (snd p1) "a" + pure cleanup + + +main = do + setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale + [n,q,t,z] <- fmap (fmap read) getArgs + cleanup_ptp <- passTheParcel z + t <- forkIO $ do + forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do + setNumCapabilities m + threadDelay t + printf "%d\n" (nqueens q) + cleanup_ptp + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 + +nqueens :: Int -> Int +nqueens nq = length (pargen 0 []) + where + safe :: Int -> Int -> [Int] -> Bool + safe x d [] = True + safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l + + gen :: [[Int]] -> [[Int]] + gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] + + pargen :: Int -> [Int] -> [[Int]] + pargen n b + | n >= threshold = iterate gen [b] !! (nq - n) + | otherwise = concat bs + where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq + + threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x ===================================== testsuite/tests/concurrent/should_run/T21651.stdout ===================================== @@ -0,0 +1 @@ +14200 ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, ['']) test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2', 'nonmoving_thr']), + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), extra_run_opts('8 12 2000'), when(have_thread_sanitizer(), expect_broken(18808)), req_smp ], compile_and_run, ['']) +test('T21651', + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), + when(opsys('mingw32'),skip), # uses POSIX pipes + when(opsys('darwin'),extra_run_opts('8 12 2000 100')), + unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files + req_smp ], + compile_and_run, ['']) + test('hs_try_putmvar001', [ when(opsys('mingw32'),skip), # uses pthread APIs in the C code ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 7bd04379ada2d9ff1c406d258629f8abdf617b30 +Subproject commit 50bad2e761b57efd77fa8924866f3964f1e59f01 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6156ec32e3ea9b55072d175cd8cf8856f867d268...55c4d9fc0a94e383da6460eab9d766dcf2878227 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6156ec32e3ea9b55072d175cd8cf8856f867d268...55c4d9fc0a94e383da6460eab9d766dcf2878227 You're receiving 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 Aug 11 16:11:51 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 11 Aug 2022 12:11:51 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] more cleanup Message-ID: <62f52a47597d_142b49517984107ea@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: ec98d6df by Matthew Pickering at 2022-08-11T17:11:44+01:00 more cleanup - - - - - 5 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/ModIface.hs - docs/users_guide/phases.rst Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -2703,6 +2703,14 @@ instance (NFData b, NFData a) => NFData (IfaceBindingX a b) where IfaceNonRec bndr e -> rnf bndr `seq` rnf e IfaceRec binds -> rnf binds +instance NFData IfaceTopBndrInfo where + rnf (IfGblTopBndr n) = n `seq` () + rnf (IfLclTopBndr fs ty info dets) = rnf fs `seq` rnf ty `seq` rnf info `seq` rnf dets `seq` () + +instance NFData IfaceMaybeRhs where + rnf IfUseUnfoldingRhs = () + rnf (IfRhs ce) = rnf ce `seq` () + instance NFData IfaceLetBndr where rnf (IfLetBndr nm ty id_info join_info) = rnf nm `seq` rnf ty `seq` rnf id_info `seq` rnf join_info ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -212,7 +212,7 @@ nameOfObject_maybe (DotO fn) = Just fn nameOfObject_maybe (DotA fn) = Just fn nameOfObject_maybe (DotDLL fn) = Just fn nameOfObject_maybe (FI {}) = Nothing -nameOfObject_maybe (LoadedBCOs{}) = Nothing +nameOfObject_maybe (LoadedBCOs{}) = Nothing nameOfObject_maybe (BCOs {}) = Nothing -- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -65,7 +65,6 @@ data ModLocation ml_hie_file :: FilePath -- ^ Where the .hie file is, whether or not it exists -- yet. - } deriving Show instance Outputable ModLocation where ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -552,9 +552,10 @@ instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclE rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` - rnf f16 `seq` rnf f17 `seq` f18 `seq` rnf f19 `seq` f20 `seq` f21 `seq` f22 `seq` rnf f23 - `seq` rnf f24 `seq` () + f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` + rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` f21 `seq` f22 `seq` f23 `seq` rnf f24 + `seq` () + instance NFData (ModIfaceBackend) where rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) ===================================== docs/users_guide/phases.rst ===================================== @@ -1,4 +1,4 @@ -.etetched. _options-phases: +.. _options-phases: Options related to a particular phase ===================================== View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec98d6df1737afa18f523a2ab7d693855ef858a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec98d6df1737afa18f523a2ab7d693855ef858a4 You're receiving 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 Aug 10 21:29:11 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 17:29:11 -0400 Subject: [Git][ghc/ghc][wip/T21986] gitlab-ci: Don't allow FreeBSD job to fail Message-ID: <62f423276b607_142b49521ac215154@gitlab.mail> Ben Gamari pushed to branch wip/T21986 at Glasgow Haskell Compiler / GHC Commits: 61cede99 by Ben Gamari at 2022-08-10T17:28:56-04:00 gitlab-ci: Don't allow FreeBSD job to fail - - - - - 1 changed file: - .gitlab/gen_ci.hs Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -785,7 +785,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) + , addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61cede993049cacb846b5d5edd4522c43ca0db55 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61cede993049cacb846b5d5edd4522c43ca0db55 You're receiving 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 Aug 9 19:52:28 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Tue, 09 Aug 2022 15:52:28 -0400 Subject: [Git][ghc/ghc][wip/nr/wasm-control-flow] 2 commits: add the two key graph modules from Martin Erwig's FGL Message-ID: <62f2bafc6ced6_182c4e4e0ac35661a@gitlab.mail> Norman Ramsey pushed to branch wip/nr/wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: 56d32019 by Norman Ramsey at 2022-08-09T15:52:11-04: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. - - - - - 071dbdcf by Norman Ramsey at 2022-08-09T15:52:11-04:00 add new modules for reducibility and WebAssembly translation also includes an emitter for GNU assembler code and some regression tests - - - - - 30 changed files: - + compiler/GHC/Cmm/Reducibility.hs - + compiler/GHC/Data/Graph/Collapse.hs - + compiler/GHC/Data/Graph/Inductive/Graph.hs - + compiler/GHC/Data/Graph/Inductive/LICENSE - + compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs - + compiler/GHC/Wasm/ControlFlow.hs - + compiler/GHC/Wasm/ControlFlow/FromCmm.hs - + compiler/GHC/Wasm/ControlFlow/ToAsm.hs - compiler/ghc.cabal.in - testsuite/tests/linters/notes.stdout - + 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e523867ddfb385fb0dc4a65e2fc7c06d4dbe4ac6...071dbdcfc83dc493eaeec8138552acd4ec8a44f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e523867ddfb385fb0dc4a65e2fc7c06d4dbe4ac6...071dbdcfc83dc493eaeec8138552acd4ec8a44f2 You're receiving 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 Aug 10 12:12:06 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 Aug 2022 08:12:06 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] 2 commits: fix some tests Message-ID: <62f3a096d306d_d270451acc2540a@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 6ef630e1 by Matthew Pickering at 2022-08-10T13:10:11+01:00 fix some tests - - - - - 2680ed9c by Matthew Pickering at 2022-08-10T13:11:57+01:00 fix more tests - - - - - 5 changed files: - testsuite/tests/driver/fat-iface/Makefile - + testsuite/tests/driver/fat-iface/fat014.script - testsuite/tests/driver/fat-iface/fat014.stdout - testsuite/tests/ghci/T16670/Makefile - testsuite/tests/ghci/scripts/ghci024.stdout Changes: ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -50,6 +50,6 @@ fat010: clean "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-fat-interface -fprefer-bytecode fat014: clean - echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v1 -fno-code FatTH.hs + echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v0 -fno-code < fat014.script ===================================== testsuite/tests/driver/fat-iface/fat014.script ===================================== @@ -0,0 +1,2 @@ +:set -v1 +:l FatTH.hs ===================================== testsuite/tests/driver/fat-iface/fat014.stdout ===================================== @@ -1,5 +1,3 @@ -GHCi, version 9.5.20220801: https://www.haskell.org/ghc/ :? for help [1 of 2] Compiling FatQuote ( FatQuote.hs, interpreted ) [2 of 2] Compiling FatTH ( FatTH.hs, interpreted ) Ok, two modules loaded. -ghci> Leaving GHCi. ===================================== testsuite/tests/ghci/T16670/Makefile ===================================== @@ -19,6 +19,6 @@ T16670_th: $(MAKE) -s --no-print-directory clean mkdir my-odir echo ":load T16670_th.hs" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) \ - -v0 -fno-code -fwrite-interface -odir my-odir + -v0 -fno-code -fno-prefer-bytecode -fwrite-interface -odir my-odir find . -name T16670_th.o test -f my-odir/T16670_th.o ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -13,6 +13,7 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fkeep-going -fshow-warning-groups + -fprefer-bytecode warning settings: -Wsemigroup -Wstar-is-type View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21d739cb8bdcbe047141a2817303551b71e7ba27...2680ed9cda3637400a45984e19c515f5e1b0ede6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21d739cb8bdcbe047141a2817303551b71e7ba27...2680ed9cda3637400a45984e19c515f5e1b0ede6 You're receiving 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 Aug 7 22:19:35 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sun, 07 Aug 2022 18:19:35 -0400 Subject: [Git][ghc/ghc][wip/andreask/deep_discounts] Make ppr prettier, fix docs maybe Message-ID: <62f03a7727884_25b01650d5c3544eb@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/deep_discounts at Glasgow Haskell Compiler / GHC Commits: 74efca8f by Andreas Klebinger at 2022-08-08T00:19:08+02:00 Make ppr prettier, fix docs maybe - - - - - 3 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Unfold.hs - docs/users_guide/using-optimisation.rst Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1390,9 +1390,9 @@ data ArgDiscount -- they will select, and provide a generic discount if we know the arg -- is a value but not what value exactly. -- Only of the the two discounts might be applied for the same argument. - | DiscSeq { ad_seq_discount :: !Int - -- , ad_app_discount :: !Int - , ad_con_discount :: !(ConMap ConDiscount)} + | DiscSeq { ad_seq_discount :: !Int -- ^ Discount if no specific constructor discount matches + , ad_con_discount :: !(ConMap ConDiscount) -- ^ Discounts for specific constructors + } -- A discount for the use of a function. | FunDisc { ad_seq_discount :: !Int, ad_fun :: Id} | NoSeqUse @@ -1402,8 +1402,10 @@ instance Outputable ArgDiscount where ppr (SomeArgUse n)= text "seq:" <> ppr n ppr (NoSeqUse)= text "lazy use" ppr (FunDisc d f ) = text "fun-"<>ppr f<>text ":"<> ppr d - ppr (DiscSeq d_seq m) = - hang (text "disc:"<> ppr d_seq) 2 $ braces (pprUFM m ppr) + ppr (DiscSeq d_seq m) + | isNullUFM m = text "disc:"<> ppr d_seq + | otherwise = sep (punctuate comma ((text "some_con:"<> ppr d_seq) : map ppr (nonDetEltsUFM m))) + -- (text "some_con:"<> ppr d_seq) <> text "||" <> braces (pprUFM m ppr) -- | 'UnfoldingGuidance' says when unfolding should take place data UnfoldingGuidance ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -283,14 +283,6 @@ calcUnfoldingGuidance opts is_top_bottoming expr , ug_res = scrut_discount } where - -- interesting_cased cased - -- | null cased = False - -- | otherwise = any (interesting_use . snd) cased - -- interesting_use NoSeqUse = False - -- interesting_use SomeArgUse{} = False - -- interesting_use (DiscSeq _d m) = sizeUFM m >= 1 -- True - - (bndrs, body) = collectBinders expr bOMB_OUT_SIZE = unfoldingCreationThreshold opts -- Bomb out if size gets bigger than this ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1664,7 +1664,8 @@ by saying ``-fno-wombat``. If we have a function application `f (Succ (Succ Zero))` with the function `f`: - .. code-block:: haskell + .. code-block:: hs + f x = case x of Zero -> 0 @@ -1691,7 +1692,8 @@ by saying ``-fno-wombat``. If we have a function f: - .. code-block:: haskell + .. code-block:: hs + f x = case x of Zero -> 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74efca8f7bd539e8a9c020d5cb491abb43199729 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74efca8f7bd539e8a9c020d5cb491abb43199729 You're receiving 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 Aug 11 12:39:09 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 11 Aug 2022 08:39:09 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] wip sharing Message-ID: <62f4f86d80d1e_142b4952184370496@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 8441b77c by Matthew Pickering at 2022-08-11T12:39:16+01:00 wip sharing - - - - - 8 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Unit/Module/FatIface.hs - compiler/GHC/Unit/Module/ModIface.hs Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -443,15 +443,12 @@ toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id)) toIfaceTopBndr :: Id -> IfaceTopBndrInfo toIfaceTopBndr id - = IfTopBndr get_name - (toIfaceType (idType id)) - (toIfaceIdInfo (idInfo id)) - (toIfaceIdDetails (idDetails id)) + = if isExternalName name + then IfGblTopBndr name + else IfLclTopBndr (occNameFS (getOccName id)) (toIfaceType (idType id)) + (toIfaceIdInfo (idInfo id)) (toIfaceIdDetails (idDetails id)) where name = getName id - get_name = if isExternalName name - then Right (getName name) - else Left (getOccFS name) toIfaceIdDetails :: IdDetails -> IfaceIdDetails toIfaceIdDetails VanillaId = IfVanillaId @@ -592,9 +589,22 @@ toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r) toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs] -toIfaceTopBind :: Bind Id -> IfaceBinding IfaceTopBndrInfo -toIfaceTopBind (NonRec b r) = IfaceNonRec (toIfaceTopBndr b) (toIfaceExpr r) -toIfaceTopBind (Rec prs) = IfaceRec [(toIfaceTopBndr b, toIfaceExpr r) | (b,r) <- prs] +toIfaceTopBind :: Bind Id -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo +toIfaceTopBind b = + case b of + NonRec b r -> uncurry IfaceNonRec (do_one (b, r)) + Rec prs -> IfaceRec (map do_one prs) + where + do_one (b, rhs) = + let top_bndr = toIfaceTopBndr b + rhs' = case top_bndr of + -- Use the existing unfolding for a global binder if we store that anyway. + IfGblTopBndr {} -> if already_has_unfolding b then IfUseUnfoldingRhs else IfRhs (toIfaceExpr rhs) + -- Local binders will have had unfoldings trimmed + IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs) + in (top_bndr, rhs') + + already_has_unfolding b = hasCoreUnfolding (realIdUnfolding b) --------------------- toIfaceAlt :: CoreAlt -> IfaceAlt ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3858,6 +3858,7 @@ impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles) ,(Opt_DoLinearCoreLinting, turnOn, Opt_DoCoreLinting) ,(Opt_Strictness, turnOn, Opt_WorkerWrapper) ,(Opt_WriteFatInterface, turnOn, Opt_WriteInterface) + ,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteFatInterface) ] ++ validHoleFitsImpliedGFlags -- General flags that are switched on/off when other general flags are switched ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -269,7 +269,7 @@ mkIface_ hsc_env semantic_mod = homeModuleNameInstantiation home_unit (moduleName this_mod) entities = typeEnvElts type_env show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env) - -- MP: TODO + extra_decls = if gopt Opt_WriteFatInterface dflags then Just [ toIfaceTopBind b | b <- core_prog ] else Nothing decls = [ tyThingToIfaceDecl show_linear_types entity ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1202,7 +1202,7 @@ addFingerprints hsc_env iface0 [(getOccName d, e) | e@(_, d) <- decls_w_hashes] -- TODO: MP implement sorting here - sorted_extra_decls :: Maybe [IfaceBinding IfaceTopBndrInfo] + sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] sorted_extra_decls = mi_extra_decls iface0 -- the flag hash depends on: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -14,7 +14,7 @@ module GHC.Iface.Syntax ( IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..), IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec, IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceJoinInfo(..), IfaceBinding, - IfaceBindingX(..), IfaceConAlt(..), + IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), @@ -593,7 +593,16 @@ data IfaceBindingX r b -- See Note [IdInfo on nested let-bindings] data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo -data IfaceTopBndrInfo = IfTopBndr (Either IfLclName IfaceTopBndr) IfaceType IfaceIdInfo IfaceIdDetails +data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDetails | IfGblTopBndr IfaceTopBndr + + {- + IfTopBndr { top_bndr_name :: Either IfLclName IfaceTopBndr + , top_bndr_type :: IfaceType + , top_bndr_id_info :: IfaceIdInfo + , top_bndr_iface_details :: IfaceIdDetails + ]-} + +data IfaceMaybeRhs = IfUseUnfoldingRhs | IfRhs IfaceExpr data IfaceJoinInfo = IfaceNotJoinPoint | IfaceJoinPoint JoinArity @@ -719,7 +728,12 @@ instance (Outputable r, Outputable b) => Outputable (IfaceBindingX r b) where ppr_bind (b, r) = ppr b <+> equals <+> ppr r instance Outputable IfaceTopBndrInfo where - ppr (IfTopBndr n _ _ _) = ppr (either ppr (ppr . getOccName) n) + ppr (IfLclTopBndr lcl_name _ _ _) = ppr lcl_name + ppr (IfGblTopBndr gbl) = ppr gbl + +instance Outputable IfaceMaybeRhs where + ppr IfUseUnfoldingRhs = text "" + ppr (IfRhs ie) = ppr ie {- Note [Minimal complete definition] @@ -2501,16 +2515,36 @@ instance Binary IfaceLetBndr where return (IfLetBndr a b c d) instance Binary IfaceTopBndrInfo where - put_ bh (IfTopBndr a b c d) = do - put_ bh a - put_ bh b - put_ bh c - put_ bh d - get bh = do a <- get bh - b <- get bh - c <- get bh - d <- get bh - return (IfTopBndr a b c d) + put_ bh (IfLclTopBndr lcl ty info dets) = do + putByte bh 0 + put_ bh lcl + put_ bh ty + put_ bh info + put_ bh dets + put_ bh (IfGblTopBndr gbl) = do + putByte bh 1 + put_ bh gbl + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLclTopBndr <$> get bh <*> get bh <*> get bh <*> get bh + 1 -> IfGblTopBndr <$> get bh + _ -> pprPanic "IfaceTopBndrInfo" (intWithCommas tag) + +instance Binary IfaceMaybeRhs where + put_ bh IfUseUnfoldingRhs = putByte bh 0 + put_ bh (IfRhs e) = do + putByte bh 1 + put_ bh e + + get bh = do + b <- getByte bh + case b of + 0 -> return IfUseUnfoldingRhs + 1 -> IfRhs <$> get bh + _ -> pprPanic "IfaceMaybeRhs" (intWithCommas b) + + instance Binary IfaceJoinInfo where put_ bh IfaceNotJoinPoint = putByte bh 0 ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -901,7 +901,7 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = name tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm) ; return (nm, idType id, b) } -tcTopIfaceBindings :: IORef TypeEnv -> [IfaceBinding IfaceTopBndrInfo] +tcTopIfaceBindings :: IORef TypeEnv -> [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfL [CoreBind] tcTopIfaceBindings ty_var ver_decls = do @@ -911,31 +911,30 @@ tcTopIfaceBindings ty_var ver_decls extendIfaceIdEnv all_ids $ mapM (tc_iface_bindings) int -tcTopBinders :: IfaceBinding IfaceTopBndrInfo -> IfL (IfaceBinding Id) +tcTopBinders :: IfaceBindingX a IfaceTopBndrInfo -> IfL (IfaceBindingX a Id) tcTopBinders = traverse mk_top_id -tc_iface_bindings :: IfaceBinding Id -> IfL CoreBind +tc_iface_bindings :: IfaceBindingX IfaceMaybeRhs Id -> IfL CoreBind tc_iface_bindings (IfaceNonRec b rhs) = do - NonRec b <$> tcIfaceExpr rhs + rhs' <- tc_iface_binding b rhs + return $ NonRec b rhs' tc_iface_bindings (IfaceRec bs) = do - rs <- mapM (\(b, rhs) -> (b,) <$> tcIfaceExpr rhs) bs + rs <- mapM (\(b, rhs) -> (b,) <$> tc_iface_binding b rhs) bs return (Rec rs) +tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr +tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i) +tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs + mk_top_id :: IfaceTopBndrInfo -> IfL Id -mk_top_id (IfTopBndr raw_name iface_type _info details) = do - case raw_name of - Left lcl -> do - name <- newIfaceName (mkVarOccFS lcl) - ty <- tcIfaceType iface_type - details <- tcIdDetails ty details - info <- tcIdInfo False TopLevel name ty [] - let new_id = (mkGlobalId details name ty info) - return new_id - Right name -> do - ty <- tcIfaceType iface_type - details <- tcIdDetails ty details - info <- tcIdInfo False TopLevel name ty [] - return (mkGlobalId details name ty info) +mk_top_id (IfGblTopBndr gbl_name) = tcIfaceExtId gbl_name +mk_top_id (IfLclTopBndr raw_name iface_type info details) = do + name <- newIfaceName (mkVarOccFS raw_name) + ty <- tcIfaceType iface_type + info' <- tcIdInfo False TopLevel name ty info + details' <- tcIdDetails ty details + let new_id = mkGlobalId details' name ty info' + return new_id tcIfaceDecls :: Bool -> [(Fingerprint, IfaceDecl)] ===================================== compiler/GHC/Unit/Module/FatIface.hs ===================================== @@ -6,7 +6,7 @@ import GHC.Unit.Module.Location import GHC.Iface.Syntax import GHC.Utils.Binary -data FatIface = FatIface { fi_bindings :: [IfaceBinding IfaceTopBndrInfo] +data FatIface = FatIface { fi_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] , fi_module :: Module , fi_mod_location :: ModLocation } ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -200,7 +200,7 @@ data ModIface_ (phase :: ModIfacePhase) -- Ditto data constructors, class operations, except that -- the hash of the parent class/tycon changes - mi_extra_decls :: Maybe [IfaceBinding IfaceTopBndrInfo], + mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo], -- ^ Extra variable definitions which are **NOT** exposed but when -- combined with mi_decls allows us to restart code generation. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8441b77c7558a86bf4cb2274a64287a6bfde4168 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8441b77c7558a86bf4cb2274a64287a6bfde4168 You're receiving 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 Aug 12 15:33:29 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 Aug 2022 11:33:29 -0400 Subject: [Git][ghc/ghc][wip/test-speed-ci] 111 commits: Make withDict opaque to the specialiser Message-ID: <62f672c94b42b_3d8149488645521f4@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: Ben Gamari pushed to branch wip/test-speed-ci at Glasgow Haskell Compiler / GHC Commits: 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. [...] Content analysis details: (5.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.6 DATE_IN_PAST_03_06 Date: is 3 to 6 hours before Received: date 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 0.5 URI_NOVOWEL URI: URI hostname has long non-vowel sequence -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 1.5 BODY_8BITS BODY: Body includes 8 consecutive 8-bit characters 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid 3.1 GAPPY_HTML HTML body with much useless whitespace 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: "Ben Gamari (@bgamari)" Subject: [Git][ghc/ghc][wip/test-speed-ci] 111 commits: Make withDict opaque to the specialiser Date: Fri, 12 Aug 2022 11:33:29 -0400 Size: 183693 URL: From gitlab at gitlab.haskell.org Fri Aug 12 15:35:25 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 Aug 2022 11:35:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/llvm-initializers Message-ID: <62f6733de8ded_3d8149488a0552692@gitlab.mail> Ben Gamari pushed new branch wip/llvm-initializers at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/llvm-initializers You're receiving 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 Aug 11 03:27:04 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 23:27:04 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f477088f0cc_142b49521ac253589@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: a91ff7c2 by Ben Gamari at 2022-08-10T23:26:54-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,64 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +905,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2024,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2035,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &&prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a91ff7c2e7a456d4216edd0869d737eb31039334 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a91ff7c2e7a456d4216edd0869d737eb31039334 You're receiving 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 Aug 9 17:36:38 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 Aug 2022 13:36:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21964 Message-ID: <62f29b264945d_182c4e50654293722@gitlab.mail> Ben Gamari pushed new branch wip/T21964 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21964 You're receiving 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 Aug 7 20:06:50 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sun, 07 Aug 2022 16:06:50 -0400 Subject: [Git][ghc/ghc][wip/andreask/deep_discounts] Add a depth discount to nested argInfo/argGuidance Message-ID: <62f01b5a4e9a3_25b01650d5c343068@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/deep_discounts at Glasgow Haskell Compiler / GHC Commits: 505d309c by Andreas Klebinger at 2022-08-07T22:06:19+02:00 Add a depth discount to nested argInfo/argGuidance - - - - - 5 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/hints.rst - docs/users_guide/using-optimisation.rst Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -877,45 +877,59 @@ rule for (*) (df d) can fire. To do this interestingArg :: SimplEnv -> CoreExpr -> ArgSummary -- See Note [Interesting arguments] interestingArg env e = - -- pprTrace "interestingArg" (ppr e $$ ppr (go env 0 e)) $ - go env 0 e - where + go env depth_limit 0 e + where + depth_limit = unfoldingMaxAppDepth . sm_uf_opts . seMode $ env + -- n is # value args to which the expression is applied - go env n (Var v) + go :: SimplEnv -> Int -> Int -> CoreExpr -> ArgSummary + go _env 0 _n !_ = TrivArg + go env depth n (Var v) = case substId env v of - DoneId v' -> go_var n v' - DoneEx e _ -> go (zapSubstEnv env) n e - ContEx tvs cvs ids e -> go (setSubstEnv env tvs cvs ids) n e + DoneId v' -> go_var depth n v' + DoneEx e _ -> go (zapSubstEnv env) depth n e + ContEx tvs cvs ids e -> go (setSubstEnv env tvs cvs ids) depth n e - go _ _ (Lit l) + go _ _depth _ (Lit l) | isLitRubbish l = TrivArg -- Leads to unproductive inlining in WWRec, #20035 | otherwise = ValueArg - go _ _ (Type _) = TrivArg - go _ _ (Coercion _) = TrivArg - go env n (App fn (Type _)) = go env n fn - go env n (App fn arg) - | ConArg con args <- fn_summary - = if (isClassTyCon $ dataConTyCon con) - then ValueArg - else ConArg con (args ++ [go env 0 arg]) - | otherwise = fn_summary - where - fn_summary = go env (n+1) fn - - go env n (Tick _ a) = go env n a - go env n (Cast e _) = go env n e - go env n (Lam v e) - | isTyVar v = go env n e + go _ _depth _ (Type _) = TrivArg + go _ _depth _ (Coercion _) = TrivArg + go env depth n (App fn (Type _)) = go env depth n fn + go env depth n e@(App _fn _arg) + | (fn,args,_ticks) <- collectArgsTicks (const True) e + = let args' = filter isValArg args + fn_summary = go env depth (n + length args') fn + arg_summaries = map (go env (depth-1) 0) args' + in case fn_summary of + ConArg con fn_args + | isClassTyCon (dataConTyCon con) -> ValueArg + | otherwise -> ConArg con (fn_args ++ arg_summaries) + _ -> fn_summary + + -- | ConArg con args <- fn_summary + -- = if (isClassTyCon $ dataConTyCon con) + -- then ValueArg + -- else ConArg con (args ++ [go env (depth-1) 0 arg]) + -- | otherwise = fn_summary + -- where + -- fn_summary = go env (depth-1) (n+1) fn + + go env depth n (Tick _ a) = go env depth n a + go env depth n (Cast e _) = go env depth n e + go env depth n (Lam v e) + | isTyVar v = go env depth n e | n>0 = NonTrivArg -- (\x.b) e is NonTriv | otherwise = ValueArg - go _ _ (Case {}) = NonTrivArg - go env n (Let b e) = case go env' n e of + go _ _depth _ (Case {}) = NonTrivArg + go env depth n (Let b e) = case go env' depth n e of ValueArg -> ValueArg + c at ConArg{} -> c _ -> NonTrivArg where env' = env `addNewInScopeIds` bindersOf b - go_var n v + go_var depth n v | Just rhs <- maybeUnfoldingTemplate (idUnfolding v) , (f, args, _ticks) <- collectArgsTicks (const True) rhs , Var f' <- varView f @@ -923,7 +937,7 @@ interestingArg env e = , not (isClassTyCon $ dataConTyCon con) = -- pprTrace "ConArg1" (ppr $ ConArg con $ map (go env 0) args) $ - ConArg con $ map (go env 0) args + ConArg con $ map (go env (depth-1) 0) args | Just con <- isDataConId_maybe v = ConArg con [] ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -26,6 +26,7 @@ module GHC.Core.Unfold ( updateFunAppDiscount, updateDictDiscount, updateVeryAggressive, updateCaseScaling, updateCaseThreshold, updateReportPrefix, + updateMaxAppDepth, updateMaxGuideDepth, ArgSummary(..), @@ -67,7 +68,7 @@ import GHC.Types.Var.Env import GHC.Utils.Panic.Plain (assert) import GHC.Utils.Panic (pprPanic) import GHC.Data.Graph.UnVar -import GHC.Utils.Trace (pprTrace) +-- import GHC.Utils.Trace (pprTrace) @@ -96,6 +97,15 @@ data UnfoldingOpts = UnfoldingOpts , unfoldingReportPrefix :: !(Maybe String) -- ^ Only report inlining decisions for names with this prefix + + , unfoldingMaxAppDepth :: !Int + -- ^ When considering unfolding a definition look this deep + -- into the applied argument. + + , unfoldingMaxGuideDepth :: !Int + -- ^ When creating unfolding guidance look this deep into + -- nested argument use. + } defaultUnfoldingOpts :: UnfoldingOpts @@ -130,6 +140,9 @@ defaultUnfoldingOpts = UnfoldingOpts -- Don't filter inlining decision reports , unfoldingReportPrefix = Nothing + + , unfoldingMaxAppDepth = 20 + , unfoldingMaxGuideDepth = 20 } -- Helpers for "GHC.Driver.Session" @@ -159,6 +172,12 @@ updateCaseScaling n opts = opts { unfoldingCaseScaling = n } updateReportPrefix :: Maybe String -> UnfoldingOpts -> UnfoldingOpts updateReportPrefix n opts = opts { unfoldingReportPrefix = n } +updateMaxAppDepth :: Int -> UnfoldingOpts -> UnfoldingOpts +updateMaxAppDepth n opts = opts { unfoldingMaxAppDepth = n } + +updateMaxGuideDepth :: Int -> UnfoldingOpts -> UnfoldingOpts +updateMaxGuideDepth n opts = opts { unfoldingMaxGuideDepth = n } + {- Note [Occurrence analysis of unfoldings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -471,52 +490,53 @@ sizeExpr :: UnfoldingOpts -- Forcing bOMB_OUT_SIZE early prevents repeated -- unboxing of the Int argument. sizeExpr opts !bOMB_OUT_SIZE top_args' expr - = let result = size_up (mkUnVarSet top_args') expr + = let result = size_up depth_limit (mkUnVarSet top_args') expr in -- pprTrace "sizeExpr" (ppr expr) $ -- pprTrace "sizeExpr2" (ppr result) $ result where - size_up :: UnVarSet -> Expr Var -> ExprSize - size_up !disc_args (Cast e _) = size_up disc_args e - size_up disc_args (Tick _ e) = size_up disc_args e - size_up _disc_args (Type _) = sizeZero -- Types cost nothing - size_up _disc_args (Coercion _) = sizeZero - size_up _disc_args (Lit lit) = sizeN (litSize lit) - size_up disc_args (Var f) | isZeroBitId f = sizeZero + depth_limit = unfoldingMaxGuideDepth opts + size_up :: Int -> UnVarSet -> Expr Var -> ExprSize + size_up !depth !disc_args (Cast e _) = size_up depth disc_args e + size_up !depth disc_args (Tick _ e) = size_up depth disc_args e + size_up !_depth _disc_args (Type _) = sizeZero -- Types cost nothing + size_up !_depth _disc_args (Coercion _) = sizeZero + size_up !_depth _disc_args (Lit lit) = sizeN (litSize lit) + size_up !_depth disc_args (Var f) | isZeroBitId f = sizeZero -- Make sure we get constructor discounts even -- on nullary constructors | otherwise = size_up_call disc_args f [] 0 - size_up disc_args (App fun arg) - | isTyCoArg arg = size_up disc_args fun - | otherwise = size_up disc_args arg `addSizeNSD` - size_up_app disc_args fun [arg] (if isZeroBitExpr arg then 1 else 0) + size_up !depth disc_args (App fun arg) + | isTyCoArg arg = size_up depth disc_args fun + | otherwise = size_up depth disc_args arg `addSizeNSD` + size_up_app depth disc_args fun [arg] (if isZeroBitExpr arg then 1 else 0) - size_up disc_args (Lam b e) - | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up (delUnVarSet disc_args b) e `addSizeN` 10) - | otherwise = size_up (delUnVarSet disc_args b) e + size_up !depth disc_args (Lam b e) + | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up depth (delUnVarSet disc_args b) e `addSizeN` 10) + | otherwise = size_up depth (delUnVarSet disc_args b) e - size_up disc_args (Let (NonRec binder rhs) body) + size_up !depth disc_args (Let (NonRec binder rhs) body) = let disc_args' = delUnVarSet disc_args binder in - size_up_rhs disc_args' (binder, rhs) `addSizeNSD` - size_up disc_args' body `addSizeN` + size_up_rhs depth disc_args' (binder, rhs) `addSizeNSD` + size_up depth disc_args' body `addSizeN` size_up_alloc binder - size_up disc_args (Let (Rec pairs) body) + size_up !depth disc_args (Let (Rec pairs) body) = let lhs_bnds = map fst pairs disc_args' = delUnVarSetList disc_args lhs_bnds in - foldr (addSizeNSD . (size_up_rhs disc_args')) - (size_up disc_args' body `addSizeN` sum (map (size_up_alloc . fst) pairs)) + foldr (addSizeNSD . (size_up_rhs depth disc_args')) + (size_up depth disc_args' body `addSizeN` sum (map (size_up_alloc . fst) pairs)) pairs - size_up disc_args (Case e _ _ alts) + size_up !depth disc_args (Case e _ _ alts) | null alts - = size_up disc_args e -- case e of {} never returns, so take size of scrutinee + = size_up depth disc_args e -- case e of {} never returns, so take size of scrutinee - size_up disc_args (Case e _ _ alts) + size_up !depth disc_args (Case e _ _ alts) -- Now alts is non-empty | Just v <- is_top_arg e -- We are scrutinising an argument variable = let @@ -530,7 +550,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr in Just (unitUFM con (ConDiscount con trim_discount (map (const NoSeqUse) alt_bndrs))) trim_size _tot_size _ _alt_size = Nothing - alt_sizes = map (size_up_alt (Just v) disc_args) alts + alt_sizes = map (size_up_alt depth (Just v) disc_args) alts added_alt_sizes = (foldr1 addAltSize alt_sizes) max_alt_size = (foldr (maxSize bOMB_OUT_SIZE) 0 alt_sizes) @@ -579,8 +599,8 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr is_top_arg _ = Nothing - size_up disc_args (Case e _ _ alts) = size_up disc_args e `addSizeNSD` - foldr (addAltSize . (size_up_alt Nothing disc_args) ) case_size alts + size_up !depth disc_args (Case e _ _ alts) = size_up depth disc_args e `addSizeNSD` + foldr (addAltSize . (size_up_alt depth Nothing disc_args) ) case_size alts where case_size | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10) @@ -617,25 +637,25 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr | otherwise = False - size_up_rhs !disc_args (bndr, rhs) + size_up_rhs !depth !disc_args (bndr, rhs) | Just join_arity <- isJoinId_maybe bndr -- Skip arguments to join point , (bndrs, body) <- collectNBinders join_arity rhs - = size_up (delUnVarSetList disc_args bndrs) body + = size_up depth (delUnVarSetList disc_args bndrs) body | otherwise - = size_up disc_args rhs + = size_up depth disc_args rhs ------------ -- size_up_app is used when there's ONE OR MORE value args - size_up_app !disc_args (App fun arg) args voids - | isTyCoArg arg = size_up_app disc_args fun args voids - | isZeroBitExpr arg = size_up_app disc_args fun (arg:args) (voids + 1) - | otherwise = size_up disc_args arg `addSizeNSD` - size_up_app disc_args fun (arg:args) voids - size_up_app disc_args (Var fun) args voids = size_up_call disc_args fun args voids - size_up_app disc_args (Tick _ expr) args voids = size_up_app disc_args expr args voids - size_up_app disc_args (Cast expr _) args voids = size_up_app disc_args expr args voids - size_up_app disc_args other args voids = size_up disc_args other `addSizeN` + size_up_app depth !disc_args (App fun arg) args voids + | isTyCoArg arg = size_up_app depth disc_args fun args voids + | isZeroBitExpr arg = size_up_app depth disc_args fun (arg:args) (voids + 1) + | otherwise = size_up depth disc_args arg `addSizeNSD` + size_up_app depth disc_args fun (arg:args) voids + size_up_app _depth disc_args (Var fun) args voids = size_up_call disc_args fun args voids + size_up_app depth disc_args (Tick _ expr) args voids = size_up_app depth disc_args expr args voids + size_up_app depth disc_args (Cast expr _) args voids = size_up_app depth disc_args expr args voids + size_up_app depth disc_args other args voids = size_up depth disc_args other `addSizeN` callSize (length args) voids -- if the lhs is not an App or a Var, or an invisible thing like a -- Tick or Cast, then we should charge for a complete call plus the @@ -652,16 +672,18 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr _ -> funSize opts disc_args fun (length val_args) voids ------------ - -- size_up_alt :: Maybe Id -> [Id] -> Alt Var -> ExprSize - size_up_alt m_top_arg !disc_args (Alt alt_con bndrs rhs) + -- Take into acount the binders of scrutinized argument binders + -- But not too deeply! Hence we check if we exhausted depth. + size_up_alt depth m_top_arg !disc_args (Alt alt_con bndrs rhs) | Just top_arg <- m_top_arg + , depth > 0 , DataAlt con <- alt_con = - let alt_size = size_up (extendUnVarSetList bndrs disc_args) rhs `addSizeN` 10 + let alt_size = size_up depth (extendUnVarSetList bndrs disc_args) rhs `addSizeN` 10 -- let alt_size = size_up (disc_args) rhs `addSizeN` 10 in asExprSize top_arg alt_size con bndrs - size_up_alt _ disc_args (Alt _con bndrs rhs) = size_up (delUnVarSetList disc_args bndrs) rhs `addSizeN` 10 + size_up_alt depth _ disc_args (Alt _con bndrs rhs) = size_up depth (delUnVarSetList disc_args bndrs) rhs `addSizeN` 10 -- Don't charge for args, so that wrappers look cheap -- (See comments about wrappers with Case) -- @@ -1006,9 +1028,6 @@ data ExprSize plusDiscountEnv :: VarEnv ArgDiscount -> VarEnv ArgDiscount -> VarEnv ArgDiscount plusDiscountEnv el er = plusUFM_C combineArgDiscount el er -todoArgDiscount :: Int -> ArgDiscount -todoArgDiscount n = SomeArgUse n - -- TODO: Might be worth giving this a larger discount if the type class is known. -- So that `f @T $d x = opDoStuff @T $d x ` applied to `f @Bool $dC_$Bool` is likely -- to inline turning the unknown into a known call. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2813,6 +2813,10 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { unfoldingOpts = updateCaseThreshold n (unfoldingOpts d)})) , make_ord_flag defFlag "funfolding-case-scaling" (intSuffix (\n d -> d { unfoldingOpts = updateCaseScaling n (unfoldingOpts d)})) + , make_ord_flag defFlag "funfolding-max-arg-depth" + (intSuffix (\n d -> d { unfoldingOpts = updateMaxAppDepth n (unfoldingOpts d)})) + , make_ord_flag defFlag "funfolding-max-guide-depth" + (intSuffix (\n d -> d { unfoldingOpts = updateMaxGuideDepth n (unfoldingOpts d)})) , make_dep_flag defFlag "funfolding-keeness-factor" (floatSuffix (\_ d -> d)) ===================================== docs/users_guide/hints.rst ===================================== @@ -404,6 +404,7 @@ decision about inlining a specific binding. * :ghc-flag:`-funfolding-case-scaling=⟨n⟩` * :ghc-flag:`-funfolding-dict-discount=⟨n⟩` * :ghc-flag:`-funfolding-fun-discount=⟨n⟩` +* :ghc-flag:`-funfolding-max-app-depth=⟨n⟩` Should the simplifier run out of ticks because of a inlining loop users are encouraged to try decreasing :ghc-flag:`-funfolding-case-threshold=⟨n⟩` ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1651,6 +1651,60 @@ by saying ``-fno-wombat``. while still allowing GHC to compile modules containing such inlining loops. +.. ghc-flag:: -funfolding-max-arg-depth=⟨n⟩ + :shortdesc: *default: 20.* Don't look deepter than `n` levels into function arguments. + :type: dynamic + :category: + + :default: 20 + + .. index:: + single: inlining, controlling + single: unfolding, controlling + + If we have a function application `f (Succ (Succ Zero))` with the function `f`: + + .. code-block:: haskell + f x = + case x of + Zero -> 0 + Succ y -> case y of + Zero -> 1 + Succ z -> case z of + Zero -> 2 + _ -> error "Large" + + Then GHC can consider the nested use of the argument when making inlining decisions. + However inspecting deeply nested arguments can be costly in terms of compile time overhead. + So we restrict inspection of the argument to a certain depth. + +.. ghc-flag:: -funfolding-max-guide-depth=⟨n⟩ + :shortdesc: *default: 20.* Don't look deepter than `n` levels into a functions use of it's arguments. + :type: dynamic + :category: + + :default: 20 + + .. index:: + single: inlining, controlling + single: unfolding, controlling + + If we have a function f: + + .. code-block:: haskell + f x = + case x of + Zero -> 0 + Succ y -> case y of + Zero -> 1 + Succ z -> case z of + Zero -> 2 + _ -> error "Large" + + GHC can consider the nested use of the argument when making inlining decisions. + However looking deeply into nested argument use can be costly in terms of compile time overhead. + So we restrict inspection of nested argument use to a certain level of nesting. + .. ghc-flag:: -fworker-wrapper :shortdesc: Enable the worker/wrapper transformation. :type: dynamic View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/505d309c272350b14213e14cfc9f92b72245a5b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/505d309c272350b14213e14cfc9f92b72245a5b3 You're receiving 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 Aug 11 23:14:17 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 Aug 2022 19:14:17 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble Message-ID: <62f58d49e934_3d814948990311686@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 3a71c769 by Simon Peyton Jones at 2022-08-12T00:14:36+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/CoreToIface.hs Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -340,7 +340,7 @@ toIfaceAppArgsX fr kind ty_args | null ty_args = IA_Nil | otherwise - = go (mkEmptyvSubst in_scope) kind ty_args + = go (mkEmptySubst in_scope) kind ty_args where in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a71c7693b8950dea31c1f9b4c724e6ffcf7cfaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a71c7693b8950dea31c1f9b4c724e6ffcf7cfaf You're receiving 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 Aug 8 19:26:07 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 15:26:07 -0400 Subject: [Git][ghc/ghc][wip/bindist-install] 2 commits: gitlab-ci: Don't use coreutils on Darwin Message-ID: <62f1634fa2719_25b0164c0405808cd@gitlab.mail> Ben Gamari pushed to branch wip/bindist-install at Glasgow Haskell Compiler / GHC Commits: 2d98e6b9 by Ben Gamari at 2022-08-08T15:26:02-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - b230cda3 by Ben Gamari at 2022-08-08T15:26:02-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 5 changed files: - .gitlab/darwin/toolchain.nix - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - + mk/install_script.sh Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -230,12 +193,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . -type f`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3fdbb04c35a250c36d3c9aa6263fde851abb2ad...b230cda34119557ba4e8a01f3081d8d64ce38aaa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3fdbb04c35a250c36d3c9aa6263fde851abb2ad...b230cda34119557ba4e8a01f3081d8d64ce38aaa You're receiving 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 Aug 9 17:37:06 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 Aug 2022 13:37:06 -0400 Subject: [Git][ghc/ghc][wip/T21964] ncg/aarch64: Don't use x18 register on AArch64/Darwin Message-ID: <62f29b421f62d_182c4e506682939a8@gitlab.mail> Ben Gamari pushed to branch wip/T21964 at Glasgow Haskell Compiler / GHC Commits: c53512f3 by normalcoder at 2022-08-09T13:36:59-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 1 changed file: - compiler/CodeGen.Platform.h Changes: ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) +-- x18 is the platform register on darwin, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c53512f3c61297e3465f2ce322d4bd92ab2213ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c53512f3c61297e3465f2ce322d4bd92ab2213ff You're receiving 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 Aug 8 14:46:44 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 10:46:44 -0400 Subject: [Git][ghc/ghc][wip/cross-ci] gitlab-ci: Add basic support for cross-compiler testiing Message-ID: <62f121d4eb1e2_25b0164c07c50516c@gitlab.mail> Ben Gamari pushed to branch wip/cross-ci at Glasgow Haskell Compiler / GHC Commits: a219863f by Ben Gamari at 2022-08-08T10:46:30-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -564,15 +565,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${CROSS_TARGET:-}" ]; then + args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" ) + fi + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} + +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +617,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +640,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +806,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/gen_ci.hs ===================================== @@ -117,6 +117,7 @@ data BuildConfig , withAssertions :: Bool , withNuma :: Bool , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -159,6 +160,7 @@ vanilla = BuildConfig , withAssertions = False , withNuma = False , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -189,8 +191,13 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } -crossConfig :: String -> BuildConfig -crossConfig triple = vanilla { crossTarget = Just triple } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -605,6 +612,7 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -780,7 +788,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) - , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu") + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -1316,6 +1316,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" @@ -3795,6 +3796,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a219863ffee148484d28b9ccb521d98c3948ff77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a219863ffee148484d28b9ccb521d98c3948ff77 You're receiving 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 Aug 11 20:59:15 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 Aug 2022 16:59:15 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles Message-ID: <62f56da3290_3d8149489048153b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: a627d70e by Simon Peyton Jones at 2022-08-11T21:59:43+01:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Type.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1545,9 +1545,6 @@ promoteCoercion co = case co of Pair ty1 ty2 = coercionKind co ki1 = typeKind ty1 ki2 = typeKind ty2 - doc = vcat[ ppr co - , text "ty1" <+> ppr ty1 <+> dcolon <+> ppr ki1 - , text "ty2" <+> ppr ty2 <+> dcolon <+> ppr ki2 ] -- | say @g = promoteCoercion h at . Then, @instCoercion g w@ yields @Just g'@, -- where @g' = promoteCoercion (h w)@. ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -664,7 +664,7 @@ kindRep k = case kindRep_maybe k of kindRep_maybe :: HasDebugCallStack => Kind -> Maybe RuntimeRepType kindRep_maybe kind | Just (_, rep) <- sORTKind_maybe kind = Just rep - | otherwise = Nothing + | otherwise = Nothing -- | Returns True if the argument is a lifted SORT -- See Note [Kind Constraint and kind Type] @@ -1626,7 +1626,7 @@ splitTyConAppNoSyn_maybe ty -- of @a@ isn't of the form @TYPE rep@). Consequently, you may need to zonk your -- type before using this function. -- --- Differs from splitTyConApp_maybe in taht it does *not* split types +-- Differs from splitTyConApp_maybe in that it does *not* split types -- headed with (=>), as that's not a TyCon in the type-checker. -- -- Moreover, for a FunTy, it only succeeds if the argument types @@ -1645,7 +1645,7 @@ tcSplitTyConApp_maybe ty TyConApp tc tys -> Just (tc, tys) FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res} | isVisibleAnonArg af -- Visible args only. See Note [Decomposing fat arrow c=>t] - -> funTyConAppTy_maybe af w arg res + -> funTyConAppTy_maybe af w arg res _ -> Nothing ------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a627d70efac1e88eb0d4fc2b4996d2aa60e042de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a627d70efac1e88eb0d4fc2b4996d2aa60e042de You're receiving 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 Aug 11 12:49:51 2022 From: gitlab at gitlab.haskell.org (John Ericson (@Ericson2314)) Date: Thu, 11 Aug 2022 08:49:51 -0400 Subject: [Git][ghc/ghc][wip/wither-eq1-and-friends] 12 commits: testsuite: 21651 add test for closeFdWith + setNumCapabilities Message-ID: <62f4faefe98d6_142b4952184371365@gitlab.mail> John Ericson pushed to branch wip/wither-eq1-and-friends at Glasgow Haskell Compiler / GHC Commits: 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - 5749029e by John Ericson at 2022-08-11T08:49:21-04:00 Relax instances for Functor combinators; put superclass on Class1 to make non-breaking The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Driver/Plugins.hs - + compiler/GHC/Driver/Plugins/External.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Runtime/Loader.hs - compiler/ghc.cabal.in - docs/users_guide/bugs.rst - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/binary_literals.rst - docs/users_guide/exts/constrained_class_methods.rst - docs/users_guide/exts/constraint_kind.rst - docs/users_guide/exts/datatype_contexts.rst - docs/users_guide/exts/deriving_extra.rst - docs/users_guide/exts/duplicate_record_fields.rst - docs/users_guide/exts/empty_case.rst - docs/users_guide/exts/empty_data_deriving.rst - docs/users_guide/exts/existential_quantification.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/explicit_namespaces.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/field_selectors.rst - docs/users_guide/exts/flexible_contexts.rst - docs/users_guide/exts/functional_dependencies.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/generics.rst - docs/users_guide/exts/hex_float_literals.rst - docs/users_guide/exts/import_qualified_post.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4b6fddba81edb62f4496d55c89781355a9f35a4...5749029ece7a328650e3cffb48da4e1c23aada18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4b6fddba81edb62f4496d55c89781355a9f35a4...5749029ece7a328650e3cffb48da4e1c23aada18 You're receiving 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 Aug 12 08:40:56 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 Aug 2022 04:40:56 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] Revert -fno-code forcing -O0 Message-ID: <62f612188bb5d_3d8149488284258df@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 943b6f7e by Matthew Pickering at 2022-08-12T09:40:42+01:00 Revert -fno-code forcing -O0 - - - - - 2 changed files: - compiler/GHC/Driver/Backend.hs - − testsuite/tests/driver/fat-iface/fat006a.stderr Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -663,7 +663,7 @@ backendForcesOptimization0 (Named NCG) = False backendForcesOptimization0 (Named LLVM) = False backendForcesOptimization0 (Named ViaC) = False backendForcesOptimization0 (Named Interpreter) = True -backendForcesOptimization0 (Named NoBackend) = True +backendForcesOptimization0 (Named NoBackend) = False -- | I don't understand exactly how this works. But if -- this flag is set *and* another condition is met, then ===================================== testsuite/tests/driver/fat-iface/fat006a.stderr deleted ===================================== @@ -1,3 +0,0 @@ - -when making flags consistent: warning: - Optimization flags are incompatible with the no code generated; optimization flags ignored. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/943b6f7e90df8d99bb8430fb56bd6ee84cca972d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/943b6f7e90df8d99bb8430fb56bd6ee84cca972d You're receiving 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 Aug 8 00:50:33 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 20:50:33 -0400 Subject: [Git][ghc/ghc][wip/armv7l-ci] Debug Message-ID: <62f05dd99b3d5_25b0164c054366162@gitlab.mail> Ben Gamari pushed to branch wip/armv7l-ci at Glasgow Haskell Compiler / GHC Commits: 80a416de by Ben Gamari at 2022-08-07T20:50:26-04:00 Debug - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -316,6 +316,7 @@ opsysVariables ARMv7 (Linux distro) = -- non-deterministically on ARMv7. See #18280. , "LD" =: "ld.gold" , "GccUseLdOpt" =: "-fuse-ld=gold" + , "HADRIAN_ARGS" =: "--test-verbose=4" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = ===================================== .gitlab/jobs.yaml ===================================== @@ -177,7 +177,8 @@ "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", "GccUseLdOpt": "-fuse-ld=gold", "LD": "ld.gold", - "TEST_ENV": "armv7-linux-deb10-validate" + "TEST_ENV": "armv7-linux-deb10-validate", + "HADRIAN_ARGS": "--test-verbose=4" } }, "i386-linux-deb9-validate": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80a416ded8e3d77de8752cd4e70ad813c4200921 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80a416ded8e3d77de8752cd4e70ad813c4200921 You're receiving 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 Aug 9 00:11:29 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 20:11:29 -0400 Subject: [Git][ghc/ghc][wip/armv7l-ci] 10 commits: hadrian: Don't use mk/config.mk.in Message-ID: <62f1a63139ecf_25b0164c07c646666@gitlab.mail> Ben Gamari pushed to branch wip/armv7l-ci at Glasgow Haskell Compiler / GHC Commits: afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - fcc296e9 by Ben Gamari at 2022-08-08T20:10:53-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 81fbffef by Ben Gamari at 2022-08-08T20:10:53-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 20 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Expr.hs - distrib/configure.ac.in - docs/users_guide/bugs.rst - hadrian/bindist/Makefile - + hadrian/bindist/config.mk.in - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_compile/T21710a.hs - + testsuite/tests/codeGen/should_compile/T21710a.stderr - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs - testsuite/tests/codeGen/should_gen_asm/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -311,8 +311,15 @@ opsysVariables _ FreeBSD = mconcat ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -480,6 +487,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -500,6 +508,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDTag = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -769,7 +779,8 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -155,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -174,7 +232,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -213,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -271,7 +332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -334,7 +395,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -358,6 +419,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -393,7 +513,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -412,7 +532,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -452,7 +575,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -511,7 +634,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -576,7 +699,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -637,7 +760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -699,7 +822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -761,7 +884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -821,7 +944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -880,7 +1003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -939,7 +1062,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -999,7 +1122,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1058,7 +1181,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1117,7 +1240,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1176,7 +1299,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1235,7 +1358,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1296,7 +1419,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1355,7 +1478,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1414,7 +1537,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1475,7 +1598,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1537,7 +1660,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1598,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1776,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1712,7 +1835,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1775,7 +1898,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1839,7 +1962,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1864,6 +1987,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1899,7 +2082,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1918,8 +2101,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -1959,7 +2145,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2019,7 +2205,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2085,7 +2271,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2147,7 +2333,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2210,7 +2396,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2273,7 +2459,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2334,7 +2520,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2394,7 +2580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2454,7 +2640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2514,7 +2700,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2574,7 +2760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2636,7 +2822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2698,7 +2884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2761,7 +2947,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2817,7 +3003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2877,7 +3063,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2941,7 +3127,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3005,7 +3191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3065,7 +3251,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3126,7 +3312,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3187,7 +3373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3246,7 +3432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3305,7 +3491,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3363,7 +3549,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3608,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3480,7 +3666,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3538,7 +3724,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3596,7 +3782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3655,7 +3841,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3715,7 +3901,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3773,7 +3959,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3831,7 +4017,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3891,7 +4077,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3952,7 +4138,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4012,7 +4198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4066,7 +4252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4124,7 +4310,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1048,10 +1048,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -------------------- add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register + -- x + imm add_code rep x (CmmLit (CmmInt y _)) | is32BitInteger y , rep /= W8 -- LEA doesn't support byte size (#18614) = add_int rep x y + -- x + (y << imm) + add_code rep x y + -- Byte size is not supported and 16bit size is slow when computed via LEA + | rep /= W8 && rep /= W16 + -- 2^3 = 8 is the highest multiplicator supported by LEA. + , Just (x,y,shift_bits) <- get_shift x y + = add_shiftL rep x y (fromIntegral shift_bits) + where + -- x + (y << imm) + get_shift x (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) + | shift_bits <= 3 + = Just (x, y, shift_bits) + -- (y << imm) + x + get_shift (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) x + | shift_bits <= 3 + = Just (x, y, shift_bits) + get_shift _ _ + = Nothing add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y where format = intFormat rep -- TODO: There are other interesting patterns we want to replace @@ -1066,6 +1085,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y -- our three-operand add instruction: + add_int :: (Width -> CmmExpr -> Integer -> NatM Register) add_int width x y = do (x_reg, x_code) <- getSomeReg x let @@ -1079,6 +1099,22 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -- return (Any format code) + -- x + (y << shift_bits) using LEA + add_shiftL :: (Width -> CmmExpr -> CmmExpr -> Int -> NatM Register) + add_shiftL width x y shift_bits = do + (x_reg, x_code) <- getSomeReg x + (y_reg, y_code) <- getSomeReg y + let + format = intFormat width + imm = ImmInt 0 + code dst + = (x_code `appOL` y_code) `snocOL` + LEA format + (OpAddr (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg (2 ^ shift_bits)) imm)) + (OpReg dst) + -- + return (Any format code) + ---------------------- -- See Note [DIV/IDIV for bytes] ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -20,6 +20,7 @@ where import GHC.Prelude +import GHC.Builtin.PrimOps ( PrimOp(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply @@ -346,6 +347,19 @@ fvArgs args = do type IsScrut = Bool +rewriteArgs :: [StgArg] -> RM [StgArg] +rewriteArgs = mapM rewriteArg +rewriteArg :: StgArg -> RM StgArg +rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v +rewriteArg (lit at StgLitArg{}) = return lit + +-- Attach a tagSig if it's tagged +rewriteId :: Id -> RM Id +rewriteId v = do + is_tagged <- isTagged v + if is_tagged then return $! setIdTagSig v (TagSig TagProper) + else return v + rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr rewriteExpr _ (e at StgCase {}) = rewriteCase e rewriteExpr _ (e at StgLet {}) = rewriteLet e @@ -355,8 +369,11 @@ rewriteExpr _ e@(StgConApp {}) = rewriteConApp e rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e rewriteExpr _ (StgLit lit) = return $! (StgLit lit) +rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do + (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) + rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ @@ -415,6 +432,7 @@ rewriteApp True (StgApp f []) = do -- isTagged looks at more than the result of our analysis. -- So always update here if useful. let f' = if f_tagged + -- TODO: We might consisder using a subst env instead of setting the sig only for select places. then setIdTagSig f (TagSig TagProper) else f return $! StgApp f' [] ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -76,6 +76,8 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = -- dataToTag# :: a -> Int# -- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold +-- TODO: There are some more optimization ideas for this code path +-- in #21710 cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do platform <- getPlatform emitComment (mkFastString "dataToTag#") @@ -92,15 +94,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do -- the constructor index is too large to fit in the pointer and therefore -- we must look in the info table. See Note [Tagging big families]. - slow_path <- getCode $ do - tmp <- newTemp (bWord platform) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - profile <- getProfile - align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig - emitAssign (CmmLocal result_reg) - $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) - - fast_path <- getCode $ do + (fast_path :: CmmAGraph) <- getCode $ do -- Return the constructor index from the pointer tag return_ptr_tag <- getCode $ do emitAssign (CmmLocal result_reg) @@ -113,8 +107,22 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do $ getConstrTag profile align_check (cmmUntag platform amode) emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False) - - emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) + -- If we know the argument is already tagged there is no need to generate code to evaluate it + -- so we skip straight to the fast path. If we don't know if there is a tag we take the slow + -- path which evaluates the argument before fetching the tag. + case (idTagSig_maybe a) of + Just sig + | isTaggedSig sig + -> emit fast_path + _ -> do + slow_path <- getCode $ do + tmp <- newTemp (bWord platform) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + profile <- getProfile + align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig + emitAssign (CmmLocal result_reg) + $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) + emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) emitReturn [CmmReg $ CmmLocal result_reg] ===================================== distrib/configure.ac.in ===================================== @@ -256,7 +256,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS # -AC_CONFIG_FILES(mk/config.mk mk/install.mk) +AC_CONFIG_FILES(config.mk mk/config.mk mk/install.mk) AC_OUTPUT # We get caught by ===================================== docs/users_guide/bugs.rst ===================================== @@ -115,6 +115,10 @@ Lexical syntax varid → small {idchar} ⟨reservedid⟩ conid → large {idchar} +- GHC allows redundant parantheses around the function name in the `funlhs` part of declarations. + That is GHC will succeed in parsing a declaration like `((f)) x = ` for any number + of parantheses around `f`. + .. _infelicities-syntax: Context-free syntax ===================================== hadrian/bindist/Makefile ===================================== @@ -1,7 +1,8 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: -include mk/config.mk +include ./mk/project.mk +include ./config.mk .PHONY: default default: @@ -177,7 +178,9 @@ install_bin_libdir: $(INSTALL_PROGRAM) $$i "$(DESTDIR)$(ActualBinsDir)"; \ done # Work around #17418 on Darwin - if [ -e "${XATTR}" ]; then "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; fi + if [ -e "${XATTR}" ]; then \ + "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; \ + fi install_bin_direct: @echo "Copying binaries to $(DESTDIR)$(WrapperBinsDir)" @@ -208,6 +211,10 @@ install_lib: lib/settings esac; \ done; \ chmod ugo+rx "$$dest"/bin/* + # Work around #17418 on Darwin + if [ -e "${XATTR}" ]; then \ + "${XATTR}" -c -r "$(DESTDIR)$(ActualLibsDir)"; \ + fi install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" ===================================== hadrian/bindist/config.mk.in ===================================== @@ -0,0 +1,285 @@ +#----------------------------------------------------------------------------- +# +# Definition of installation directories, we don't use half of these, but since +# the configure script has them on offer while passing through, we might as well +# set them. Note that we have to be careful, because the GNU coding standards +# have changed a bit over the course of time, and autoconf development reflects +# this. +# +# A little bit of history regarding autoconf and GNU coding standards, use this +# as a cheat-sheet for the stuff below: +# +# variable | default < 2.60 | default >= 2.60 +# ------------+--------------------+-------------------------------------- +# exec_prefix | ${prefix} | ${prefix} +# libdir | ${exec_prefix}/lib | ${exec_prefix}/lib +# datarootdir | NONE! | ${prefix}/share +# datadir | ${prefix}/share | ${datarootdir} +# infodir | ${prefix}/info | ${datarootdir}/info +# mandir | ${prefix}/man | ${datarootdir}/man +# docdir | NONE! | ${datarootdir}/doc/${PACKAGE_TARNAME} +# htmldir | NONE! | ${docdir} +# dvidir | NONE! | ${docdir} +# pdfdir | NONE! | ${docdir} +# psdir | NONE! | ${docdir} +# +# NOTE: The default e.g. ${docdir} above means that autoconf substitutes the +# string "${docdir}", not the value of docdir! This is crucial for the GNU +# coding standards. See #1924. + +define set_default +# $1 = variable to set +# $2 = default value to use, if configure didn't expand it +# If $1 starts with an @ then configure didn't set it (because a version +# of autoconf that is too old was used), so set it to a sensible value +ifneq "$$(filter @%,$$($1))" "" +$1 = $2 +endif +endef + +prefix = @prefix@ + +datarootdir = @datarootdir@ +$(eval $(call set_default,datarootdir,$${prefix}/share)) + +exec_prefix = @exec_prefix@ +bindir = @bindir@ +datadir = @datadir@ +libdir = @libdir@ +includedir = @includedir@ +mandir = @mandir@ + +# Note that `./configure --docdir=/foo/bar` should work. +docdir = @docdir@ +PACKAGE_TARNAME = ghc-${ProjectVersion} +$(eval $(call set_default,docdir,$${datarootdir}/doc/$${PACKAGE_TARNAME})) + +htmldir = @htmldir@ +dvidir = @dvidir@ +pdfdir = @pdfdir@ +psdir = @psdir@ +$(eval $(call set_default,htmldir,$${docdir})) +$(eval $(call set_default,dvidir,$${docdir})) +$(eval $(call set_default,pdfdir,$${docdir})) +$(eval $(call set_default,psdir,$${docdir})) + +ifeq "$(RelocatableBuild)" "YES" + +# Hack: our directory layouts tend to be different on Windows, so +# hack around configure's bogus assumptions here. +datarootdir = $(prefix) +datadir = $(prefix)/lib +libdir = $(prefix)/lib + +docdir = $(prefix)/doc +htmldir = $(docdir) +dvidir = $(docdir) +pdfdir = $(docdir) +psdir = $(docdir) + +ghclibdir = $(libdir) + +else + +# Unix: override libdir and datadir to put ghc-specific stuff in +# a subdirectory with the version number included. +ghclibdir = $(libdir)/$(CrossCompilePrefix)ghc-$(ProjectVersion) +endif + +ghclibexecdir = $(ghclibdir) +topdir = $(ghclibdir) +ghcheaderdir = $(ghclibdir)/rts/include + +#----------------------------------------------------------------------------- +# Utilities needed by the installation Makefile + +GENERATED_FILE = chmod a-w +EXECUTABLE_FILE = chmod +x +CP = cp +FIND = @FindCmd@ +INSTALL = @INSTALL@ +INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) +LN_S = @LN_S@ +MV = mv +SED = @SedCmd@ +SHELL = @SHELL@ + +# +# Invocations of `install' for different classes +# of targets: +# +INSTALL_PROGRAM = $(INSTALL) -m 755 +INSTALL_SCRIPT = $(INSTALL) -m 755 +INSTALL_SHLIB = $(INSTALL) -m 755 +INSTALL_DATA = $(INSTALL) -m 644 +INSTALL_HEADER = $(INSTALL) -m 644 +INSTALL_MAN = $(INSTALL) -m 644 +INSTALL_DOC = $(INSTALL) -m 644 +INSTALL_DIR = $(INSTALL) -m 755 -d + +CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create +CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create + +#----------------------------------------------------------------------------- +# Build configuration + +CrossCompiling = @CrossCompiling@ +CrossCompilePrefix = @CrossCompilePrefix@ +GhcUnregisterised = @Unregisterised@ + +# ArchSupportsSMP should be set iff there is support for that arch in +# rts/include/stg/SMP.h +ifeq "$(TargetArch_CPP)" "arm" +# We don't support load/store barriers pre-ARMv7. See #10433. +ArchSupportsSMP=$(if $(filter $(ARM_ISA),ARMv5 ARMv6),NO,YES) +else +ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64 riscv64))) +endif + +# The THREADED_RTS requires `BaseReg` to be in a register and the +# `GhcUnregisterised` mode doesn't allow that. +GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO)) + +# Whether to include GHCi in the compiler. Depends on whether the RTS linker +# has support for this OS/ARCH combination. +OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu))) +ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm aarch64))) + +ifeq "$(OsSupportsGHCi)$(ArchSupportsGHCi)" "YESYES" +GhcWithInterpreter=YES +else +GhcWithInterpreter=$(if $(findstring YES,$(DYNAMIC_GHC_PROGRAMS)),YES,NO) +endif + +# On Windows we normally want to make a relocatable bindist, to we +# ignore flags like libdir +ifeq "$(Windows_Host)" "YES" +RelocatableBuild = YES +else +RelocatableBuild = NO +endif + + +# runhaskell and hsc2hs are special, in that other compilers besides +# GHC might provide them. Systems with a package manager often come +# with tools to manage this kind of clash, e.g. RPM's +# update-alternatives. When building a distribution for such a system, +# we recommend setting both of the following to 'YES'. +# +# NO_INSTALL_RUNHASKELL = YES +# NO_INSTALL_HSC2HS = YES +# +# NB. we use negative tests here because for binary-distributions we cannot +# test build-time variables at install-time, so they must default to on. + +ifneq "$(DESTDIR)" "" +override DESTDIR := $(abspath $(DESTDIR)) +endif + +# We build the libraries at least the "vanilla" way (way "v") +# Technically we don't need the v way if DYNAMIC_GHC_PROGRAMS is YES, +# but with -dynamic-too it's cheap, and makes life easier. +GhcLibWays = v + +# In addition to the normal sequential way, the default is to also build +# profiled prelude libraries +# $(if $(filter ...)) allows controlling this expression from build.mk. +GhcLibWays += $(if $(filter $(BUILD_PROF_LIBS),NO),,p) + +# Backward compatibility: although it would be cleaner to test for +# PlatformSupportsSharedLibs, or perhaps a new variable BUILD_SHARED_LIBS, +# some users currently expect that DYNAMIC_GHC_PROGRAMS=NO in build.mk implies +# that dyn is not added to GhcLibWays. +GhcLibWays += $(if $(filter $(DYNAMIC_GHC_PROGRAMS),NO),,dyn) + +# Handy way to test whether we're building shared libs or not. +BuildSharedLibs=$(strip $(if $(findstring dyn,$(GhcLibWays)),YES,NO)) + +# In addition, the RTS is built in some further variations. Ways that +# make sense here: +# +# thr : threaded +# thr_p : threaded + profiled +# debug : debugging +# thr_debug : debugging + threaded +# p : profiled +# +# While the eventlog used to be enabled in only a subset of ways, we now always +# enable it. + +# Usually want the debug version +GhcRTSWays = debug + +# We always have the threaded versions, but note that SMP support may be disabled +# (see GhcWithSMP). +GhcRTSWays += thr thr_debug +GhcRTSWays += $(if $(findstring p, $(GhcLibWays)),thr_p,) +GhcRTSWays += $(if $(findstring dyn, $(GhcLibWays)),dyn debug_dyn thr_dyn thr_debug_dyn,) +GhcRTSWays += $(if $(findstring p, $(GhcLibWays)),thr_debug_p debug_p,) + +# We can only build GHCi threaded if we have a threaded RTS: +GhcThreaded = $(if $(findstring thr,$(GhcRTSWays)),YES,NO) + +# Configuration for libffi +UseSystemLibFFI=@UseSystemLibFFI@ +UseLibffiForAdjustors=@UseLibffiForAdjustors@ + +# GHC needs arch-specific tweak at least in +# rts/Libdw.c:set_initial_registers() +GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseLibdw@,NO)) + +#----------------------------------------------------------------------------- +# Settings + +# We are in the process of moving the settings file from being entirely +# generated by configure, to generated being by the build system. Many of these +# might become redundant. +# See Note [tooldir: How GHC finds mingw on Windows] + +GccExtraViaCOpts = @GccExtraViaCOpts@ +LdHasFilelist = @LdHasFilelist@ +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@ +SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ +SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ +SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ +SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ +SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ +SettingsLdCommand = @SettingsLdCommand@ +SettingsLdFlags = @SettingsLdFlags@ +SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ +SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ +SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ +SettingsRanlibCommand = @SettingsRanlibCommand@ +SettingsDllWrapCommand = @SettingsDllWrapCommand@ +SettingsWindresCommand = @SettingsWindresCommand@ +SettingsLibtoolCommand = @SettingsLibtoolCommand@ +SettingsTouchCommand = @SettingsTouchCommand@ +SettingsClangCommand = @SettingsClangCommand@ +SettingsLlcCommand = @SettingsLlcCommand@ +SettingsOptCommand = @SettingsOptCommand@ +SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ + ===================================== hadrian/src/Packages.hs ===================================== @@ -14,7 +14,7 @@ module Packages ( ghcPackages, isGhcPackage, -- * Package information - programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, + crossPrefix, programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, rtsContext, rtsBuildPath, libffiBuildPath, ensureConfigured ) where @@ -154,15 +154,20 @@ linter name = program name ("linters" -/- name) setPath :: Package -> FilePath -> Package setPath pkg path = pkg { pkgPath = path } +-- | Target prefix to prepend to executable names. +crossPrefix :: Action String +crossPrefix = do + cross <- flag CrossCompiling + targetPlatform <- setting TargetPlatformFull + return $ if cross then targetPlatform ++ "-" else "" + -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC -- built in 'Stage0' is called @ghc-stage1 at . If the given package is a -- 'Library', the function simply returns its name. programName :: Context -> Action String programName Context {..} = do - cross <- flag CrossCompiling - targetPlatform <- setting TargetPlatformFull - let prefix = if cross then targetPlatform ++ "-" else "" + prefix <- crossPrefix -- TODO: Can we extract this information from Cabal files? -- Alp: We could, but then the iserv package would have to -- use Cabal conditionals + a 'profiling' flag ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TupleSections, MultiWayIf #-} module Rules.BinaryDist where import Hadrian.Haskell.Cabal @@ -254,6 +254,7 @@ bindistRules = do -- other machine. need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) + copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do @@ -346,7 +347,9 @@ compressorExtension Bzip2 = "bz2" bindistInstallFiles :: [FilePath] bindistInstallFiles = [ "config.sub", "config.guess", "install-sh" - , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in", "mk" -/- "project.mk" + , "mk" -/- "config.mk.in" -- TODO: Remove when make is gone + , "mk" -/- "install.mk.in" -- TODO: Remove when make is gone + , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" , "README", "INSTALL" ] @@ -370,19 +373,20 @@ useGhcPrefix pkg | pkg == ghciWrapper = False | otherwise = True - -- | Which wrappers point to a specific package pkgToWrappers :: Package -> Action [String] -pkgToWrappers pkg - -- ghc also has the ghci script wrapper - | pkg == ghc = pure ["ghc", "ghci"] - | pkg == runGhc = pure ["runghc", "runhaskell"] - -- These are the packages which we want to expose to the user and hence - -- there are wrappers installed in the bindist. - | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] - = (:[]) <$> (programName =<< programContext Stage1 pkg) - | otherwise = pure [] - +pkgToWrappers pkg = do + prefix <- crossPrefix + if -- ghc also has the ghci script wrapper + -- N.B. programName would add the crossPrefix therefore we must do the + -- same here. + | pkg == ghc -> pure $ map (prefix++) ["ghc", "ghci"] + | pkg == runGhc -> pure $ map (prefix++) ["runghc", "runhaskell"] + -- These are the packages which we want to expose to the user and hence + -- there are wrappers installed in the bindist. + | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] + -> (:[]) <$> (programName =<< programContext Stage1 pkg) + | otherwise -> pure [] wrapper :: FilePath -> Action String wrapper "ghc" = ghcWrapper ===================================== rts/PrimOps.cmm ===================================== @@ -2801,21 +2801,6 @@ stg_getApStackValzh ( P_ ap_stack, W_ offset ) } } -// Write the cost center stack of the first argument on stderr; return -// the second. Possibly only makes sense for already evaluated -// things? -stg_traceCcszh ( P_ obj, P_ ret ) -{ - W_ ccs; - -#if defined(PROFILING) - ccs = StgHeader_ccs(UNTAG(obj)); - ccall fprintCCS_stderr(ccs "ptr"); -#endif - - jump stg_ap_0_fast(ret); -} - stg_getSparkzh () { W_ spark; ===================================== rts/RtsSymbols.c ===================================== @@ -1015,7 +1015,6 @@ extern char **environ; SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(enabled_capabilities) \ - SymI_HasDataProto(stg_traceCcszh) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -566,7 +566,6 @@ RTS_FUN_DECL(stg_numSparkszh); RTS_FUN_DECL(stg_noDuplicatezh); -RTS_FUN_DECL(stg_traceCcszh); RTS_FUN_DECL(stg_clearCCSzh); RTS_FUN_DECL(stg_traceEventzh); RTS_FUN_DECL(stg_traceBinaryEventzh); ===================================== testsuite/tests/codeGen/should_compile/T21710a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# OPTIONS_GHC -O #-} + +module M where + +import GHC.Exts + +data E = A | B | C | D | E + +foo x = + case x of + A -> 2# + B -> 42# + -- In this branch we already now `x` is evaluated, so we shouldn't generate an extra `call` for it. + _ -> dataToTag# x ===================================== testsuite/tests/codeGen/should_compile/T21710a.stderr ===================================== @@ -0,0 +1,446 @@ + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'E2_bytes" { + M.$tc'E2_bytes: + I8[] "'E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'D2_bytes" { + M.$tc'D2_bytes: + I8[] "'D" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'C2_bytes" { + M.$tc'C2_bytes: + I8[] "'C" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'B2_bytes" { + M.$tc'B2_bytes: + I8[] "'B" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'A3_bytes" { + M.$tc'A3_bytes: + I8[] "'A" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tcE2_bytes" { + M.$tcE2_bytes: + I8[] "E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule2_bytes" { + M.$trModule2_bytes: + I8[] "M" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule4_bytes" { + M.$trModule4_bytes: + I8[] "main" + }] + + + +==================== Output Cmm ==================== +[M.foo_entry() { // [R2] + { info_tbls: [(cBa, + label: block_cBa_info + rep: StackRep [] + srt: Nothing), + (cBi, + label: M.foo_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cBi: // global + if ((Sp + -8) < SpLim) (likely: False) goto cBj; else goto cBk; // CmmCondBranch + cBj: // global + R1 = M.foo_closure; // CmmAssign + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall + cBk: // global + I64[Sp - 8] = cBa; // CmmStore + R1 = R2; // CmmAssign + Sp = Sp - 8; // CmmAssign + if (R1 & 7 != 0) goto cBa; else goto cBb; // CmmCondBranch + cBb: // global + call (I64[R1])(R1) returns to cBa, args: 8, res: 8, upd: 8; // CmmCall + cBa: // global + _cBh::P64 = R1 & 7; // CmmAssign + if (_cBh::P64 != 1) goto uBz; else goto cBf; // CmmCondBranch + uBz: // global + if (_cBh::P64 != 2) goto cBe; else goto cBg; // CmmCondBranch + cBe: // global + // dataToTag# + _cBn::P64 = R1 & 7; // CmmAssign + if (_cBn::P64 == 7) (likely: False) goto cBs; else goto cBr; // CmmCondBranch + cBs: // global + _cBo::I64 = %MO_UU_Conv_W32_W64(I32[I64[R1 & (-8)] - 4]); // CmmAssign + goto cBq; // CmmBranch + cBr: // global + _cBo::I64 = _cBn::P64 - 1; // CmmAssign + goto cBq; // CmmBranch + cBq: // global + R1 = _cBo::I64; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBg: // global + R1 = 42; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBf: // global + R1 = 2; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }, + section ""data" . M.foo_closure" { + M.foo_closure: + const M.foo_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule3_closure" { + M.$trModule3_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule4_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule1_closure" { + M.$trModule1_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule_closure" { + M.$trModule_closure: + const GHC.Types.Module_con_info; + const M.$trModule3_closure+1; + const M.$trModule1_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE1_closure" { + M.$tcE1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tcE2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE_closure" { + M.$tcE_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tcE1_closure+1; + const GHC.Types.krep$*_closure+5; + const 10475418246443540865; + const 12461417314693222409; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A1_closure" { + M.$tc'A1_closure: + const GHC.Types.KindRepTyConApp_con_info; + const M.$tcE_closure+1; + const GHC.Types.[]_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A2_closure" { + M.$tc'A2_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'A3_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A_closure" { + M.$tc'A_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'A2_closure+1; + const M.$tc'A1_closure+1; + const 10991425535368257265; + const 3459663971500179679; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B1_closure" { + M.$tc'B1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'B2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B_closure" { + M.$tc'B_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'B1_closure+1; + const M.$tc'A1_closure+1; + const 13038863156169552918; + const 13430333535161531545; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C1_closure" { + M.$tc'C1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'C2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C_closure" { + M.$tc'C_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'C1_closure+1; + const M.$tc'A1_closure+1; + const 8482817676735632621; + const 8146597712321241387; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D1_closure" { + M.$tc'D1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'D2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D_closure" { + M.$tc'D_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'D1_closure+1; + const M.$tc'A1_closure+1; + const 7525207739284160575; + const 13746130127476219356; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E1_closure" { + M.$tc'E1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'E2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E_closure" { + M.$tc'E_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'E1_closure+1; + const M.$tc'A1_closure+1; + const 6748545530683684316; + const 10193016702094081137; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.A_closure" { + M.A_closure: + const M.A_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.B_closure" { + M.B_closure: + const M.B_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.C_closure" { + M.C_closure: + const M.C_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.D_closure" { + M.D_closure: + const M.D_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.E_closure" { + M.E_closure: + const M.E_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""relreadonly" . M.E_closure_tbl" { + M.E_closure_tbl: + const M.A_closure+1; + const M.B_closure+2; + const M.C_closure+3; + const M.D_closure+4; + const M.E_closure+5; + }] + + + +==================== Output Cmm ==================== +[M.A_con_entry() { // [] + { info_tbls: [(cC5, + label: M.A_con_info + rep: HeapRep 1 nonptrs { Con {tag: 0 descr:"main:M.A"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cC5: // global + R1 = R1 + 1; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.B_con_entry() { // [] + { info_tbls: [(cCa, + label: M.B_con_info + rep: HeapRep 1 nonptrs { Con {tag: 1 descr:"main:M.B"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCa: // global + R1 = R1 + 2; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.C_con_entry() { // [] + { info_tbls: [(cCf, + label: M.C_con_info + rep: HeapRep 1 nonptrs { Con {tag: 2 descr:"main:M.C"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCf: // global + R1 = R1 + 3; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.D_con_entry() { // [] + { info_tbls: [(cCk, + label: M.D_con_info + rep: HeapRep 1 nonptrs { Con {tag: 3 descr:"main:M.D"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCk: // global + R1 = R1 + 4; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.E_con_entry() { // [] + { info_tbls: [(cCp, + label: M.E_con_info + rep: HeapRep 1 nonptrs { Con {tag: 4 descr:"main:M.E"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCp: // global + R1 = R1 + 5; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -108,3 +108,4 @@ test('T18614', normal, compile, ['']) test('mk-big-obj', [unless(opsys('mingw32'), skip), pre_cmd('$PYTHON mk-big-obj.py > mk-big-obj.c')], multimod_compile, ['mk-big-obj.c', '-c -v0 -no-hs-main']) +test('T21710a', [ only_ways(['optasm']), when(wordsize(32), skip), grep_errmsg('(call)',[1]) ], compile, ['-ddump-cmm -dno-typeable-binds']) ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm ===================================== @@ -0,0 +1,46 @@ +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_f_info +.type AddMulX86_f_info, @function +AddMulX86_f_info: +.LcAx: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_f_info, .-AddMulX86_f_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_f_closure +.type AddMulX86_f_closure, @object +AddMulX86_f_closure: + .quad AddMulX86_f_info +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_g_info +.type AddMulX86_g_info, @function +AddMulX86_g_info: +.LcAL: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_g_info, .-AddMulX86_g_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_g_closure +.type AddMulX86_g_closure, @object +AddMulX86_g_closure: + .quad AddMulX86_g_info +.section .note.GNU-stack,"", at progbits +.ident "GHC 9.3.20220228" + + ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash #-} + +module AddMulX86 where + +import GHC.Exts + +f :: Int# -> Int# -> Int# +f x y = + x +# (y *# 8#) -- Should result in a lea instruction, which we grep the assembly output for. + +g x y = + (y *# 8#) +# x -- Should result in a lea instruction, which we grep the assembly output for. ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -10,3 +10,4 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', '']) test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections']) +test('AddMulX86', is_amd64_codegen, compile_cmp_asm, ['hs', '-dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cff673900aad2cc457752ba72e4d530caa6ed336...81fbffefdd6c338b216c4f36c84fa9e073670da5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cff673900aad2cc457752ba72e4d530caa6ed336...81fbffefdd6c338b216c4f36c84fa9e073670da5 You're receiving 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 Aug 10 10:03:19 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 06:03:19 -0400 Subject: [Git][ghc/ghc][master] hadrian RunRest: add type signature for stageNumber Message-ID: <62f3826763ab8_d270451cfc21509a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - 1 changed file: - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -285,6 +285,7 @@ runTestBuilderArgs = builder Testsuite ? do where emitWhenSet Nothing _ = mempty emitWhenSet (Just v) f = f v + stageNumber :: Stage -> Int stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot" stageNumber (Stage0 InTreeLibs) = 1 stageNumber Stage1 = 2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/823fe5b56450a7eefbf41ce8ece34095bf2217ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/823fe5b56450a7eefbf41ce8ece34095bf2217ee You're receiving 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 Aug 7 22:30:35 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 18:30:35 -0400 Subject: [Git][ghc/ghc][wip/cross-ci] 6 commits: hadrian: Don't use mk/config.mk.in Message-ID: <62f03d0b9deec_25b0164bfdc354729@gitlab.mail> Ben Gamari pushed to branch wip/cross-ci at Glasgow Haskell Compiler / GHC Commits: afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 953201c1 by Ben Gamari at 2022-08-07T18:30:24-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - 0426e5c0 by Ben Gamari at 2022-08-07T18:30:24-04:00 Bump process submodule - - - - - 2e895564 by Ben Gamari at 2022-08-07T18:30:24-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 10 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - distrib/configure.ac.in - hadrian/bindist/Makefile - + hadrian/bindist/config.mk.in - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - libraries/process Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -564,15 +565,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${target_triple:-}" ]; then + args+=( "--target=$target_triple" "--host=$target_triple" ) + fi + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} + +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +617,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + run "$CROSS_EMULATOR" ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +640,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +806,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/gen_ci.hs ===================================== @@ -116,6 +116,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +159,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } + llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] + ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] -- | The hadrian flavour string we are going to use for this build @@ -597,7 +611,8 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - + , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -773,6 +788,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -1261,6 +1261,67 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3680,6 +3741,66 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== distrib/configure.ac.in ===================================== @@ -256,7 +256,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS # -AC_CONFIG_FILES(mk/config.mk mk/install.mk) +AC_CONFIG_FILES(config.mk mk/config.mk mk/install.mk) AC_OUTPUT # We get caught by ===================================== hadrian/bindist/Makefile ===================================== @@ -1,7 +1,8 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: -include mk/config.mk +include ./mk/project.mk +include ./config.mk .PHONY: default default: @@ -177,7 +178,9 @@ install_bin_libdir: $(INSTALL_PROGRAM) $$i "$(DESTDIR)$(ActualBinsDir)"; \ done # Work around #17418 on Darwin - if [ -e "${XATTR}" ]; then "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; fi + if [ -e "${XATTR}" ]; then \ + "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; \ + fi install_bin_direct: @echo "Copying binaries to $(DESTDIR)$(WrapperBinsDir)" @@ -208,6 +211,10 @@ install_lib: lib/settings esac; \ done; \ chmod ugo+rx "$$dest"/bin/* + # Work around #17418 on Darwin + if [ -e "${XATTR}" ]; then \ + "${XATTR}" -c -r "$(DESTDIR)$(ActualLibsDir)"; \ + fi install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" ===================================== hadrian/bindist/config.mk.in ===================================== @@ -0,0 +1,285 @@ +#----------------------------------------------------------------------------- +# +# Definition of installation directories, we don't use half of these, but since +# the configure script has them on offer while passing through, we might as well +# set them. Note that we have to be careful, because the GNU coding standards +# have changed a bit over the course of time, and autoconf development reflects +# this. +# +# A little bit of history regarding autoconf and GNU coding standards, use this +# as a cheat-sheet for the stuff below: +# +# variable | default < 2.60 | default >= 2.60 +# ------------+--------------------+-------------------------------------- +# exec_prefix | ${prefix} | ${prefix} +# libdir | ${exec_prefix}/lib | ${exec_prefix}/lib +# datarootdir | NONE! | ${prefix}/share +# datadir | ${prefix}/share | ${datarootdir} +# infodir | ${prefix}/info | ${datarootdir}/info +# mandir | ${prefix}/man | ${datarootdir}/man +# docdir | NONE! | ${datarootdir}/doc/${PACKAGE_TARNAME} +# htmldir | NONE! | ${docdir} +# dvidir | NONE! | ${docdir} +# pdfdir | NONE! | ${docdir} +# psdir | NONE! | ${docdir} +# +# NOTE: The default e.g. ${docdir} above means that autoconf substitutes the +# string "${docdir}", not the value of docdir! This is crucial for the GNU +# coding standards. See #1924. + +define set_default +# $1 = variable to set +# $2 = default value to use, if configure didn't expand it +# If $1 starts with an @ then configure didn't set it (because a version +# of autoconf that is too old was used), so set it to a sensible value +ifneq "$$(filter @%,$$($1))" "" +$1 = $2 +endif +endef + +prefix = @prefix@ + +datarootdir = @datarootdir@ +$(eval $(call set_default,datarootdir,$${prefix}/share)) + +exec_prefix = @exec_prefix@ +bindir = @bindir@ +datadir = @datadir@ +libdir = @libdir@ +includedir = @includedir@ +mandir = @mandir@ + +# Note that `./configure --docdir=/foo/bar` should work. +docdir = @docdir@ +PACKAGE_TARNAME = ghc-${ProjectVersion} +$(eval $(call set_default,docdir,$${datarootdir}/doc/$${PACKAGE_TARNAME})) + +htmldir = @htmldir@ +dvidir = @dvidir@ +pdfdir = @pdfdir@ +psdir = @psdir@ +$(eval $(call set_default,htmldir,$${docdir})) +$(eval $(call set_default,dvidir,$${docdir})) +$(eval $(call set_default,pdfdir,$${docdir})) +$(eval $(call set_default,psdir,$${docdir})) + +ifeq "$(RelocatableBuild)" "YES" + +# Hack: our directory layouts tend to be different on Windows, so +# hack around configure's bogus assumptions here. +datarootdir = $(prefix) +datadir = $(prefix)/lib +libdir = $(prefix)/lib + +docdir = $(prefix)/doc +htmldir = $(docdir) +dvidir = $(docdir) +pdfdir = $(docdir) +psdir = $(docdir) + +ghclibdir = $(libdir) + +else + +# Unix: override libdir and datadir to put ghc-specific stuff in +# a subdirectory with the version number included. +ghclibdir = $(libdir)/$(CrossCompilePrefix)ghc-$(ProjectVersion) +endif + +ghclibexecdir = $(ghclibdir) +topdir = $(ghclibdir) +ghcheaderdir = $(ghclibdir)/rts/include + +#----------------------------------------------------------------------------- +# Utilities needed by the installation Makefile + +GENERATED_FILE = chmod a-w +EXECUTABLE_FILE = chmod +x +CP = cp +FIND = @FindCmd@ +INSTALL = @INSTALL@ +INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) +LN_S = @LN_S@ +MV = mv +SED = @SedCmd@ +SHELL = @SHELL@ + +# +# Invocations of `install' for different classes +# of targets: +# +INSTALL_PROGRAM = $(INSTALL) -m 755 +INSTALL_SCRIPT = $(INSTALL) -m 755 +INSTALL_SHLIB = $(INSTALL) -m 755 +INSTALL_DATA = $(INSTALL) -m 644 +INSTALL_HEADER = $(INSTALL) -m 644 +INSTALL_MAN = $(INSTALL) -m 644 +INSTALL_DOC = $(INSTALL) -m 644 +INSTALL_DIR = $(INSTALL) -m 755 -d + +CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create +CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create + +#----------------------------------------------------------------------------- +# Build configuration + +CrossCompiling = @CrossCompiling@ +CrossCompilePrefix = @CrossCompilePrefix@ +GhcUnregisterised = @Unregisterised@ + +# ArchSupportsSMP should be set iff there is support for that arch in +# rts/include/stg/SMP.h +ifeq "$(TargetArch_CPP)" "arm" +# We don't support load/store barriers pre-ARMv7. See #10433. +ArchSupportsSMP=$(if $(filter $(ARM_ISA),ARMv5 ARMv6),NO,YES) +else +ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64 riscv64))) +endif + +# The THREADED_RTS requires `BaseReg` to be in a register and the +# `GhcUnregisterised` mode doesn't allow that. +GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO)) + +# Whether to include GHCi in the compiler. Depends on whether the RTS linker +# has support for this OS/ARCH combination. +OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu))) +ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm aarch64))) + +ifeq "$(OsSupportsGHCi)$(ArchSupportsGHCi)" "YESYES" +GhcWithInterpreter=YES +else +GhcWithInterpreter=$(if $(findstring YES,$(DYNAMIC_GHC_PROGRAMS)),YES,NO) +endif + +# On Windows we normally want to make a relocatable bindist, to we +# ignore flags like libdir +ifeq "$(Windows_Host)" "YES" +RelocatableBuild = YES +else +RelocatableBuild = NO +endif + + +# runhaskell and hsc2hs are special, in that other compilers besides +# GHC might provide them. Systems with a package manager often come +# with tools to manage this kind of clash, e.g. RPM's +# update-alternatives. When building a distribution for such a system, +# we recommend setting both of the following to 'YES'. +# +# NO_INSTALL_RUNHASKELL = YES +# NO_INSTALL_HSC2HS = YES +# +# NB. we use negative tests here because for binary-distributions we cannot +# test build-time variables at install-time, so they must default to on. + +ifneq "$(DESTDIR)" "" +override DESTDIR := $(abspath $(DESTDIR)) +endif + +# We build the libraries at least the "vanilla" way (way "v") +# Technically we don't need the v way if DYNAMIC_GHC_PROGRAMS is YES, +# but with -dynamic-too it's cheap, and makes life easier. +GhcLibWays = v + +# In addition to the normal sequential way, the default is to also build +# profiled prelude libraries +# $(if $(filter ...)) allows controlling this expression from build.mk. +GhcLibWays += $(if $(filter $(BUILD_PROF_LIBS),NO),,p) + +# Backward compatibility: although it would be cleaner to test for +# PlatformSupportsSharedLibs, or perhaps a new variable BUILD_SHARED_LIBS, +# some users currently expect that DYNAMIC_GHC_PROGRAMS=NO in build.mk implies +# that dyn is not added to GhcLibWays. +GhcLibWays += $(if $(filter $(DYNAMIC_GHC_PROGRAMS),NO),,dyn) + +# Handy way to test whether we're building shared libs or not. +BuildSharedLibs=$(strip $(if $(findstring dyn,$(GhcLibWays)),YES,NO)) + +# In addition, the RTS is built in some further variations. Ways that +# make sense here: +# +# thr : threaded +# thr_p : threaded + profiled +# debug : debugging +# thr_debug : debugging + threaded +# p : profiled +# +# While the eventlog used to be enabled in only a subset of ways, we now always +# enable it. + +# Usually want the debug version +GhcRTSWays = debug + +# We always have the threaded versions, but note that SMP support may be disabled +# (see GhcWithSMP). +GhcRTSWays += thr thr_debug +GhcRTSWays += $(if $(findstring p, $(GhcLibWays)),thr_p,) +GhcRTSWays += $(if $(findstring dyn, $(GhcLibWays)),dyn debug_dyn thr_dyn thr_debug_dyn,) +GhcRTSWays += $(if $(findstring p, $(GhcLibWays)),thr_debug_p debug_p,) + +# We can only build GHCi threaded if we have a threaded RTS: +GhcThreaded = $(if $(findstring thr,$(GhcRTSWays)),YES,NO) + +# Configuration for libffi +UseSystemLibFFI=@UseSystemLibFFI@ +UseLibffiForAdjustors=@UseLibffiForAdjustors@ + +# GHC needs arch-specific tweak at least in +# rts/Libdw.c:set_initial_registers() +GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseLibdw@,NO)) + +#----------------------------------------------------------------------------- +# Settings + +# We are in the process of moving the settings file from being entirely +# generated by configure, to generated being by the build system. Many of these +# might become redundant. +# See Note [tooldir: How GHC finds mingw on Windows] + +GccExtraViaCOpts = @GccExtraViaCOpts@ +LdHasFilelist = @LdHasFilelist@ +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@ +SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ +SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ +SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ +SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ +SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ +SettingsLdCommand = @SettingsLdCommand@ +SettingsLdFlags = @SettingsLdFlags@ +SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ +SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ +SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ +SettingsRanlibCommand = @SettingsRanlibCommand@ +SettingsDllWrapCommand = @SettingsDllWrapCommand@ +SettingsWindresCommand = @SettingsWindresCommand@ +SettingsLibtoolCommand = @SettingsLibtoolCommand@ +SettingsTouchCommand = @SettingsTouchCommand@ +SettingsClangCommand = @SettingsClangCommand@ +SettingsLlcCommand = @SettingsLlcCommand@ +SettingsOptCommand = @SettingsOptCommand@ +SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ + ===================================== hadrian/src/Packages.hs ===================================== @@ -14,7 +14,7 @@ module Packages ( ghcPackages, isGhcPackage, -- * Package information - programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, + crossPrefix, programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, rtsContext, rtsBuildPath, libffiBuildPath, ensureConfigured ) where @@ -154,15 +154,20 @@ linter name = program name ("linters" -/- name) setPath :: Package -> FilePath -> Package setPath pkg path = pkg { pkgPath = path } +-- | Target prefix to prepend to executable names. +crossPrefix :: Action String +crossPrefix = do + cross <- flag CrossCompiling + targetPlatform <- setting TargetPlatformFull + return $ if cross then targetPlatform ++ "-" else "" + -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC -- built in 'Stage0' is called @ghc-stage1 at . If the given package is a -- 'Library', the function simply returns its name. programName :: Context -> Action String programName Context {..} = do - cross <- flag CrossCompiling - targetPlatform <- setting TargetPlatformFull - let prefix = if cross then targetPlatform ++ "-" else "" + prefix <- crossPrefix -- TODO: Can we extract this information from Cabal files? -- Alp: We could, but then the iserv package would have to -- use Cabal conditionals + a 'profiling' flag ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TupleSections, MultiWayIf #-} module Rules.BinaryDist where import Hadrian.Haskell.Cabal @@ -254,6 +254,7 @@ bindistRules = do -- other machine. need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) + copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do @@ -346,7 +347,9 @@ compressorExtension Bzip2 = "bz2" bindistInstallFiles :: [FilePath] bindistInstallFiles = [ "config.sub", "config.guess", "install-sh" - , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in", "mk" -/- "project.mk" + , "mk" -/- "config.mk.in" -- TODO: Remove when make is gone + , "mk" -/- "install.mk.in" -- TODO: Remove when make is gone + , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" , "README", "INSTALL" ] @@ -370,19 +373,20 @@ useGhcPrefix pkg | pkg == ghciWrapper = False | otherwise = True - -- | Which wrappers point to a specific package pkgToWrappers :: Package -> Action [String] -pkgToWrappers pkg - -- ghc also has the ghci script wrapper - | pkg == ghc = pure ["ghc", "ghci"] - | pkg == runGhc = pure ["runghc", "runhaskell"] - -- These are the packages which we want to expose to the user and hence - -- there are wrappers installed in the bindist. - | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] - = (:[]) <$> (programName =<< programContext Stage1 pkg) - | otherwise = pure [] - +pkgToWrappers pkg = do + prefix <- crossPrefix + if -- ghc also has the ghci script wrapper + -- N.B. programName would add the crossPrefix therefore we must do the + -- same here. + | pkg == ghc -> pure $ map (prefix++) ["ghc", "ghci"] + | pkg == runGhc -> pure $ map (prefix++) ["runghc", "runhaskell"] + -- These are the packages which we want to expose to the user and hence + -- there are wrappers installed in the bindist. + | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] + -> (:[]) <$> (programName =<< programContext Stage1 pkg) + | otherwise -> pure [] wrapper :: FilePath -> Action String wrapper "ghc" = ghcWrapper ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 7a7431a0ef586c0f1e602e382398b988c699dfc2 +Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69fe554e77145dff573b3f1a2df8323b0e09b56c...2e89556493ecbeddcc2151d3945837642aaab57b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69fe554e77145dff573b3f1a2df8323b0e09b56c...2e89556493ecbeddcc2151d3945837642aaab57b You're receiving 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 Aug 11 22:12:39 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 11 Aug 2022 18:12:39 -0400 Subject: [Git][ghc/ghc][wip/andreask/deep_discounts] A bit of cleanup Message-ID: <62f57ed763238_3d8149488503043fc@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/deep_discounts at Glasgow Haskell Compiler / GHC Commits: 9750d9e7 by Andreas Klebinger at 2022-08-12T00:12:10+02:00 A bit of cleanup - - - - - 4 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1394,7 +1394,7 @@ data ArgDiscount , ad_con_discount :: !(ConMap ConDiscount) -- ^ Discounts for specific constructors } -- A discount for the use of a function. - | FunDisc { ad_seq_discount :: !Int, ad_fun :: Id} + | FunDisc { ad_seq_discount :: !Int, ad_fun :: !Name} | NoSeqUse deriving Eq ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -907,14 +907,6 @@ interestingArg env e = | otherwise -> ConArg con (fn_args ++ arg_summaries) _ -> fn_summary - -- | ConArg con args <- fn_summary - -- = if (isClassTyCon $ dataConTyCon con) - -- then ValueArg - -- else ConArg con (args ++ [go env (depth-1) 0 arg]) - -- | otherwise = fn_summary - -- where - -- fn_summary = go env (depth-1) (n+1) fn - go env depth n (Tick _ a) = go env depth n a go env depth n (Cast e _) = go env depth n e go env depth n (Lam v e) ===================================== compiler/GHC/Core/Seq.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Core.Type( seqType, isTyVar ) import GHC.Core.Coercion( seqCo ) import GHC.Types.Id( idInfo ) import GHC.Utils.Misc (seqList) +import GHC.Types.Unique.FM (seqEltsUFM) -- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the -- compiler @@ -113,5 +114,12 @@ seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, seqUnfolding _ = () seqGuidance :: UnfoldingGuidance -> () -seqGuidance (UnfIfGoodArgs ns n b) = n `seq` (seqList ns ()) `seq` b `seq` () +seqGuidance (UnfIfGoodArgs ns n b) = n `seq` (seqList (map seqArgDiscount ns) ()) `seq` b `seq` () seqGuidance _ = () + +seqArgDiscount :: ArgDiscount -> () +seqArgDiscount (DiscSeq !_ sub_args) = seqEltsUFM seqConDiscount sub_args +seqArgDiscount !_ = () + +seqConDiscount :: ConDiscount -> () +seqConDiscount (ConDiscount !_ !_ sub_args) = seqList (map seqArgDiscount sub_args) () \ No newline at end of file ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -62,13 +62,11 @@ import GHC.Types.Tickish import qualified Data.ByteString as BS import Data.List (isPrefixOf) import GHC.Types.Unique.FM --- import GHC.Utils.Trace import Data.Maybe import GHC.Types.Var.Env import GHC.Utils.Panic.Plain (assert) -import GHC.Utils.Panic (pprPanic) import GHC.Data.Graph.UnVar --- import GHC.Utils.Trace (pprTrace) +import GHC.Utils.Trace (pprTraceDebug) @@ -262,8 +260,7 @@ calcUnfoldingGuidance opts is_top_bottoming (Tick t expr) | not (tickishIsCode t) -- non-code ticks don't matter for unfolding = calcUnfoldingGuidance opts is_top_bottoming expr calcUnfoldingGuidance opts is_top_bottoming expr - = -- (\r -> pprTrace "calcUnfoldingGuidance" (ppr expr $$ ppr r $$ ppr (sizeExpr opts bOMB_OUT_SIZE val_bndrs body) $$ ppr r $$ ppr is_top_bottoming) r) $ - case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of + = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of TooBig -> UnfNever SizeIs size cased_bndrs scrut_discount | uncondInline expr n_val_bndrs size @@ -275,10 +272,7 @@ calcUnfoldingGuidance opts is_top_bottoming expr -> UnfNever -- See Note [Do not inline top-level bottoming functions] | otherwise - -> - -- (if not (interesting_cased cased_bndrs) then id else pprTrace "UnfWhenDiscount" (ppr cased_bndrs)) - - UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs + -> UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs , ug_size = size , ug_res = scrut_discount } @@ -292,17 +286,6 @@ calcUnfoldingGuidance opts is_top_bottoming expr mk_discount :: VarEnv ArgDiscount -> Id -> ArgDiscount mk_discount cbs bndr = lookupWithDefaultVarEnv cbs NoSeqUse bndr - -- foldl' combine NoSeqUse cbs - -- where - -- combine acc (bndr', use) - -- | bndr == bndr' = acc `plus_disc` use - -- | otherwise = acc - - -- plus_disc :: ArgDiscount -> ArgDiscount -> ArgDiscount - -- plus_disc | isFunTy (idType bndr) = maxArgDiscount - -- | otherwise = combineArgDiscount - -- -- See Note [Function and non-function discounts] - {- Note [Inline unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We really want to inline unsafeCoerce, even when applied to boring @@ -482,95 +465,84 @@ sizeExpr :: UnfoldingOpts -- Forcing bOMB_OUT_SIZE early prevents repeated -- unboxing of the Int argument. sizeExpr opts !bOMB_OUT_SIZE top_args' expr - = let result = size_up depth_limit (mkUnVarSet top_args') expr - in - -- pprTrace "sizeExpr" (ppr expr) $ - -- pprTrace "sizeExpr2" (ppr result) $ - result + = size_up depth_limit (mkUnVarSet top_args') expr where depth_limit = unfoldingMaxGuideDepth opts size_up :: Int -> UnVarSet -> Expr Var -> ExprSize - size_up !depth !disc_args (Cast e _) = size_up depth disc_args e - size_up !depth disc_args (Tick _ e) = size_up depth disc_args e - size_up !_depth _disc_args (Type _) = sizeZero -- Types cost nothing - size_up !_depth _disc_args (Coercion _) = sizeZero - size_up !_depth _disc_args (Lit lit) = sizeN (litSize lit) - size_up !_depth disc_args (Var f) | isZeroBitId f = sizeZero + size_up !depth !arg_comps (Cast e _) = size_up depth arg_comps e + size_up !depth arg_comps (Tick _ e) = size_up depth arg_comps e + size_up !_depth _arg_comps (Type _) = sizeZero -- Types cost nothing + size_up !_depth _arg_comps (Coercion _) = sizeZero + size_up !_depth _arg_comps (Lit lit) = sizeN (litSize lit) + size_up !_depth arg_comps (Var f) | isZeroBitId f = sizeZero -- Make sure we get constructor discounts even -- on nullary constructors - | otherwise = size_up_call disc_args f [] 0 + | otherwise = size_up_call arg_comps f [] 0 - size_up !depth disc_args (App fun arg) - | isTyCoArg arg = size_up depth disc_args fun - | otherwise = size_up depth disc_args arg `addSizeNSD` - size_up_app depth disc_args fun [arg] (if isZeroBitExpr arg then 1 else 0) + size_up !depth arg_comps (App fun arg) + | isTyCoArg arg = size_up depth arg_comps fun + | otherwise = size_up depth arg_comps arg `addSizeNSD` + size_up_app depth arg_comps fun [arg] (if isZeroBitExpr arg then 1 else 0) - size_up !depth disc_args (Lam b e) - | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up depth (delUnVarSet disc_args b) e `addSizeN` 10) - | otherwise = size_up depth (delUnVarSet disc_args b) e + size_up !depth arg_comps (Lam b e) + | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up depth (delUnVarSet arg_comps b) e `addSizeN` 10) + | otherwise = size_up depth (delUnVarSet arg_comps b) e - size_up !depth disc_args (Let (NonRec binder rhs) body) - = let disc_args' = delUnVarSet disc_args binder + size_up !depth arg_comps (Let (NonRec binder rhs) body) + = let arg_comps' = delUnVarSet arg_comps binder in - size_up_rhs depth disc_args' (binder, rhs) `addSizeNSD` - size_up depth disc_args' body `addSizeN` + size_up_rhs depth arg_comps' (binder, rhs) `addSizeNSD` + size_up depth arg_comps' body `addSizeN` size_up_alloc binder - size_up !depth disc_args (Let (Rec pairs) body) + size_up !depth arg_comps (Let (Rec pairs) body) = let lhs_bnds = map fst pairs - disc_args' = delUnVarSetList disc_args lhs_bnds + arg_comps' = delUnVarSetList arg_comps lhs_bnds in - foldr (addSizeNSD . (size_up_rhs depth disc_args')) - (size_up depth disc_args' body `addSizeN` sum (map (size_up_alloc . fst) pairs)) + foldr (addSizeNSD . (size_up_rhs depth arg_comps')) + (size_up depth arg_comps' body `addSizeN` sum (map (size_up_alloc . fst) pairs)) pairs - size_up !depth disc_args (Case e _ _ alts) + size_up !depth arg_comps (Case e _ _ alts) | null alts - = size_up depth disc_args e -- case e of {} never returns, so take size of scrutinee + = size_up depth arg_comps e -- case e of {} never returns, so take size of scrutinee - size_up !depth disc_args (Case e _ _ alts) + size_up !depth arg_comps (Case e _ _ alts) -- Now alts is non-empty - | Just v <- is_top_arg e -- We are scrutinising an argument variable + -- We are scrutinising an argument variable or a subcomponent thereof. + | Just v <- is_top_arg e = let - -- If the constructor is then apply a discount for that constructor that - -- is equal to size_all_alts - size_this_alt. - -- This means the size of the function will be considered the same as if - -- we had replace the whole case with just the rhs of the alternative. - -- Which is what we want. - trim_size tot_size (Alt (DataAlt con) alt_bndrs _rhs) (SizeIs alt_size _ _) = + -- Compute size of alternatives + alt_sizes = map (size_up_alt depth (Just v) arg_comps) alts + + -- Apply a discount for a given constructor that brings the size down to just + -- the size of the alternative. + alt_size_discount tot_size (Alt (DataAlt con) alt_bndrs _rhs) (SizeIs alt_size _ _) = let trim_discount = max 10 $ tot_size - alt_size in Just (unitUFM con (ConDiscount con trim_discount (map (const NoSeqUse) alt_bndrs))) - trim_size _tot_size _ _alt_size = Nothing - - alt_sizes = map (size_up_alt depth (Just v) disc_args) alts + alt_size_discount _tot_size _ _alt_size = Nothing + -- Add up discounts from the alternatives added_alt_sizes = (foldr1 addAltSize alt_sizes) - max_alt_size = (foldr (maxSize bOMB_OUT_SIZE) 0 alt_sizes) + -- Compute size of the largest rhs + largest_alt_size = (foldr (maxSize bOMB_OUT_SIZE) 0 alt_sizes) - -- alts_size tries to compute a good discount for - -- the case when we are scrutinising an argument variable + -- alts_size tries to compute a good discount for + -- the case when we are scrutinising an argument variable or subcomponent thereof alts_size (SizeIs tot tot_disc tot_scrut) - -- Size of all alternatives combined - max_alt_size - - = -- TODO: Perhaps worth having a default-alternative discount (we take the default branch) - -- and "default" discout we apply if no other discount matched. (E.g the alternative was too big) - -- Currently we only have the later - -- Worst case we take the biggest alternative, so the discount is equivalent to eliminating all other - -- alternatives. - let default_alt_discount = 20 + tot - max_alt_size - alt_discounts = unitUFM v $ DiscSeq default_alt_discount $ plusUFMList $ catMaybes $ zipWith (trim_size tot) alts alt_sizes - in + largest_alt_size + = let default_alt_discount = 20 + tot - largest_alt_size + alt_discounts = unitUFM v $ DiscSeq default_alt_discount $ plusUFMList $ catMaybes $ zipWith (alt_size_discount tot) alts alt_sizes + in SizeIs tot (tot_disc `plusDiscountEnv` (alt_discounts)) tot_scrut - -- If the variable is known, we produce a - -- discount that will take us back to 'max', - -- the size of the largest alternative The - -- 1+ is a little discount for reduced - -- allocation in the caller + -- If the variable is known but we don't have a + -- specific constructor discount for it, we produce a + -- discount that will take us back to 'largest_alt_size', + -- the size of the largest alternative. -- -- Notice though, that we return tot_disc, -- the total discount from all branches. I @@ -581,18 +553,18 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr -- Why foldr1? We might get TooBig already after the first few alternatives -- in which case we don't have to look at the remaining ones. alts_size added_alt_sizes -- alts is non-empty - max_alt_size + largest_alt_size -- Good to inline if an arg is scrutinised, because -- that may eliminate allocation in the caller -- And it eliminates the case itself where - is_top_arg (Var v) | v `elemUnVarSet` disc_args = Just v + is_top_arg (Var v) | v `elemUnVarSet` arg_comps = Just v is_top_arg (Cast e _) = is_top_arg e is_top_arg _ = Nothing - size_up !depth disc_args (Case e _ _ alts) = size_up depth disc_args e `addSizeNSD` - foldr (addAltSize . (size_up_alt depth Nothing disc_args) ) case_size alts + size_up !depth arg_comps (Case e _ _ alts) = size_up depth arg_comps e `addSizeNSD` + foldr (addAltSize . (size_up_alt depth Nothing arg_comps) ) case_size alts where case_size | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10) @@ -629,25 +601,25 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr | otherwise = False - size_up_rhs !depth !disc_args (bndr, rhs) + size_up_rhs !depth !arg_comps (bndr, rhs) | Just join_arity <- isJoinId_maybe bndr -- Skip arguments to join point , (bndrs, body) <- collectNBinders join_arity rhs - = size_up depth (delUnVarSetList disc_args bndrs) body + = size_up depth (delUnVarSetList arg_comps bndrs) body | otherwise - = size_up depth disc_args rhs + = size_up depth arg_comps rhs ------------ -- size_up_app is used when there's ONE OR MORE value args - size_up_app depth !disc_args (App fun arg) args voids - | isTyCoArg arg = size_up_app depth disc_args fun args voids - | isZeroBitExpr arg = size_up_app depth disc_args fun (arg:args) (voids + 1) - | otherwise = size_up depth disc_args arg `addSizeNSD` - size_up_app depth disc_args fun (arg:args) voids - size_up_app _depth disc_args (Var fun) args voids = size_up_call disc_args fun args voids - size_up_app depth disc_args (Tick _ expr) args voids = size_up_app depth disc_args expr args voids - size_up_app depth disc_args (Cast expr _) args voids = size_up_app depth disc_args expr args voids - size_up_app depth disc_args other args voids = size_up depth disc_args other `addSizeN` + size_up_app depth !arg_comps (App fun arg) args voids + | isTyCoArg arg = size_up_app depth arg_comps fun args voids + | isZeroBitExpr arg = size_up_app depth arg_comps fun (arg:args) (voids + 1) + | otherwise = size_up depth arg_comps arg `addSizeNSD` + size_up_app depth arg_comps fun (arg:args) voids + size_up_app _depth arg_comps (Var fun) args voids = size_up_call arg_comps fun args voids + size_up_app depth arg_comps (Tick _ expr) args voids = size_up_app depth arg_comps expr args voids + size_up_app depth arg_comps (Cast expr _) args voids = size_up_app depth arg_comps expr args voids + size_up_app depth arg_comps other args voids = size_up depth arg_comps other `addSizeN` callSize (length args) voids -- if the lhs is not an App or a Var, or an invisible thing like a -- Tick or Cast, then we should charge for a complete call plus the @@ -655,27 +627,28 @@ sizeExpr opts !bOMB_OUT_SIZE top_args' expr ------------ size_up_call :: UnVarSet -> Id -> [CoreExpr] -> Int -> ExprSize - size_up_call !disc_args fun val_args voids + size_up_call !arg_comps fun val_args voids = case idDetails fun of FCallId _ -> sizeN (callSize (length val_args) voids) DataConWorkId dc -> conSize dc (length val_args) PrimOpId op _ -> primOpSize op (length val_args) - ClassOpId _ -> classOpSize opts disc_args val_args - _ -> funSize opts disc_args fun (length val_args) voids + ClassOpId _ -> classOpSize opts arg_comps val_args + _ -> funSize opts arg_comps fun (length val_args) voids ------------ -- Take into acount the binders of scrutinized argument binders -- But not too deeply! Hence we check if we exhausted depth. - size_up_alt depth m_top_arg !disc_args (Alt alt_con bndrs rhs) + -- If so we simply ingore the case binders. + size_up_alt depth m_top_arg !arg_comps (Alt alt_con bndrs rhs) | Just top_arg <- m_top_arg , depth > 0 , DataAlt con <- alt_con = - let alt_size = size_up depth (extendUnVarSetList bndrs disc_args) rhs `addSizeN` 10 - -- let alt_size = size_up (disc_args) rhs `addSizeN` 10 + let alt_size = size_up depth (extendUnVarSetList bndrs arg_comps) rhs `addSizeN` 10 + -- let alt_size = size_up (arg_comps) rhs `addSizeN` 10 in asExprSize top_arg alt_size con bndrs - size_up_alt depth _ disc_args (Alt _con bndrs rhs) = size_up depth (delUnVarSetList disc_args bndrs) rhs `addSizeN` 10 + size_up_alt depth _ arg_comps (Alt _con bndrs rhs) = size_up depth (delUnVarSetList arg_comps bndrs) rhs `addSizeN` 10 -- Don't charge for args, so that wrappers look cheap -- (See comments about wrappers with Case) -- @@ -797,7 +770,7 @@ funSize opts !top_args fun n_val_args voids -- See Note [Function and non-function discounts] arg_discount | some_val_args && fun `elemUnVarSet` top_args = -- pprTrace "mkFunSize" (ppr fun) $ - unitUFM fun (FunDisc (unfoldingFunAppDiscount opts) fun) + unitUFM fun (FunDisc (unfoldingFunAppDiscount opts) (idName fun)) | otherwise = mempty -- If the function is an argument and is applied -- to some values, give it an arg-discount @@ -1026,13 +999,11 @@ plusDiscountEnv el er = plusUFM_C combineArgDiscount el er classOpArgDiscount :: Int -> ArgDiscount classOpArgDiscount n = SomeArgUse n --- We computes the size of a case alternative. --- Now we want to transfer to discount from scrutinizing the constructor binders --- to the constructor discounts for the current scrutinee. +-- After computing the discounts for an alternatives rhs we transfer discounts from the +-- alt binders to the constructor specific discount of the scrutinee for the given constructor. asExprSize :: Id -> ExprSize -> DataCon -> [Id] -> ExprSize asExprSize _ TooBig _ _ = TooBig asExprSize scrut (SizeIs n arg_discs s_d) con alt_bndrs = - -- pprTrace "asExprSize" (ppr (scrut, (SizeIs n arg_discs s_d))) $ let (alt_discount_bags, top_discounts) = partitionWithKeyUFM (\k _v -> k `elem` map getUnique alt_bndrs) arg_discs alt_discount_map = alt_discount_bags alt_bndr_uses = map (\bndr -> lookupWithDefaultVarEnv alt_discount_map NoSeqUse bndr ) alt_bndrs :: [ArgDiscount] @@ -1044,9 +1015,8 @@ mkConUse :: DataCon -> [ArgDiscount] -> ArgDiscount mkConUse con uses = DiscSeq 0 - -- We apply a penalty of 1 per case alternative, so here we apply a discount of 1 by eliminated - -- case alternative. - -- And then one more because we get rid of a conditional branch which is always good. + -- We apply a penalty of 1 per case alternative, so here we apply a discount of 1 per *eliminated* + -- case alternative. And then one more because we get rid of a conditional branch which is always good. (unitUFM con (ConDiscount con (length uses) uses)) combineArgDiscount :: ArgDiscount -> ArgDiscount -> ArgDiscount @@ -1058,7 +1028,9 @@ combineArgDiscount (DiscSeq d1 m1) (SomeArgUse d2) = DiscSeq (d1 + d2) m1 combineArgDiscount (DiscSeq d1 m1) (DiscSeq d2 m2) = DiscSeq (d1 + d2) (plusUFM_C combineMapEntry m1 m2) -- See Note [Function and non-function discounts] why we need this combineArgDiscount f1@(FunDisc d1 _f1) f2@(FunDisc d2 _f2) = if d1 > d2 then f1 else f2 -combineArgDiscount u1 u2 = pprPanic "Variable seemingly discounted as both function and constructor" (ppr u1 $$ ppr u2) +-- This can happen either through shadowing or with things like unsafeCoerce. A good idea to warn for debug builds but we don't want to panic here. +combineArgDiscount f1@(FunDisc _d _n) u2 = pprTraceDebug "Variable seemingly discounted as both function and constructor" (ppr f1 $$ ppr u2) f1 +combineArgDiscount u1 f2@(FunDisc _d _n) = pprTraceDebug "Variable seemingly discounted as both function and constructor" (ppr u1 $$ ppr f2) f2 combineMapEntry :: ConDiscount -> ConDiscount -> ConDiscount combineMapEntry (ConDiscount c1 dc1 u1) (ConDiscount c2 dc2 u2) = @@ -1609,16 +1581,24 @@ This kind of thing can occur if you have which Roman did. - +Note [Minimum value discount] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We always give *some* benefit to value arguments. +A discount of 10 per arg because we replace the arguments +and another of 10 if it's some non-trivial value. +However when computing unfolding guidance we might have come to +the conclusion that certain argument values deservere little or no +discount. But we want to chance of inlining to only ever increase as +more is known about the argument to keep things more predictable. So +we always give at least 10 discount if the argument is a value. No matter +what the actual value is. -} computeDiscount :: [ArgDiscount] -> Int -> [ArgSummary] -> CallCtxt -> Int computeDiscount arg_discounts res_discount arg_infos cont_info - = - -- pprTrace "computeDiscount" (ppr arg_infos $$ ppr arg_discounts $$ ppr total_arg_discount) $ - 10 -- Discount of 10 because the result replaces the call + = 10 -- Discount of 10 because the result replaces the call -- so we count 10 for the function itself + 10 * length actual_arg_discounts @@ -1630,32 +1610,18 @@ computeDiscount arg_discounts res_discount arg_infos cont_info actual_arg_discounts = zipWith mk_arg_discount arg_discounts arg_infos total_arg_discount = sum actual_arg_discounts - -- mk_arg_discount _ TrivArg = 0 - -- mk_arg_discount _ NonTrivArg = 10 - -- mk_arg_discount discount ValueArg = discount - --- Note [Minimum value discount] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- We always give *some* benefit to value arguments. --- A discount of 10 per arg because we replace the arguments --- and another of 10 if it's some non-trivial value. --- However when computing unfolding guidance we might come to --- the conclusion that inlining something if a certain argument --- is let's say `Nothing` is pointless. --- beyond + -- See Note [Minimum value discount] mk_arg_discount :: ArgDiscount -> ArgSummary -> Int mk_arg_discount _ TrivArg = 0 - mk_arg_discount NoSeqUse _ = 10 mk_arg_discount _ NonTrivArg = 10 - mk_arg_discount discount ValueArg = max (ad_seq_discount discount) 10 + mk_arg_discount NoSeqUse _ = 10 + mk_arg_discount discount ValueArg = max 10 (ad_seq_discount discount) mk_arg_discount (DiscSeq seq_discount con_discounts) (ConArg con args) -- There is a discount specific to this constructor, use that. - -- BUT only use it if the specific one is larger than the generic one. - -- Otherwise we might stop inlining something if the constructor becomes visible. | Just (ConDiscount _ branch_dc arg_discounts) <- lookupUFM con_discounts con = max 10 $ max seq_discount (branch_dc + (sum $ zipWith mk_arg_discount arg_discounts args)) -- Otherwise give it the generic seq discount - | otherwise = seq_discount + | otherwise = max 10 seq_discount mk_arg_discount (SomeArgUse d) ConArg{} = max 10 d mk_arg_discount (FunDisc d _) (ConArg{}) -- How can this arise? With dictionary constructors for example. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9750d9e7275a23c9638be1ffc953a0caffdaa4b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9750d9e7275a23c9638be1ffc953a0caffdaa4b8 You're receiving 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 Aug 9 00:11:07 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 20:11:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: gitlab-ci: Introduce validation job for aarch64 cross-compilation Message-ID: <62f1a61bd5560_25b0164d24c6454b1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - 5b0ff652 by Ben Gamari at 2022-08-08T20:10:46-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - 3f8f6678 by Krzysztof Gogolewski at 2022-08-08T20:10:46-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Unit/Types.hs - hadrian/bindist/Makefile - libraries/process - rts/PrimOps.cmm - rts/include/Cmm.h - + testsuite/tests/array/should_run/T21962.hs - testsuite/tests/array/should_run/all.T - testsuite/tests/linters/notes.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -564,15 +565,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${CROSS_TARGET:-}" ]; then + args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" ) + fi + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} + +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +617,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +640,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +806,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/gen_ci.hs ===================================== @@ -116,6 +116,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +159,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } + llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] + ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] -- | The hadrian flavour string we are going to use for this build @@ -597,7 +611,8 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - + , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -774,6 +789,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -1378,6 +1378,67 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3857,6 +3918,66 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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\")", + "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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== compiler/GHC/Cmm.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Cmm ( module GHC.Cmm.Expr, -- * Pretty-printing - pprCmms, pprCmmGroup, pprSection, pprStatic + pprCmmGroup, pprSection, pprStatic ) where import GHC.Prelude @@ -379,12 +379,6 @@ pprBBlock (BasicBlock ident stmts) = -- -- These conventions produce much more readable Cmm output. -pprCmms :: (OutputableP Platform info, OutputableP Platform g) - => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc -pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms)) - where - separator = space $$ text "-------------------" $$ space - pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g) => Platform -> GenCmmGroup d info g -> SDoc pprCmmGroup platform tops ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -294,9 +294,6 @@ data CLabel instance Show CLabel where show = showPprUnsafe . pprDebugCLabel genericPlatform -instance Outputable CLabel where - ppr = text . show - data ModuleLabelKind = MLK_Initializer String | MLK_InitializerArray @@ -1412,19 +1409,19 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] AsmStyle | use_leading_underscores -> pp_cSEP <> doc _ -> doc - tempLabelPrefixOrUnderscore :: Platform -> SDoc - tempLabelPrefixOrUnderscore platform = case sty of + tempLabelPrefixOrUnderscore :: SDoc + tempLabelPrefixOrUnderscore = case sty of AsmStyle -> asmTempLabelPrefix platform CStyle -> char '_' in case lbl of LocalBlockLabel u -> case sty of - AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u + AsmStyle -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u + CStyle -> tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u AsmTempLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + -> tempLabelPrefixOrUnderscore <> pprUniqueAlways u AsmTempDerivedLabel l suf -> asmTempLabelPrefix platform @@ -1474,7 +1471,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CStyle -> ppr name <> ppIdFlavor flavor SRTLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt" RtsLabel (RtsApFast (NonDetFastString str)) -> maybe_underscore $ ftext str <> text "_fast" @@ -1514,7 +1511,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr" LargeBitmapLabel u - -> maybe_underscore $ tempLabelPrefixOrUnderscore platform + -> maybe_underscore $ tempLabelPrefixOrUnderscore <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') -- until that gets resolved we'll just force them to start ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -50,14 +50,14 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock config top_info) blocks) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl platform lbl Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ -- pprProcAlignment config $$ (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' + then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain @@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> ppr info_lbl + <+> pdoc platform info_lbl <+> char '-' - <+> ppr (mkDeadStripPreventer info_lbl) + <+> pdoc platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -87,9 +87,6 @@ pprAlignForSection _platform _seg -- .balign is stable, whereas .align is platform dependent. = text "\t.balign 8" -- always 8 -instance Outputable Instr where - ppr = pprInstr genericPlatform - -- | Print section header and appropriate alignment for that section. -- -- This one will emit the header: @@ -118,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel asmLbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -138,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then ppr (mkAsmTempEndLabel info_lbl) <> char ':' + then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' else empty) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -235,7 +232,7 @@ pprImm _ (ImmInt i) = int i pprImm _ (ImmInteger i) = integer i pprImm p (ImmCLbl l) = pdoc p l pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i -pprImm _ (ImmLit s) = s +pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! pprImm _ (ImmFloat f) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -59,7 +59,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -67,14 +67,8 @@ data Imm | ImmConstantDiff Imm Imm deriving (Eq, Show) -instance Show SDoc where - show = showPprUnsafe . ppr - -instance Eq SDoc where - lhs == rhs = show lhs == show rhs - strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do let code dst = toOL [ LD II32 dst tocAddr ] - tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]")) + tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]") return (Any II32 code) | target32Bit platform = do reg <- getPicBaseNat $ archWordFormat (target32Bit platform) ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -240,7 +240,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/PPC/Regs.hs ===================================== @@ -133,7 +133,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -147,7 +147,7 @@ data Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -432,7 +432,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pdoc platform l ImmIndex l i -> pdoc platform l <> char '+' <> int i - ImmLit s -> s + ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -55,7 +55,6 @@ import GHC.Platform.Reg.Class import GHC.Cmm import GHC.Cmm.CLabel ( CLabel ) -import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -111,7 +110,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit SDoc -- Simple string + | ImmLit String | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -119,7 +118,7 @@ data Imm | ImmConstantDiff Imm Imm strImmLit :: String -> Imm -strImmLit s = ImmLit (text s) +strImmLit s = ImmLit s litToImm :: CmmLit -> Imm ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -363,7 +363,7 @@ emitTickyCounter cloType tickee Just (CgIdInfo { cg_lf = cg_lf }) | isLFThunk cg_lf -> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf - _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -- | -- #name_types# @@ -282,24 +281,9 @@ pprOccName (OccName sp occ) = getPprStyle $ \ sty -> if codeStyle sty then ztext (zEncodeFS occ) - else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) - where - pp_occ = sdocOption sdocSuppressUniques $ \case - True -> text (strip_th_unique (unpackFS occ)) - False -> ftext occ - - -- See Note [Suppressing uniques in OccNames] - strip_th_unique ('[' : c : _) | isAlphaNum c = [] - strip_th_unique (c : cs) = c : strip_th_unique cs - strip_th_unique [] = [] + else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp)) {- -Note [Suppressing uniques in OccNames] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is a hack to de-wobblify the OccNames that contain uniques from -Template Haskell that have been turned into a string in the OccName. -See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs" - ************************************************************************ * * \subsection{Construction} ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -207,7 +207,7 @@ pprModule mod@(Module p n) = getPprStyle doc | qualModule sty mod = case p of HoleUnit -> angleBrackets (pprModuleName n) - _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n + _ -> ppr p <> char ':' <> pprModuleName n | otherwise = pprModuleName n ===================================== hadrian/bindist/Makefile ===================================== @@ -83,6 +83,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 7a7431a0ef586c0f1e602e382398b988c699dfc2 +Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 ===================================== rts/PrimOps.cmm ===================================== @@ -350,6 +350,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init ) StgMutArrPtrs_ptrs(arr) = n; StgMutArrPtrs_size(arr) = size; + /* Ensure that the card array is initialized */ + if (n != 0) { + setCardsValue(arr, 0, n, 0); + } + // Initialise all elements of the array with the value in R2 p = arr + SIZEOF_StgMutArrPtrs; for: ===================================== rts/include/Cmm.h ===================================== @@ -870,10 +870,11 @@ /* * Set the cards in the array pointed to by arr for an * update to n elements, starting at element dst_off to value (0 to indicate - * clean, 1 to indicate dirty). + * clean, 1 to indicate dirty). n must be non-zero. */ #define setCardsValue(arr, dst_off, n, value) \ W_ __start_card, __end_card, __cards, __dst_cards_p; \ + ASSERT(n != 0); \ __dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \ __start_card = mutArrPtrCardDown(dst_off); \ __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \ ===================================== testsuite/tests/array/should_run/T21962.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.IO +import GHC.Exts + +main :: IO () +main = do + IO $ \s0 -> case newArray# 0# () s0 of (# s1, arr #) -> (# s1, () #) ===================================== testsuite/tests/array/should_run/all.T ===================================== @@ -23,3 +23,4 @@ test('arr017', when(fast(), skip), compile_and_run, ['']) test('arr018', when(fast(), skip), compile_and_run, ['']) test('arr019', normal, compile_and_run, ['']) test('arr020', normal, compile_and_run, ['']) +test('T21962', normal, compile_and_run, ['']) ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -44,7 +44,6 @@ ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-bo ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] -ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell] ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37ece3c67a9a75717d1f5be942d1f831df64994a...3f8f6678fbf3686fc6ffc73cbf3db9b485ef53ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37ece3c67a9a75717d1f5be942d1f831df64994a...3f8f6678fbf3686fc6ffc73cbf3db9b485ef53ee You're receiving 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 Aug 10 05:21:35 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 01:21:35 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Relax instances for Functor combinators; put superclass on Class1 to make non-breaking Message-ID: <62f3405f5f56e_d270451d248939@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4b5a4e99 by John Ericson at 2022-08-10T01:21:16-04:00 Relax instances for Functor combinators; put superclass on Class1 to make non-breaking The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - a32663b3 by Douglas Wilson at 2022-08-10T01:21:20-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - cd6068ee by Douglas Wilson at 2022-08-10T01:21:20-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - 051628b4 by Trevis Elser at 2022-08-10T01:21:24-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 30 changed files: - docs/users_guide/bugs.rst - docs/users_guide/exts/binary_literals.rst - docs/users_guide/exts/constrained_class_methods.rst - docs/users_guide/exts/constraint_kind.rst - docs/users_guide/exts/datatype_contexts.rst - docs/users_guide/exts/deriving_extra.rst - docs/users_guide/exts/duplicate_record_fields.rst - docs/users_guide/exts/empty_case.rst - docs/users_guide/exts/empty_data_deriving.rst - docs/users_guide/exts/existential_quantification.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/explicit_namespaces.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/field_selectors.rst - docs/users_guide/exts/flexible_contexts.rst - docs/users_guide/exts/functional_dependencies.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/generics.rst - docs/users_guide/exts/hex_float_literals.rst - docs/users_guide/exts/import_qualified_post.rst - docs/users_guide/exts/instances.rst - docs/users_guide/exts/kind_signatures.rst - docs/users_guide/exts/let_generalisation.rst - docs/users_guide/exts/linear_types.rst - docs/users_guide/exts/multi_param_type_classes.rst - docs/users_guide/exts/newtype_deriving.rst - docs/users_guide/exts/nk_patterns.rst - docs/users_guide/exts/nullary_type_classes.rst - docs/users_guide/exts/nullary_types.rst - docs/users_guide/exts/numeric_underscores.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7c7ae9a406bb2b87f9aa5566ccfe5fe371cfb08...051628b4589e0c5e8bae78aaa7698201a5f1071d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7c7ae9a406bb2b87f9aa5566ccfe5fe371cfb08...051628b4589e0c5e8bae78aaa7698201a5f1071d You're receiving 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 Aug 12 18:00:18 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 Aug 2022 14:00:18 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] 2 commits: Fat Interface Files Message-ID: <62f69532c9ffc_3d81494883c6370e8@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 0a5c84c7 by Matthew Pickering at 2022-08-12T19:00:12+01:00 Fat Interface Files This commit adds three new flags * -fwrite-fat-interface: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for a fat interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of fat interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 51f6ab03 by Matthew Pickering at 2022-08-12T19:00:12+01:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - 30 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Backpack.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/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Unit/Home/ModInfo.hs - + compiler/GHC/Unit/Module/FatIface.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Status.hs - compiler/ghc.cabal.in - docs/users_guide/phases.rst - ghc/GHCi/Leak.hs - ghc/Main.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T20300/T20300.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bdfda1ac79916487b7a64f4bbd611ca7ed7a86a...51f6ab03a43df1a3eb422e9688b90518c40331ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bdfda1ac79916487b7a64f4bbd611ca7ed7a86a...51f6ab03a43df1a3eb422e9688b90518c40331ed You're receiving 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 Aug 10 10:02:42 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 06:02:42 -0400 Subject: [Git][ghc/ghc][master] Updates language extension documentation Message-ID: <62f382427c6d4_d27044b80c2116dc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 30 changed files: - docs/users_guide/bugs.rst - docs/users_guide/exts/binary_literals.rst - docs/users_guide/exts/constrained_class_methods.rst - docs/users_guide/exts/constraint_kind.rst - docs/users_guide/exts/datatype_contexts.rst - docs/users_guide/exts/deriving_extra.rst - docs/users_guide/exts/duplicate_record_fields.rst - docs/users_guide/exts/empty_case.rst - docs/users_guide/exts/empty_data_deriving.rst - docs/users_guide/exts/existential_quantification.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/explicit_namespaces.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/field_selectors.rst - docs/users_guide/exts/flexible_contexts.rst - docs/users_guide/exts/functional_dependencies.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/generics.rst - docs/users_guide/exts/hex_float_literals.rst - docs/users_guide/exts/import_qualified_post.rst - docs/users_guide/exts/instances.rst - docs/users_guide/exts/kind_signatures.rst - docs/users_guide/exts/let_generalisation.rst - docs/users_guide/exts/linear_types.rst - docs/users_guide/exts/multi_param_type_classes.rst - docs/users_guide/exts/newtype_deriving.rst - docs/users_guide/exts/nk_patterns.rst - docs/users_guide/exts/nullary_type_classes.rst - docs/users_guide/exts/nullary_types.rst - docs/users_guide/exts/numeric_underscores.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc76439de605bb833d6e226b176879cb0d5262ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc76439de605bb833d6e226b176879cb0d5262ce You're receiving 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 Aug 12 15:40:09 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 Aug 2022 11:40:09 -0400 Subject: [Git][ghc/ghc][wip/llvm-initializers] CmmToLlvm: Don't aliasify builtin LLVM variables Message-ID: <62f674594d59a_3d8149489a456266f@gitlab.mail> Ben Gamari pushed to branch wip/llvm-initializers at Glasgow Haskell Compiler / GHC Commits: a7300809 by Ben Gamari at 2022-08-12T11:39:59-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - 1 changed file: - compiler/GHC/CmmToLlvm/Base.hs Changes: ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Logger import Data.Maybe (fromJust) import Control.Monad (ap) -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, isPrefixOf) import Data.Ord (comparing) -- ---------------------------------------------------------------------------- @@ -504,6 +504,12 @@ generateExternDecls = do modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | Is a variable one of the special @$llvm@ globals? +isBuiltinLlvmVar :: LlvmVar -> Bool +isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) = + "$llvm" `isPrefixOf` unpackFS lbl +isBuiltinLlvmVar _ = False + -- | Here we take a global variable definition, rename it with a -- @$def@ suffix, and generate the appropriate alias. aliasify :: LMGlobal -> LlvmM [LMGlobal] @@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal] -- Here we obtain the indirectee's precise type and introduce -- fresh aliases to both the precise typed label (lbl$def) and the i8* -- typed (regular) label of it with the matching new names. -aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) - (Just orig)) = do +aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias) + (Just orig)) + | not $ isBuiltinLlvmVar var = do let defLbl = llvmDefLabel lbl LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig defOrigLbl = llvmDefLabel origLbl @@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') ] -aliasify (LMGlobal var val) = do +aliasify (LMGlobal var val) + | not $ isBuiltinLlvmVar var = do let LMGlobalVar lbl ty link sect align const = var defLbl = llvmDefLabel lbl @@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do return [ LMGlobal defVar val , LMGlobal aliasVar (Just aliasVal) ] +aliasify global = pure [global] -- Note [Llvm Forward References] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do -- away with casting the alias to the desired type in @getSymbolPtr@ -- and instead just emit a reference to the definition symbol directly. -- This is the @Just@ case in @getSymbolPtr at . +-- +-- Note that we must take care not to turn LLVM's builtin variables into +-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a730080952c35d0f4cdfbd9f1d3ea9fbdd14ebb5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a730080952c35d0f4cdfbd9f1d3ea9fbdd14ebb5 You're receiving 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 Aug 12 15:39:55 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 Aug 2022 11:39:55 -0400 Subject: [Git][ghc/ghc][wip/llvm-initializers] CmmToLlvm: Don't aliasify builtin LLVM variables Message-ID: <62f6744b4c917_3d814948850562221@gitlab.mail> Ben Gamari pushed to branch wip/llvm-initializers at Glasgow Haskell Compiler / GHC Commits: 28d03900 by Ben Gamari at 2022-08-12T11:37:51-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. - - - - - 1 changed file: - compiler/GHC/CmmToLlvm/Base.hs Changes: ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Logger import Data.Maybe (fromJust) import Control.Monad (ap) -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, isPrefixOf) import Data.Ord (comparing) -- ---------------------------------------------------------------------------- @@ -504,6 +504,12 @@ generateExternDecls = do modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | Is a variable one of the special @$llvm@ globals? +isBuiltinLlvmVar :: LlvmVar -> Bool +isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) = + "$llvm" `isPrefixOf` unpackFS lbl +isBuiltinLlvmVar _ = False + -- | Here we take a global variable definition, rename it with a -- @$def@ suffix, and generate the appropriate alias. aliasify :: LMGlobal -> LlvmM [LMGlobal] @@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal] -- Here we obtain the indirectee's precise type and introduce -- fresh aliases to both the precise typed label (lbl$def) and the i8* -- typed (regular) label of it with the matching new names. -aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) - (Just orig)) = do +aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias) + (Just orig)) + | not $ isBuiltinLlvmVar var = do let defLbl = llvmDefLabel lbl LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig defOrigLbl = llvmDefLabel origLbl @@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') ] -aliasify (LMGlobal var val) = do +aliasify (LMGlobal var val) + | not $ isBuiltinLlvmVar var = do let LMGlobalVar lbl ty link sect align const = var defLbl = llvmDefLabel lbl @@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do return [ LMGlobal defVar val , LMGlobal aliasVar (Just aliasVal) ] +aliasify global = pure [global] -- Note [Llvm Forward References] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do -- away with casting the alias to the desired type in @getSymbolPtr@ -- and instead just emit a reference to the definition symbol directly. -- This is the @Just@ case in @getSymbolPtr at . +-- +-- Note that we must take care not to turn LLVM's builtin variables into +-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d039007d05eb4bf2cde6457b66bc9a2182fdc3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d039007d05eb4bf2cde6457b66bc9a2182fdc3 You're receiving 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 Aug 10 10:02:08 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 06:02:08 -0400 Subject: [Git][ghc/ghc][master] 2 commits: testsuite: 21651 add test for closeFdWith + setNumCapabilities Message-ID: <62f3822038a34_d27044b8342061f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - 4 changed files: - libraries/base/GHC/Event/Thread.hs - + testsuite/tests/concurrent/should_run/T21651.hs - + testsuite/tests/concurrent/should_run/T21651.stdout - testsuite/tests/concurrent/should_run/all.T Changes: ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Event.Thread -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) @@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, - threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) + threadStatus, writeTVar, newTVarIO, readTVar, retry, + throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, @@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM +import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) @@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () -closeFdWith close fd = do - eventManagerArray <- readIORef eventManager - let (low, high) = boundsIOArray eventManagerArray - mgrs <- flip mapM [low..high] $ \i -> do - Just (_,!mgr) <- readIOArray eventManagerArray i - return mgr - -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. - -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have - -- to use uninterruptible mask. - uninterruptibleMask_ $ do - tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd - cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables - close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) +closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys) + -- The array inside 'eventManager' can be swapped out at any time, see + -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by + -- checking the array bounds before and after. When such a swap has + -- happened we cleanup and try again + close_loop = do + eventManagerArray <- readIORef eventManager + let ema_bounds@(low, high) = boundsIOArray eventManagerArray + mgrs <- flip mapM [low..high] $ \i -> do + Just (_,!mgr) <- readIOArray eventManagerArray i + return mgr + + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. + -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have + -- to use uninterruptible mask. + join $ uninterruptibleMask_ $ do + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager + -- Here we exploit Note [The eventManager Array] + if new_ema_bounds /= ema_bounds + then do + -- the array has been modified. + -- mgrs still holds the right EventManagers, by the Note. + -- new_ema_bounds must be larger than ema_bounds, by the note. + -- return the MVars we took and try again + sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables + pure close_loop + else do + -- We surely have taken all the appropriate MVars. Even if the array + -- has been swapped, our mgrs is still correct. + -- Remove the Fd from all callback tables, close the Fd, and run all + -- callbacks. + cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables + close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) + pure (pure ()) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId - (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager - mmgr <- readIOArray eventManagerArray cap - return $ fmap snd mmgr + let r = boundsIOArray eventManagerArray + (cap, _) <- threadCapability t + -- It is possible that we've just increased the number of capabilities and the + -- new EventManager has not yet been constructed by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- Two options to proceed: + -- 1) return the EventManager for capability 0. This is guaranteed to exist, + -- and "shouldn't" cause any correctness issues. + -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, + -- because we must be on a brand capability and there must be a call to + -- 'ioManagerCapabilitiesChanged' pending. + -- + -- We take the second option, with the yield, judging it the most robust. + if not (inRange r cap) + then yield >> getSystemEventManager + else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do @@ -191,6 +229,22 @@ getSystemEventManager_ = do foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A mutable array holding the current EventManager for each capability +-- An entry is Nothing only while the eventmanagers are initialised, see +-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'. +-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality +-- 'cap'. +-- The array will be swapped with newer arrays when the number of capabilities +-- changes(via 'setNumCapabilities'). However: +-- * the size of the arrays will never decrease; and +-- * The 'EventManager's in the array are not replaced with other +-- 'EventManager' constructors. +-- +-- This is a similar strategy as the rts uses for it's +-- capabilities array (n_capabilities is the size of the array, +-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities @@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged = startIOManagerThread new_eventManagerArray -- update the event manager array reference: - writeIORef eventManager new_eventManagerArray + atomicWriteIORef eventManager new_eventManagerArray + -- We need an atomic write here because 'eventManager' is accessed + -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i ===================================== testsuite/tests/concurrent/should_run/T21651.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test is adapted from setnumcapabilities001. + +import GHC.Conc hiding (threadWaitRead, threadWaitWrite) +import GHC.Exts +import GHC.IO.Encoding +import System.Environment +import System.IO +import Control.Monad +import Text.Printf +import Data.Time.Clock +import Control.DeepSeq + +import System.Posix.IO +import System.Posix.Types +import Control.Concurrent +import Control.Exception + +passTheParcel :: Int -> IO (IO ()) +passTheParcel n = do + pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe + rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do + let + read = fdRead readfd $ fromIntegral 1 + write = fdWrite writefd + mv <- newEmptyMVar + tid <- forkIO $ let + loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do + threadWaitRead readfd + (s, _) <- read + threadWaitWrite writefd + write s + cleanup = do + closeFdWith closeFd readfd + closeFdWith closeFd writefd + putMVar mv () + in loop `finally` cleanup + pure (mv, tid) + + let + cleanup = do + killThread tid1 + forM_ rs $ \(mv, _) -> takeMVar mv + + fdWrite (snd p1) "a" + pure cleanup + + +main = do + setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale + [n,q,t,z] <- fmap (fmap read) getArgs + cleanup_ptp <- passTheParcel z + t <- forkIO $ do + forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do + setNumCapabilities m + threadDelay t + printf "%d\n" (nqueens q) + cleanup_ptp + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 + +nqueens :: Int -> Int +nqueens nq = length (pargen 0 []) + where + safe :: Int -> Int -> [Int] -> Bool + safe x d [] = True + safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l + + gen :: [[Int]] -> [[Int]] + gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] + + pargen :: Int -> [Int] -> [[Int]] + pargen n b + | n >= threshold = iterate gen [b] !! (nq - n) + | otherwise = concat bs + where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq + + threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x ===================================== testsuite/tests/concurrent/should_run/T21651.stdout ===================================== @@ -0,0 +1 @@ +14200 ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, ['']) test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2', 'nonmoving_thr']), + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), extra_run_opts('8 12 2000'), when(have_thread_sanitizer(), expect_broken(18808)), req_smp ], compile_and_run, ['']) +test('T21651', + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), + when(opsys('mingw32'),skip), # uses POSIX pipes + when(opsys('darwin'),extra_run_opts('8 12 2000 100')), + unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files + req_smp ], + compile_and_run, ['']) + test('hs_try_putmvar001', [ when(opsys('mingw32'),skip), # uses pthread APIs in the C code View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d71a20514546e0befe6e238d0658cbaad5a13996...7589ee7241d46b393979d98d4ded17a15ee974fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d71a20514546e0befe6e238d0658cbaad5a13996...7589ee7241d46b393979d98d4ded17a15ee974fb You're receiving 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 Aug 11 22:09:47 2022 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Thu, 11 Aug 2022 18:09:47 -0400 Subject: [Git][ghc/ghc][wip/az/T21355-exactprint-update] 176 commits: ghci: Fix most calls to isLoaded to work in multi-mode Message-ID: <62f57e2b817fe_3d81494882830290@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: Alan Zimmerman pushed to branch wip/az/T21355-exactprint-update at Glasgow Haskell Compiler / GHC Commits: 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode [...] Content analysis details: (5.4 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.0 DATE_IN_PAST_12_24 Date: is 12 to 24 hours before Received: date 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 0.5 URI_NOVOWEL URI: URI hostname has long non-vowel sequence -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 1.5 BODY_8BITS BODY: Body includes 8 consecutive 8-bit characters 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid 3.1 GAPPY_HTML HTML body with much useless whitespace 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: "Alan Zimmerman (@alanz)" Subject: [Git][ghc/ghc][wip/az/T21355-exactprint-update] 176 commits: ghci: Fix most calls to isLoaded to work in multi-mode Date: Thu, 11 Aug 2022 18:09:47 -0400 Size: 264068 URL: From gitlab at gitlab.haskell.org Mon Aug 8 19:34:00 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 15:34:00 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] 13 commits: gitlab-ci: Don't use coreutils on Darwin Message-ID: <62f16528deb51_25b0164bff05860cf@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 2d98e6b9 by Ben Gamari at 2022-08-08T15:26:02-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - b230cda3 by Ben Gamari at 2022-08-08T15:26:02-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 34c04295 by Ben Gamari at 2022-08-08T15:33:42-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - da6ded8d by Ben Gamari at 2022-08-08T15:33:42-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 102379f6 by Ben Gamari at 2022-08-08T15:33:42-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 46804861 by Ben Gamari at 2022-08-08T15:33:42-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 65117a60 by Ben Gamari at 2022-08-08T15:33:42-04:00 XXX: Bump up freebsd job - - - - - f1a60c8e by Ben Gamari at 2022-08-08T15:33:42-04:00 gitlab-ci: Use cabal-install-3.6.2.0 on FreeBSD - - - - - 8b6175de by Ben Gamari at 2022-08-08T15:33:42-04:00 gitlab-ci: XXX temporary GHC bindist on FreeBSD - - - - - a4d85016 by Ben Gamari at 2022-08-08T15:33:42-04:00 Update jobs.yaml - - - - - 6997956c by Ben Gamari at 2022-08-08T15:33:42-04:00 fix - - - - - 2725995a by Ben Gamari at 2022-08-08T15:33:42-04:00 cabal - - - - - 0ec9269f by Ben Gamari at 2022-08-08T15:33:42-04:00 temp - - - - - 10 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -279,6 +282,9 @@ function fetch_ghc() { start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + if [ "$(uname)" = "FreeBSD" ]; then + url="http://home.smart-cactus.org/~ben/ghc/ghc-9.4.1-x86_64-portbld-freebsd.tar.xz" + fi info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" @@ -287,7 +293,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +331,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,15 +299,15 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "GHC_VERSION" =: "9.4.1" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , modifyJobs (\x -> x {jobStage = "quick-build"}) $ allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) ===================================== .gitlab/jobs.yaml ===================================== @@ -541,7 +541,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +551,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +560,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -586,19 +586,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2050,7 +2050,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2060,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2069,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2095,20 +2095,20 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2970,7 +2970,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +2980,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +2989,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3015,19 +3015,19 @@ ".gitlab/ci.sh build_hadrian", ".gitlab/ci.sh test_hadrian" ], - "stage": "full-build", + "stage": "quick-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", + "GHC_VERSION": "9.4.1", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -83,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -230,12 +195,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . -type f`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c77dad3adb6c4d451a44e4b2717ccce14541dc3e...0ec9269f76595f1370f85c45bb21986c7cac74dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c77dad3adb6c4d451a44e4b2717ccce14541dc3e...0ec9269f76595f1370f85c45bb21986c7cac74dd You're receiving 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 Aug 8 20:46:51 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 16:46:51 -0400 Subject: [Git][ghc/ghc][master] dataToTag#: Skip runtime tag check if argument is infered tagged Message-ID: <62f1763bdbf9f_25b0164c158595747@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 5 changed files: - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Expr.hs - + testsuite/tests/codeGen/should_compile/T21710a.hs - + testsuite/tests/codeGen/should_compile/T21710a.stderr - testsuite/tests/codeGen/should_compile/all.T Changes: ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -20,6 +20,7 @@ where import GHC.Prelude +import GHC.Builtin.PrimOps ( PrimOp(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply @@ -346,6 +347,19 @@ fvArgs args = do type IsScrut = Bool +rewriteArgs :: [StgArg] -> RM [StgArg] +rewriteArgs = mapM rewriteArg +rewriteArg :: StgArg -> RM StgArg +rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v +rewriteArg (lit at StgLitArg{}) = return lit + +-- Attach a tagSig if it's tagged +rewriteId :: Id -> RM Id +rewriteId v = do + is_tagged <- isTagged v + if is_tagged then return $! setIdTagSig v (TagSig TagProper) + else return v + rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr rewriteExpr _ (e at StgCase {}) = rewriteCase e rewriteExpr _ (e at StgLet {}) = rewriteLet e @@ -355,8 +369,11 @@ rewriteExpr _ e@(StgConApp {}) = rewriteConApp e rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e rewriteExpr _ (StgLit lit) = return $! (StgLit lit) +rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do + (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) + rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ @@ -415,6 +432,7 @@ rewriteApp True (StgApp f []) = do -- isTagged looks at more than the result of our analysis. -- So always update here if useful. let f' = if f_tagged + -- TODO: We might consisder using a subst env instead of setting the sig only for select places. then setIdTagSig f (TagSig TagProper) else f return $! StgApp f' [] ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -76,6 +76,8 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = -- dataToTag# :: a -> Int# -- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold +-- TODO: There are some more optimization ideas for this code path +-- in #21710 cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do platform <- getPlatform emitComment (mkFastString "dataToTag#") @@ -92,15 +94,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do -- the constructor index is too large to fit in the pointer and therefore -- we must look in the info table. See Note [Tagging big families]. - slow_path <- getCode $ do - tmp <- newTemp (bWord platform) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - profile <- getProfile - align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig - emitAssign (CmmLocal result_reg) - $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) - - fast_path <- getCode $ do + (fast_path :: CmmAGraph) <- getCode $ do -- Return the constructor index from the pointer tag return_ptr_tag <- getCode $ do emitAssign (CmmLocal result_reg) @@ -113,8 +107,22 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do $ getConstrTag profile align_check (cmmUntag platform amode) emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False) - - emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) + -- If we know the argument is already tagged there is no need to generate code to evaluate it + -- so we skip straight to the fast path. If we don't know if there is a tag we take the slow + -- path which evaluates the argument before fetching the tag. + case (idTagSig_maybe a) of + Just sig + | isTaggedSig sig + -> emit fast_path + _ -> do + slow_path <- getCode $ do + tmp <- newTemp (bWord platform) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + profile <- getProfile + align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig + emitAssign (CmmLocal result_reg) + $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) + emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) emitReturn [CmmReg $ CmmLocal result_reg] ===================================== testsuite/tests/codeGen/should_compile/T21710a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# OPTIONS_GHC -O #-} + +module M where + +import GHC.Exts + +data E = A | B | C | D | E + +foo x = + case x of + A -> 2# + B -> 42# + -- In this branch we already now `x` is evaluated, so we shouldn't generate an extra `call` for it. + _ -> dataToTag# x ===================================== testsuite/tests/codeGen/should_compile/T21710a.stderr ===================================== @@ -0,0 +1,446 @@ + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'E2_bytes" { + M.$tc'E2_bytes: + I8[] "'E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'D2_bytes" { + M.$tc'D2_bytes: + I8[] "'D" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'C2_bytes" { + M.$tc'C2_bytes: + I8[] "'C" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'B2_bytes" { + M.$tc'B2_bytes: + I8[] "'B" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'A3_bytes" { + M.$tc'A3_bytes: + I8[] "'A" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tcE2_bytes" { + M.$tcE2_bytes: + I8[] "E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule2_bytes" { + M.$trModule2_bytes: + I8[] "M" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule4_bytes" { + M.$trModule4_bytes: + I8[] "main" + }] + + + +==================== Output Cmm ==================== +[M.foo_entry() { // [R2] + { info_tbls: [(cBa, + label: block_cBa_info + rep: StackRep [] + srt: Nothing), + (cBi, + label: M.foo_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cBi: // global + if ((Sp + -8) < SpLim) (likely: False) goto cBj; else goto cBk; // CmmCondBranch + cBj: // global + R1 = M.foo_closure; // CmmAssign + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall + cBk: // global + I64[Sp - 8] = cBa; // CmmStore + R1 = R2; // CmmAssign + Sp = Sp - 8; // CmmAssign + if (R1 & 7 != 0) goto cBa; else goto cBb; // CmmCondBranch + cBb: // global + call (I64[R1])(R1) returns to cBa, args: 8, res: 8, upd: 8; // CmmCall + cBa: // global + _cBh::P64 = R1 & 7; // CmmAssign + if (_cBh::P64 != 1) goto uBz; else goto cBf; // CmmCondBranch + uBz: // global + if (_cBh::P64 != 2) goto cBe; else goto cBg; // CmmCondBranch + cBe: // global + // dataToTag# + _cBn::P64 = R1 & 7; // CmmAssign + if (_cBn::P64 == 7) (likely: False) goto cBs; else goto cBr; // CmmCondBranch + cBs: // global + _cBo::I64 = %MO_UU_Conv_W32_W64(I32[I64[R1 & (-8)] - 4]); // CmmAssign + goto cBq; // CmmBranch + cBr: // global + _cBo::I64 = _cBn::P64 - 1; // CmmAssign + goto cBq; // CmmBranch + cBq: // global + R1 = _cBo::I64; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBg: // global + R1 = 42; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBf: // global + R1 = 2; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }, + section ""data" . M.foo_closure" { + M.foo_closure: + const M.foo_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule3_closure" { + M.$trModule3_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule4_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule1_closure" { + M.$trModule1_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule_closure" { + M.$trModule_closure: + const GHC.Types.Module_con_info; + const M.$trModule3_closure+1; + const M.$trModule1_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE1_closure" { + M.$tcE1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tcE2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE_closure" { + M.$tcE_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tcE1_closure+1; + const GHC.Types.krep$*_closure+5; + const 10475418246443540865; + const 12461417314693222409; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A1_closure" { + M.$tc'A1_closure: + const GHC.Types.KindRepTyConApp_con_info; + const M.$tcE_closure+1; + const GHC.Types.[]_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A2_closure" { + M.$tc'A2_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'A3_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A_closure" { + M.$tc'A_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'A2_closure+1; + const M.$tc'A1_closure+1; + const 10991425535368257265; + const 3459663971500179679; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B1_closure" { + M.$tc'B1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'B2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B_closure" { + M.$tc'B_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'B1_closure+1; + const M.$tc'A1_closure+1; + const 13038863156169552918; + const 13430333535161531545; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C1_closure" { + M.$tc'C1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'C2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C_closure" { + M.$tc'C_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'C1_closure+1; + const M.$tc'A1_closure+1; + const 8482817676735632621; + const 8146597712321241387; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D1_closure" { + M.$tc'D1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'D2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D_closure" { + M.$tc'D_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'D1_closure+1; + const M.$tc'A1_closure+1; + const 7525207739284160575; + const 13746130127476219356; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E1_closure" { + M.$tc'E1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'E2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E_closure" { + M.$tc'E_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'E1_closure+1; + const M.$tc'A1_closure+1; + const 6748545530683684316; + const 10193016702094081137; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.A_closure" { + M.A_closure: + const M.A_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.B_closure" { + M.B_closure: + const M.B_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.C_closure" { + M.C_closure: + const M.C_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.D_closure" { + M.D_closure: + const M.D_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.E_closure" { + M.E_closure: + const M.E_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""relreadonly" . M.E_closure_tbl" { + M.E_closure_tbl: + const M.A_closure+1; + const M.B_closure+2; + const M.C_closure+3; + const M.D_closure+4; + const M.E_closure+5; + }] + + + +==================== Output Cmm ==================== +[M.A_con_entry() { // [] + { info_tbls: [(cC5, + label: M.A_con_info + rep: HeapRep 1 nonptrs { Con {tag: 0 descr:"main:M.A"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cC5: // global + R1 = R1 + 1; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.B_con_entry() { // [] + { info_tbls: [(cCa, + label: M.B_con_info + rep: HeapRep 1 nonptrs { Con {tag: 1 descr:"main:M.B"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCa: // global + R1 = R1 + 2; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.C_con_entry() { // [] + { info_tbls: [(cCf, + label: M.C_con_info + rep: HeapRep 1 nonptrs { Con {tag: 2 descr:"main:M.C"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCf: // global + R1 = R1 + 3; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.D_con_entry() { // [] + { info_tbls: [(cCk, + label: M.D_con_info + rep: HeapRep 1 nonptrs { Con {tag: 3 descr:"main:M.D"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCk: // global + R1 = R1 + 4; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.E_con_entry() { // [] + { info_tbls: [(cCp, + label: M.E_con_info + rep: HeapRep 1 nonptrs { Con {tag: 4 descr:"main:M.E"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCp: // global + R1 = R1 + 5; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -108,3 +108,4 @@ test('T18614', normal, compile, ['']) test('mk-big-obj', [unless(opsys('mingw32'), skip), pre_cmd('$PYTHON mk-big-obj.py > mk-big-obj.c')], multimod_compile, ['mk-big-obj.c', '-c -v0 -no-hs-main']) +test('T21710a', [ only_ways(['optasm']), when(wordsize(32), skip), grep_errmsg('(call)',[1]) ], compile, ['-ddump-cmm -dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/742292e461e4040faecf3482349a4574a9184239 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/742292e461e4040faecf3482349a4574a9184239 You're receiving 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 Aug 8 20:48:03 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 16:48:03 -0400 Subject: [Git][ghc/ghc][master] Document a divergence from the report in parsing function lhss. Message-ID: <62f17683b14fd_25b0164bfa06044b9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 1 changed file: - docs/users_guide/bugs.rst Changes: ===================================== docs/users_guide/bugs.rst ===================================== @@ -115,6 +115,10 @@ Lexical syntax varid → small {idchar} ⟨reservedid⟩ conid → large {idchar} +- GHC allows redundant parantheses around the function name in the `funlhs` part of declarations. + That is GHC will succeed in parsing a declaration like `((f)) x = ` for any number + of parantheses around `f`. + .. _infelicities-syntax: Context-free syntax View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a52de3cbe63af21085d6237b7e540e569a9c0f2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a52de3cbe63af21085d6237b7e540e569a9c0f2e You're receiving 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 Aug 12 15:45:02 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 12 Aug 2022 11:45:02 -0400 Subject: [Git][ghc/ghc][wip/andreask/infer_exprs] 2 commits: Stg.InferTags.Rewrite - Avoid some thunks. Message-ID: <62f6757e96019_3d8149488a05638a6@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer_exprs at Glasgow Haskell Compiler / GHC Commits: d8166f9e by Andreas Klebinger at 2022-08-12T17:44:22+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 0e4e4ac7 by Andreas Klebinger at 2022-08-12T17:44:41+02:00 Fix testsuite - - - - - 2 changed files: - compiler/GHC/Stg/InferTags/Rewrite.hs - testsuite/tests/simplStg/should_compile/all.T Changes: ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -128,7 +128,7 @@ getMap :: RM (UniqFM Id TagSig) getMap = RM $ ((\(fst,_,_,_) -> fst) <$> get) setMap :: (UniqFM Id TagSig) -> RM () -setMap m = RM $ do +setMap !m = RM $ do (_,us,mod,lcls) <- get put (m, us,mod,lcls) @@ -139,7 +139,7 @@ getFVs :: RM IdSet getFVs = RM $ ((\(_,_,_,lcls) -> lcls) <$> get) setFVs :: IdSet -> RM () -setFVs fvs = RM $ do +setFVs !fvs = RM $ do (tag_map,us,mod,_lcls) <- get put (tag_map, us,mod,fvs) @@ -195,9 +195,9 @@ withBinders NotTopLevel sigs cont = do withClosureLcls :: DIdSet -> RM a -> RM a withClosureLcls fvs act = do old_fvs <- getFVs - let fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs + let !fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs setFVs fvs' - r <- act + !r <- act setFVs old_fvs return r @@ -206,9 +206,9 @@ withClosureLcls fvs act = do withLcl :: Id -> RM a -> RM a withLcl fv act = do old_fvs <- getFVs - let fvs' = extendVarSet old_fvs fv + let !fvs' = extendVarSet old_fvs fv setFVs fvs' - r <- act + !r <- act setFVs old_fvs return r @@ -222,7 +222,7 @@ isTagged v = do | otherwise -> do -- Local binding !s <- getMap let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v - return $ case sig of + return $! case sig of TagSig info -> case info of TagDunno -> False @@ -234,7 +234,7 @@ isTagged v = do , isNullaryRepDataCon con -> return True | Just lf_info <- idLFInfo_maybe v - -> return $ + -> return $! -- Can we treat the thing as tagged based on it's LFInfo? case lf_info of -- Function, applied not entered. @@ -353,7 +353,7 @@ rewriteArg (lit at StgLitArg{}) = return lit rewriteId :: Id -> RM Id rewriteId v = do - is_tagged <- isTagged v + !is_tagged <- isTagged v if is_tagged then return $! setIdTagSig v (TagSig TagProper) else return v ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -12,4 +12,3 @@ setTestOpts(f) test('T13588', [ grep_errmsg('case') ] , compile, ['-dverbose-stg2stg -fno-worker-wrapper']) test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typeable-binds']) test('inferTags002', [ only_ways(['optasm']), grep_errmsg('(stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) -test('inferTags002', [ grep_errmsg('(stg_ap_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0a70269bf0a9e8959c3a3984dc966555cd84729...0e4e4ac7938b02dfe13ca478245308875c963865 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0a70269bf0a9e8959c3a3984dc966555cd84729...0e4e4ac7938b02dfe13ca478245308875c963865 You're receiving 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 Aug 8 18:28:17 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 14:28:17 -0400 Subject: [Git][ghc/ghc][wip/bindist-install] 2 commits: hadrian: Fix bindist installation on Darwin Message-ID: <62f155c18a2b3_25b0164c07c571295@gitlab.mail> Ben Gamari pushed to branch wip/bindist-install at Glasgow Haskell Compiler / GHC Commits: e7189622 by Ben Gamari at 2022-08-08T14:28:12-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - bec49e59 by Ben Gamari at 2022-08-08T14:28:12-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 3 changed files: - .gitlab/darwin/toolchain.nix - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== hadrian/bindist/Makefile ===================================== @@ -39,11 +39,11 @@ endif # of program names. For hadrian build this will work as programs have a # consistent naming procedure. define installscript - echo "installscript $1 -> $2" + @echo "$1 installed to $2"; @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ + $(CP) -RP 'wrappers/$1' '$2' ; \ + else \ + rm -f '$2' && \ $(CREATE_SCRIPT) '$2' && \ echo "#!$(SHELL)" >> '$2' && \ echo "exedir=\"$4\"" >> '$2' && \ @@ -57,7 +57,6 @@ define installscript cat 'wrappers/$1' >> '$2' && \ $(EXECUTABLE_FILE) '$2' ; \ fi - @echo "$1 installed to $2" endef # patchpackageconf ===================================== hadrian/bindist/config.mk.in ===================================== @@ -103,6 +103,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db6501e91553278ff80889fedf17dff1f2b6c957...bec49e598bf1498ea1d5db66af8bef94e9caa448 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db6501e91553278ff80889fedf17dff1f2b6c957...bec49e598bf1498ea1d5db66af8bef94e9caa448 You're receiving 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 Aug 8 20:47:28 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 16:47:28 -0400 Subject: [Git][ghc/ghc][master] rts: remove redundant stg_traceCcszh Message-ID: <62f1766092c15_25b0164c07c599337@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - 3 changed files: - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h Changes: ===================================== rts/PrimOps.cmm ===================================== @@ -2801,21 +2801,6 @@ stg_getApStackValzh ( P_ ap_stack, W_ offset ) } } -// Write the cost center stack of the first argument on stderr; return -// the second. Possibly only makes sense for already evaluated -// things? -stg_traceCcszh ( P_ obj, P_ ret ) -{ - W_ ccs; - -#if defined(PROFILING) - ccs = StgHeader_ccs(UNTAG(obj)); - ccall fprintCCS_stderr(ccs "ptr"); -#endif - - jump stg_ap_0_fast(ret); -} - stg_getSparkzh () { W_ spark; ===================================== rts/RtsSymbols.c ===================================== @@ -1015,7 +1015,6 @@ extern char **environ; SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(enabled_capabilities) \ - SymI_HasDataProto(stg_traceCcszh) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -566,7 +566,6 @@ RTS_FUN_DECL(stg_numSparkszh); RTS_FUN_DECL(stg_noDuplicatezh); -RTS_FUN_DECL(stg_traceCcszh); RTS_FUN_DECL(stg_clearCCSzh); RTS_FUN_DECL(stg_traceEventzh); RTS_FUN_DECL(stg_traceBinaryEventzh); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1504a93eecfc9efb3e6d2bda492d811dc32b6122 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1504a93eecfc9efb3e6d2bda492d811dc32b6122 You're receiving 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 Aug 8 03:16:56 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 23:16:56 -0400 Subject: [Git][ghc/ghc][wip/cross-ci] gitlab-ci: Add basic support for cross-compiler testiing Message-ID: <62f08028367d_25b0164bff037088e@gitlab.mail> Ben Gamari pushed to branch wip/cross-ci at Glasgow Haskell Compiler / GHC Commits: 9ff8d70e by Ben Gamari at 2022-08-07T23:16:48-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -564,15 +565,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${target_triple:-}" ]; then + args+=( "--target=$target_triple" "--host=$target_triple" ) + fi + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} + +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +617,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + run $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +640,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" if [[ "${WINDOWS_HOST}" == "no" ]]; then run_hadrian \ @@ -779,6 +806,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/gen_ci.hs ===================================== @@ -117,6 +117,7 @@ data BuildConfig , withAssertions :: Bool , withNuma :: Bool , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -159,6 +160,7 @@ vanilla = BuildConfig , withAssertions = False , withNuma = False , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -189,8 +191,13 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } -crossConfig :: String -> BuildConfig -crossConfig triple = vanilla { crossTarget = Just triple } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -605,6 +612,7 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -780,7 +788,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) - , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu") + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .gitlab/jobs.yaml ===================================== @@ -1316,6 +1316,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" @@ -3795,6 +3796,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ff8d70e15849fc12f793316ae624ecf561fb411 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ff8d70e15849fc12f793316ae624ecf561fb411 You're receiving 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 Aug 8 11:24:22 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 08 Aug 2022 07:24:22 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Doc Message-ID: <62f0f266674d4_25b0164c07c450277@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 63051477 by Sylvain Henry at 2022-08-08T13:27:10+02:00 Doc - - - - - 1 changed file: - compiler/GHC/StgToJS.hs Changes: ===================================== compiler/GHC/StgToJS.hs ===================================== @@ -25,56 +25,115 @@ import GHC.StgToJS.CodeGen -- -- Primitives -- ~~~~~~~~~~ --- See GHC.StgToJS.Types:VarType --- - Addr#: represented with two fields: array (used as a namespace) and index --- - StablePtr#: similar to Addr# with array fixed to h$stablePtrBuf --- - Int64#/Word64#: represented with two fields: high, low --- - Float#/Double#: both represented as Javascript Double (no Float!) --- - JSVal#: any Javascript object (used to pass JS objects via FFI) --- - TVar#, MVar#, etc. are represented with a JS object +-- Haskell primitives have to be represented as JavaScript values. This is done +-- as follows: +-- +-- - Int#/Int32# -> number in Int32 range +-- - Int16# -> number in Int16 range +-- - Int8# -> number in Int8 range +-- - Word#/Word32# -> number in Word32 range +-- - Word16# -> number in Word16 range +-- - Word8# -> number in Word8 range +-- +-- - Float#/Double# -> both represented as Javascript Double (no Float!) +-- +-- - Int64# -> represented with two fields: +-- high -> number in Int32 range +-- low -> number in Word32 range +-- - Word64# -> represented with two fields: high, low +-- high -> number in Word32 range +-- low -> number in Word32 range +-- +-- - Addr# -> represented with two fields: array (used as a namespace) and index +-- - StablePtr# -> similar to Addr# with array fixed to h$stablePtrBuf +-- +-- - JSVal# -> any Javascript object (used to pass JS objects via FFI) +-- +-- - TVar#, MVar#, etc. are represented with JS objects -- -- Foreign JavaScript imports -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ -- StgToJS supports inline JavaScript code. Example: -- -- > foreign import javascript unsafe --- > "$1 + $2" +-- > "((x,y) => x + y)" -- > plus :: Int -> Int -> Int -- --- The parser is inherited from JMacro and supports local variable declarations, --- loops, etc. Local variables are converted to hygienic names to avoid capture. --- --- TODO: argument order for multi-values primreps (Int64#, Word64#, Addr#) --- TODO: "$c" safe call continuation? +-- Currently the JS backend only supports functions as JS imports. +-- +-- In comparison, GHCJS supports JavaScript snippets with $1, $2... variables +-- as placeholders for the arguments. It requires a JavaScript parser that the +-- JS backend lacks. In GHCJS, the parser is inherited from JMacro and supports +-- local variable declarations, loops, etc. Local variables are converted to +-- hygienic names to avoid capture. +-- +-- Primitives that are represented as multiple values (Int64#, Word64#, Addr#) +-- are passed to FFI functions with multiple arguments. +-- +-- FIXME: specify argument order: +-- high then low (Int64#/Word64#)? +-- array then offset(Addr#)? +-- StablePtr#: do we pass the array? +-- FIXME: how do we return them from FFI? With h$retN variables as for +-- unboex tuples? +-- +-- Interruptible convention: FFI imports with the "interruptible" calling +-- convention are passed an extra argument (usually named "$c") that is a +-- continuation function. The FFI function must call this function to return to +-- Haskell code. +-- +-- Unboxed tuples: returning an unboxed tuple can be done with the predefined +-- macros RETURN_UBX_TUPn where n is the size of the tuples. Internally it uses +-- predefined "h$retN" global variables to pass additional values; the first +-- element of the tuple is returned normally. -- -- Memory management -- ~~~~~~~~~~~~~~~~~ --- Stack: the Haskell stack is implemented with a dynamically growing JavaScript --- array ("h$stack"). --- TODO: does it shrink sometimes? --- TODO: what are the elements of the stack? one JS object per stack frame? --- --- Heap: objects on the heap ("closures") are represented as JavaScript objects --- with the following fields: --- --- { f: function -- entry function --- , m: meta -- meta data --- , d1: x -- closure specific fields --- , d2: y +-- Heap objects are represented as JavaScript values. +-- +-- Most heap objects are represented generically as JavaScript "objects" (hash +-- maps). However, some Haskell heap objects can use use a more memory efficient +-- JavaScript representation: number, string... An example of a consequence of +-- this is that both Int# and Int are represented the same as a JavaScript +-- number. JavaScript introspection (e.g. typeof) is used to differentiate +-- heap object representations when necessary. +-- +-- Generic representation: objects on the heap ("closures") are represented as +-- JavaScript objects with the following fields: +-- +-- { f -- (function) entry function + info table +-- , d1 -- two fields of payload +-- , d2 +-- , m -- GC mark +-- , cc -- optional cost-center -- } -- --- Every heap object has an entry function "f". --- --- Similarly to info tables in native code generation, the JS function object --- "f" also contains some metadata about the Haskell object: --- --- { t: closure type --- , a: constructor tag / fun arity +-- Payload: payload only consists of two fields (d1, d2). When more than two +-- fields of payload are required, the second field is itself an object. +-- payload [] ==> { d1 = null, d2 = null } +-- payload [a] ==> { d1 = a , d2 = null } +-- payload [a,b] ==> { d1 = a , d2 = b } +-- payload [a,b,c] ==> { d1 = a , d2 = { d1 = b, d2 = c} } +-- payload [a,b,c...] ==> { d1 = a , d2 = { d1 = b, d2 = c, ...} } +-- +-- Entry function/ info tables: JavaScript functions are JavaScript objects. If +-- "f" is a function, we can: +-- - call it, e.g. "f(arg0,arg1...)" +-- - get/set its fields, e.g. "f.xyz = abc" +-- This is used to implement the equivalent of tables-next-to-code in +-- JavaScript: every heap object has an entry function "f" that also contains +-- some metadata (info table) about the Haskell object: +-- { t -- object type +-- , size -- number of fields in the payload (-1 if variable layout) +-- , i -- (array) fields layout (empty if variable layout) +-- , n -- (string) object name for easier dubugging +-- , a -- constructor tag / fun arity +-- , r -- FIXME +-- , s -- static references? FIXME +-- , m -- GC mark? -- } -- --- Note that functions in JS are objects so if "f" is a function we can: --- - call it, e.g. "f(arg0,arg1...)" --- - get/set its metadata, e.g. "var closureType = f.t" +-- Payloads for each kind of heap object: -- -- THUNK = -- { f = returns the object reduced to WHNF @@ -127,6 +186,12 @@ import GHC.StgToJS.CodeGen -- When a shared thunk is entered, it is overriden with a black hole ("eager -- blackholing") and an update frame is pushed on the stack. -- +-- Stack: the Haskell stack is implemented with a dynamically growing JavaScript +-- array ("h$stack"). +-- TODO: does it shrink sometimes? +-- TODO: what are the elements of the stack? one JS object per stack frame? +-- +-- -- Interaction with JavaScript's garbage collector -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Using JS objects to represent Haskell heap objects means that JS's GC does View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/630514779b31e0573250bd67bef645af5c02ab43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/630514779b31e0573250bd67bef645af5c02ab43 You're receiving 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 Aug 9 17:47:07 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 13:47:07 -0400 Subject: [Git][ghc/ghc][master] 3 commits: rts/linker: Resolve iconv_* on FreeBSD Message-ID: <62f29d9bb805e_182c4e4b85c31603f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - 5 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - m4/fp_find_cxx_std_lib.m4 - rts/Linker.c Changes: ===================================== .gitlab/ci.sh ===================================== @@ -207,6 +207,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -288,7 +291,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -326,9 +329,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -223,7 +223,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -242,7 +242,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -313,7 +313,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -321,7 +321,7 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -489,12 +489,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -512,8 +512,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -781,7 +781,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) ===================================== .gitlab/jobs.yaml ===================================== @@ -658,7 +658,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -668,7 +668,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -677,7 +677,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -705,17 +705,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2288,7 +2288,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2298,7 +2298,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2307,7 +2307,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2335,18 +2335,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -3208,7 +3208,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -3218,7 +3218,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -3227,7 +3227,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3255,17 +3255,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9dfd26a38182e9c284b7db16cb10fc889eedf9e...ea90e61dc3c6ba0433e008284dc6c3970ead98a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9dfd26a38182e9c284b7db16cb10fc889eedf9e...ea90e61dc3c6ba0433e008284dc6c3970ead98a7 You're receiving 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 Aug 10 22:55:36 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 18:55:36 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] 24 commits: configure: Set RELEASE=NO Message-ID: <62f437681806e_142b49517fc231376@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: 616c77fa by Ben Gamari at 2022-08-07T17:42:19-04:00 configure: Set RELEASE=NO - - - - - 1270bfc3 by Ben Gamari at 2022-08-07T18:39:38-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. (cherry picked from commit 844df61e8de5e2d9a058e6cbe388802755fc0305) (cherry picked from commit d8961a2dc974b7f8f8752781c4aec261ae8f8c0f) - - - - - b40accc1 by Ben Gamari at 2022-08-07T20:09:24-04:00 users-guide: Fix typo in release notes - - - - - c6c9a939 by Ben Gamari at 2022-08-08T09:37:40-04:00 users-guide: Fix incorrect directives - - - - - 4e21fb9d by Ben Gamari at 2022-08-09T12:29:51-04:00 relnotes: Reintroduce "included libraries" section As requested in #21988. - - - - - 47b4fea0 by Ben Gamari at 2022-08-09T12:31:10-04:00 make: Fix bootstrapping with profiling enabled 12ae2a9cf89af3ae9e4df051818b631cf213a1b8 attempted to work around a make build system deficiency by adding some dependencies from modules of `containers` which contain TH splices to the `template-haskell` package. However, it only did this for the vanilla way. Here we add similar edges for profiled objects. Fixes #21987. - - - - - dbb74a20 by normalcoder at 2022-08-10T18:48:53-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms (cherry picked from commit 67575f2004340564d6e52af055ed6fb43d3f9711) - - - - - e6d3fe19 by Ben Gamari at 2022-08-10T18:52:33-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. (cherry picked from commit afa584a327ce9aaf560c6ff09781c6e810c23a60) - - - - - ed9e9216 by Ben Gamari at 2022-08-10T18:52:40-04:00 hadrian: Fix naming of cross-compiler wrappers (cherry picked from commit b9bb45d7368ceeb874ded7e55e603327c103ce9f) - - - - - 0f587c14 by Ben Gamari at 2022-08-10T18:52:58-04:00 gitlab-ci: Add release job for aarch64/debian 11 (cherry picked from commit 5765e13370634979eb6a0d9f67aa9afa797bee46) - - - - - 8bf86cc9 by Ben Gamari at 2022-08-10T18:53:02-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. (cherry picked from commit 5b26f32412d503c9004fc0a2e6e9a2ab680d43f3) - - - - - 302505a3 by Ben Gamari at 2022-08-10T18:53:19-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. (cherry picked from commit ae707762335dabe2bb7e40639fd2ab2c7d3234fd) - - - - - 342637e5 by Ben Gamari at 2022-08-10T18:53:27-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. (cherry picked from commit c1c08bd829fb33a185f0a71f08babe5d7e6556fc) - - - - - dcca4858 by Ben Gamari at 2022-08-10T18:53:31-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. (cherry picked from commit 1c582f44e41f534a8506a76618f6cffe5d71ed42) - - - - - a38a4ce4 by Ben Gamari at 2022-08-10T18:53:35-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. (cherry picked from commit 681aa076259c05c626266cf516de7e7c5524eadb) - - - - - da22f74d by Ben Gamari at 2022-08-10T18:53:47-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt (cherry picked from commit 5d66a0ce39f47b7b9f6c732a18ac6e102a21ee6b) - - - - - 3a31aaf5 by Ben Gamari at 2022-08-10T18:53:53-04:00 gitlab-ci: Bump to use freebsd13 runners (cherry picked from commit ea90e61dc3c6ba0433e008284dc6c3970ead98a7) - - - - - 3a41eaa0 by sheaf at 2022-08-10T18:54:04-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 (cherry picked from commit d71a20514546e0befe6e238d0658cbaad5a13996) - - - - - 87846991 by Douglas Wilson at 2022-08-10T18:54:11-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. (cherry picked from commit 76b52cf0c52ee05c20f7d1b80f5600eecab3c42a) - - - - - 624f72e3 by Douglas Wilson at 2022-08-10T18:54:15-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. (cherry picked from commit 7589ee7241d46b393979d98d4ded17a15ee974fb) - - - - - f7762eb7 by Jens Petersen at 2022-08-10T18:54:28-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally (cherry picked from commit 823fe5b56450a7eefbf41ce8ece34095bf2217ee) - - - - - 81977824 by Ben Gamari at 2022-08-10T18:54:34-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. (cherry picked from commit 5bc489cac104717f09be73f2b578719bcc1e3fcb) - - - - - 5f259b8f by Ben Gamari at 2022-08-10T18:54:39-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used (cherry picked from commit 596db9a5f966643bcc9994d45f2f6ffb4037ad74) - - - - - 480b066d by Ben Gamari at 2022-08-10T18:54:43-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. (cherry picked from commit 7cabea7c9b10d2d15a4798be9f3130994393dd9c) - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Core/Unfold.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/9.4.1-notes.rst - ghc.mk - hadrian/bindist/Makefile - + hadrian/bindist/config.mk.in - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/Event/Thread.hs - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - + testsuite/tests/concurrent/should_run/T21651.hs - + testsuite/tests/concurrent/should_run/T21651.stdout - testsuite/tests/concurrent/should_run/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 9e4c540d9e4972a36291dfdf81f079f37d748890 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/ci.sh ===================================== @@ -93,6 +93,7 @@ Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. REINSTALL_GHC Build and test a reinstalled "stage3" ghc built using cabal-install This tests the "reinstall" configuration + CROSS_EMULATOR The emulator to use for testing of cross-compilers. Environment variables determining bootstrap toolchain (Linux): @@ -206,6 +207,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +291,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +329,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" @@ -564,15 +566,38 @@ function make_install_destdir() { fi info "merging file tree from $destdir to $instdir" cp -a "$destdir/$instdir"/* "$instdir"/ - "$instdir"/bin/ghc-pkg recache + "$instdir"/bin/${cross_prefix}ghc-pkg recache } -function test_hadrian() { - if [ -n "${CROSS_TARGET:-}" ]; then - info "Can't test cross-compiled build." - return - fi +# install the binary distribution in directory $1 to $2. +function install_bindist() { + local bindist="$1" + local instdir="$2" + pushd "$bindist" + case "$(uname)" in + MSYS_*|MINGW*) + mkdir -p "$instdir" + cp -a * "$instdir" + ;; + *) + read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" + + # FIXME: The bindist configure script shouldn't need to be reminded of + # the target platform. See #21970. + if [ -n "${CROSS_TARGET:-}" ]; then + args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" ) + fi + + run ./configure \ + --prefix="$instdir" \ + "${args[@]+"${args[@]}"}" + make_install_destdir "$TOP"/destdir "$instdir" + ;; + esac + popd +} +function test_hadrian() { check_msys2_deps _build/stage1/bin/ghc --version check_release_build @@ -593,7 +618,21 @@ function test_hadrian() { fi - if [[ -n "${REINSTALL_GHC:-}" ]]; then + if [ -n "${CROSS_TARGET:-}" ]; then + if [ -n "${CROSS_EMULATOR:-}" ]; then + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" + echo 'main = putStrLn "hello world"' > hello.hs + echo "hello world" > expected + run "$test_compiler" hello.hs + $CROSS_EMULATOR ./hello > actual + run diff expected actual + else + info "Cannot test cross-compiled build without CROSS_EMULATOR being set." + return + fi + elif [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian \ test \ --test-root-dirs=testsuite/tests/stage1 \ @@ -602,20 +641,9 @@ function test_hadrian() { --test-root-dirs=testsuite/tests/typecheck \ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" else - cd _build/bindist/ghc-*/ - case "$(uname)" in - MSYS_*|MINGW*) - mkdir -p "$TOP"/_build/install - cp -a * "$TOP"/_build/install - ;; - *) - read -r -a args <<< "${INSTALL_CONFIGURE_ARGS:-}" - run ./configure --prefix="$TOP"/_build/install "${args[@]+"${args[@]}"}" - make_install_destdir "$TOP"/destdir "$TOP"/_build/install - ;; - esac - cd ../../../ - test_compiler="$TOP/_build/install/bin/ghc$exe" + local instdir="$TOP/_build/install" + local test_compiler="$instdir/bin/ghc$exe" + install_bindist _build/bindist/ghc-*/ "$instdir" # Disabled, see #21072 # run_hadrian \ @@ -776,6 +804,9 @@ esac if [ -n "${CROSS_TARGET:-}" ]; then info "Cross-compiling for $CROSS_TARGET..." target_triple="$CROSS_TARGET" + cross_prefix="$target_triple-" +else + cross_prefix="" fi echo "Branch name ${CI_MERGE_REQUEST_SOURCE_BRANCH_NAME:-}" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -116,6 +116,8 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , crossTarget :: Maybe String + , crossEmulator :: Maybe String , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +128,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +159,8 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , crossTarget = Nothing + , crossEmulator = Nothing , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -186,6 +191,14 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } +crossConfig :: String -- ^ target triple + -> Maybe String -- ^ emulator for testing + -> BuildConfig +crossConfig triple emulator = + vanilla { crossTarget = Just triple + , crossEmulator = emulator + } + llvm :: BuildConfig llvm = vanilla { llvmBootstrap = True } @@ -210,7 +223,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +242,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -252,6 +265,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] + ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] -- | The hadrian flavour string we are going to use for this build @@ -299,7 +313,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,12 +321,19 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -475,12 +496,13 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +520,10 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -597,7 +621,8 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - + , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty ] @@ -766,13 +791,15 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu")) ] where ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -155,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -174,7 +232,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -213,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -271,7 +332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -334,7 +395,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -358,6 +419,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -393,7 +513,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -412,7 +532,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -452,7 +575,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -511,7 +634,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -541,7 +664,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +674,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +683,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -576,7 +699,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -588,17 +711,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -637,7 +760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -699,7 +822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -761,7 +884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -821,7 +944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -880,7 +1003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -939,7 +1062,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -999,7 +1122,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1058,7 +1181,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1117,7 +1240,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1176,7 +1299,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1235,7 +1358,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1261,6 +1384,67 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1296,7 +1480,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1355,7 +1539,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1414,7 +1598,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1475,7 +1659,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1537,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1598,7 +1782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1837,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1712,7 +1896,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1775,7 +1959,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1839,7 +2023,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1864,6 +2048,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1899,7 +2143,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1918,8 +2162,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -1959,7 +2206,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2019,7 +2266,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2050,7 +2297,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2307,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2316,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2085,7 +2332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2097,18 +2344,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2147,7 +2394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2210,7 +2457,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2273,7 +2520,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2334,7 +2581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2394,7 +2641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2454,7 +2701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2514,7 +2761,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2574,7 +2821,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2636,7 +2883,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2698,7 +2945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2761,7 +3008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2817,7 +3064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2877,7 +3124,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2941,7 +3188,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2970,7 +3217,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +3227,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +3236,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3005,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3017,17 +3264,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { @@ -3065,7 +3312,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3126,7 +3373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3187,7 +3434,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3246,7 +3493,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3305,7 +3552,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3363,7 +3610,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3669,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3480,7 +3727,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3538,7 +3785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3596,7 +3843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3655,7 +3902,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3680,6 +3927,66 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3715,7 +4022,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3773,7 +4080,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3831,7 +4138,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3891,7 +4198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3952,7 +4259,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4012,7 +4319,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4066,7 +4373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4124,7 +4431,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -580,10 +580,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- Cost to allocate binding with given binder size_up_alloc bndr - | isTyVar bndr -- Doesn't exist at runtime - || isJoinId bndr -- Not allocated at all - || isUnliftedType (idType bndr) -- Doesn't live in heap - -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder) + | isTyVar bndr -- Doesn't exist at runtime + || isJoinId bndr -- Not allocated at all + || not (isBoxedType (idType bndr)) -- Doesn't live in heap = 0 | otherwise = 10 ===================================== configure.ac ===================================== @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.4.1], [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 ===================================== distrib/configure.ac.in ===================================== @@ -256,7 +256,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS # -AC_CONFIG_FILES(mk/config.mk mk/install.mk) +AC_CONFIG_FILES(config.mk mk/config.mk mk/install.mk) AC_OUTPUT # We get caught by ===================================== docs/users_guide/9.4.1-notes.rst ===================================== @@ -31,7 +31,7 @@ upgrading to GHC 9.4: and are deprecated, having been superceded by the now levity-polymorphic ``Array#`` type. -- The type equality operator, ``(~)``, is not considered to be a type operator +- The type equality operator, ``(~)``, is now considered to be a type operator (exported from ``Prelude``) and therefore requires the enabling of the :extension:`TypeOperators` extension rather than :extension:`GADTs` or :extension:`TypeFamilies` as was sufficient previously. @@ -62,7 +62,7 @@ Language - GHC Proposal `#511 `_ has been implemented, introducing a new language extension, - :lang-ext:`DeepSubsumption`. This extension allows the user + :extension:`DeepSubsumption`. This extension allows the user to opt-in to the deep type subsumption-checking behavior implemented by GHC 8.10 and earlier. @@ -283,7 +283,7 @@ Runtime system ~~~~~~~~~~~~~~~~ - ``GHC.Generics`` now provides a set of newtypes, ``Generically`` and - ``Generically1``, for deriving generic instances via :lang-ext:`DerivingVia`. + ``Generically1``, for deriving generic instances via :extension:`DerivingVia`. ``Generically`` instances include ``Semigroup`` and ``Monoid``. - There's a new special function ``withDict`` in ``GHC.Exts``: :: @@ -513,3 +513,50 @@ Runtime system - The ``link`` field of ``GHC.Exts.Heap.WeakClosure`` has been replaced with a ``weakLink`` field which is ``Nothing`` if and only if ``link`` would have been NULL. + + +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 + ===================================== ghc.mk ===================================== @@ -510,6 +510,11 @@ libraries/containers/containers/dist-install/build/Data/Graph.o: libraries/templ libraries/containers/containers/dist-install/build/Data/Set/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi libraries/containers/containers/dist-install/build/Data/IntSet/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/IntMap/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Graph.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Set/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/IntSet/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi + ifeq "$(BIGNUM_BACKEND)" "gmp" GMP_ENABLED = YES libraries/ghc-bignum_CONFIGURE_OPTS += --configure-option="--with-gmp" ===================================== hadrian/bindist/Makefile ===================================== @@ -1,7 +1,8 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: -include mk/config.mk +include ./mk/project.mk +include ./config.mk .PHONY: default default: @@ -22,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -82,6 +46,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -216,10 +182,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ @@ -227,12 +195,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -0,0 +1,281 @@ +#----------------------------------------------------------------------------- +# +# Definition of installation directories, we don't use half of these, but since +# the configure script has them on offer while passing through, we might as well +# set them. Note that we have to be careful, because the GNU coding standards +# have changed a bit over the course of time, and autoconf development reflects +# this. +# +# A little bit of history regarding autoconf and GNU coding standards, use this +# as a cheat-sheet for the stuff below: +# +# variable | default < 2.60 | default >= 2.60 +# ------------+--------------------+-------------------------------------- +# exec_prefix | ${prefix} | ${prefix} +# libdir | ${exec_prefix}/lib | ${exec_prefix}/lib +# datarootdir | NONE! | ${prefix}/share +# datadir | ${prefix}/share | ${datarootdir} +# infodir | ${prefix}/info | ${datarootdir}/info +# mandir | ${prefix}/man | ${datarootdir}/man +# docdir | NONE! | ${datarootdir}/doc/${PACKAGE_TARNAME} +# htmldir | NONE! | ${docdir} +# dvidir | NONE! | ${docdir} +# pdfdir | NONE! | ${docdir} +# psdir | NONE! | ${docdir} +# +# NOTE: The default e.g. ${docdir} above means that autoconf substitutes the +# string "${docdir}", not the value of docdir! This is crucial for the GNU +# coding standards. See #1924. + +define set_default +# $1 = variable to set +# $2 = default value to use, if configure didn't expand it +# If $1 starts with an @ then configure didn't set it (because a version +# of autoconf that is too old was used), so set it to a sensible value +ifneq "$$(filter @%,$$($1))" "" +$1 = $2 +endif +endef + +prefix = @prefix@ + +datarootdir = @datarootdir@ +$(eval $(call set_default,datarootdir,$${prefix}/share)) + +exec_prefix = @exec_prefix@ +bindir = @bindir@ +datadir = @datadir@ +libdir = @libdir@ +includedir = @includedir@ +mandir = @mandir@ + +# Note that `./configure --docdir=/foo/bar` should work. +docdir = @docdir@ +PACKAGE_TARNAME = ghc-${ProjectVersion} +$(eval $(call set_default,docdir,$${datarootdir}/doc/$${PACKAGE_TARNAME})) + +htmldir = @htmldir@ +dvidir = @dvidir@ +pdfdir = @pdfdir@ +psdir = @psdir@ +$(eval $(call set_default,htmldir,$${docdir})) +$(eval $(call set_default,dvidir,$${docdir})) +$(eval $(call set_default,pdfdir,$${docdir})) +$(eval $(call set_default,psdir,$${docdir})) + +ifeq "$(RelocatableBuild)" "YES" + +# Hack: our directory layouts tend to be different on Windows, so +# hack around configure's bogus assumptions here. +datarootdir = $(prefix) +datadir = $(prefix)/lib +libdir = $(prefix)/lib + +docdir = $(prefix)/doc +htmldir = $(docdir) +dvidir = $(docdir) +pdfdir = $(docdir) +psdir = $(docdir) + +ghclibdir = $(libdir) + +else + +# Unix: override libdir and datadir to put ghc-specific stuff in +# a subdirectory with the version number included. +ghclibdir = $(libdir)/$(CrossCompilePrefix)ghc-$(ProjectVersion) +endif + +ghclibexecdir = $(ghclibdir) +topdir = $(ghclibdir) +ghcheaderdir = $(ghclibdir)/rts/include + +#----------------------------------------------------------------------------- +# Utilities needed by the installation Makefile + +FIND = @FindCmd@ +INSTALL = @INSTALL@ +INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) +LN_S = @LN_S@ +MV = mv +SED = @SedCmd@ +SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ + +# +# Invocations of `install' for different classes +# of targets: +# +INSTALL_PROGRAM = $(INSTALL) -m 755 +INSTALL_SCRIPT = $(INSTALL) -m 755 +INSTALL_SHLIB = $(INSTALL) -m 755 +INSTALL_DATA = $(INSTALL) -m 644 +INSTALL_HEADER = $(INSTALL) -m 644 +INSTALL_MAN = $(INSTALL) -m 644 +INSTALL_DOC = $(INSTALL) -m 644 +INSTALL_DIR = $(INSTALL) -m 755 -d + +#----------------------------------------------------------------------------- +# Build configuration + +CrossCompiling = @CrossCompiling@ +CrossCompilePrefix = @CrossCompilePrefix@ +GhcUnregisterised = @Unregisterised@ + +# ArchSupportsSMP should be set iff there is support for that arch in +# rts/include/stg/SMP.h +ifeq "$(TargetArch_CPP)" "arm" +# We don't support load/store barriers pre-ARMv7. See #10433. +ArchSupportsSMP=$(if $(filter $(ARM_ISA),ARMv5 ARMv6),NO,YES) +else +ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64 riscv64))) +endif + +# The THREADED_RTS requires `BaseReg` to be in a register and the +# `GhcUnregisterised` mode doesn't allow that. +GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO)) + +# Whether to include GHCi in the compiler. Depends on whether the RTS linker +# has support for this OS/ARCH combination. +OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu))) +ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm aarch64))) + +ifeq "$(OsSupportsGHCi)$(ArchSupportsGHCi)" "YESYES" +GhcWithInterpreter=YES +else +GhcWithInterpreter=$(if $(findstring YES,$(DYNAMIC_GHC_PROGRAMS)),YES,NO) +endif + +# On Windows we normally want to make a relocatable bindist, to we +# ignore flags like libdir +ifeq "$(Windows_Host)" "YES" +RelocatableBuild = YES +else +RelocatableBuild = NO +endif + + +# runhaskell and hsc2hs are special, in that other compilers besides +# GHC might provide them. Systems with a package manager often come +# with tools to manage this kind of clash, e.g. RPM's +# update-alternatives. When building a distribution for such a system, +# we recommend setting both of the following to 'YES'. +# +# NO_INSTALL_RUNHASKELL = YES +# NO_INSTALL_HSC2HS = YES +# +# NB. we use negative tests here because for binary-distributions we cannot +# test build-time variables at install-time, so they must default to on. + +ifneq "$(DESTDIR)" "" +override DESTDIR := $(abspath $(DESTDIR)) +endif + +# We build the libraries at least the "vanilla" way (way "v") +# Technically we don't need the v way if DYNAMIC_GHC_PROGRAMS is YES, +# but with -dynamic-too it's cheap, and makes life easier. +GhcLibWays = v + +# In addition to the normal sequential way, the default is to also build +# profiled prelude libraries +# $(if $(filter ...)) allows controlling this expression from build.mk. +GhcLibWays += $(if $(filter $(BUILD_PROF_LIBS),NO),,p) + +# Backward compatibility: although it would be cleaner to test for +# PlatformSupportsSharedLibs, or perhaps a new variable BUILD_SHARED_LIBS, +# some users currently expect that DYNAMIC_GHC_PROGRAMS=NO in build.mk implies +# that dyn is not added to GhcLibWays. +GhcLibWays += $(if $(filter $(DYNAMIC_GHC_PROGRAMS),NO),,dyn) + +# Handy way to test whether we're building shared libs or not. +BuildSharedLibs=$(strip $(if $(findstring dyn,$(GhcLibWays)),YES,NO)) + +# In addition, the RTS is built in some further variations. Ways that +# make sense here: +# +# thr : threaded +# thr_p : threaded + profiled +# debug : debugging +# thr_debug : debugging + threaded +# p : profiled +# +# While the eventlog used to be enabled in only a subset of ways, we now always +# enable it. + +# Usually want the debug version +GhcRTSWays = debug + +# We always have the threaded versions, but note that SMP support may be disabled +# (see GhcWithSMP). +GhcRTSWays += thr thr_debug +GhcRTSWays += $(if $(findstring p, $(GhcLibWays)),thr_p,) +GhcRTSWays += $(if $(findstring dyn, $(GhcLibWays)),dyn debug_dyn thr_dyn thr_debug_dyn,) +GhcRTSWays += $(if $(findstring p, $(GhcLibWays)),thr_debug_p debug_p,) + +# We can only build GHCi threaded if we have a threaded RTS: +GhcThreaded = $(if $(findstring thr,$(GhcRTSWays)),YES,NO) + +# Configuration for libffi +UseSystemLibFFI=@UseSystemLibFFI@ +UseLibffiForAdjustors=@UseLibffiForAdjustors@ + +# GHC needs arch-specific tweak at least in +# rts/Libdw.c:set_initial_registers() +GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseLibdw@,NO)) + +#----------------------------------------------------------------------------- +# Settings + +# We are in the process of moving the settings file from being entirely +# generated by configure, to generated being by the build system. Many of these +# might become redundant. +# See Note [tooldir: How GHC finds mingw on Windows] + +GccExtraViaCOpts = @GccExtraViaCOpts@ +LdHasFilelist = @LdHasFilelist@ +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@ +SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ +SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ +SettingsCCompilerFlags = @SettingsCCompilerFlags@ +SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ +SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ +SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ +SettingsLdCommand = @SettingsLdCommand@ +SettingsLdFlags = @SettingsLdFlags@ +SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ +SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ +SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ +SettingsRanlibCommand = @SettingsRanlibCommand@ +SettingsDllWrapCommand = @SettingsDllWrapCommand@ +SettingsWindresCommand = @SettingsWindresCommand@ +SettingsLibtoolCommand = @SettingsLibtoolCommand@ +SettingsTouchCommand = @SettingsTouchCommand@ +SettingsClangCommand = @SettingsClangCommand@ +SettingsLlcCommand = @SettingsLlcCommand@ +SettingsOptCommand = @SettingsOptCommand@ +SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ + ===================================== hadrian/src/Packages.hs ===================================== @@ -14,7 +14,7 @@ module Packages ( ghcPackages, isGhcPackage, -- * Package information - programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, + crossPrefix, programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, rtsContext, rtsBuildPath, libffiBuildPath, ensureConfigured ) where @@ -154,15 +154,20 @@ linter name = program name ("linters" -/- name) setPath :: Package -> FilePath -> Package setPath pkg path = pkg { pkgPath = path } +-- | Target prefix to prepend to executable names. +crossPrefix :: Action String +crossPrefix = do + cross <- flag CrossCompiling + targetPlatform <- setting TargetPlatformFull + return $ if cross then targetPlatform ++ "-" else "" + -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC -- built in 'Stage0' is called @ghc-stage1 at . If the given package is a -- 'Library', the function simply returns its name. programName :: Context -> Action String programName Context {..} = do - cross <- flag CrossCompiling - targetPlatform <- setting TargetPlatformFull - let prefix = if cross then targetPlatform ++ "-" else "" + prefix <- crossPrefix -- TODO: Can we extract this information from Cabal files? -- Alp: We could, but then the iserv package would have to -- use Cabal conditionals + a 'profiling' flag ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TupleSections, MultiWayIf #-} module Rules.BinaryDist where import Hadrian.Haskell.Cabal @@ -254,6 +254,7 @@ bindistRules = do -- other machine. need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) + copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do @@ -346,9 +347,12 @@ compressorExtension Bzip2 = "bz2" bindistInstallFiles :: [FilePath] bindistInstallFiles = [ "config.sub", "config.guess", "install-sh" - , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in", "mk" -/- "project.mk" + , "mk" -/- "config.mk.in" -- TODO: Remove when make is gone + , "mk" -/- "install.mk.in" -- TODO: Remove when make is gone + , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' @@ -370,19 +374,20 @@ useGhcPrefix pkg | pkg == ghciWrapper = False | otherwise = True - -- | Which wrappers point to a specific package pkgToWrappers :: Package -> Action [String] -pkgToWrappers pkg - -- ghc also has the ghci script wrapper - | pkg == ghc = pure ["ghc", "ghci"] - | pkg == runGhc = pure ["runghc", "runhaskell"] - -- These are the packages which we want to expose to the user and hence - -- there are wrappers installed in the bindist. - | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] - = (:[]) <$> (programName =<< programContext Stage1 pkg) - | otherwise = pure [] - +pkgToWrappers pkg = do + prefix <- crossPrefix + if -- ghc also has the ghci script wrapper + -- N.B. programName would add the crossPrefix therefore we must do the + -- same here. + | pkg == ghc -> pure $ map (prefix++) ["ghc", "ghci"] + | pkg == runGhc -> pure $ map (prefix++) ["runghc", "runhaskell"] + -- These are the packages which we want to expose to the user and hence + -- there are wrappers installed in the bindist. + | pkg `elem` [hpcBin, haddock, hp2ps, hsc2hs, ghc, ghcPkg] + -> (:[]) <$> (programName =<< programContext Stage1 pkg) + | otherwise -> pure [] wrapper :: FilePath -> Action String wrapper "ghc" = ghcWrapper ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -278,6 +278,7 @@ runTestBuilderArgs = builder Testsuite ? do where emitWhenSet Nothing _ = mempty emitWhenSet (Just v) f = f v + stageNumber :: Stage -> Int stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot" stageNumber (Stage0 InTreeLibs) = 1 stageNumber Stage1 = 2 ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Event.Thread -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) @@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, - threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) + threadStatus, writeTVar, newTVarIO, readTVar, retry, + throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, @@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM +import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) @@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () -closeFdWith close fd = do - eventManagerArray <- readIORef eventManager - let (low, high) = boundsIOArray eventManagerArray - mgrs <- flip mapM [low..high] $ \i -> do - Just (_,!mgr) <- readIOArray eventManagerArray i - return mgr - -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. - -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have - -- to use uninterruptible mask. - uninterruptibleMask_ $ do - tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd - cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables - close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) +closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys) + -- The array inside 'eventManager' can be swapped out at any time, see + -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by + -- checking the array bounds before and after. When such a swap has + -- happened we cleanup and try again + close_loop = do + eventManagerArray <- readIORef eventManager + let ema_bounds@(low, high) = boundsIOArray eventManagerArray + mgrs <- flip mapM [low..high] $ \i -> do + Just (_,!mgr) <- readIOArray eventManagerArray i + return mgr + + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. + -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have + -- to use uninterruptible mask. + join $ uninterruptibleMask_ $ do + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager + -- Here we exploit Note [The eventManager Array] + if new_ema_bounds /= ema_bounds + then do + -- the array has been modified. + -- mgrs still holds the right EventManagers, by the Note. + -- new_ema_bounds must be larger than ema_bounds, by the note. + -- return the MVars we took and try again + sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables + pure close_loop + else do + -- We surely have taken all the appropriate MVars. Even if the array + -- has been swapped, our mgrs is still correct. + -- Remove the Fd from all callback tables, close the Fd, and run all + -- callbacks. + cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables + close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) + pure (pure ()) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId - (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager - mmgr <- readIOArray eventManagerArray cap - return $ fmap snd mmgr + let r = boundsIOArray eventManagerArray + (cap, _) <- threadCapability t + -- It is possible that we've just increased the number of capabilities and the + -- new EventManager has not yet been constructed by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- Two options to proceed: + -- 1) return the EventManager for capability 0. This is guaranteed to exist, + -- and "shouldn't" cause any correctness issues. + -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, + -- because we must be on a brand capability and there must be a call to + -- 'ioManagerCapabilitiesChanged' pending. + -- + -- We take the second option, with the yield, judging it the most robust. + if not (inRange r cap) + then yield >> getSystemEventManager + else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do @@ -191,6 +229,22 @@ getSystemEventManager_ = do foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A mutable array holding the current EventManager for each capability +-- An entry is Nothing only while the eventmanagers are initialised, see +-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'. +-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality +-- 'cap'. +-- The array will be swapped with newer arrays when the number of capabilities +-- changes(via 'setNumCapabilities'). However: +-- * the size of the arrays will never decrease; and +-- * The 'EventManager's in the array are not replaced with other +-- 'EventManager' constructors. +-- +-- This is a similar strategy as the rts uses for it's +-- capabilities array (n_capabilities is the size of the array, +-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities @@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged = startIOManagerThread new_eventManagerArray -- update the event manager array reference: - writeIORef eventManager new_eventManagerArray + atomicWriteIORef eventManager new_eventManagerArray + -- We need an atomic write here because 'eventManager' is accessed + -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== testsuite/tests/concurrent/should_run/T21651.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test is adapted from setnumcapabilities001. + +import GHC.Conc hiding (threadWaitRead, threadWaitWrite) +import GHC.Exts +import GHC.IO.Encoding +import System.Environment +import System.IO +import Control.Monad +import Text.Printf +import Data.Time.Clock +import Control.DeepSeq + +import System.Posix.IO +import System.Posix.Types +import Control.Concurrent +import Control.Exception + +passTheParcel :: Int -> IO (IO ()) +passTheParcel n = do + pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe + rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do + let + read = fdRead readfd $ fromIntegral 1 + write = fdWrite writefd + mv <- newEmptyMVar + tid <- forkIO $ let + loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do + threadWaitRead readfd + (s, _) <- read + threadWaitWrite writefd + write s + cleanup = do + closeFdWith closeFd readfd + closeFdWith closeFd writefd + putMVar mv () + in loop `finally` cleanup + pure (mv, tid) + + let + cleanup = do + killThread tid1 + forM_ rs $ \(mv, _) -> takeMVar mv + + fdWrite (snd p1) "a" + pure cleanup + + +main = do + setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale + [n,q,t,z] <- fmap (fmap read) getArgs + cleanup_ptp <- passTheParcel z + t <- forkIO $ do + forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do + setNumCapabilities m + threadDelay t + printf "%d\n" (nqueens q) + cleanup_ptp + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 + +nqueens :: Int -> Int +nqueens nq = length (pargen 0 []) + where + safe :: Int -> Int -> [Int] -> Bool + safe x d [] = True + safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l + + gen :: [[Int]] -> [[Int]] + gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] + + pargen :: Int -> [Int] -> [[Int]] + pargen n b + | n >= threshold = iterate gen [b] !! (nq - n) + | otherwise = concat bs + where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq + + threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x ===================================== testsuite/tests/concurrent/should_run/T21651.stdout ===================================== @@ -0,0 +1 @@ +14200 ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, ['']) test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2', 'nonmoving_thr']), + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), extra_run_opts('8 12 2000'), when(have_thread_sanitizer(), expect_broken(18808)), req_smp ], compile_and_run, ['']) +test('T21651', + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), + when(opsys('mingw32'),skip), # uses POSIX pipes + when(opsys('darwin'),extra_run_opts('8 12 2000 100')), + unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files + req_smp ], + compile_and_run, ['']) + test('hs_try_putmvar001', [ when(opsys('mingw32'),skip), # uses pthread APIs in the C code View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d01245c458c49ca25c89ec13be3268ab6930a27...480b066d06e6f7a0fa66c0e73e917935a76390a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d01245c458c49ca25c89ec13be3268ab6930a27...480b066d06e6f7a0fa66c0e73e917935a76390a9 You're receiving 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 Aug 7 23:46:32 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 19:46:32 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] system-cxx-std-lib: Add support for FreeBSD libcxxrt Message-ID: <62f04ed8a0e57_25b0164bff0357343@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 48d748a2 by Ben Gamari at 2022-08-07T19:46:27-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - 1 changed file: - m4/fp_find_cxx_std_lib.m4 Changes: ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48d748a26f71be43d6bd60db01a99b2435490cfd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48d748a26f71be43d6bd60db01a99b2435490cfd You're receiving 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 Aug 8 23:05:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 19:05:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21976 Message-ID: <62f196b27c1eb_25b0164bfdc629119@gitlab.mail> Ben Gamari pushed new branch wip/T21976 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21976 You're receiving 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 Aug 8 20:48:38 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 16:48:38 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Add release job for aarch64/debian 11 Message-ID: <62f176a630f10_25b0164bfa0607843@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -769,6 +769,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) ===================================== .gitlab/jobs.yaml ===================================== @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -358,6 +416,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1864,6 +1981,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5765e13370634979eb6a0d9f67aa9afa797bee46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5765e13370634979eb6a0d9f67aa9afa797bee46 You're receiving 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 Aug 9 17:47:43 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 Aug 2022 13:47:43 -0400 Subject: [Git][ghc/ghc][master] Fix size_up_alloc to account for UnliftedDatatypes Message-ID: <62f29dbfc6a24_182c4e50618321723@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -580,10 +580,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- Cost to allocate binding with given binder size_up_alloc bndr - | isTyVar bndr -- Doesn't exist at runtime - || isJoinId bndr -- Not allocated at all - || isUnliftedType (idType bndr) -- Doesn't live in heap - -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder) + | isTyVar bndr -- Doesn't exist at runtime + || isJoinId bndr -- Not allocated at all + || not (isBoxedType (idType bndr)) -- Doesn't live in heap = 0 | otherwise = 10 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d71a20514546e0befe6e238d0658cbaad5a13996 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d71a20514546e0befe6e238d0658cbaad5a13996 You're receiving 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 Aug 9 16:34:59 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Tue, 09 Aug 2022 12:34:59 -0400 Subject: [Git][ghc/ghc][wip/js-staging] StgToJS.Arg: Unboxable Literal Optimization note Message-ID: <62f28cb351b62_182c4e5062c270722@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: f0d38680 by doyougnu at 2022-08-09T12:34:00-04:00 StgToJS.Arg: Unboxable Literal Optimization note - - - - - 1 changed file: - compiler/GHC/StgToJS/Arg.hs Changes: ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -39,6 +39,60 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import qualified Control.Monad.Trans.State.Strict as State +{- +Note [ Unboxable Literals Optimization ] +~~~~~~~~~~~~~~~~~~ + +Boxable types in the JS backend are represented as heap objects. See Note +[StgToJS design] in GHC.StgToJS.hs for more details. Some types, such as Int8 +do not benefit from not being wrapped in an object in the JS runtime. This optimization +detects such types and changes the code generator to generate a more efficient +representation. The change is minor and saves one level on indirection. Instead +of generating a wrapper object with a field for the value's payload, such as: + +// a JS object for an Int8 +var anInt8 = { d1 = + , f : entry function which would scrutinize the payload + } + +we instead generate: + +// notice, no wrapper object. This representation is essentially an Int8# in the JS backend +var anInt8 = + +This optimization fires when the follow invariants hold: + 1. The value in question has a Type which has a single data constructor + 2. The data constructor holds a single field that is monomorphic + 3. The value in question is distinguishable from a THUNK using the JavaScript typeof operator. + +From the haskell perspective this means that: + 1. An Int8# is always a JavaScript 'number', never a JavaScript object. + 2. An Int8 is either a JavaScript 'number' _or_ a JavaScript object depending on + its use case and this optimization. + +How is this sound? +~~~~~~~~~~~~~~~~~~ + +Normally this optimization would violate the guarantees of call-by-need, however +we are able to statically detect whether the type in question will be a THUNK or +not during code gen because the JS backend is consuming STG and we can check +during runtime with the typeof operator. Similarly we can check at runtime using +JavaScript's introspection operator `typeof`. Thus, when we know the value in +question will not be a THUNK we can safely elide the wrapping object, which +unboxes the value in the JS runtime. For example, an Int8 contains an Int8# +which has the JavaScript type 'number'. A THUNK of type Int8 would have a +JavaScript type 'object', so using 'typeof' allows us to check if we have +something that is definitely evaluated (i.e., a 'number') or something else. If +it is an 'object' then we may need to enter it to begin its evaluation. Consider +a type which has a 'ThreadId#' field; such as type would not be subject to this +optimization because it has to be represented as a JavaScript 'object' and thus +cannot be unboxed in this way. Another (edge) case is Int64#. Int64# is +similarly not unboxable in this way because Int64# does not fit in one +JavaScript variable and thus requires an 'object' for its representation in the +JavaScript runtime. + +-} + genStaticArg :: HasDebugCallStack => StgArg -> G [StaticArg] genStaticArg a = case a of StgLitArg l -> map StaticLitArg <$> genStaticLit l @@ -130,6 +184,8 @@ allocConStatic (TxtI to) cc con args = do cc' <- costCentreStackLbl cc allocConStatic' cc' (concat as) where + -- see Note [ Unboxable Literals Optimization ] for the purpose of these + -- checks allocConStatic' :: HasDebugCallStack => Maybe Ident -> [StaticArg] -> G () allocConStatic' cc' [] | isBoolDataCon con && dataConTag con == 1 = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0d386800543af225a7d77542674a3325c50590e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0d386800543af225a7d77542674a3325c50590e You're receiving 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 Aug 8 20:46:17 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 16:46:17 -0400 Subject: [Git][ghc/ghc][master] NCG(x86): Compile add+shift as lea if possible. Message-ID: <62f17619235cf_25b0164c07c592124@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 4 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs - testsuite/tests/codeGen/should_gen_asm/all.T Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1048,10 +1048,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -------------------- add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register + -- x + imm add_code rep x (CmmLit (CmmInt y _)) | is32BitInteger y , rep /= W8 -- LEA doesn't support byte size (#18614) = add_int rep x y + -- x + (y << imm) + add_code rep x y + -- Byte size is not supported and 16bit size is slow when computed via LEA + | rep /= W8 && rep /= W16 + -- 2^3 = 8 is the highest multiplicator supported by LEA. + , Just (x,y,shift_bits) <- get_shift x y + = add_shiftL rep x y (fromIntegral shift_bits) + where + -- x + (y << imm) + get_shift x (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) + | shift_bits <= 3 + = Just (x, y, shift_bits) + -- (y << imm) + x + get_shift (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) x + | shift_bits <= 3 + = Just (x, y, shift_bits) + get_shift _ _ + = Nothing add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y where format = intFormat rep -- TODO: There are other interesting patterns we want to replace @@ -1066,6 +1085,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y -- our three-operand add instruction: + add_int :: (Width -> CmmExpr -> Integer -> NatM Register) add_int width x y = do (x_reg, x_code) <- getSomeReg x let @@ -1079,6 +1099,22 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -- return (Any format code) + -- x + (y << shift_bits) using LEA + add_shiftL :: (Width -> CmmExpr -> CmmExpr -> Int -> NatM Register) + add_shiftL width x y shift_bits = do + (x_reg, x_code) <- getSomeReg x + (y_reg, y_code) <- getSomeReg y + let + format = intFormat width + imm = ImmInt 0 + code dst + = (x_code `appOL` y_code) `snocOL` + LEA format + (OpAddr (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg (2 ^ shift_bits)) imm)) + (OpReg dst) + -- + return (Any format code) + ---------------------- -- See Note [DIV/IDIV for bytes] ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm ===================================== @@ -0,0 +1,46 @@ +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_f_info +.type AddMulX86_f_info, @function +AddMulX86_f_info: +.LcAx: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_f_info, .-AddMulX86_f_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_f_closure +.type AddMulX86_f_closure, @object +AddMulX86_f_closure: + .quad AddMulX86_f_info +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_g_info +.type AddMulX86_g_info, @function +AddMulX86_g_info: +.LcAL: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_g_info, .-AddMulX86_g_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_g_closure +.type AddMulX86_g_closure, @object +AddMulX86_g_closure: + .quad AddMulX86_g_info +.section .note.GNU-stack,"", at progbits +.ident "GHC 9.3.20220228" + + ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash #-} + +module AddMulX86 where + +import GHC.Exts + +f :: Int# -> Int# -> Int# +f x y = + x +# (y *# 8#) -- Should result in a lea instruction, which we grep the assembly output for. + +g x y = + (y *# 8#) +# x -- Should result in a lea instruction, which we grep the assembly output for. ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -10,3 +10,4 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', '']) test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections']) +test('AddMulX86', is_amd64_codegen, compile_cmp_asm, ['hs', '-dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20457d775885d6c3df020d204da9a7acfb3c2e5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20457d775885d6c3df020d204da9a7acfb3c2e5a You're receiving 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 Aug 11 08:19:54 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 11 Aug 2022 04:19:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/revert-aarch64-deb11 Message-ID: <62f4bbaa798c8_142b49521ac31292d@gitlab.mail> Matthew Pickering pushed new branch wip/revert-aarch64-deb11 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/revert-aarch64-deb11 You're receiving 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 Aug 10 20:39:13 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 16:39:13 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f4177111b30_142b49518382004f2@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: 658f704a by Ben Gamari at 2022-08-10T16:31:47-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -852,8 +851,58 @@ ocGetNames_ELF ( ObjectCode* oc ) + shdr[i].sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + const char *sh_name = oc->sections[i].info->name; + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + } + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority must be run last + prio = 0; + } + // .ctors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + } if (shdr[i].sh_type != SHT_SYMTAB) continue; @@ -1971,62 +2020,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2031,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,190 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors + * - then run .init_arrays + * + * and on unload we run in opposite order: + * + * - first run fini_arrays + * - then run .dtors + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + break; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + break; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,25 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &&prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = 0; + prio = 0; + } else { + // .ctors are executed in reverse order: higher numbers are executed first + prio = 0xffff - prio; } - oc->info->init = slist; + addInitFini(&oc->info->init, oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + prio = INT_MAX; } - oc->info->fini = slist; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1591,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2125,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->fini) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/658f704a5cae2c54cb8332959d934ca6acf24abd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/658f704a5cae2c54cb8332959d934ca6acf24abd You're receiving 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 Aug 8 12:43:06 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 08 Aug 2022 08:43:06 -0400 Subject: [Git][ghc/ghc][wip/andreask/add_mul_lea] 832 commits: Make T20214 terminate promptly be setting input to /dev/null Message-ID: <62f104da796cd_25b01650d5c464843@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/add_mul_lea at Glasgow Haskell Compiler / GHC Commits: 706deee0 by Greg Steuck at 2022-03-05T17:44:10-08:00 Make T20214 terminate promptly be setting input to /dev/null It was hanging and timing out on OpenBSD before. - - - - - 14e90098 by Simon Peyton Jones at 2022-03-07T14:05:41-05:00 Always generalise top-level bindings Fix #21023 by always generalising top-level binding; change the documentation of -XMonoLocalBinds to match. - - - - - c9c31c3c by Matthew Pickering at 2022-03-07T14:06:16-05:00 hadrian: Add little flavour transformer to build stage2 with assertions This can be useful to build a `perf+assertions` build or even better `default+no_profiled_libs+omit_pragmas+assertions`. - - - - - 89c14a6c by Matthew Pickering at 2022-03-07T14:06:16-05:00 ci: Convert all deb10 make jobs into hadrian jobs This is the first step in converting all the CI configs to use hadrian rather than make. (#21129) The metrics increase due to hadrian using --hyperlinked-source for haddock builds. (See #21156) ------------------------- Metric Increase: haddock.Cabal haddock.base haddock.compiler ------------------------- - - - - - 7bfae2ee by Matthew Pickering at 2022-03-07T14:06:16-05:00 Replace use of BIN_DIST_PREP_TAR_COMP with BIN_DIST_NAME And adds a check to make sure we are not accidently settings BIN_DIST_PREP_TAR_COMP when using hadrian. - - - - - 5b35ca58 by Matthew Pickering at 2022-03-07T14:06:16-05:00 Fix gen_contents_index logic for hadrian bindist - - - - - 273bc133 by Krzysztof Gogolewski at 2022-03-07T14:06:52-05:00 Fix reporting constraints in pprTcSolverReportMsg 'no_instance_msg' and 'no_deduce_msg' were omitting the first wanted. - - - - - 5874a30a by Simon Jakobi at 2022-03-07T14:07:28-05:00 Improve setBit for Natural Previously the default definition was used, which involved allocating intermediate Natural values. Fixes #21173. - - - - - 7a02aeb8 by Matthew Pickering at 2022-03-07T14:08:03-05:00 Remove leftover trace in testsuite - - - - - 6ce6c250 by Andreas Klebinger at 2022-03-07T23:48:56-05:00 Expand and improve the Note [Strict Worker Ids]. I've added an explicit mention of the invariants surrounding those. As well as adding more direct cross references to the Strict Field Invariant. - - - - - d0f892fe by Ryan Scott at 2022-03-07T23:49:32-05:00 Delete GenericKind_ in favor of GenericKind_DC When deriving a `Generic1` instance, we need to know what the last type variable of a data type is. Previously, there were two mechanisms to determine this information: * `GenericKind_`, where `Gen1_` stored the last type variable of a data type constructor (i.e., the `tyConTyVars`). * `GenericKind_DC`, where `Gen1_DC` stored the last universally quantified type variable in a data constructor (i.e., the `dataConUnivTyVars`). These had different use cases, as `GenericKind_` was used for generating `Rep(1)` instances, while `GenericKind_DC` was used for generating `from(1)` and `to(1)` implementations. This was already a bit confusing, but things went from confusing to outright wrong after !6976. This is because after !6976, the `deriving` machinery stopped using `tyConTyVars` in favor of `dataConUnivTyVars`. Well, everywhere with the sole exception of `GenericKind_`, which still continued to use `tyConTyVars`. This lead to disaster when deriving a `Generic1` instance for a GADT family instance, as the `tyConTyVars` do not match the `dataConUnivTyVars`. (See #21185.) The fix is to stop using `GenericKind_` and replace it with `GenericKind_DC`. For the most part, this proves relatively straightforward. Some highlights: * The `forgetArgVar` function was deleted entirely, as it no longer proved necessary after `GenericKind_`'s demise. * The substitution that maps from the last type variable to `Any` (see `Note [Generating a correctly typed Rep instance]`) had to be moved from `tc_mkRepTy` to `tc_mkRepFamInsts`, as `tc_mkRepTy` no longer has access to the last type variable. Fixes #21185. - - - - - a60ddffd by Matthew Pickering at 2022-03-08T22:51:37+00:00 Move bootstrap and cabal-reinstall test jobs to nightly CI is creaking under the pressure of too many jobs so attempt to reduce the strain by removing a couple of jobs. - - - - - 7abe3288 by Matthew Pickering at 2022-03-09T10:24:15+00:00 Add 10 minute timeout to linters job - - - - - 3cf75ede by Matthew Pickering at 2022-03-09T10:24:16+00:00 Revert "hadrian: Correctly set whether we have a debug compiler when running tests" Needing the arguments for "GHC/Utils/Constant.hs" implies a dependency on the previous stage compiler. Whilst we work out how to get around this I will just revert this commit (as it only affects running the testsuite in debug way). This reverts commit ce65d0cceda4a028f30deafa3c39d40a250acc6a. - - - - - 18b9ba56 by Matthew Pickering at 2022-03-09T11:07:23+00:00 ci: Fix save_cache function Each interation of saving the cache would copy the whole `cabal` store into a subfolder in the CACHE_DIR rather than copying the contents of the cabal store into the cache dir. This resulted in a cache which looked like: ``` /builds/ghc/ghc/cabal-cache/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/ ``` So it would get one layer deeper every CI run and take longer and longer to compress. - - - - - bc684dfb by Ben Gamari at 2022-03-10T03:20:07-05:00 mr-template: Mention timeframe for review - - - - - 7f5f4ede by Vladislav Zavialov at 2022-03-10T03:20:43-05:00 Bump submodules: containers, exceptions GHC Proposal #371 requires TypeOperators to use type equality a~b. This submodule update pulls in the appropriate forward-compatibility changes in 'libraries/containers' and 'libraries/exceptions' - - - - - 8532b8a9 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Add an inline pragma to lookupVarEnv The containers bump reduced the size of the Data.IntMap.Internal.lookup function so that it no longer experienced W/W. This means that the size of lookupVarEnv increased over the inlining threshold and it wasn't inlined into the hot code path in substTyVar. See containers#821, #21159 and !7638 for some more explanation. ------------------------- Metric Decrease: LargeRecord T12227 T13386 T15703 T18223 T5030 T8095 T9872a T9872b T9872c TcPlugin_RewritePerf ------------------------- - - - - - 844cf1e1 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Normalise output of T10970 test The output of this test changes each time the containers submodule version updates. It's easier to apply the version normaliser so that the test checks that there is a version number, but not which one it is. - - - - - 24b6af26 by Ryan Scott at 2022-03-11T19:56:28-05:00 Refactor tcDeriving to generate tyfam insts before any bindings Previously, there was an awful hack in `genInst` (now called `genInstBinds` after this patch) where we had to return a continutation rather than directly returning the bindings for a derived instance. This was done for staging purposes, as we had to first infer the instance contexts for derived instances and then feed these contexts into the continuations to ensure the generated instance bindings had accurate instance contexts. `Note [Staging of tcDeriving]` in `GHC.Tc.Deriving` described this confusing state of affairs. The root cause of this confusing design was the fact that `genInst` was trying to generate instance bindings and associated type family instances for derived instances simultaneously. This really isn't possible, however: as `Note [Staging of tcDeriving]` explains, one needs to have access to the associated type family instances before one can properly infer the instance contexts for derived instances. The use of continuation-returning style was an attempt to circumvent this dependency, but it did so in an awkward way. This patch detangles this awkwardness by splitting up `genInst` into two functions: `genFamInsts` (for associated type family instances) and `genInstBinds` (for instance bindings). Now, the `tcDeriving` function calls `genFamInsts` and brings all the family instances into scope before calling `genInstBinds`. This removes the need for the awkward continuation-returning style seen in the previous version of `genInst`, making the code easier to understand. There are some knock-on changes as well: 1. `hasStockDeriving` now needs to return two separate functions: one that describes how to generate family instances for a stock-derived instance, and another that describes how to generate the instance bindings. I factored out this pattern into a new `StockGenFns` data type. 2. While documenting `StockGenFns`, I realized that there was some inconsistency regarding which `StockGenFns` functions needed which arguments. In particular, the function in `GHC.Tc.Deriv.Generics` which generates `Rep(1)` instances did not take a `SrcSpan` like other `gen_*` functions did, and it included an extra `[Type]` argument that was entirely redundant. As a consequence, I refactored the code in `GHC.Tc.Deriv.Generics` to more closely resemble other `gen_*` functions. A happy result of all this is that all `StockGenFns` functions now take exactly the same arguments, which makes everything more uniform. This is purely a refactoring that should not have any effect on user-observable behavior. The new design paves the way for an eventual fix for #20719. - - - - - 62caaa9b by Ben Gamari at 2022-03-11T19:57:03-05:00 gitlab-ci: Use the linters image in hlint job As the `hlint` executable is only available in the linters image. Fixes #21146. - - - - - 4abd7eb0 by Matthew Pickering at 2022-03-11T19:57:38-05:00 Remove partOfGhci check in the loader This special logic has been part of GHC ever since template haskell was introduced in 9af77fa423926fbda946b31e174173d0ec5ebac8. It's hard to believe in any case that this special logic pays its way at all. Given * The list is out-of-date, which has potential to lead to miscompilation when using "editline", which was removed in 2010 (46aed8a4). * The performance benefit seems negligable as each load only happens once anyway and packages specified by package flags are preloaded into the linker state at the start of compilation. Therefore we just remove this logic. Fixes #19791 - - - - - c40cbaa2 by Andreas Klebinger at 2022-03-11T19:58:14-05:00 Improve -dtag-inference-checks checks. FUN closures don't get tagged when evaluated. So no point in checking their tags. - - - - - ab00d23b by Simon Jakobi at 2022-03-11T19:58:49-05:00 Improve clearBit and complementBit for Natural Also optimize bigNatComplementBit#. Fixes #21175, #21181, #21194. - - - - - a6d8facb by Sebastian Graf at 2022-03-11T19:59:24-05:00 gitignore all (build) directories headed by _ - - - - - 524795fe by Sebastian Graf at 2022-03-11T19:59:24-05:00 Demand: Document why we need three additional equations of multSubDmd - - - - - 6bdcd557 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make 64-bit word splitting for 32-bit targets respect target endianness This used to been broken for little-endian targets. - - - - - 9e67c69e by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix Double# literal payload for 32-bit targets Contrary to the legacy comment, the splitting didn't happen and we ended up with a single StgWord64 literal in the output code! Let's just do the splitting here. - - - - - 1eee2e28 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: use __builtin versions of memcpyish functions to fix type mismatch Our memcpyish primop's type signatures doesn't match the C type signatures. It's not a problem for typical archs, since their C ABI permits dropping the result, but it doesn't work for wasm. The previous logic would cast the memcpyish function pointer to an incorrect type and perform an indirect call, which results in a runtime trap on wasm. The most straightforward fix is: don't emit EFF_ for memcpyish functions. Since we don't want to include extra headers in .hc to bring in their prototypes, we can just use the __builtin versions. - - - - - 9d8d4837 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: emit __builtin_unreachable() when CmmSwitch doesn't contain fallback case Otherwise the C compiler may complain "warning: non-void function does not return a value in all control paths [-Wreturn-type]". - - - - - 27da5540 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make floatToWord32/doubleToWord64 faster Use castFloatToWord32/castDoubleToWord64 in base to perform the reinterpret cast. - - - - - c98e8332 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix -Wunused-value warning in ASSIGN_BaseReg When ASSIGN_BaseReg is a no-op, we shouldn't generate any C code, otherwise C compiler complains a bunch of -Wunused-value warnings when doing unregisterised codegen. - - - - - 5932247c by Ben Gamari at 2022-03-11T20:00:36-05:00 users guide: Eliminate spurious \spxentry mentions We were failing to pass the style file to `makeindex`, as is done by the mklatex configuration generated by Sphinx. Fixes #20913. - - - - - e40cf4ef by Simon Jakobi at 2022-03-11T20:01:11-05:00 ghc-bignum: Tweak integerOr The result of ORing two BigNats is always greater or equal to the larger of the two. Therefore it is safe to skip the magnitude checks of integerFromBigNat#. - - - - - cf081476 by Vladislav Zavialov at 2022-03-12T07:02:40-05:00 checkUnboxedLitPat: use non-fatal addError This enables GHC to report more parse errors in a single pass. - - - - - 7fe07143 by Andreas Klebinger at 2022-03-12T07:03:16-05:00 Rename -fprof-late-ccs to -fprof-late - - - - - 88a94541 by Sylvain Henry at 2022-03-12T07:03:56-05:00 Hadrian: avoid useless allocations in trackArgument Cf ticky report before the change: Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 696987 29044128 0 1 L main:Target.trackArgument_go5{v r24kY} (fun) - - - - - 2509d676 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: avoid allocating in stageString (#19209) - - - - - c062fac0 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: remove useless imports Added for no reason in 7ce1b694f7be7fbf6e2d7b7eb0639e61fbe358c6 - - - - - c82fb934 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: avoid allocations in WayUnit's Read instance (#19209) - - - - - ed04aed2 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: use IntSet Binary instance for Way (#19209) - - - - - ad835531 by Simon Peyton Jones at 2022-03-13T18:12:12-04:00 Fix bug in weak loop-breakers in OccurAnal Note [Weak loop breakers] explains why we need to track variables free in RHS of rules. But we need to do this for /inactive/ rules as well as active ones, unlike the rhs_fv_env stuff. So we now have two fields in node Details, one for free vars of active rules, and one for free vars of all rules. This was shown up by #20820, which is now fixed. - - - - - 76b94b72 by Sebastian Graf at 2022-03-13T18:12:48-04:00 Worker/wrapper: Preserve float barriers (#21150) Issue #21150 shows that worker/wrapper allocated a worker function for a function with multiple calls that said "called at most once" when the first argument was absent. That's bad! This patch makes it so that WW preserves at least one non-one-shot value lambda (see `Note [Preserving float barriers]`) by passing around `void#` in place of absent arguments. Fixes #21150. Since the fix is pretty similar to `Note [Protecting the last value argument]`, I put the logic in `mkWorkerArgs`. There I realised (#21204) that `-ffun-to-thunk` is basically useless with `-ffull-laziness`, so I deprecated the flag, simplified and split into `needsVoidWorkerArg`/`addVoidWorkerArg`. SpecConstr is another client of that API. Fixes #21204. Metric Decrease: T14683 - - - - - 97db789e by romes at 2022-03-14T11:36:39-04:00 Fix up Note [Bind free vars] Move GHC-specific comments from Language.Haskell.Syntax.Binds to GHC.Hs.Binds It looks like the Note was deleted but there were actually two copies of it. L.H.S.B no longer references it, and GHC.Hs.Binds keeps an updated copy. (See #19252) There are other duplicated notes -- they will be fixed in the next commit - - - - - 135888dd by romes at 2022-03-14T11:36:39-04:00 TTG Pull AbsBinds and ABExport out of the main AST AbsBinds and ABExport both depended on the typechecker, and were thus removed from the main AST Expr. CollectPass now has a new function `collectXXHsBindsLR` used for the new HsBinds extension point Bumped haddock submodule to work with AST changes. The removed Notes from Language.Haskell.Syntax.Binds were duplicated (and not referenced) and the copies in GHC.Hs.Binds are kept (and referenced there). (See #19252) - - - - - 106413f0 by sheaf at 2022-03-14T11:37:21-04:00 Add two coercion optimisation perf tests - - - - - 8eadea67 by sheaf at 2022-03-14T15:08:24-04:00 Fix isLiftedType_maybe and handle fallout As #20837 pointed out, `isLiftedType_maybe` returned `Just False` in many situations where it should return `Nothing`, because it didn't take into account type families or type variables. In this patch, we fix this issue. We rename `isLiftedType_maybe` to `typeLevity_maybe`, which now returns a `Levity` instead of a boolean. We now return `Nothing` for types with kinds of the form `TYPE (F a1 ... an)` for a type family `F`, as well as `TYPE (BoxedRep l)` where `l` is a type variable. This fix caused several other problems, as other parts of the compiler were relying on `isLiftedType_maybe` returning a `Just` value, and were now panicking after the above fix. There were two main situations in which panics occurred: 1. Issues involving the let/app invariant. To uphold that invariant, we need to know whether something is lifted or not. If we get an answer of `Nothing` from `isLiftedType_maybe`, then we don't know what to do. As this invariant isn't particularly invariant, we can change the affected functions to not panic, e.g. by behaving the same in the `Just False` case and in the `Nothing` case (meaning: no observable change in behaviour compared to before). 2. Typechecking of data (/newtype) constructor patterns. Some programs involving patterns with unknown representations were accepted, such as T20363. Now that we are stricter, this caused further issues, culminating in Core Lint errors. However, the behaviour was incorrect the whole time; the incorrectness only being revealed by this change, not triggered by it. This patch fixes this by overhauling where the representation polymorphism involving pattern matching are done. Instead of doing it in `tcMatches`, we instead ensure that the `matchExpected` functions such as `matchExpectedFunTys`, `matchActualFunTySigma`, `matchActualFunTysRho` allow return argument pattern types which have a fixed RuntimeRep (as defined in Note [Fixed RuntimeRep]). This ensures that the pattern matching code only ever handles types with a known runtime representation. One exception was that patterns with an unknown representation type could sneak in via `tcConPat`, which points to a missing representation-polymorphism check, which this patch now adds. This means that we now reject the program in #20363, at least until we implement PHASE 2 of FixedRuntimeRep (allowing type families in RuntimeRep positions). The aforementioned refactoring, in which checks have been moved to `matchExpected` functions, is a first step in implementing PHASE 2 for patterns. Fixes #20837 - - - - - 8ff32124 by Sebastian Graf at 2022-03-14T15:09:01-04:00 DmdAnal: Don't unbox recursive data types (#11545) As `Note [Demand analysis for recursive data constructors]` describes, we now refrain from unboxing recursive data type arguments, for two reasons: 1. Relating to run/alloc perf: Similar to `Note [CPR for recursive data constructors]`, it seldomly improves run/alloc performance if we just unbox a finite number of layers of a potentially huge data structure. 2. Relating to ghc/alloc perf: Inductive definitions on single-product recursive data types like the one in T11545 will (diverge, and) have very deep demand signatures before any other abortion mechanism in Demand analysis is triggered. That leads to great and unnecessary churn on Demand analysis when ultimately we will never make use of any nested strictness information anyway. Conclusion: Discard nested demand and boxity information on such recursive types with the help of `Note [Detecting recursive data constructors]`. I also implemented `GHC.Types.Unique.MemoFun.memoiseUniqueFun` in order to avoid the overhead of repeated calls to `GHC.Core.Opt.WorkWrap.Utils.isRecDataCon`. It's nice and simple and guards against some smaller regressions in T9233 and T16577. ghc/alloc performance-wise, this patch is a very clear win: Test Metric value New value Change --------------------------------------------------------------------------------------- LargeRecord(normal) ghc/alloc 6,141,071,720 6,099,871,216 -0.7% MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,740,973,040 2,705,146,640 -1.3% T11545(normal) ghc/alloc 945,475,492 85,768,928 -90.9% GOOD T13056(optasm) ghc/alloc 370,245,880 326,980,632 -11.7% GOOD T18304(normal) ghc/alloc 90,933,944 76,998,064 -15.3% GOOD T9872a(normal) ghc/alloc 1,800,576,840 1,792,348,760 -0.5% T9872b(normal) ghc/alloc 2,086,492,432 2,073,991,848 -0.6% T9872c(normal) ghc/alloc 1,750,491,240 1,737,797,832 -0.7% TcPlugin_RewritePerf(normal) ghc/alloc 2,286,813,400 2,270,957,896 -0.7% geo. mean -2.9% No noteworthy change in run/alloc either. NoFib results show slight wins, too: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- constraints -1.9% -1.4% fasta -3.6% -2.7% reverse-complem -0.3% -0.9% treejoin -0.0% -0.3% -------------------------------------------------------------------------------- Min -3.6% -2.7% Max +0.1% +0.1% Geometric Mean -0.1% -0.1% Metric Decrease: T11545 T13056 T18304 - - - - - ab618309 by Vladislav Zavialov at 2022-03-15T18:34:38+03:00 Export (~) from Data.Type.Equality (#18862) * Users can define their own (~) type operator * Haddock can display documentation for the built-in (~) * New transitional warnings implemented: -Wtype-equality-out-of-scope -Wtype-equality-requires-operators Updates the haddock submodule. - - - - - 577135bf by Aaron Allen at 2022-03-16T02:27:48-04:00 Convert Diagnostics in GHC.Tc.Gen.Foreign Converts all uses of 'TcRnUnknownMessage' to proper diagnostics. - - - - - c1fed9da by Aaron Allen at 2022-03-16T02:27:48-04:00 Suggest FFI extensions as hints (#20116) - Use extension suggestion hints instead of suggesting extensions in the error message body for several FFI errors. - Adds a test case for `TcRnForeignImportPrimExtNotSet` - - - - - a33d1045 by Zubin Duggal at 2022-03-16T02:28:24-04:00 TH: allow negative patterns in quotes (#20711) We still don't allow negative overloaded patterns. Earler all negative patterns were treated as negative overloaded patterns. Now, we expliclty check the extension field to see if the pattern is actually a negative overloaded pattern - - - - - 1575c4a5 by Sebastian Graf at 2022-03-16T02:29:03-04:00 Demand: Let `Boxed` win in `lubBoxity` (#21119) Previously, we let `Unboxed` win in `lubBoxity`, which is unsoundly optimistic in terms ob Boxity analysis. "Unsoundly" in the sense that we sometimes unbox parameters that we better shouldn't unbox. Examples are #18907 and T19871.absent. Until now, we thought that this hack pulled its weight becuase it worked around some shortcomings of the phase separation between Boxity analysis and CPR analysis. But it is a gross hack which caused regressions itself that needed all kinds of fixes and workarounds. See for example #20767. It became impossible to work with in !7599, so I want to remove it. For example, at the moment, `lubDmd B dmd` will not unbox `dmd`, but `lubDmd A dmd` will. Given that `B` is supposed to be the bottom element of the lattice, it's hardly justifiable to get a better demand when `lub`bing with `A`. The consequence of letting `Boxed` win in `lubBoxity` is that we *would* regress #2387, #16040 and parts of #5075 and T19871.sumIO, until Boxity and CPR are able to communicate better. Fortunately, that is not the case since I could tweak the other source of optimism in Boxity analysis that is described in `Note [Unboxed demand on function bodies returning small products]` so that we *recursively* assume unboxed demands on function bodies returning small products. See the updated Note. `Note [Boxity for bottoming functions]` describes why we need bottoming functions to have signatures that say that they deeply unbox their arguments. In so doing, I had to tweak `finaliseArgBoxities` so that it will never unbox recursive data constructors. This is in line with our handling of them in CPR. I updated `Note [Which types are unboxed?]` to reflect that. In turn we fix #21119, #20767, #18907, T19871.absent and get a much simpler implementation (at least to think about). We can also drop the very ad-hoc definition of `deferAfterPreciseException` and its Note in favor of the simple, intuitive definition we used to have. Metric Decrease: T16875 T18223 T18698a T18698b hard_hole_fits Metric Increase: LargeRecord MultiComponentModulesRecomp T15703 T8095 T9872d Out of all the regresions, only the one in T9872d doesn't vanish in a perf build, where the compiler is bootstrapped with -O2 and thus SpecConstr. Reason for regressions: * T9872d is due to `ty_co_subst` taking its `LiftingContext` boxed. That is because the context is passed to a function argument, for example in `liftCoSubstTyVarBndrUsing`. * In T15703, LargeRecord and T8095, we get a bit more allocations in `expand_syn` and `piResultTys`, because a `TCvSubst` isn't unboxed. In both cases that guards against reboxing in some code paths. * The same is true for MultiComponentModulesRecomp, where we get less unboxing in `GHC.Unit.Finder.$wfindInstalledHomeModule`. In a perf build, allocations actually *improve* by over 4%! Results on NoFib: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- awards -0.4% +0.3% cacheprof -0.3% +2.4% fft -1.5% -5.1% fibheaps +1.2% +0.8% fluid -0.3% -0.1% ida +0.4% +0.9% k-nucleotide +0.4% -0.1% last-piece +10.5% +13.9% lift -4.4% +3.5% mandel2 -99.7% -99.8% mate -0.4% +3.6% parser -1.0% +0.1% puzzle -11.6% +6.5% reverse-complem -3.0% +2.0% scs -0.5% +0.1% sphere -0.4% -0.2% wave4main -8.2% -0.3% -------------------------------------------------------------------------------- Summary excludes mandel2 because of excessive bias Min -11.6% -5.1% Max +10.5% +13.9% Geometric Mean -0.2% +0.3% -------------------------------------------------------------------------------- Not bad for a bug fix. The regression in `last-piece` could become a win if SpecConstr would work on non-recursive functions. The regression in `fibheaps` is due to `Note [Reboxed crud for bottoming calls]`, e.g., #21128. - - - - - bb779b90 by sheaf at 2022-03-16T02:29:42-04:00 Add a regression test for #21130 This problem was due to a bug in cloneWanted, which was incorrectly creating a coercion hole to hold an evidence variable. This bug was introduced by 8bb52d91 and fixed in 81740ce8. Fixes #21130 - - - - - 0f0e2394 by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Initial Windows C++ exception unwinding support - - - - - 36d20d4d by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Fix ADDR32NB relocations on Windows - - - - - 8a516527 by Tamar Christina at 2022-03-17T10:16:37-04:00 testsuite: properly escape string paths - - - - - 1a0dd008 by sheaf at 2022-03-17T10:17:13-04:00 Hadrian: account for change in late-ccs flag The late cost centre flag was renamed from -fprof-late-ccs to -fprof-late in 7fe07143, but this change hadn't been propagated to Hadrian. - - - - - 8561c1af by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor HsBracket - - - - - 19163397 by romes at 2022-03-18T05:10:58-04:00 Type-checking untyped brackets When HsExpr GhcTc, the HsBracket constructor should hold a HsBracket GhcRn, rather than an HsBracket GhcTc. We make use of the HsBracket p extension constructor (XBracket (XXBracket p)) to hold an HsBracket GhcRn when the pass is GhcTc See !4782 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - 310890a5 by romes at 2022-03-18T05:10:58-04:00 Separate constructors for typed and untyped brackets Split HsBracket into HsTypedBracket and HsUntypedBracket. Unfortunately, we still cannot get rid of instance XXTypedBracket GhcTc = HsTypedBracket GhcRn despite no longer requiring it for typechecking, but rather because the TH desugarer works on GhcRn rather than GhcTc (See GHC.HsToCore.Quote) - - - - - 4a2567f5 by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor bracket for desugaring during tc When desugaring a bracket we want to desugar /renamed/ rather than /typechecked/ code; So in (HsExpr GhcTc) tree, we must have a (HsExpr GhcRn) for the quotation itself. This commit reworks the TTG refactor on typed and untyped brackets by storing the /renamed/ code in the bracket field extension rather than in the constructor extension in `HsQuote` (previously called `HsUntypedBracket`) See Note [The life cycle of a TH quotation] and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - b056adc8 by romes at 2022-03-18T05:10:58-04:00 TTG: Make HsQuote GhcTc isomorphic to NoExtField An untyped bracket `HsQuote p` can never be constructed with `p ~ GhcTc`. This is because we don't typecheck `HsQuote` at all. That's OK, because we also never use `HsQuote GhcTc`. To enforce this at the type level we make `HsQuote GhcTc` isomorphic to `NoExtField` and impossible to construct otherwise, by using TTG field extensions to make all constructors, except for `XQuote` (which takes `NoExtField`), unconstructable, with `DataConCantHappen` This is explained more in detail in Note [The life cycle of a TH quotation] Related discussion: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - ac3b2e7d by romes at 2022-03-18T05:10:58-04:00 TTG: TH brackets finishing touches Rewrite the critical notes and fix outdated ones, use `HsQuote GhcRn` (in `HsBracketTc`) for desugaring regardless of the bracket being typed or untyped, remove unused `EpAnn` from `Hs*Bracket GhcRn`, zonkExpr factor out common brackets code, ppr_expr factor out common brackets code, and fix tests, to finish MR https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782. ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - d147428a by Ben Gamari at 2022-03-18T05:11:35-04:00 codeGen: Fix signedness of jump table indexing Previously while constructing the jump table index we would zero-extend the discriminant before subtracting the start of the jump-table. This goes subtly wrong in the case of a sub-word, signed discriminant, as described in the included Note. Fix this in both the PPC and X86 NCGs. Fixes #21186. - - - - - 435a3d5d by Ben Gamari at 2022-03-18T05:11:35-04:00 testsuite: Add test for #21186 - - - - - e9d8de93 by Zubin Duggal at 2022-03-19T07:35:49-04:00 TH: Fix pretty printing of newtypes with operators and GADT syntax (#20868) The pretty printer for regular data types already accounted for these, and had some duplication with the newtype pretty printer. Factoring the logic out into a common function and using it for both newtypes and data declarations is enough to fix the bug. - - - - - 244da9eb by sheaf at 2022-03-19T07:36:24-04:00 List GHC.Event.Internal in base.cabal on Windows GHC.Event.Internal was not listed in base.cabal on Windows. This caused undefined reference errors. This patch adds it back, by moving it out of the OS-specific logic in base.cabal. Fixes #21245. - - - - - d1c03719 by Andreas Klebinger at 2022-03-19T07:37:00-04:00 Compact regions: Maintain tags properly Fixes #21251 - - - - - d45bb701 by romes at 2022-03-19T07:37:36-04:00 Remove dead code HsDoRn - - - - - c842611f by nineonine at 2022-03-20T21:16:06-04:00 Revamp derived Eq instance code generation (#17240) This patch improves code generation for derived Eq instances. The idea is to use 'dataToTag' to evaluate both arguments. This allows to 'short-circuit' when tags do not match. Unfortunately, inner evals are still present when we branch on tags. This is due to the way 'dataToTag#' primop evaluates its argument in the code generator. #21207 was created to explore further optimizations. Metric Decrease: LargeRecord - - - - - 52ffd38c by Sylvain Henry at 2022-03-20T21:16:46-04:00 Avoid some SOURCE imports - - - - - b91798be by Zubin Duggal at 2022-03-23T13:39:39-04:00 hi haddock: Lex and store haddock docs in interface files Names appearing in Haddock docstrings are lexed and renamed like any other names appearing in the AST. We currently rename names irrespective of the namespace, so both type and constructor names corresponding to an identifier will appear in the docstring. Haddock will select a given name as the link destination based on its own heuristics. This patch also restricts the limitation of `-haddock` being incompatible with `Opt_KeepRawTokenStream`. The export and documenation structure is now computed in GHC and serialised in .hi files. This can be used by haddock to directly generate doc pages without reparsing or renaming the source. At the moment the operation of haddock is not modified, that's left to a future patch. Updates the haddock submodule with the minimum changes needed. - - - - - 78db231f by Cheng Shao at 2022-03-23T13:40:17-04:00 configure: bump LlvmMaxVersion to 14 LLVM 13.0.0 is released in Oct 2021, and latest head validates against LLVM 13 just fine if LlvmMaxVersion is bumped. - - - - - b06e5dd8 by Adam Sandberg Ericsson at 2022-03-23T13:40:54-04:00 docs: clarify the eventlog format documentation a little bit - - - - - 4dc62498 by Matthew Pickering at 2022-03-23T13:41:31-04:00 Fix behaviour of -Wunused-packages in ghci Ticket #21110 points out that -Wunused-packages behaves a bit unusually in GHCi. Now we define the semantics for -Wunused-packages in interactive mode as follows: * If you use -Wunused-packages on an initial load then the warning is reported. * If you explicitly set -Wunused-packages on the command line then the warning is displayed (until it is disabled) * If you then subsequently modify the set of available targets by using :load or :cd (:cd unloads everything) then the warning is (silently) turned off. This means that every :r the warning is printed if it's turned on (but you did ask for it). Fixes #21110 - - - - - fed05347 by Ben Gamari at 2022-03-23T13:42:07-04:00 rts/adjustor: Place adjustor templates in data section on all OSs In !7604 we started placing adjustor templates in the data section on Linux as some toolchains there reject relocations in the text section. However, it turns out that OpenBSD also exhibits this restriction. Fix this by *always* placing adjustor templates in the data section. Fixes #21155. - - - - - db32bb8c by Zubin Duggal at 2022-03-23T13:42:44-04:00 Improve error message when warning about unsupported LLVM version (#20958) Change the wording to make it clear that the upper bound is non-inclusive. - - - - - f214349a by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Untag function field in scavenge_PAP_payload Previously we failed to untag the function closure when scavenging the payload of a PAP, resulting in an invalid closure pointer being passed to scavenge_large_bitmap and consequently #21254. Fix this. Fixes #21254 - - - - - e6d0e287 by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Don't mark object code in markCAFs unless necessary Previously `markCAFs` would call `markObjectCode` even in non-major GCs. This is problematic since `prepareUnloadCheck` is not called in such GCs, meaning that the section index has not been updated. Fixes #21254 - - - - - 1a7cf096 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Avoid redundant imports of GHC.Driver.Session Remove GHC.Driver.Session imports that weren't considered as redundant because of the reexport of PlatformConstants. Also remove this reexport as modules using this datatype should import GHC.Platform instead. - - - - - e3f60577 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Reverse dependency between StgToCmm and Runtime.Heap.Layout - - - - - e6585ca1 by Sylvain Henry at 2022-03-23T13:44:46-04:00 Define filterOut with filter filter has fusion rules that filterOut lacks - - - - - c58d008c by Ryan Scott at 2022-03-24T06:10:43-04:00 Fix and simplify DeriveAnyClass's context inference using SubTypePredSpec As explained in `Note [Gathering and simplifying constraints for DeriveAnyClass]` in `GHC.Tc.Deriv.Infer`, `DeriveAnyClass` infers instance contexts by emitting implication constraints. Previously, these implication constraints were constructed by hand. This is a terribly trick thing to get right, as it involves a delicate interplay of skolemisation, metavariable instantiation, and `TcLevel` bumping. Despite much effort, we discovered in #20719 that the implementation was subtly incorrect, leading to valid programs being rejected. While we could scrutinize the code that manually constructs implication constraints and repair it, there is a better, less error-prone way to do things. After all, the heart of `DeriveAnyClass` is generating code which fills in each class method with defaults, e.g., `foo = $gdm_foo`. Typechecking this sort of code is tantamount to calling `tcSubTypeSigma`, as we much ensure that the type of `$gdm_foo` is a subtype of (i.e., more polymorphic than) the type of `foo`. As an added bonus, `tcSubTypeSigma` is a battle-tested function that handles skolemisation, metvariable instantiation, `TcLevel` bumping, and all other means of tricky bookkeeping correctly. With this insight, the solution to the problems uncovered in #20719 is simple: use `tcSubTypeSigma` to check if `$gdm_foo`'s type is a subtype of `foo`'s type. As a side effect, `tcSubTypeSigma` will emit exactly the implication constraint that we were attempting to construct by hand previously. Moreover, it does so correctly, fixing #20719 as a consequence. This patch implements the solution thusly: * The `PredSpec` data type (previously named `PredOrigin`) is now split into `SimplePredSpec`, which directly stores a `PredType`, and `SubTypePredSpec`, which stores the actual and expected types in a subtype check. `SubTypePredSpec` is only used for `DeriveAnyClass`; all other deriving strategies use `SimplePredSpec`. * Because `tcSubTypeSigma` manages the finer details of type variable instantiation and constraint solving under the hood, there is no longer any need to delicately split apart the method type signatures in `inferConstraintsAnyclass`. This greatly simplifies the implementation of `inferConstraintsAnyclass` and obviates the need to store skolems, metavariables, or given constraints in a `ThetaSpec` (previously named `ThetaOrigin`). As a bonus, this means that `ThetaSpec` now simply becomes a synonym for a list of `PredSpec`s, which is conceptually much simpler than it was before. * In `simplifyDeriv`, each `SubTypePredSpec` results in a call to `tcSubTypeSigma`. This is only performed for its side effect of emitting an implication constraint, which is fed to the rest of the constraint solving machinery in `simplifyDeriv`. I have updated `Note [Gathering and simplifying constraints for DeriveAnyClass]` to explain this in more detail. To make the changes in `simplifyDeriv` more manageable, I also performed some auxiliary refactoring: * Previously, every iteration of `simplifyDeriv` was skolemising the type variables at the start, simplifying, and then performing a reverse substitution at the end to un-skolemise the type variables. This is not necessary, however, since we can just as well skolemise once at the beginning of the `deriving` pipeline and zonk the `TcTyVar`s after `simplifyDeriv` is finished. This patch does just that, having been made possible by prior work in !7613. I have updated `Note [Overlap and deriving]` in `GHC.Tc.Deriv.Infer` to explain this, and I have also left comments on the relevant data structures (e.g., `DerivEnv` and `DerivSpec`) to explain when things might be `TcTyVar`s or `TyVar`s. * All of the aforementioned cleanup allowed me to remove an ad hoc deriving-related in `checkImplicationInvariants`, as all of the skolems in a `tcSubTypeSigma`–produced implication constraint should now be `TcTyVar` at the time the implication is created. * Since `simplifyDeriv` now needs a `SkolemInfo` and `UserTypeCtxt`, I have added `ds_skol_info` and `ds_user_ctxt` fields to `DerivSpec` to store these. Similarly, I have also added a `denv_skol_info` field to `DerivEnv`, which ultimately gets used to initialize the `ds_skol_info` in a `DerivSpec`. Fixes #20719. - - - - - 21680fb0 by Sebastian Graf at 2022-03-24T06:11:19-04:00 WorkWrap: Handle partial FUN apps in `isRecDataCon` (#21265) Partial FUN apps like `(->) Bool` aren't detected by `splitFunTy_maybe`. A silly oversight that is easily fixed by replacing `splitFunTy_maybe` with a guard in the `splitTyConApp_maybe` case. But fortunately, Simon nudged me into rewriting the whole `isRecDataCon` function in a way that makes it much shorter and hence clearer which DataCons are actually considered as recursive. Fixes #21265. - - - - - a2937e2b by Matthew Pickering at 2022-03-24T17:13:22-04:00 Add test for T21035 This test checks that you are allowed to explicitly supply object files for dependencies even if you haven't got the shared object for that library yet. Fixes #21035 - - - - - 1756d547 by Matthew Pickering at 2022-03-24T17:13:58-04:00 Add check to ensure we are not building validate jobs for releases - - - - - 99623358 by Matthew Pickering at 2022-03-24T17:13:58-04:00 hadrian: Correct generation of hsc2hs wrapper If you inspect the inside of a wrapper script for hsc2hs you will see that the cflag and lflag values are concatenated incorrectly. ``` HSC2HS_EXTRA="--cflag=-U__i686--lflag=-fuse-ld=gold" ``` It should instead be ``` HSC2HS_EXTRA="--cflag=-U__i686 --lflag=-fuse-ld=gold" ``` Fixes #21221 - - - - - fefd4e31 by Matthew Pickering at 2022-03-24T17:13:59-04:00 testsuite: Remove library dependenices from T21119 These dependencies would affect the demand signature depending on various rules and so on. Fixes #21271 - - - - - 5ff690b8 by Matthew Pickering at 2022-03-24T17:13:59-04:00 ci: Generate jobs for all normal builds and use hadrian for all builds This commit introduces a new script (.gitlab/gen_ci.hs) which generates a yaml file (.gitlab/jobs.yaml) which contains explicit descriptions for all the jobs we want to run. The jobs are separated into three categories: * validate - jobs run on every MR * nightly - jobs run once per day on the master branch * release - jobs for producing release artifacts The generation script is a Haskell program which includes a DSL for specifying the different jobs. The hope is that it's easier to reason about the different jobs and how the variables are merged together rather than the unclear and opaque yaml syntax. The goal is to fix issues like #21190 once and for all.. The `.gitlab/jobs.yaml` can be generated by running the `.gitlab/generate_jobs` script. You have to do this manually. Another consequence of this patch is that we use hadrian for all the validate, nightly and release builds on all platforms. - - - - - 1d673aa2 by Christiaan Baaij at 2022-03-25T11:35:49-04:00 Add the OPAQUE pragma A new pragma, `OPAQUE`, that ensures that every call of a named function annotated with an `OPAQUE` pragma remains a call of that named function, not some name-mangled variant. Implements GHC proposal 0415: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst This commit also updates the haddock submodule to handle the newly introduced lexer tokens corresponding to the OPAQUE pragma. - - - - - 83f5841b by Bodigrim at 2022-03-25T11:36:31-04:00 Add instance Lift ByteArray - - - - - 7cc1184a by Matthew Pickering at 2022-03-25T11:37:07-04:00 Make -ddump-rn-ast and -ddump-tc-ast work in GHCi Fixes #17830 - - - - - 940feaf3 by Sylvain Henry at 2022-03-25T11:37:47-04:00 Modularize Tidy (#17957) - Factorize Tidy options into TidyOpts datatype. Initialize it in GHC.Driver.Config.Tidy - Same thing for StaticPtrOpts - Perform lookups of unpackCString[Utf8]# once in initStaticPtrOpts instead of for every use of mkStringExprWithFS - - - - - 25101813 by Takenobu Tani at 2022-03-28T01:16:02-04:00 users-guide: Correct markdown for profiling This patch corrects some markdown. [skip ci] - - - - - c832ae93 by Matthew Pickering at 2022-03-28T01:16:38-04:00 hadrian: Flag cabal flag handling This patch basically deletes some ad-hoc handling of Cabal Flags and replaces it with a correct query of the LocalBuildInfo. The flags in the local build info can be modified by users by passing hadrian options For example (!4331) ``` *.genapply.cabal.configure.opts += --flags=unregisterised ``` And all the flags specified by the `Cabal Flags` builder were already passed to configure properly using `--flags`. - - - - - a9f3a5c6 by Ben Gamari at 2022-03-28T01:16:38-04:00 Disable text's dependency on simdutf by default Unfortunately we are simply not currently in a good position to robustly ship binary distributions which link against C++ code like simdutf. Fixes #20724. - - - - - eff86e8a by Richard Eisenberg at 2022-03-28T01:17:14-04:00 Add Red Herring to Note [What might equal later?] Close #21208. - - - - - 12653be9 by jberryman at 2022-03-28T01:17:55-04:00 Document typed splices inhibiting unused bind detection (#16524) - - - - - 4aeade15 by Adam Sandberg Ericsson at 2022-03-28T01:18:31-04:00 users-guide: group ticky-ticky profiling under one heading - - - - - cc59648a by Sylvain Henry at 2022-03-28T01:19:12-04:00 Hadrian: allow testsuite to run with cross-compilers (#21292) - - - - - 89cb1315 by Matthew Pickering at 2022-03-28T01:19:48-04:00 hadrian: Add show target to bindist makefile Some build systems use "make show" to query facts about the bindist, for example: ``` make show VALUE=ProjectVersion > version ``` to determine the ProjectVersion - - - - - 8229885c by Alan Zimmerman at 2022-03-28T19:23:28-04:00 EPA: let stmt with semicolon has wrong anchor The code let ;x =1 Captures the semicolon annotation, but did not widen the anchor in the ValBinds. Fix that. Closes #20247 - - - - - 2c12627c by Ryan Scott at 2022-03-28T19:24:04-04:00 Consistently attach SrcSpans to sub-expressions in TH splices Before, `GHC.ThToHs` was very inconsistent about where various sub-expressions would get the same `SrcSpan` from the original TH splice location or just a generic `noLoc` `SrcSpan`. I have ripped out all uses of `noLoc` in favor of the former instead, and I have added a `Note [Source locations within TH splices]` to officially enshrine this design choice. Fixes #21299. - - - - - 789add55 by Zubin Duggal at 2022-03-29T13:07:22-04:00 Fix all invalid haddock comments in the compiler Fixes #20935 and #20924 - - - - - 967dad03 by Zubin Duggal at 2022-03-29T13:07:22-04:00 hadrian: Build lib:GHC with -haddock and -Winvalid-haddock (#21273) - - - - - ad09a5f7 by sheaf at 2022-03-29T13:08:05-04:00 Hadrian: make DDEBUG separate from debugged RTS This patchs separates whether -DDEBUG is enabled (i.e. whether debug assertions are enabled) from whether we are using the debugged RTS (i.e. GhcDebugged = YES). This means that we properly skip tests which have been marked with `when(compiler_debugged(), skip)`. Fixes #21113, #21153 and #21234 - - - - - 840a6811 by Matthew Pickering at 2022-03-29T13:08:42-04:00 RTS: Zero gc_cpu_start and gc_cpu_end after accounting When passed a combination of `-N` and `-qn` options the cpu time for garbage collection was being vastly overcounted because the counters were not being zeroed appropiately. When -qn1 is passed, only 1 of the N avaiable GC threads is chosen to perform work, the rest are idle. At the end of the GC period, stat_endGC traverses all the GC threads and adds up the elapsed time from each of them. For threads which didn't participate in this GC, the value of the cpu time should be zero, but before this patch, the counters were not zeroed and hence we would count the same elapsed time on many subsequent iterations (until the thread participated in a GC again). The most direct way to zero these fields is to do so immediately after the value is added into the global counter, after which point they are never used again. We also tried another approach where we would zero the counter in yieldCapability but there are some (undiagnosed) siations where a capbility would not pass through yieldCapability before the GC ended and the same double counting problem would occur. Fixes #21082 - - - - - dda46e2d by Matthew Pickering at 2022-03-29T13:09:18-04:00 Add test for T21306 Fixes #21306 - - - - - f07c7766 by Jakob Brünker at 2022-03-30T03:10:33-04:00 Give parsing plugins access to errors Previously, when the parser produced non-fatal errors (i.e. it produced errors but the 'PState' is 'POk'), compilation would be aborted before the 'parsedResultAction' of any plugin was invoked. This commit changes that, so that such that 'parsedResultAction' gets collections of warnings and errors as argument, and must return them after potentially modifying them. Closes #20803 - - - - - e5dfde75 by Ben Gamari at 2022-03-30T03:11:10-04:00 Fix reference to Note [FunBind vs PatBind] This Note was renamed in 2535a6716202253df74d8190b028f85cc6d21b72 yet this occurrence was not updated. - - - - - 21894a63 by Krzysztof Gogolewski at 2022-03-30T03:11:45-04:00 Refactor: make primtypes independent of PrimReps Previously, 'pcPrimTyCon', the function used to define a primitive type, was taking a PrimRep, only to convert it to a RuntimeRep. Now it takes a RuntimeRep directly. Moved primRepToRuntimeRep to GHC.Types.RepType. It is now located next to its inverse function runtimeRepPrimRep. Now GHC.Builtin.Types.Prim no longer mentions PrimRep, and GHC.Types.RepType no longer imports GHC.Builtin.Types.Prim. Removed unused functions `primRepsToRuntimeRep` and `mkTupleRep`. Removed Note [PrimRep and kindPrimRep] - it was never referenced, didn't belong to Types.Prim, and Note [Getting from RuntimeRep to PrimRep] is more comprehensive. - - - - - 43da2963 by Matthew Pickering at 2022-03-30T09:55:49+01:00 Fix mention of non-existent "rehydrateIface" function [skip ci] Fixes #21303 - - - - - 6793a20f by gershomb at 2022-04-01T10:33:46+01:00 Remove wrong claim about naturality law. This docs change removes a longstanding confusion in the Traversable docs. The docs say "(The naturality law is implied by parametricity and thus so is the purity law [1, p15].)". However if one reads the reference a different "natural" law is implied by parametricity. The naturality law given as a law here is imposed. Further, the reference gives examples which violate both laws -- so they cannot be implied by parametricity. This PR just removes the wrong claim. - - - - - 5beeff46 by Ben Gamari at 2022-04-01T10:34:39+01:00 Refactor handling of global initializers GHC uses global initializers for a number of things including cost-center registration, info-table provenance registration, and setup of foreign exports. Previously, the global initializer arrays which referenced these initializers would live in the object file of the C stub, which would then be merged into the main object file of the module. Unfortunately, this approach is no longer tenable with the move to Clang/LLVM on Windows (see #21019). Specifically, lld's PE backend does not support object merging (that is, the -r flag). Instead we are now rather packaging a module's object files into a static library. However, this is problematic in the case of initializers as there are no references to the C stub object in the archive, meaning that the linker may drop the object from the final link. This patch refactors our handling of global initializers to instead place initializer arrays within the object file of the module to which they belong. We do this by introducing a Cmm data declaration containing the initializer array in the module's Cmm stream. While the initializer functions themselves remain in separate C stub objects, the reference from the module's object ensures that they are not dropped from the final link. In service of #21068. - - - - - 3e6fe71b by Matthew Pickering at 2022-04-01T10:35:41+01:00 Fix remaining issues in eventlog types (gen_event_types.py) * The size of End concurrent mark phase looks wrong and, it used to be 4 and now it's 0. * The size of Task create is wrong, used to be 18 and now 14. * The event ticky-ticky entry counter begin sample has the wrong name * The event ticky-ticky entry counter being sample has the wrong size, was 0 now 32. Closes #21070 - - - - - 7847f47a by Ben Gamari at 2022-04-01T10:35:41+01:00 users-guide: Fix a few small issues in eventlog format descriptions The CONC_MARK_END event description didn't mention its payload. Clarify the meaning of the CREATE_TASK's payload. - - - - - acfd5a4c by Matthew Pickering at 2022-04-01T10:35:53+01:00 ci: Regenerate jobs.yaml It seems I forgot to update this to reflect the current state of gen_ci.hs - - - - - a952dd80 by Matthew Pickering at 2022-04-01T10:35:59+01:00 ci: Attempt to fix windows cache issues It appears that running the script directly does nothing (no info is printed about saving the cache). - - - - - fb65e6e3 by Adrian Ratiu at 2022-04-01T10:49:52+01:00 fp_prog_ar.m4: take AR var into consideration In ChromeOS and Gentoo we want the ability to use LLVM ar instead of GNU ar even though both are installed, thus we pass (for eg) AR=llvm-ar to configure. Unfortunately GNU ar always gets picked regardless of the AR setting because the check does not consider the AR var when setting fp_prog_ar, hence this fix. - - - - - 1daaefdf by Greg Steuck at 2022-04-01T10:50:16+01:00 T13366 requires c++ & c++abi libraries on OpenBSD Fixes this failure: =====> 1 of 1 [0, 0, 0] T13366(normal) 1 of 1 [0, 0, 0] Compile failed (exit code 1) errors were: <no location info>: error: user specified .o/.so/.DLL could not be loaded (File not found) Whilst trying to load: (dynamic) stdc++ Additional directories searched: (none) *** unexpected failure for T13366(normal) - - - - - 18e6c85b by Jakob Bruenker at 2022-04-01T10:54:28+01:00 new datatypes for parsedResultAction Previously, the warnings and errors were given and returned as a tuple (Messages PsWarnings, Messages PsErrors). Now, it's just PsMessages. This, together with the HsParsedModule the parser plugin gets and returns, has been wrapped up as ParsedResult. - - - - - 9727e592 by Morrow at 2022-04-01T10:55:12+01:00 Clarify that runghc interprets the input program - - - - - f589dea3 by sheaf at 2022-04-01T10:59:58+01:00 Unify RuntimeRep arguments in ty_co_match The `ty_co_match` function ignored the implicit RuntimeRep coercions that occur in a `FunCo`. Even though a comment explained that this should be fine, #21205 showed that it could result in discarding a RuntimeRep coercion, and thus discarding an important cast entirely. With this patch, we first match the kinds in `ty_co_match`. Fixes #21205 ------------------------- Metric Increase: T12227 T18223 ------------------------- - - - - - 6f4dc372 by Andreas Klebinger at 2022-04-01T11:01:35+01:00 Export MutableByteArray from Data.Array.Byte This implements CLC proposal #49 - - - - - 5df9f5e7 by ARATA Mizuki at 2022-04-01T11:02:35+01:00 Add test cases for #20640 Closes #20640 - - - - - 8334ff9e by Krzysztof Gogolewski at 2022-04-01T11:03:16+01:00 Minor cleanup - Remove unused functions exprToCoercion_maybe, applyTypeToArg, typeMonoPrimRep_maybe, runtimeRepMonoPrimRep_maybe. - Replace orValid with a simpler check - Use splitAtList in applyTysX - Remove calls to extra_clean in the testsuite; it does not do anything. Metric Decrease: T18223 - - - - - b2785cfc by Eric Lindblad at 2022-04-01T11:04:07+01:00 hadrian typos - - - - - 418e6fab by Eric Lindblad at 2022-04-01T11:04:12+01:00 two typos - - - - - dd7c7c99 by Phil de Joux at 2022-04-01T11:04:56+01:00 Add tests and docs on plugin args and order. - - - - - 3e209a62 by MaxHearnden at 2022-04-01T11:05:19+01:00 Change may not to might not - - - - - b84380d3 by Matthew Pickering at 2022-04-01T11:07:27+01:00 hadrian: Remove linters-common from bindist Zubin observed that the bindists contains the utility library linters-common. There are two options: 1. Make sure only the right files are added into the bindist.. a bit tricky due to the non-trivial structure of the lib directory. 2. Remove the bad files once they get copied in.. a bit easier So I went for option 2 but we perhaps should go for option 1 in the future. Fixes #21203 - - - - - ba9904c1 by Zubin Duggal at 2022-04-01T11:07:31+01:00 hadrian: allow testing linters with out of tree compilers - - - - - 26547759 by Matthew Pickering at 2022-04-01T11:07:35+01:00 hadrian: Introduce CheckProgram datatype to replace a 7-tuple - - - - - df65d732 by Jakob Bruenker at 2022-04-01T11:08:28+01:00 Fix panic when pretty printing HsCmdLam When pretty printing a HsCmdLam with more than one argument, GHC panicked because of a missing case. This fixes that. Closes #21300 - - - - - ad6cd165 by John Ericson at 2022-04-01T11:10:06+01:00 hadrian: Remove vestigial -this-unit-id support check This has been dead code since 400ead81e80f66ad7b1260b11b2a92f25ccc3e5a. - - - - - 8ca7ab81 by Matthew Pickering at 2022-04-01T11:10:23+01:00 hadrian: Fix race involving empty package databases There was a small chance of a race occuring between the small window of 1. The first package (.conf) file get written into the database 2. hadrian calling "ghc-pkg recache" to refresh the package.conf file In this window the package database would contain rts.conf but not a package.cache file, and therefore if ghc was invoked it would error because it was missing. To solve this we call "ghc-pkg recache" at when the database is created by shake by writing the stamp file into the database folder. This also creates the package.cache file and so avoids the possibility of this race. - - - - - cc4ec64b by Matthew Pickering at 2022-04-01T11:11:05+01:00 hadrian: Add assertion that in/out tree args are the same There have been a few instances where this calculation was incorrect, so we add a non-terminal assertion when now checks they the two computations indeed compute the same thing. Fixes #21285 - - - - - 691508d8 by Matthew Pickering at 2022-04-01T11:13:10+01:00 hlint: Ignore suggestions in generated HaddockLex file With the make build system this file ends up in the compiler/ subdirectory so is linted. With hadrian, the file ends up in _build so it's not linted. Fixes #21313 - - - - - f8f152e7 by Krzysztof Gogolewski at 2022-04-01T11:14:08+01:00 Change GHC.Prim to GHC.Exts in docs and tests Users are supposed to import GHC.Exts rather than GHC.Prim. Part of #18749. - - - - - f8fc6d2e by Matthew Pickering at 2022-04-01T11:15:24+01:00 driver: Improve -Wunused-packages error message (and simplify implementation) In the past I improved the part of -Wunused-packages which found which packages were used. Now I improve the part which detects which ones were specified. The key innovation is to use the explicitUnits field from UnitState which has the result of resolving the package flags, so we don't need to mess about with the flag arguments from DynFlags anymore. The output now always includes the package name and version (and the flag which exposed it). ``` The following packages were specified via -package or -package-id flags, but were not needed for compilation: - bytestring-0.11.2.0 (exposed by flag -package bytestring) - ghc-9.3 (exposed by flag -package ghc) - process-1.6.13.2 (exposed by flag -package process) ``` Fixes #21307 - - - - - 5e5a12d9 by Matthew Pickering at 2022-04-01T11:15:32+01:00 driver: In oneshot mode, look for interface files in hidir How things should work: * -i is the search path for source files * -hidir explicitly sets the search path for interface files and the output location for interface files. * -odir sets the search path and output location for object files. Before in one shot mode we would look for the interface file in the search locations given by `-i`, but then set the path to be in the `hidir`, so in unusual situations the finder could find an interface file in the `-i` dir but later fail because it tried to read the interface file from the `-hidir`. A bug identified by #20569 - - - - - 950f58e7 by Matthew Pickering at 2022-04-01T11:15:36+01:00 docs: Update documentation interaction of search path, -hidir and -c mode. As noted in #20569 the documentation for search path was wrong because it seemed to indicate that `-i` dirs were important when looking for interface files in `-c` mode, but they are not important if `-hidir` is set. Fixes #20569 - - - - - d85c7dcb by sheaf at 2022-04-01T11:17:56+01:00 Keep track of promotion ticks in HsOpTy This patch adds a PromotionFlag field to HsOpTy, which is used in pretty-printing and when determining whether to emit warnings with -fwarn-unticked-promoted-constructors. This allows us to correctly report tick-related warnings for things like: type A = Int : '[] type B = [Int, Bool] Updates haddock submodule Fixes #19984 - - - - - 32070e6c by Jakob Bruenker at 2022-04-01T20:31:08+02:00 Implement \cases (Proposal 302) This commit implements proposal 302: \cases - Multi-way lambda expressions. This adds a new expression heralded by \cases, which works exactly like \case, but can match multiple apats instead of a single pat. Updates submodule haddock to support the ITlcases token. Closes #20768 - - - - - c6f77f39 by sheaf at 2022-04-01T20:33:05+02:00 Add a regression test for #21323 This bug was fixed at some point between GHC 9.0 and GHC 9.2; this patch simply adds a regression test. - - - - - 3596684e by Jakob Bruenker at 2022-04-01T20:33:05+02:00 Fix error when using empty case in arrow notation It was previously not possible to use -XEmptyCase in Arrow notation, since GHC would print "Exception: foldb of empty list". This is now fixed. Closes #21301 - - - - - 9a325b59 by Ben Gamari at 2022-04-01T20:33:05+02:00 users-guide: Fix various markup issues - - - - - aefb1e6d by sheaf at 2022-04-01T20:36:01+02:00 Ensure implicit parameters are lifted `tcExpr` typechecked implicit parameters by introducing a metavariable of kind `TYPE kappa`, without enforcing that `kappa ~ LiftedRep`. This patch instead creates a metavariable of kind `Type`. Fixes #21327 - - - - - ed62dc66 by Ben Gamari at 2022-04-05T11:44:51-04:00 gitlab-ci: Disable cabal-install store caching on Windows For reasons that remain a mystery, cabal-install seems to consistently corrupt its cache on Windows. Disable caching for now. Works around #21347. - - - - - 5ece5c5a by Ryan Scott at 2022-04-06T13:00:51-04:00 Add /linters/*/dist-install/ to .gitignore Fixes #21335. [ci skip] - - - - - 410c76ee by Ben Gamari at 2022-04-06T13:01:28-04:00 Use static archives as an alternative to object merging Unfortunately, `lld`'s COFF backend does not currently support object merging. With ld.bfd having broken support for high image-load base addresses, it's necessary to find an alternative. Here I introduce support in the driver for generating static archives, which we use on Windows instead of object merging. Closes #21068. - - - - - 400666c8 by Ben Gamari at 2022-04-06T13:01:28-04: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 - - - - - 694d39f0 by Ben Gamari at 2022-04-06T13:01:28-04:00 driver: Make object merging optional On Windows we don't have a linker which supports object joining (i.e. the `-r` flag). Consequently, `-pgmlm` is now a `Maybe`. See #21068. - - - - - 41fcb5cd by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Refactor handling of ar flags Previously the setup was quite fragile as it had to assume which arguments were file arguments and which were flags. - - - - - 3ac80a86 by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Produce ar archives with L modifier on Windows Since object files may in fact be archive files, we must ensure that their contents are merged rather than constructing an archive-of-an-archive. See #21068. - - - - - 295c35c5 by Ben Gamari at 2022-04-06T13:01:28-04:00 Add a Note describing lack of object merging on Windows See #21068. - - - - - d2ae0a3a by Ben Gamari at 2022-04-06T13:01:28-04:00 Build ar archives with -L when "joining" objects Since there may be .o files which are in fact archives. - - - - - babb47d2 by Zubin Duggal at 2022-04-06T13:02:04-04:00 Add warnings for file header pragmas that appear in the body of a module (#20385) Once we are done parsing the header of a module to obtain the options, we look through the rest of the tokens in order to determine if they contain any misplaced file header pragmas that would usually be ignored, potentially resulting in bad error messages. The warnings are reported immediately so that later errors don't shadow over potentially helpful warnings. Metric Increase: T13719 - - - - - 3f31825b by Ben Gamari at 2022-04-06T13:02:40-04:00 rts/AdjustorPool: Generalize to allow arbitrary contexts Unfortunately the i386 adjustor logic needs this. - - - - - 9b645ee1 by Ben Gamari at 2022-04-06T13:02:40-04:00 adjustors/i386: Use AdjustorPool In !7511 (closed) I introduced a new allocator for adjustors, AdjustorPool, which eliminates the address space fragmentation issues which adjustors can introduce. In that work I focused on amd64 since that was the platform where I observed issues. However, in #21132 we noted that the size of adjustors is also a cause of CI fragility on i386. In this MR I port i386 to use AdjustorPool. Sadly the complexity of the i386 adjustor code does cause require a bit of generalization which makes the code a bit more opaque but such is the world. Closes #21132. - - - - - c657a616 by Ben Gamari at 2022-04-06T13:03:16-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 9ce273b9 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Drop dead HACKAGE_INDEX_STATE variable - - - - - 01845375 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab/darwin: Factor out bindists This makes it a bit easier to bump them. - - - - - c41c478e by Ben Gamari at 2022-04-06T13:03:16-04:00 Fix a few new warnings when booting with GHC 9.2.2 -Wuni-incomplete-patterns and apparent improvements in the pattern match checker surfaced these. - - - - - 6563cd24 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Bump bootstrap compiler to 9.2.2 This is necessary to build recent `text` commits. Bumps Hackage index state for a hashable which builds with GHC 9.2. - - - - - a62e983e by Ben Gamari at 2022-04-06T13:03:16-04:00 Bump text submodule to current `master` Addresses #21295. - - - - - 88d61031 by Vladislav Zavialov at 2022-04-06T13:03:53-04:00 Refactor OutputableBndrFlag instances The matching on GhcPass introduced by 95275a5f25a is not necessary. This patch reverts it to make the code simpler. - - - - - f601f002 by GHC GitLab CI at 2022-04-06T15:18:26-04:00 rts: Eliminate use of nested functions This is a gcc-specific extension. - - - - - d4c5f29c by Ben Gamari at 2022-04-06T15:18:26-04:00 driver: Drop hacks surrounding windres invocation Drop hack for #1828, among others as they appear to be unnecessary when using `llvm-windres`. - - - - - 6be2c5a7 by Ben Gamari at 2022-04-06T15:18:26-04:00 Windows/Clang: Build system adaptation * Bump win32-tarballs to 0.7 * Move Windows toolchain autoconf logic into separate file * Use clang and LLVM utilities as described in #21019 * Disable object merging as lld doesn't support -r * Drop --oformat=pe-bigobj-x86-64 arguments from ld flags as LLD detects that the output is large on its own. * Drop gcc wrapper since Clang finds its root fine on its own. - - - - - c6fb7aff by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Test that we can build bigobj PE objects - - - - - 79851c07 by Ben Gamari at 2022-04-06T15:18:26-04:00 Drop -static-libgcc This flag is not applicable when Clang is used. - - - - - 1f8a8264 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Port T16514 to C Previously this test was C++ which made it a bit of a portability problem. - - - - - d7e650d1 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark Windows as a libc++ platform - - - - - d7886c46 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark T9405 as fixed on Windows I have not seen it fail since moving to clang. Closes #12714. - - - - - 4c3fbb4e by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark FloatFnInverses as fixed The new toolchain has fixed it. Closes #15670. - - - - - 402c36ba by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Rework T13606 to avoid gcc dependence Previously we used libgcc_s's import library in T13606. However, now that we ship with clang we no longer have this library. Instead we now use gdi32. - - - - - 9934ad54 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Clean up tests depending on C++ std lib - - - - - 12fcdef2 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Split T13366 into two tests Split up the C and C++ uses since the latter is significantly more platform-dependent. - - - - - 3c08a198 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Fix mk-big-obj I'm a bit unclear on how this previously worked as it attempted to build an executable without defining `main`. - - - - - 7e97cc23 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Provide module definitions in T10955dyn Otherwise the linker will export all symbols, including those provided by the RTS, from the produced shared object. Consequently, attempting to link against multiple objects simultaneously will cause the linker to complain that RTS symbols are multiply defined. Avoid this by limiting the DLL exports with a module definition file. - - - - - 9a248afa by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark test-defaulting-plugin as fragile on Windows Currently llvm-ar does not handle long file paths, resulting in occassional failures of these tests and #21293. - - - - - 39371aa4 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite/driver: Treat framework failures of fragile tests as non-fatal Previously we would report framework failures of tests marked as fragile as failures. Now we rather treat them as fragile test failures, which are not fatal to the testsuite run. Noticed while investigating #21293. - - - - - a1e6661d by Ben Gamari at 2022-04-06T15:18:32-04:00 Bump Cabal submodule - Disable support for library-for-ghci on Windows as described in #21068. - Teach Cabal to use `ar -L` when available - - - - - f7b0f63c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump process submodule Fixes missing TEST_CC_OPTS in testsuite tests. - - - - - 109cee19 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Disable ghci libraries when object merging is not available - - - - - c22fba5c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump bytestring submodule - - - - - 6e2744cc by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump text submodule - - - - - 32333747 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Build wrappers using ghc rather than cc - - - - - 59787ba5 by Ben Gamari at 2022-04-06T15:18:37-04:00 linker/PEi386: More descriptive error message - - - - - 5e3c3c4f by Ben Gamari at 2022-04-06T15:18:37-04:00 testsuite: Mark TH_spliceE5_prof as unbroken on Windows It was previously failing due to #18721 and now passes with the new toolchain. Closes #18721. - - - - - 9eb0a9d9 by GHC GitLab CI at 2022-04-06T15:23:48-04:00 rts/PEi386: Move some debugging output to -DL - - - - - ce874595 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen/x86: Use %rip-relative addressing On Windows with high-entropy ASLR we must use %rip-relative addressing to avoid overflowing the signed 32-bit immediate size of x86-64. Since %rip-relative addressing comes essentially for free and can make linking significantly easier, we use it on all platforms. - - - - - 52deee64 by Ben Gamari at 2022-04-06T15:24:01-04:00 Generate LEA for label expressions - - - - - 105a0056 by Ben Gamari at 2022-04-06T15:24:01-04:00 Refactor is32BitLit to take Platform rather than Bool - - - - - ec4526b5 by Ben Gamari at 2022-04-06T15:24:01-04:00 Don't assume that labels are 32-bit on Windows - - - - - ffdbe457 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen: Note signed-extended nature of MOV - - - - - bfb79697 by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 5ad143fd by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - a59a66a8 by Ben Gamari at 2022-04-06T15:30:56-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - 42bf7528 by GHC GitLab CI at 2022-04-06T16:25:04-04:00 rts/PEi386: Fix memory leak Previously we would leak the section information of the `.bss` section. - - - - - d286a55c by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Preserve information about symbol types As noted in #20978, the linker would previously handle overflowed relocations by creating a jump island. While this is fine in the case of code symbols, it's very much not okay in the case of data symbols. To fix this we must keep track of whether each symbol is code or data and relocate them appropriately. This patch takes the first step in this direction, adding a symbol type field to the linker's symbol table. It doesn't yet change relocation behavior to take advantage of this knowledge. Fixes #20978. - - - - - e689e9d5 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Fix relocation overflow behavior This fixes handling of overflowed relocations on PEi386 targets: * Refuse to create jump islands for relocations of data symbols * Correctly handle the `__imp___acrt_iob_func` symbol, which is an new type of symbol: `SYM_TYPE_INDIRECT_DATA` - - - - - 655e7d8f by GHC GitLab CI at 2022-04-06T16:25:25-04:00 rts: Mark anything that might have an info table as data Tables-next-to-code mandates that we treat symbols with info tables like data since we cannot relocate them using a jump island. See #20983. - - - - - 7e8cc293 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Rework linker This is a significant rework of the PEi386 linker, making the linker compatible with high image base addresses. Specifically, we now use the m32 allocator instead of `HeapAllocate`. In addition I found a number of latent bugs in our handling of import libraries and relocations. I've added quite a few comments describing what I've learned about Windows import libraries while fixing these. Thanks to Tamar Christina (@Phyx) for providing the address space search logic, countless hours of help while debugging, and his boundless Windows knowledge. Co-Authored-By: Tamar Christina <tamar at zhox.com> - - - - - ff625218 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Move allocateBytes to MMap.c - - - - - f562b5ca by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Avoid accidentally-quadratic allocation cost We now preserve the address that we last mapped, allowing us to resume our search and avoiding quadratic allocation costs. This fixes the runtime of T10296a, which allocates many adjustors. - - - - - 3247b7db by Ben Gamari at 2022-04-06T16:25:25-04:00 Move msvcrt dep out of base - - - - - fa404335 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: More descriptive debug output - - - - - 140f338f by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PathUtils: Define pathprintf in terms of snwprintf on Windows swprintf deviates from usual `snprintf` semantics in that it does not guarantee reasonable behavior when the buffer is NULL (that is, returning the number of bytes that would have been emitted). - - - - - eb60565b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Report archive member index - - - - - 209fd61b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Split up object resolution and initialization Previously the RTS linker would call initializers during the "resolve" phase of linking. However, this is problematic in the case of cyclic dependencies between objects. In particular, consider the case where we have a situation where a static library contains a set of recursive objects: * object A has depends upon symbols in object B * object B has an initializer that depends upon object A * we try to load object A The linker would previously: 1. start resolving object A 2. encounter the reference to object B, loading it resolve object B 3. run object B's initializer 4. the initializer will attempt to call into object A, which hasn't been fully resolved (and therefore protected) Fix this by moving constructor execution to a new linking phase, which follows resolution. Fix #21253. - - - - - 8e8a1021 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker/LoadArchive: Fix leaking file handle Previously `isArchive` could leak a `FILE` handle if the `fread` returned a short read. - - - - - 429ea5d9 by sheaf at 2022-04-07T07:55:52-04:00 Remove Fun pattern from Typeable COMPLETE set GHC merge request !963 improved warnings in the presence of COMPLETE annotations. This allows the removal of the Fun pattern from the complete set. Doing so expectedly causes some redundant pattern match warnings, in particular in GHC.Utils.Binary.Typeable and Data.Binary.Class from the binary library; this commit addresses that. Updates binary submodule Fixes #20230 - - - - - 54b18824 by Alan Zimmerman at 2022-04-07T07:56:28-04:00 EPA: handling of con_bndrs in mkGadtDecl Get rid of unnnecessary case clause that always matched. Closes #20558 - - - - - 9c838429 by Ben Gamari at 2022-04-07T09:38:53-04:00 testsuite: Mark T10420 as broken on Windows Due to #21322. - - - - - 50739d2b by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Refactor and fix printf attributes on clang Clang on Windows does not understand the `gnu_printf` attribute; use `printf` instead. - - - - - 9eeaeca4 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Add missing newline in error message - - - - - fcef9a17 by Ben Gamari at 2022-04-07T09:42:42-04:00 configure: Make environ decl check more robust Some platforms (e.g. Windows/clang64) declare `environ` in `<stdlib.h>`, not `<unistd.h>` - - - - - 8162b4f3 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Adjust RTS symbol table on Windows for ucrt - - - - - 633280d7 by Ben Gamari at 2022-04-07T09:43:21-04:00 testsuite: Fix exit code of bounds checking tests on Windows `abort` exits with 255, not 134, on Windows. - - - - - cab4dc01 by Ben Gamari at 2022-04-07T09:43:31-04:00 testsuite: Update expected output from T5435 tests on Windows I'll admit, I don't currently see *why* this output is reordered but it is a fairly benign difference and I'm out of time to investigate. - - - - - edf5134e by Ben Gamari at 2022-04-07T09:43:35-04:00 testsuite: Mark T20918 as broken on Windows Our toolchain on Windows doesn't currently have Windows support. - - - - - d0ddeff3 by Ben Gamari at 2022-04-07T09:43:39-04:00 testsuite: Mark linker unloading tests as broken on Windows Due to #20354. We will need to investigate this prior the release. - - - - - 5a86da2b by Ben Gamari at 2022-04-07T09:43:43-04:00 testsuite: Mark T9405 as broken on Windows Due to #21361. - - - - - 4aa86dcf by Ben Gamari at 2022-04-07T09:44:18-04:00 Merge branches 'wip/windows-high-codegen', 'wip/windows-high-linker', 'wip/windows-clang-2' and 'wip/lint-rts-includes' into wip/windows-clang-join - - - - - 7206f055 by Ben Gamari at 2022-04-07T09:45:07-04:00 rts/CloneStack: Ensure that Rts.h is #included first As is necessary on Windows. - - - - - 9cfcb27b by Ben Gamari at 2022-04-07T09:45:07-04:00 rts: Fallback to ucrtbase not msvcrt Since we have switched to Clang the toolchain now links against ucrt rather than msvcrt. - - - - - d6665d85 by Ben Gamari at 2022-04-07T09:46:25-04:00 Accept spurious perf test shifts on Windows Metric Decrease: T16875 Metric Increase: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 83363c8b by Simon Peyton Jones at 2022-04-07T12:57:21-04:00 Use prepareBinding in tryCastWorkerWrapper As #21144 showed, tryCastWorkerWrapper was calling prepareRhs, and then unconditionally floating the bindings, without the checks of doFloatFromRhs. That led to floating an unlifted binding into a Rec group. This patch refactors prepareBinding to make these checks, and do them uniformly across all calls. A nice improvement. Other changes * Instead of passing around a RecFlag and a TopLevelFlag; and sometimes a (Maybe SimplCont) for join points, define a new Simplifier-specific data type BindContext: data BindContext = BC_Let TopLevelFlag RecFlag | BC_Join SimplCont and use it consistently. * Kill off completeNonRecX by inlining it. It was only called in one place. * Add a wrapper simplImpRules for simplRules. Compile time on T9630 drops by 4.7%; little else changes. Metric Decrease: T9630 - - - - - 02279a9c by Vladislav Zavialov at 2022-04-07T12:57:59-04:00 Rename [] to List (#21294) This patch implements a small part of GHC Proposal #475. The key change is in GHC.Types: - data [] a = [] | a : [a] + data List a = [] | a : List a And the rest of the patch makes sure that List is pretty-printed as [] in various contexts. Updates the haddock submodule. - - - - - 08480d2a by Simon Peyton Jones at 2022-04-07T12:58:36-04:00 Fix the free-var test in validDerivPred The free-var test (now documented as (VD3)) was too narrow, affecting only class predicates. #21302 demonstrated that this wasn't enough! Fixes #21302. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - b3d6d23d by Andreas Klebinger at 2022-04-07T12:59:12-04:00 Properly explain where INLINE pragmas can appear. Fixes #20676 - - - - - 23ef62b3 by Ben Gamari at 2022-04-07T14:28:28-04:00 rts: Fix off-by-one in snwprintf usage - - - - - b2dbcc7d by Simon Jakobi at 2022-04-08T03:00:38-04:00 Improve seq[D]VarSet Previously, the use of size[D]VarSet would involve a traversal of the entire underlying IntMap. Since IntMaps are already spine-strict, this is unnecessary. - - - - - 64ac20a7 by sheaf at 2022-04-08T03:01:16-04:00 Add test for #21338 This no-skolem-info bug was fixed by the no-skolem-info patch that will be part of GHC 9.4. This patch adds a regression test for the issue reported in issue #21338. Fixes #21338. - - - - - c32c4db6 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 56f85d62 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - cb1f31f5 by Ben Gamari at 2022-04-08T03:01:53-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - c44432db by Krzysztof Gogolewski at 2022-04-08T03:02:29-04:00 Fixes to 9.4 release notes - Mention -Wforall-identifier - Improve description of withDict - Fix formatting - - - - - 777365f1 by sheaf at 2022-04-08T09:43:35-04:00 Correctly report SrcLoc of redundant constraints We were accidentally dropping the source location information in certain circumstances when reporting redundant constraints. This patch makes sure that we set the TcLclEnv correctly before reporting the warning. Fixes #21315 - - - - - af300a43 by Vladislav Zavialov at 2022-04-08T09:44:11-04:00 Reject illegal quote mark in data con declarations (#17865) * Non-fatal (i.e. recoverable) parse error * Checking infix constructors * Extended the regression test - - - - - 56254e6b by Ben Gamari at 2022-04-08T09:59:46-04:00 Merge remote-tracking branch 'origin/master' - - - - - 6e2c3b7c by Matthew Pickering at 2022-04-08T13:55:15-04:00 driver: Introduce HomeModInfoCache abstraction The HomeModInfoCache is a mutable cache which is updated incrementally as the driver completes, this makes it robust to exceptions including (SIGINT) The interface for the cache is described by the `HomeMOdInfoCache` data type: ``` data HomeModInfoCache = HomeModInfoCache { hmi_clearCache :: IO [HomeModInfo] , hmi_addToCache :: HomeModInfo -> IO () } ``` The first operation clears the cache and returns its contents. This is designed so it's harder to end up in situations where the cache is retained throughout the execution of upsweep. The second operation allows a module to be added to the cache. The one slightly nasty part is in `interpretBuildPlan` where we have to be careful to ensure that the cache writes happen: 1. In parralel 2. Before the executation continues after upsweep. This requires some simple, localised MVar wrangling. Fixes #20780 - - - - - 85f4a3c9 by Andreas Klebinger at 2022-04-08T13:55:50-04:00 Add flag -fprof-manual which controls if GHC should honour manual cost centres. This allows disabling of manual control centres in code a user doesn't control like libraries. Fixes #18867 - - - - - 3415981c by Vladislav Zavialov at 2022-04-08T13:56:27-04:00 HsUniToken for :: in GADT constructors (#19623) One more step towards the new design of EPA. Updates the haddock submodule. - - - - - 23f95735 by sheaf at 2022-04-08T13:57:07-04:00 Docs: datacon eta-expansion, rep-poly checks The existing notes weren't very clear on how the eta-expansion of data constructors that occurs in tcInferDataCon/dsConLike interacts with the representation polymorphism invariants. So we explain with a few more details how we ensure that the representation-polymorphic lambdas introduced by tcInferDataCon/dsConLike don't end up causing problems, by checking they are properly instantiated and then relying on the simple optimiser to perform beta reduction. A few additional changes: - ConLikeTc just take type variables instead of binders, as we never actually used the binders. - Removed the FRRApp constructor of FRROrigin; it was no longer used now that we use ExpectedFunTyOrigin. - Adds a bit of documentation to the constructors of ExpectedFunTyOrigin. - - - - - d4480490 by Matthew Pickering at 2022-04-08T13:57:43-04:00 ci: Replace "always" with "on_success" to stop build jobs running before hadrian-ghci has finished See https://docs.gitlab.com/ee/ci/yaml/#when * always means, always run not matter what * on_success means, run if the dependencies have built successfully - - - - - 0736e949 by Vladislav Zavialov at 2022-04-08T13:58:19-04:00 Disallow (->) as a data constructor name (#16999) The code was misusing isLexCon, which was never meant for validation. In fact, its documentation states the following: Use these functions to figure what kind of name a 'FastString' represents; these functions do /not/ check that the identifier is valid. Ha! This sign can't stop me because I can't read. The fix is to use okConOcc instead. The other checks (isTcOcc or isDataOcc) seem superfluous, so I also removed those. - - - - - e58d5eeb by Simon Peyton Jones at 2022-04-08T13:58:55-04:00 Tiny documentation wibble This commit commit 83363c8b04837ee871a304cf85207cf79b299fb0 Author: Simon Peyton Jones <simon.peytonjones at gmail.com> Date: Fri Mar 11 16:55:38 2022 +0000 Use prepareBinding in tryCastWorkerWrapper refactored completeNonRecX away, but left a Note referring to it. This MR fixes that Note. - - - - - 4bb00839 by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Fix nightly head.hackage pipelines This also needs a corresponding commit to head.hackage, I also made the job explicitly depend on the fedora33 job so that it isn't blocked by a failing windows job, which causes docs-tarball to fail. - - - - - 3c48e12a by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Remove doc-tarball dependency from perf and perf-nofib jobs These don't depend on the contents of the tarball so we can run them straight after the fedora33 job finishes. - - - - - 27362265 by Matthew Pickering at 2022-04-09T07:41:04-04:00 Bump deepseq to 1.4.7.0 Updates deepseq submodule Fixes #20653 - - - - - dcf30da8 by Joachim Breitner at 2022-04-09T13:02:19-04:00 Drop the app invariant previously, GHC had the "let/app-invariant" which said that the RHS of a let or the argument of an application must be of lifted type or ok for speculation. We want this on let to freely float them around, and we wanted that on app to freely convert between the two (e.g. in beta-reduction or inlining). However, the app invariant meant that simple code didn't stay simple and this got in the way of rules matching. By removing the app invariant, this thus fixes #20554. The new invariant is now called "let-can-float invariant", which is hopefully easier to guess its meaning correctly. Dropping the app invariant means that everywhere where we effectively do beta-reduction (in the two simplifiers, but also in `exprIsConApp_maybe` and other innocent looking places) we now have to check if the argument must be evaluated (unlifted and side-effecting), and analyses have to be adjusted to the new semantics of `App`. Also, `LetFloats` in the simplifier can now also carry such non-floating bindings. The fix for DmdAnal, refine by Sebastian, makes functions with unlifted arguments strict in these arguments, which changes some signatures. This causes some extra calls to `exprType` and `exprOkForSpeculation`, so some perf benchmarks regress a bit (while others improve). Metric Decrease: T9020 Metric Increase: LargeRecord T12545 T15164 T16577 T18223 T5642 T9961 Co-authored-by: Sebastian Graf <sebastian.graf at kit.edu> - - - - - 6c6c5379 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add functions traceWith, traceShowWith, traceEventWith. As discussed at https://github.com/haskell/core-libraries-committee/issues/36 - - - - - 8fafacf7 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add tests for several trace functions. - - - - - 20bbf3ac by Philip Hazelden at 2022-04-09T13:02:59-04:00 Update changelog. - - - - - 47d18b0b by Andreas Klebinger at 2022-04-09T13:03:35-04:00 Add regression test for #19569 - - - - - 5f8d6e65 by sheaf at 2022-04-09T13:04:14-04:00 Fix missing SymCo in pushCoercionIntoLambda There was a missing SymCo in pushCoercionIntoLambda. Currently this codepath is only used with rewrite rules, so this bug managed to slip by, but trying to use pushCoercionIntoLambda in other contexts revealed the bug. - - - - - 20eca489 by Vladislav Zavialov at 2022-04-09T13:04:50-04:00 Refactor: simplify lexing of the dot Before this patch, the lexer did a truly roundabout thing with the dot: 1. look up the varsym in reservedSymsFM and turn it into ITdot 2. under OverloadedRecordDot, turn it into ITvarsym 3. in varsym_(prefix|suffix|...) turn it into ITvarsym, ITdot, or ITproj, depending on extensions and whitespace Turns out, the last step is sufficient to handle the dot correctly. This patch removes the first two steps. - - - - - 5440f63e by Hécate Moonlight at 2022-04-12T11:11:06-04:00 Document that DuplicateRecordFields doesn't tolerates ambiguous fields Fix #19891 - - - - - 0090ad7b by Sebastian Graf at 2022-04-12T11:11:42-04:00 Eta reduction based on evaluation context (#21261) I completely rewrote our Notes surrounding eta-reduction. The new entry point is `Note [Eta reduction makes sense]`. Then I went on to extend the Simplifier to maintain an evaluation context in the form of a `SubDemand` inside a `SimplCont`. That `SubDemand` is useful for doing eta reduction according to `Note [Eta reduction based on evaluation context]`, which describes how Demand analysis, Simplifier and `tryEtaReduce` interact to facilitate eta reduction in more scenarios. Thus we fix #21261. ghc/alloc perf marginally improves (-0.0%). A medium-sized win is when compiling T3064 (-3%). It seems that haddock improves by 0.6% to 1.0%, too. Metric Decrease: T3064 - - - - - 4d2ee313 by Sebastian Graf at 2022-04-12T17:54:57+02:00 Specialising through specialised method calls (#19644) In #19644, we discovered that the ClassOp/DFun rules from Note [ClassOp/DFun selection] inhibit transitive specialisation in a scenario like ``` class C a where m :: Show b => a -> b -> ...; n :: ... instance C Int where m = ... -- $cm :: Show b => Int -> b -> ... f :: forall a b. (C a, Show b) => ... f $dC $dShow = ... m @a $dC @b $dShow ... main = ... f @Int @Bool ... ``` After we specialise `f` for `Int`, we'll see `m @a $dC @b $dShow` in the body of `$sf`. But before this patch, Specialise doesn't apply the ClassOp/DFun rule to rewrite to a call of the instance method for `C Int`, e.g., `$cm @Bool $dShow`. As a result, Specialise couldn't further specialise `$cm` for `Bool`. There's a better example in `Note [Specialisation modulo dictionary selectors]`. This patch enables proper Specialisation, as follows: 1. In the App case of `specExpr`, try to apply the CalssOp/DictSel rule on the head of the application 2. Attach an unfolding to freshly-bound dictionary ids such as `$dC` and `$dShow` in `bindAuxiliaryDict` NB: Without (2), (1) would be pointless, because `lookupRule` wouldn't be able to look into the RHS of `$dC` to see the DFun. (2) triggered #21332, because the Specialiser floats around dictionaries without accounting for them in the `SpecEnv`'s `InScopeSet`, triggering a panic when rewriting dictionary unfoldings. Fixes #19644 and #21332. - - - - - b06f4f47 by Sebastian Graf at 2022-04-12T17:54:58+02:00 Specialise: Check `typeDeterminesValue` before specialising on an interesting dictionary I extracted the checks from `Note [Type determines value]` into its own function, so that we share the logic properly. Then I made sure that we actually call `typeDeterminesValue` everywhere we check for `interestingDict`. - - - - - a42dbc55 by Matthew Pickering at 2022-04-13T06:24:52-04:00 Refine warning about defining rules in SAFE modules This change makes it clear that it's the definition rather than any usage which is a problem, and that rules defined in other modules will still be used to do rewrites. Fixes #20923 - - - - - df893f66 by Andreas Klebinger at 2022-04-14T08:18:37-04:00 StgLint: Lint constructor applications and strict workers for arity. This will mean T9208 when run with lint will return a lint error instead of resulting in a panic. Fixes #21117 - - - - - 426ec446 by sheaf at 2022-04-14T08:19:16-04:00 Hadrian: use a set to keep track of ways The order in which ways are provided doesn't matter, so we use a data structure with the appropriate semantics to represent ways. Fixes #21378 - - - - - 7c639b9a by Dylan Yudaken at 2022-04-15T13:55:59-04:00 Only enable PROF_SPIN in DEBUG - - - - - 96b9e5ea by Ben Gamari at 2022-04-15T13:56:34-04:00 testsuite: Add test for #21390 - - - - - d8392f6a by Ben Gamari at 2022-04-15T13:56:34-04:00 rts: Ensure that the interpreter doesn't disregard tags Previously the interpreter's handling of `RET_BCO` stack frames would throw away the tag of the returned closure. This resulted in #21390. - - - - - 83c67f76 by Alan Zimmerman at 2022-04-20T11:49:28-04:00 Add -dkeep-comments flag to keep comments in the parser This provides a way to set the Opt_KeepRawTokenStream from the command line, allowing exact print annotation users to see exactly what is produced for a given parsed file, when used in conjunction with -ddump-parsed-ast Discussed in #19706, but this commit does not close the issue. - - - - - a5ea65c9 by Krzysztof Gogolewski at 2022-04-20T11:50:04-04:00 Remove LevityInfo Every Id was storing a boolean whether it could be levity-polymorphic. This information is no longer needed since representation-checking has been moved to the typechecker. - - - - - 49bd7584 by Andreas Klebinger at 2022-04-20T11:50:39-04:00 Fix a shadowing issue in StgUnarise. For I assume performance reasons we don't record no-op replacements during unarise. This lead to problems with code like this: f = \(Eta_B0 :: VoidType) x1 x2 -> ... let foo = \(Eta_B0 :: LiftedType) -> g x y Eta_B0 in ... Here we would record the outer Eta_B0 as void rep, but would not shadow Eta_B0 inside `foo` because this arg is single-rep and so doesn't need to replaced. But this means when looking at occurence sites we would check the env and assume it's void rep based on the entry we made for the (no longer in scope) outer `Eta_B0`. Fixes #21396 and the ticket has a few more details. - - - - - 0c02c919 by Simon Peyton Jones at 2022-04-20T11:51:15-04:00 Fix substitution in bindAuxiliaryDict In GHC.Core.Opt.Specialise.bindAuxiliaryDict we were unnecessarily calling `extendInScope` to bring into scope variables that were /already/ in scope. Worse, GHC.Core.Subst.extendInScope strangely deleted the newly-in-scope variables from the substitution -- and that was fatal in #21391. I removed the redundant calls to extendInScope. More ambitiously, I changed GHC.Core.Subst.extendInScope (and cousins) to stop deleting variables from the substitution. I even changed the names of the function to extendSubstInScope (and cousins) and audited all the calls to check that deleting from the substitution was wrong. In fact there are very few such calls, and they are all about introducing a fresh non-in-scope variable. These are "OutIds"; it is utterly wrong to mess with the "InId" substitution. I have not added a Note, because I'm deleting wrong code, and it'd be distracting to document a bug. - - - - - 0481a6af by Cheng Shao at 2022-04-21T11:06:06+00:00 [ci skip] Drop outdated TODO in RtsAPI.c - - - - - 1e062a8a by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Introduce ip_STACK_FRAME While debugging it is very useful to be able to determine whether a given info table is a stack frame or not. We have spare bits in the closure flags array anyways, use one for this information. - - - - - 08a6a2ee by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Mark closureFlags array as const - - - - - 8f9b8282 by Krzysztof Gogolewski at 2022-04-22T02:13:35-04:00 Check for zero-bit types in sizeExpr Fixes #20940 Metric Decrease: T18698a - - - - - fcf22883 by Andreas Klebinger at 2022-04-22T02:14:10-04:00 Include the way string in the file name for dump files. This can be disabled by `-fno-dump-with-ways` if not desired. Finally we will be able to look at both profiled and non-profiled dumps when compiling with dump flags and we compile in both ways. - - - - - 252394ce by Bodigrim at 2022-04-22T02:14:48-04:00 Improve error messages from GHC.IO.Encoding.Failure - - - - - 250f57c1 by Bodigrim at 2022-04-22T02:14:48-04:00 Update test baselines to match new error messages from GHC.IO.Encoding.Failure - - - - - 5ac9b321 by Ben Gamari at 2022-04-22T02:15:25-04:00 get-win32-tarballs: Drop i686 architecture As of #18487 we no longer support 32-bit Windows. Fixes #21372. - - - - - dd5fecb0 by Ben Gamari at 2022-04-22T02:16:00-04:00 hadrian: Don't rely on xxx not being present in installation path Previously Hadrian's installation makefile would assume that the string `xxx` did not appear in the installation path. This would of course break for some users. Fixes #21402. - - - - - 09e98859 by Ben Gamari at 2022-04-22T02:16:35-04:00 testsuite: Ensure that GHC doesn't pick up environment files Here we set GHC_ENVIRONMENT="-" to ensure that GHC invocations of tests don't pick up a user's local package environment. Fixes #21365. Metric Decrease: T10421 T12234 T12425 T13035 T16875 T9198 - - - - - 76bb8cb3 by Ben Gamari at 2022-04-22T02:17:11-04:00 hadrian: Enable -dlint in devel2 flavour Previously only -dcore-lint was enabled. - - - - - f435d55f by Krzysztof Gogolewski at 2022-04-22T08:00:18-04:00 Fixes to rubbish literals * In CoreToStg, the application 'RUBBISH[rep] x' was simplified to 'RUBBISH[rep]'. But it is possible that the result of the function is represented differently than the function. * In Unarise, 'LitRubbish (primRepToType prep)' is incorrect: LitRubbish takes a RuntimeRep such as IntRep, while primRepToType returns a type such as Any @(TYPE IntRep). Use primRepToRuntimeRep instead. This code is never run in the testsuite. * In StgToByteCode, all rubbish literals were assumed to be boxed. This code predates representation-polymorphic RubbishLit and I think it was not updated. I don't have a testcase for any of those issues, but the code looks wrong. - - - - - 93c16b94 by sheaf at 2022-04-22T08:00:57-04:00 Relax "suppressing errors" assert in reportWanteds The assertion in reportWanteds that we aren't suppressing all the Wanted constraints was too strong: it might be the case that we are inside an implication, and have already reported an unsolved Wanted from outside the implication. It is possible that all Wanteds inside the implication have been rewritten by the outer Wanted, so we shouldn't throw an assertion failure in that case. Fixes #21405 - - - - - 78ec692d by Andreas Klebinger at 2022-04-22T08:01:33-04:00 Mention new MutableByteArray# wrapper in base changelog. - - - - - 56d7cb53 by Eric Lindblad at 2022-04-22T14:13:32-04:00 unlist announce - - - - - 1e4dcf23 by sheaf at 2022-04-22T14:14:12-04:00 decideMonoTyVars: account for CoVars in candidates The "candidates" passed to decideMonoTyVars can contain coercion holes. This is because we might well decide to quantify over some unsolved equality constraints, as long as they are not definitely insoluble. In that situation, decideMonoTyVars was passing a set of type variables that was not closed over kinds to closeWrtFunDeps, which was tripping up an assertion failure. Fixes #21404 - - - - - 2c541f99 by Simon Peyton Jones at 2022-04-22T14:14:47-04:00 Improve floated dicts in Specialise Second fix to #21391. It turned out that we missed calling bringFloatedDictsIntoScope when specialising imports, which led to the same bug as before. I refactored to move that call to a single place, in specCalls, so we can't forget it. This meant making `FloatedDictBinds` into its own type, pairing the dictionary bindings themselves with the set of their binders. Nicer this way. - - - - - 0950e2c4 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Ensure that --extra-lib-dirs are used Previously we only took `extraLibDirs` and friends from the package description, ignoring any contribution from the `LocalBuildInfo`. Fix this. Fixes #20566. - - - - - 53cc93ae by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Drop redundant include directories The package-specific include directories in Settings.Builders.Common.cIncludeDirs are now redundant since they now come from Cabal. Closes #20566. - - - - - b2721819 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Clean up handling of libffi dependencies - - - - - 18e5103f by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: More robust library way detection Previously `test.mk` would try to determine whether the dynamic, profiling, and vanilla library ways are available by searching for `PrimOpWrappers.{,dyn_,p_}hi` in directory reported by `ghc-pkg field ghc-prim library-dirs`. However, this is extremely fragile as there is no guarantee that there is only one library directory. To handle the case of multiple `library-dirs` correct we would have to carry out the delicate task of tokenising the directory list (in shell, no less). Since this isn't a task that I am eager to solve, I have rather moved the detection logic into the testsuite driver and instead perform a test compilation in each of the ways. This should be more robust than the previous approach. I stumbled upon this while fixing #20579. - - - - - 6c7a4913 by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: Cabalify ghc-config To ensure that the build benefits from Hadrian's usual logic for building packages, avoiding #21409. Closes #21409. - - - - - 9af091f7 by Ben Gamari at 2022-04-25T10:18:53-04:00 rts: Factor out built-in GC roots - - - - - e7c4719d by Ben Gamari at 2022-04-25T10:18:54-04:00 Ensure that wired-in exception closures aren't GC'd As described in Note [Wired-in exceptions are not CAFfy], a small set of built-in exception closures get special treatment in the code generator, being declared as non-CAFfy despite potentially containing CAF references. The original intent of this treatment for the RTS to then add StablePtrs for each of the closures, ensuring that they are not GC'd. However, this logic was not applied consistently and eventually removed entirely in 951c1fb0. This lead to #21141. Here we fix this bug by reintroducing the StablePtrs and document the status quo. Closes #21141. - - - - - 9587726f by Ben Gamari at 2022-04-25T10:18:54-04:00 testsuite: Add testcase for #21141 - - - - - cb71226f by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop dead code in GHC.Linker.Static.linkBinary' Previously we supported building statically-linked executables using libtool. However, this was dropped in 91262e75dd1d80f8f28a3922934ec7e59290e28c in favor of using ar/ranlib directly. Consequently we can drop this logic. Fixes #18826. - - - - - 9420d26b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop libtool path from settings file GHC no longers uses libtool for linking and therefore this is no longer necessary. - - - - - 41cf758b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop remaining vestiges of libtool Drop libtool logic from gen-dll, allowing us to drop the remaining logic from the `configure` script. Strangely, this appears to reliably reduce compiler allocations of T16875 on Windows. Closes #18826. Metric Decrease: T16875 - - - - - e09afbf2 by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - e76705cf by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Improve documentation of closure types Also drops the unused TREC_COMMITTED transaction state. - - - - - f2c08124 by Bodigrim at 2022-04-25T10:20:44-04:00 Document behaviour of RULES with KnownNat - - - - - 360dc2bc by Li-yao Xia at 2022-04-25T19:13:06+00:00 Fix rendering of liftA haddock - - - - - 16df6058 by Ben Gamari at 2022-04-27T10:02:25-04:00 testsuite: Report minimum and maximum stat changes As suggested in #20733. - - - - - e39cab62 by Fabian Thorand at 2022-04-27T10:03:03-04:00 Defer freeing of mega block groups Solves the quadratic worst case performance of freeing megablocks that was described in issue #19897. During GC runs, we now keep a secondary free list for megablocks that is neither sorted, nor coalesced. That way, free becomes an O(1) operation at the expense of not being able to reuse memory for larger allocations. At the end of a GC run, the secondary free list is sorted and then merged into the actual free list in a single pass. That way, our worst case performance is O(n log(n)) rather than O(n^2). We postulate that temporarily losing coalescense during a single GC run won't have any adverse effects in practice because: - We would need to release enough memory during the GC, and then after that (but within the same GC run) allocate a megablock group of more than one megablock. This seems unlikely, as large objects are not copied during GC, and so we shouldn't need such large allocations during a GC run. - Allocations of megablock groups of more than one megablock are rare. They only happen when a single heap object is large enough to require that amount of space. Any allocation areas that are supposed to hold more than one heap object cannot use megablock groups, because only the first megablock of a megablock group has valid `bdescr`s. Thus, heap object can only start in the first megablock of a group, not in later ones. - - - - - 5de6be0c by Fabian Thorand at 2022-04-27T10:03:03-04:00 Add note about inefficiency in returnMemoryToOS - - - - - 8bef471a by sheaf at 2022-04-27T10:03:43-04:00 Ensure that Any is Boxed in FFI imports/exports We should only accept the type `Any` in foreign import/export declarations when it has type `Type` or `UnliftedType`. This patch adds a kind check, and a special error message triggered by occurrences of `Any` in foreign import/export declarations at other kinds. Fixes #21305 - - - - - ba3d4e1c by Ben Gamari at 2022-04-27T10:04:19-04:00 Basic response file support Here we introduce support into our command-line parsing infrastructure and driver for handling gnu-style response file arguments, typically used to work around platform command-line length limitations. Fixes #16476. - - - - - 3b6061be by Ben Gamari at 2022-04-27T10:04:19-04:00 testsuite: Add test for #16476 - - - - - 75bf1337 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix cabal-reinstall job It's quite nice we can do this by mostly deleting code Fixes #21373 - - - - - 2c00d904 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add test to check that release jobs have profiled libs - - - - - 50d78d3b by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Explicitly handle failures in test_hadrian We also disable the stage1 testing which is broken. Related to #21072 - - - - - 2dcdf091 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix shell command - - - - - 55c84123 by Matthew Pickering at 2022-04-27T10:04:55-04:00 bootstrap: Add bootstrapping files for ghc-9_2_2 Fixes #21373 - - - - - c7ee0be6 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add linting job which checks authors are not GHC CI - - - - - 23aad124 by Adam Sandberg Ericsson at 2022-04-27T10:05:31-04:00 rts: state explicitly what evacuate and scavange mean in the copying gc - - - - - 318e0005 by Ben Gamari at 2022-04-27T10:06:07-04:00 rts/eventlog: Don't attempt to flush if there is no writer If the user has not configured a writer then there is nothing to flush. - - - - - ee11d043 by Ben Gamari at 2022-04-27T10:06:07-04:00 Enable eventlog support in all ways by default Here we deprecate the eventlogging RTS ways and instead enable eventlog support in the remaining ways. This simplifies packaging and reduces GHC compilation times (as we can eliminate two whole compilations of the RTS) while simplifying the end-user story. The trade-off is a small increase in binary sizes in the case that the user does not want eventlogging support, but we think that this is a fine trade-off. This also revealed a latent RTS bug: some files which included `Cmm.h` also assumed that it defined various macros which were in fact defined by `Config.h`, which `Cmm.h` did not include. Fixing this in turn revealed that `StgMiscClosures.cmm` failed to import various spinlock statistics counters, as evidenced by the failed unregisterised build. Closes #18948. - - - - - a2e5ab70 by Andreas Klebinger at 2022-04-27T10:06:43-04:00 Change `-dsuppress-ticks` to only suppress non-code ticks. This means cost centres and coverage ticks will still be present in output. Makes using -dsuppress-all more convenient when looking at profiled builds. - - - - - ec9d7e04 by Ben Gamari at 2022-04-27T10:07:21-04:00 Bump text submodule. This should fix #21352 - - - - - c3105be4 by Bodigrim at 2022-04-27T10:08:01-04:00 Documentation for setLocaleEncoding - - - - - 7f618fd3 by sheaf at 2022-04-27T10:08:40-04:00 Update docs for change to type-checking plugins There was no mention of the changes to type-checking plugins in the 9.4.1 notes, and the extending_ghc documentation contained a reference to an outdated type. - - - - - 4419dd3a by Adam Sandberg Ericsson at 2022-04-27T10:09:18-04:00 rts: add some more documentation to StgWeak closure type - - - - - 5a7f0dee by Matthew Pickering at 2022-04-27T10:09:54-04:00 Give Cmm files fake ModuleNames which include full filepath This fixes the initialisation functions when using -prof or -finfo-table-map. Fixes #21370 - - - - - 81cf52bb by sheaf at 2022-04-27T10:10:33-04:00 Mark GHC.Prim.PtrEq as Unsafe This module exports unsafe pointer equality operations, so we accordingly mark it as Unsafe. Fixes #21433 - - - - - f6a8185d by Ben Gamari at 2022-04-28T09:10:31+00:00 testsuite: Add performance test for #14766 This distills the essence of the Sigs.hs program found in the ticket. - - - - - c7a3dc29 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Add Monoid instance to Way - - - - - 654bafea by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Enrich flavours to build profiled/debugged/threaded ghcs per stage - - - - - 4ad559c8 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: add debug_ghc and debug_stage1_ghc flavour transformers - - - - - f9728fdb by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Don't pass -rtsopts when building libraries - - - - - 769279e6 by Matthew Pickering at 2022-04-28T18:54:44-04:00 testsuite: Fix calculation about whether to pass -dynamic to compiler - - - - - da8ae7f2 by Ben Gamari at 2022-04-28T18:55:20-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 61305184 by Ben Gamari at 2022-04-28T18:55:56-04:00 Bump process submodule - - - - - a8c99391 by sheaf at 2022-04-28T18:56:37-04:00 Fix unification of ConcreteTvs, removing IsRefl# This patch fixes the unification of concrete type variables. The subtlety was that unifying concrete metavariables is more subtle than other metavariables, as decomposition is possible. See the Note [Unifying concrete metavariables], which explains how we unify a concrete type variable with a type 'ty' by concretising 'ty', using the function 'GHC.Tc.Utils.Concrete.concretise'. This can be used to perform an eager syntactic check for concreteness, allowing us to remove the IsRefl# special predicate. Instead of emitting two constraints `rr ~# concrete_tv` and `IsRefl# rr concrete_tv`, we instead concretise 'rr'. If this succeeds we can fill 'concrete_tv', and otherwise we directly emit an error message to the typechecker environment instead of deferring. We still need the error message to be passed on (instead of directly thrown), as we might benefit from further unification in which case we will need to zonk the stored types. To achieve this, we change the 'wc_holes' field of 'WantedConstraints' to 'wc_errors', which stores general delayed errors. For the moement, a delayed error is either a hole, or a syntactic equality error. hasFixedRuntimeRep_MustBeRefl is now hasFixedRuntimeRep_syntactic, and hasFixedRuntimeRep has been refactored to directly return the most useful coercion for PHASE 2 of FixedRuntimeRep. This patch also adds a field ir_frr to the InferResult datatype, holding a value of type Maybe FRROrigin. When this value is not Nothing, this means that we must fill the ir_ref field with a type which has a fixed RuntimeRep. When it comes time to fill such an ExpType, we ensure that the type has a fixed RuntimeRep by performing a representation-polymorphism check with the given FRROrigin This is similar to what we already do to ensure we fill an Infer ExpType with a type of the correct TcLevel. This allows us to properly perform representation-polymorphism checks on 'Infer' 'ExpTypes'. The fillInferResult function had to be moved to GHC.Tc.Utils.Unify to avoid a cyclic import now that it calls hasFixedRuntimeRep. This patch also changes the code in matchExpectedFunTys to make use of the coercions, which is now possible thanks to the previous change. This implements PHASE 2 of FixedRuntimeRep in some situations. For example, the test cases T13105 and T17536b are now both accepted. Fixes #21239 and #21325 ------------------------- Metric Decrease: T18223 T5631 ------------------------- - - - - - 43bd897d by Simon Peyton Jones at 2022-04-28T18:57:13-04:00 Add INLINE pragmas for Enum helper methods As #21343 showed, we need to be super-certain that the "helper methods" for Enum instances are actually inlined or specialised. I also tripped over this when I discovered that numericEnumFromTo and friends had no pragmas at all, so their performance was very fragile. If they weren't inlined, all bets were off. So I've added INLINE pragmas for them too. See new Note [Inline Enum method helpers] in GHC.Enum. I also expanded Note [Checking for INLINE loop breakers] in GHC.Core.Lint to explain why an INLINE function might temporarily be a loop breaker -- this was the initial bug report in #21343. Strangely we get a 16% runtime allocation decrease in perf/should_run/T15185, but only on i386. Since it moves in the right direction I'm disinclined to investigate, so I'll accept it. Metric Decrease: T15185 - - - - - ca1434e3 by Ben Gamari at 2022-04-28T18:57:49-04:00 configure: Bump GHC version to 9.5 Bumps haddock submodule. - - - - - 292e3971 by Teo Camarasu at 2022-04-28T18:58:28-04:00 add since annotation for GHC.Stack.CCS.whereFrom - - - - - 905206d6 by Tamar Christina at 2022-04-28T22:19:34-04:00 winio: add support to iserv. - - - - - d182897e by Tamar Christina at 2022-04-28T22:19:34-04:00 Remove unused line - - - - - 22cf4698 by Matthew Pickering at 2022-04-28T22:20:10-04:00 Revert "rts: Refactor handling of dead threads' stacks" This reverts commit e09afbf2a998beea7783e3de5dce5dd3c6ff23db. - - - - - 8ed57135 by Matthew Pickering at 2022-04-29T04:11:29-04:00 Provide efficient unionMG function for combining two module graphs. This function is used by API clients (hls). This supercedes !6922 - - - - - 0235ff02 by Ben Gamari at 2022-04-29T04:12:05-04:00 Bump bytestring submodule Update to current `master`. - - - - - 01988418 by Matthew Pickering at 2022-04-29T04:12:05-04:00 testsuite: Normalise package versions in UnusedPackages test - - - - - 724d0dc0 by Matthew Pickering at 2022-04-29T08:59:42+00:00 testsuite: Deduplicate ways correctly This was leading to a bug where we would run a profasm test twice which led to invalid junit.xml which meant the test results database was not being populated for the fedora33-perf job. - - - - - 5630dde6 by Ben Gamari at 2022-04-29T13:06:20-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - 0cdef807 by parsonsmatt at 2022-04-30T16:51:12-04:00 Add a note about instance visibility across component boundaries In principle, the *visible* instances are * all instances defined in a prior top-level declaration group (see docs on `newDeclarationGroup`), or * all instances defined in any module transitively imported by the module being compiled However, actually searching all modules transitively below the one being compiled is unreasonably expensive, so `reifyInstances` will report only the instance for modules that GHC has had some cause to visit during this compilation. This is a shortcoming: `reifyInstances` might fail to report instances for a type that is otherwise unusued, or instances defined in a different component. You can work around this shortcoming by explicitly importing the modules whose instances you want to be visible. GHC issue #20529 has some discussion around this. Fixes #20529 - - - - - e2dd884a by Ryan Scott at 2022-04-30T16:51:47-04:00 Make mkFunCo take AnonArgFlags into account Previously, whenever `mkFunCo` would produce reflexive coercions, it would use `mkVisFunTy` to produce the kind of the coercion. However, `mkFunCo` is also used to produce coercions between types of the form `ty1 => ty2` in certain places. This has the unfortunate side effect of causing the type of the coercion to appear as `ty1 -> ty2` in certain error messages, as spotted in #21328. This patch address this by changing replacing the use of `mkVisFunTy` with `mkFunctionType` in `mkFunCo`. `mkFunctionType` checks the kind of `ty1` and makes the function arrow `=>` instead of `->` if `ty1` has kind `Constraint`, so this should always produce the correct `AnonArgFlag`. As a result, this patch fixes part (2) of #21328. This is not the only possible way to fix #21328, as the discussion on that issue lists some possible alternatives. Ultimately, it was concluded that the alternatives would be difficult to maintain, and since we already use `mkFunctionType` in `coercionLKind` and `coercionRKind`, using `mkFunctionType` in `mkFunCo` is consistent with this choice. Moreover, using `mkFunctionType` does not regress the performance of any test case we have in GHC's test suite. - - - - - 170da54f by Ben Gamari at 2022-04-30T16:52:27-04:00 Convert More Diagnostics (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors. - - - - - 39edc7b4 by Marius Ghita at 2022-04-30T16:53:06-04:00 Update user guide example rewrite rules formatting Change the rewrite rule examples to include a space between the composition of `f` and `g` in the map rewrite rule examples. Without this change, if the user has locally enabled the extension OverloadedRecordDot the copied example will result in a compile time error that `g` is not a field of `f`. ``` • Could not deduce (GHC.Records.HasField "g" (a -> b) (a1 -> b)) arising from selecting the field ‘g’ ``` - - - - - 2e951e48 by Adam Sandberg Ericsson at 2022-04-30T16:53:42-04:00 ghc-boot: export typesynonyms from GHC.Utils.Encoding This makes the Haddocks easier to understand. - - - - - d8cbc77e by Adam Sandberg Ericsson at 2022-04-30T16:54:18-04:00 users guide: add categories to some flags - - - - - d0f14fad by Chris Martin at 2022-04-30T16:54:57-04:00 hacking guide: mention the core libraries committee - - - - - 34b28200 by Matthew Pickering at 2022-04-30T16:55:32-04:00 Revert "Make the specialiser handle polymorphic specialisation" This reverts commit ef0135934fe32da5b5bb730dbce74262e23e72e8. See ticket #21229 ------------------------- Metric Decrease: T15164 Metric Increase: T13056 ------------------------- - - - - - ee891c1e by Matthew Pickering at 2022-04-30T16:55:32-04:00 Add test for T21229 - - - - - ab677cc8 by Matthew Pickering at 2022-04-30T16:56:08-04:00 Hadrian: Update README about the flavour/testsuite contract There have been a number of tickets about non-tested flavours not passing the testsuite.. this is expected and now noted in the documentation. You use other flavours to run the testsuite at your own risk. Fixes #21418 - - - - - b57b5b92 by Ben Gamari at 2022-04-30T16:56:44-04: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. - - - - - a7053a6c by sheaf at 2022-04-30T16:57:23-04:00 Testsuite driver: don't crash on empty metrics The testsuite driver crashed when trying to display minimum/maximum performance changes when there are no metrics (i.e. there is no baseline available). This patch fixes that. - - - - - 636f7c62 by Andreas Klebinger at 2022-05-01T22:21:17-04:00 StgLint: Check that functions are applied to compatible runtime reps We use compatibleRep to compare reps, and avoid checking functions with levity polymorphic types because of #21399. - - - - - 60071076 by Hécate Moonlight at 2022-05-01T22:21:55-04:00 Add documentation to the ByteArray# primetype. close #21417 - - - - - 2b2e3020 by Andreas Klebinger at 2022-05-01T22:22:31-04:00 exprIsDeadEnd: Use isDeadEndAppSig to check if a function appliction is bottoming. We used to check the divergence and that the number of arguments > arity. But arity zero represents unknown arity so this was subtly broken for a long time! We would check if the saturated function diverges, and if we applied >=arity arguments. But for unknown arity functions any number of arguments is >=idArity. This fixes #21440. - - - - - 4eaf0f33 by Eric Lindblad at 2022-05-01T22:23:11-04:00 typos - - - - - fc58df90 by Niklas Hambüchen at 2022-05-02T08:59:27+00:00 libraries/base: docs: Explain relationshipt between `finalizeForeignPtr` and `*Conc*` creation Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/21420 - - - - - 3e400f20 by Krzysztof Gogolewski at 2022-05-02T18:29:23-04:00 Remove obsolete code in CoreToStg Note [Nullary unboxed tuple] was removed in e9e61f18a548b70693f4. This codepath is tested by T15696_3. - - - - - 4a780928 by Krzysztof Gogolewski at 2022-05-02T18:29:24-04:00 Fix several note references - - - - - 15ffe2b0 by Sebastian Graf at 2022-05-03T20:11:51+02:00 Assume at least one evaluation for nested SubDemands (#21081, #21133) See the new `Note [SubDemand denotes at least one evaluation]`. A demand `n :* sd` on a let binder `x=e` now means > "`x` was evaluated `n` times and in any program trace it is evaluated, `e` is > evaluated deeply in sub-demand `sd`." The "any time it is evaluated" premise is what this patch adds. As a result, we get better nested strictness. For example (T21081) ```hs f :: (Bool, Bool) -> (Bool, Bool) f pr = (case pr of (a,b) -> a /= b, True) -- before: <MP(L,L)> -- after: <MP(SL,SL)> g :: Int -> (Bool, Bool) g x = let y = let z = odd x in (z,z) in f y ``` The change in demand signature "before" to "after" allows us to case-bind `z` here. Similarly good things happen for the `sd` in call sub-demands `Cn(sd)`, which allows for more eta-reduction (which is only sound with `-fno-pedantic-bottoms`, albeit). We also fix #21085, a surprising inconsistency with `Poly` to `Call` sub-demand expansion. In an attempt to fix a regression caused by less inlining due to eta-reduction in T15426, I eta-expanded the definition of `elemIndex` and `elemIndices`, thus fixing #21345 on the go. The main point of this patch is that it fixes #21081 and #21133. Annoyingly, I discovered that more precise demand signatures for join points can transform a program into a lazier program if that join point gets floated to the top-level, see #21392. There is no simple fix at the moment, but !5349 might. Thus, we accept a ~5% regression in `MultiLayerModulesTH_OneShot`, where #21392 bites us in `addListToUniqDSet`. T21392 reliably reproduces the issue. Surprisingly, ghc/alloc perf on Windows improves much more than on other jobs, by 0.4% in the geometric mean and by 2% in T16875. Metric Increase: MultiLayerModulesTH_OneShot Metric Decrease: T16875 - - - - - 948c7e40 by Andreas Klebinger at 2022-05-04T09:57:34-04:00 CoreLint - When checking for levity polymorphism look through more ticks. For expressions like `(scc<cc_name> primOp#) arg1` we should also look at arg1 to determine if we call primOp# at a fixed runtime rep. This is what corePrep already does but CoreLint didn't yet. This patch will bring them in sync in this regard. It also uses tickishFloatable in CorePrep instead of CorePrep having it's own slightly differing definition of when a tick is floatable. - - - - - 85bc73bd by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Support Unicode properly - - - - - 063d485e by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Replace LaTeX documentation syntax with Haddock The LaTeX documentation generator does not seem to have been used for quite some time, so the LaTeX-to-Haddock preprocessing step has become a pointless complication that makes documenting the contents of GHC.Prim needlessly difficult. This commit replaces the LaTeX syntax with the Haddock it would have been converted into, anyway, though with an additional distinction: it uses single quotes in places to instruct Haddock to generate hyperlinks to bindings. This improves the quality of the generated output. - - - - - d61f7428 by Ben Gamari at 2022-05-04T09:58:50-04:00 rts/ghc.mk: Only build StgCRunAsm.S when it is needed Previously the make build system unconditionally included StgCRunAsm.S in the link, meaning that the RTS would require an execstack unnecessarily. Fixes #21478. - - - - - 934a90dd by Simon Peyton Jones at 2022-05-04T16:15:34-04:00 Improve error reporting in generated code Our error reporting in generated code (via desugaring before typechecking) only worked when the generated code was just a simple call. This commit makes it work in nested cases. - - - - - 445d3657 by sheaf at 2022-05-04T16:16:12-04:00 Ensure Any is not levity-polymorphic in FFI The previous patch forgot to account for a type such as Any @(TYPE (BoxedRep l)) for a quantified levity variable l. - - - - - ddd2591c by Ben Gamari at 2022-05-04T16:16:48-04:00 Update supported LLVM versions Pull forward minimum version to match 9.2. (cherry picked from commit c26faa54c5fbe902ccb74e79d87e3fa705e270d1) - - - - - f9698d79 by Ben Gamari at 2022-05-04T16:16:48-04:00 testsuite/T7275: Use sed -r Darwin requires the `-r` flag to be compatible with GNU sed. (cherry picked from commit 512338c8feec96c38ef0cf799f3a01b77c967c56) - - - - - 8635323b by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Use ld.lld on ARMv7/Linux Due to #16177. Also cleanup some code style issues. (cherry picked from commit cc1c3861e2372f464bf9e3c9c4d4bd83f275a1a6) - - - - - 4f6370c7 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Always preserve artifacts, even in failed jobs (cherry picked from commit fd08b0c91ea3cab39184f1b1b1aafcd63ce6973f) - - - - - 6f662754 by Ben Gamari at 2022-05-04T16:16:48-04:00 configure: Make sphinx version check more robust It appears that the version of sphinx shipped on CentOS 7 reports a version string of `Sphinx v1...`. Accept the `v`. (cherry picked from commit a9197a292fd4b13308dc6664c01351c7239357ed) - - - - - 0032dc38 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Don't run make job in release pipelines (cherry picked from commit 16d6a8ff011f2194485387dcca1c00f8ddcdbdeb) - - - - - 27f9aab3 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab/ci: Fix name of bootstrap compiler directory Windows binary distributions built with Hadrian have a target platform suffix in the name of their root directory. Teach `ci.sh` about this fact. (cherry picked from commit df5752f39671f6d04d8cd743003469ae5eb67235) - - - - - b528f0f6 by Krzysztof Gogolewski at 2022-05-05T09:05:43-04:00 Fix several note references, part 2 - - - - - 691aacf6 by Adam Sandberg Ericsson at 2022-05-05T09:06:19-04:00 adjustors: align comment about number of integer like arguments with implementation for Amd4+MinGW implementation - - - - - f050557e by Simon Jakobi at 2022-05-05T12:47:32-04:00 Remove two uses of IntMap.size IntMap.size is O(n). The new code should be slightly more efficient. The transformation of GHC.CmmToAsm.CFG.calcFreqs.nodeCount can be described formally as the transformation: (\sum_{0}^{n-1} \sum_{0}^{k-1} i_nk) + n ==> (\sum_{0}^{n-1} 1 + \sum_{0}^{k-1} i_nk) - - - - - 7da90ae3 by Tom Ellis at 2022-05-05T12:48:09-04:00 Explain that 'fail s' should run in the monad itself - - - - - 610d0283 by Matthew Craven at 2022-05-05T12:48:47-04:00 Add a test for the bracketing in rules for (^) - - - - - 016f9ca6 by Matthew Craven at 2022-05-05T12:48:47-04:00 Fix broken rules for (^) with known small powers - - - - - 9372aaab by Matthew Craven at 2022-05-05T12:48:47-04:00 Give the two T19569 tests different names - - - - - 61901b32 by Andreas Klebinger at 2022-05-05T12:49:23-04:00 SpecConstr: Properly create rules for call patterns representing partial applications The main fix is that in addVoidWorkerArg we now add the argument to the front. This fixes #21448. ------------------------- Metric Decrease: T16875 ------------------------- - - - - - 71278dc7 by Teo Camarasu at 2022-05-05T12:50:03-04:00 add since annotations for instances of ByteArray - - - - - 962ff90b by sheaf at 2022-05-05T12:50:42-04:00 Start 9.6.1-notes Updates the documentation notes to start tracking changes for the 9.6.1 release (instead of 9.4). - - - - - aacb15a3 by Matthew Pickering at 2022-05-05T20:24:01-04:00 ci: Add job to check that jobs.yaml is up-to-date There have been quite a few situations where jobs.yaml has been out of date. It's better to add a CI job which checks that it's right. We don't want to use a staged pipeline because it obfuscates the structure of the pipeline. - - - - - be7102e5 by Ben Gamari at 2022-05-05T20:24:37-04:00 rts: Ensure that XMM registers are preserved on Win64 Previously we only preserved the bottom 64-bits of the callee-saved 128-bit XMM registers, in violation of the Win64 calling convention. Fix this. Fixes #21465. - - - - - 73b22ff1 by Ben Gamari at 2022-05-05T20:24:37-04:00 testsuite: Add test for #21465 - - - - - e2ae9518 by Ziyang Liu at 2022-05-06T19:22:22-04:00 Allow `let` just before pure/return in ApplicativeDo The following is currently rejected: ```haskell -- F is an Applicative but not a Monad x :: F (Int, Int) x = do a <- pure 0 let b = 1 pure (a, b) ``` This has bitten me multiple times. This MR contains a simple fix: only allow a "let only" segment to be merged with the next (and not the previous) segment. As a result, when the last one or more statements before pure/return are `LetStmt`s, there will be one more segment containing only those `LetStmt`s. Note that if the `let` statement mentions a name bound previously, then the program is still rejected, for example ```haskell x = do a <- pure 0 let b = a + 1 pure (a, b) ``` or the example in #18559. To support this would require a more complex approach, but this is IME much less common than the previous case. - - - - - 0415449a by Matthew Pickering at 2022-05-06T19:22:58-04:00 template-haskell: Fix representation of OPAQUE pragmas There is a mis-match between the TH representation of OPAQUE pragmas and GHC's internal representation due to how OPAQUE pragmas disallow phase annotations. It seemed most in keeping to just fix the wired in name issue by adding a special case to the desugaring of INLINE pragmas rather than making TH/GHC agree with how the representation should look. Fixes #21463 - - - - - 4de887e2 by Simon Peyton Jones at 2022-05-06T19:23:34-04:00 Comments only: Note [AppCtxt] - - - - - 6e69964d by Matthew Pickering at 2022-05-06T19:24:10-04:00 Fix name of windows release bindist in doc-tarball job - - - - - ced4689e by Matthew Pickering at 2022-05-06T19:24:46-04:00 ci: Generate source-tarball in release jobs We need to distribute the source tarball so we should generate it in the CI pipeline. - - - - - 3c91de21 by Rob at 2022-05-08T13:40:53+02:00 Change Specialise to use OrdList. Fixes #21362 Metric Decrease: T16875 - - - - - 67072c31 by Simon Jakobi at 2022-05-08T12:23:43-04:00 Tweak GHC.CmmToAsm.CFG.delEdge mapAdjust is more efficient than mapAlter. - - - - - 374554bb by Teo Camarasu at 2022-05-09T16:24:37-04:00 Respect -po when heap profiling (#21446) - - - - - 1ea414b6 by Teo Camarasu at 2022-05-09T16:24:37-04:00 add test case for #21446 - - - - - c7902078 by Jens Petersen at 2022-05-09T16:25:17-04:00 avoid hadrian/bindist/Makefile install_docs error when --docs=none When docs are disabled the bindist does not have docs/ and hence docs-utils/ is not generated. Here we just test that docs-utils exists before attempting to install prologue.txt and gen_contents_index to avoid the error: /usr/bin/install: cannot stat 'docs-utils/prologue.txt': No such file or directory make: *** [Makefile:195: install_docs] Error 1 - - - - - 158bd659 by Hécate Moonlight at 2022-05-09T16:25:56-04:00 Correct base's changelog for 4.16.1.0 This commit reaffects the new Ix instances of the foreign integral types from base 4.17 to 4.16.1.0 closes #21529 - - - - - a4fbb589 by Sylvain Henry at 2022-05-09T16:26:36-04:00 STG: only print cost-center if asked to - - - - - 50347ded by Gergo ERDI at 2022-05-10T11:43:33+00:00 Improve "Glomming" note Add a paragraph that clarifies that `occurAnalysePgm` finding out-of-order references, and thus needing to glom, is not a cause for concern when its root cause is rewrite rules. - - - - - df2e3373 by Eric Lindblad at 2022-05-10T20:45:41-04:00 update INSTALL - - - - - dcac3833 by Matthew Pickering at 2022-05-10T20:46:16-04:00 driver: Make -no-keep-o-files -no-keep-hi-files work in --make mode It seems like it was just an oversight to use the incorrect DynFlags (global rather than local) when implementing these two options. Using the local flags allows users to request these intermediate files get cleaned up, which works fine in --make mode because 1. Interface files are stored in memory 2. Object files are only cleaned at the end of session (after link) Fixes #21349 - - - - - 35da81f8 by Ben Gamari at 2022-05-10T20:46:52-04:00 configure: Check for ffi.h As noted in #21485, we checked for ffi.h yet then failed to throw an error if it is missing. Fixes #21485. - - - - - bdc99cc2 by Simon Peyton Jones at 2022-05-10T20:47:28-04:00 Check for uninferrable variables in tcInferPatSynDecl This fixes #21479 See Note [Unquantified tyvars in a pattern synonym] While doing this, I found that some error messages pointed at the pattern synonym /name/, rather than the /declaration/ so I widened the SrcSpan to encompass the declaration. - - - - - 142a73d9 by Matthew Pickering at 2022-05-10T20:48:04-04:00 hadrian: Fix split-sections transformer The splitSections transformer has been broken since -dynamic-too support was implemented in hadrian. This is because we actually build the dynamic way when building the dynamic way, so the predicate would always fail. The fix is to just always pass `split-sections` even if it doesn't do anything for a particular way. Fixes #21138 - - - - - 699f5935 by Matthew Pickering at 2022-05-10T20:48:04-04: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. Closes #21135 - - - - - 21feece2 by Simon Peyton Jones at 2022-05-10T20:48:39-04:00 Use the wrapper for an unlifted binding We assumed the wrapper for an unlifted binding is the identity, but as #21516 showed, that is no always true. Solution is simple: use it. - - - - - 68d1ea5f by Matthew Pickering at 2022-05-10T20:49:15-04:00 docs: Fix path to GHC API docs in index.html In the make bindists we generate documentation in docs/ghc-<VER> but the hadrian bindists generate docs/ghc/ so the path to the GHC API docs was wrong in the index.html file. Rather than make the hadrian and make bindists the same it was easier to assume that if you're using the mkDocs script that you're using hadrian bindists. Fixes #21509 - - - - - 9d8f44a9 by Matthew Pickering at 2022-05-10T20:49:51-04:00 hadrian: Don't pass -j to haddock This has high potential for oversubcribing as many haddock jobs can be spawned in parralel which will each request the given number of capabilities. Once -jsem is implemented (#19416, !5176) we can expose that haddock via haddock and use that to pass a semaphore. Ticket #21136 - - - - - fec3e7aa by Matthew Pickering at 2022-05-10T20:50:27-04:00 hadrian: Only copy and install libffi headers when using in-tree libffi When passed `--use-system-libffi` then we shouldn't copy and install the headers from the system package. Instead the headers are expected to be available as a runtime dependency on the users system. Fixes #21485 #21487 - - - - - 5b791ed3 by mikael at 2022-05-11T08:22:13-04:00 FIND_LLVM_PROG: Recognize llvm suffix used by FreeBSD, ie llc10. - - - - - 8500206e by ARATA Mizuki at 2022-05-11T08:22:57-04:00 Make floating-point abs IEEE 754 compliant The old code used by via-C backend didn't handle the sign bit of NaN. See #21043. - - - - - 4a4c77ed by Alan Zimmerman at 2022-05-11T08:23:33-04:00 EPA: do statement with leading semicolon has wrong anchor The code do; a <- doAsync; b Generated an incorrect Anchor for the statement list that starts after the first semicolon. This commit fixes it. Closes #20256 - - - - - e3ca8dac by Simon Peyton Jones at 2022-05-11T08:24:08-04:00 Specialiser: saturate DFuns correctly Ticket #21489 showed that the saturation mechanism for DFuns (see Note Specialising DFuns) should use both UnspecType and UnspecArg. We weren't doing that; but this MR fixes that problem. No test case because it's hard to tickle, but it showed up in Gergo's work with GHC-as-a-library. - - - - - fcc7dc4c by Ben Gamari at 2022-05-11T20:05:41-04:00 gitlab-ci: Check for dynamic msys2 dependencies Both #20878 and #21196 were caused by unwanted dynamic dependencies being introduced by boot libraries. Ensure that we catch this in CI by attempting to run GHC in an environment with a minimal PATH. - - - - - 3c998f0d by Matthew Pickering at 2022-05-11T20:06:16-04:00 Add back Debian9 CI jobs 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. Fixes #21469 - - - - - dea9a3d9 by Ben Gamari at 2022-05-11T20:06:51-04:00 rts: Drop setExecutable Since f6e366c058b136f0789a42222b8189510a3693d1 setExecutable has been dead code. Drop it. - - - - - 32cdf62d by Simon Peyton Jones at 2022-05-11T20:07:27-04:00 Add a missing guard in GHC.HsToCore.Utils.is_flat_prod_pat This missing guard gave rise to #21519. - - - - - 2c00a8d0 by Matthew Pickering at 2022-05-11T20:08:02-04:00 Add mention of -hi to RTS --help Fixes #21546 - - - - - a2dcad4e by Andre Marianiello at 2022-05-12T02:15:48+00:00 Decouple dynflags in Cmm parser (related to #17957) - - - - - 3a022baa by Andre Marianiello at 2022-05-12T02:15:48+00:00 Remove Module argument from initCmmParserConfig - - - - - 2fc8d76b by Andre Marianiello at 2022-05-12T02:15:48+00:00 Move CmmParserConfig and PDConfig into GHC.Cmm.Parser.Config - - - - - b8c5ffab by Andre Marianiello at 2022-05-12T18:13:55-04:00 Decouple dynflags in GHC.Core.Opt.Arity (related to #17957) Metric Decrease: T16875 - - - - - 3bf938b6 by sheaf at 2022-05-12T18:14:34-04:00 Update extending_ghc for TcPlugin changes The documentation still mentioned Derived constraints and an outdated datatype TcPluginResult. - - - - - 668a9ef4 by jackohughes at 2022-05-13T12:10:34-04:00 Fix printing of brackets in multiplicities (#20315) Change mulArrow to allow for printing of correct application precedence where necessary and update callers of mulArrow to reflect this. As part of this, move mulArrow from GHC/Utils/Outputtable to GHC/Iface/Type. Fixes #20315 - - - - - 30b8b7f1 by Ben Gamari at 2022-05-13T12:11:09-04:00 rts: Add debug output on ocResolve failure This makes it easier to see how resolution failures nest. - - - - - 53b3fa1c by Ben Gamari at 2022-05-13T12:11:09-04:00 rts/PEi386: Fix handling of weak symbols Previously we would flag the symbol as weak but failed to set its address, which must be computed from an "auxiliary" symbol entry the follows the weak symbol. Fixes #21556. - - - - - 5678f017 by Ben Gamari at 2022-05-13T12:11:09-04:00 testsuite: Add tests for #21556 - - - - - 49af0e52 by Ben Gamari at 2022-05-13T22:23:26-04:00 Re-export augment and build from GHC.List Resolves https://gitlab.haskell.org/ghc/ghc/-/issues/19127 - - - - - aed356e1 by Simon Peyton Jones at 2022-05-13T22:24:02-04:00 Comments only around HsWrapper - - - - - 27b90409 by Ben Gamari at 2022-05-16T08:30:44-04:00 hadrian: Introduce linting flavour transformer (+lint) The linting flavour enables -dlint uniformly across anything build by the stage1 compiler. -dcmm-lint is not currently enabled because it fails on i386 (see #21563) - - - - - 3f316776 by Matthew Pickering at 2022-05-16T08:30:44-04:00 hadrian: Uniformly enable -dlint with enableLinting transformer This fixes some bugs where * -dcore-lint was being passed when building stage1 libraries with the boot compiler * -dcore-lint was not being passed when building executables. Fixes #20135 - - - - - 3d74cfca by Andreas Klebinger at 2022-05-16T08:31:20-04:00 Make closure macros EXTERN_INLINE to make debugging easier Implements #21424. The RTS macros get_itbl and friends are extremely helpful during debugging. However only a select few of those were available in the compiled RTS as actual symbols as the rest were INLINE macros. This commit marks all of them as EXTERN_INLINE. This will still inline them at use sites but allow us to use their compiled counterparts during debugging. This allows us to use things like `p get_fun_itbl(ptr)` in the gdb shell since `get_fun_itbl` will now be available as symbol! - - - - - 93153aab by Matthew Pickering at 2022-05-16T08:31:55-04:00 packaging: Introduce CI job for generating hackage documentation This adds a CI job (hackage-doc-tarball) which generates the necessary tarballs for uploading libraries and documentation to hackage. The release script knows to download this folder and the upload script will also upload the release to hackage as part of the release. The `ghc_upload_libs` script is moved from ghc-utils into .gitlab/ghc_upload_libs There are two modes, preparation and upload. * The `prepare` mode takes a link to a bindist and creates a folder containing the source and doc tarballs ready to upload to hackage. * The `upload` mode takes the folder created by prepare and performs the upload to hackage. Fixes #21493 Related to #21512 - - - - - 65d31d05 by Simon Peyton Jones at 2022-05-16T15:32:50-04:00 Add arity to the INLINE pragmas for pattern synonyms The lack of INLNE arity was exposed by #21531. The fix is simple enough, if a bit clumsy. - - - - - 43c018aa by Krzysztof Gogolewski at 2022-05-16T15:33:25-04:00 Misc cleanup - Remove groupWithName (unused) - Use the RuntimeRepType synonym where possible - Replace getUniqueM + mkSysLocalOrCoVar with mkSysLocalOrCoVarM No functional changes. - - - - - 8dfea078 by Pavol Vargovcik at 2022-05-16T15:34:04-04:00 TcPlugin: access to irreducible givens + fix passed ev_binds_var - - - - - fb579e15 by Ben Gamari at 2022-05-17T00:25:02-04:00 driver: Introduce pgmcxx Here we introduce proper support for compilation of C++ objects. This includes: * logic in `configure` to detect the C++ toolchain and propagating this information into the `settings` file * logic in the driver to use the C++ toolchain when compiling C++ sources - - - - - 43628ed4 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Build T20918 with HC, not CXX - - - - - 0ef249aa by Ben Gamari at 2022-05-17T00:25:02-04:00 Introduce package to capture dependency on C++ stdlib Here we introduce a new "virtual" package into the initial package database, `system-cxx-std-lib`. This gives users a convenient, platform agnostic way to link against C++ libraries, addressing #20010. Fixes #20010. - - - - - 03efe283 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Add tests for system-cxx-std-lib package Test that we can successfully link against C++ code both in GHCi and batch compilation. See #20010 - - - - - 5f6527e0 by nineonine at 2022-05-17T00:25:38-04:00 OverloadedRecordFields: mention parent name in 'ambiguous occurrence' error for better disambiguation (#17420) - - - - - eccdb208 by Simon Peyton Jones at 2022-05-17T07:16:39-04:00 Adjust flags for pprTrace We were using defaultSDocContext for pprTrace, which suppresses lots of useful infomation. This small MR adds GHC.Utils.Outputable.traceSDocContext and uses it for pprTrace and pprTraceUserWarning. traceSDocContext is a global, and hence not influenced by flags, but that seems unavoidable. But I made the sdocPprDebug bit controlled by unsafeHasPprDebug, since we have the latter for exactly this purpose. Fixes #21569 - - - - - d2284c4c by Simon Peyton Jones at 2022-05-17T07:17:15-04:00 Fix bad interaction between withDict and the Specialiser This MR fixes a bad bug, where the withDict was inlined too vigorously, which in turn made the type-class Specialiser generate a bogus specialisation, because it saw the same overloaded function applied to two /different/ dictionaries. Solution: inline `withDict` later. See (WD8) of Note [withDict] in GHC.HsToCore.Expr See #21575, which is fixed by this change. - - - - - 70f52443 by Matthew Pickering at 2022-05-17T07:17:50-04:00 Bump time submodule to 1.12.2 This bumps the time submodule to the 1.12.2 release. Fixes #21571 - - - - - 2343457d by Vladislav Zavialov at 2022-05-17T07:18:26-04:00 Remove unused test files (#21582) Those files were moved to the perf/ subtree in 11c9a469, and then accidentally reintroduced in 680ef2c8. - - - - - cb52b4ae by Ben Gamari at 2022-05-17T16:00:14-04:00 CafAnal: Improve code clarity Here we implement a few measures to improve the clarity of the CAF analysis implementation. Specifically: * Use CafInfo instead of Bool since the former is more descriptive * Rename CAFLabel to CAFfyLabel, since not all CAFfyLabels are in fact CAFs * Add numerous comments - - - - - b048a9f4 by Ben Gamari at 2022-05-17T16:00:14-04:00 codeGen: Ensure that static datacon apps are included in SRTs When generating an SRT for a recursive group, GHC.Cmm.Info.Build.oneSRT filters out recursive references, as described in Note [recursive SRTs]. However, doing so for static functions would be unsound, for the reason described in Note [Invalid optimisation: shortcutting]. However, the same argument applies to static data constructor applications, as we discovered in #20959. Fix this by ensuring that static data constructor applications are included in recursive SRTs. The approach here is not entirely satisfactory, but it is a starting point. Fixes #20959. - - - - - 0e2d16eb by Matthew Pickering at 2022-05-17T16:00:50-04:00 Add test for #21558 This is now fixed on master and 9.2 branch. Closes #21558 - - - - - ef3c8d9e by Sylvain Henry at 2022-05-17T20:22:02-04:00 Don't store LlvmConfig into DynFlags LlvmConfig contains information read from llvm-passes and llvm-targets files in GHC's top directory. Reading these files is done only when needed (i.e. when the LLVM backend is used) and cached for the whole compiler session. This patch changes the way this is done: - Split LlvmConfig into LlvmConfig and LlvmConfigCache - Store LlvmConfigCache in HscEnv instead of DynFlags: there is no good reason to store it in DynFlags. As it is fixed per session, we store it in the session state instead (HscEnv). - Initializing LlvmConfigCache required some changes to driver functions such as newHscEnv. I've used the opportunity to untangle initHscEnv from initGhcMonad (in top-level GHC module) and to move it to GHC.Driver.Main, close to newHscEnv. - I've also made `cmmPipeline` independent of HscEnv in order to remove the call to newHscEnv in regalloc_unit_tests. - - - - - 828fbd8a by Andreas Klebinger at 2022-05-17T20:22:38-04:00 Give all EXTERN_INLINE closure macros prototypes - - - - - cfc8e2e2 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Introduce [sg]etFinalizerExceptionHandler This introduces a global hook which is called when an exception is thrown during finalization. - - - - - 372cf730 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Throw exceptions raised while closing finalized Handles Fixes #21336. - - - - - 3dd2f944 by Ben Gamari at 2022-05-19T04:57:51-04:00 testsuite: Add tests for #21336 - - - - - 297156e0 by Matthew Pickering at 2022-05-19T04:58:27-04:00 Add release flavour and use it for the release jobs The release flavour is essentially the same as the perf flavour currently but also enables `-haddock`. I have hopefully updated all the relevant places where the `-perf` flavour was hardcoded. Fixes #21486 - - - - - a05b6293 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Don't build sphinx documentation on centos The centos docker image lacks the sphinx builder so we disable building sphinx docs for these jobs. Fixes #21580 - - - - - 209d7c69 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Use correct syntax when args list is empty This seems to fail on the ancient version of bash present on CentOS - - - - - 02d16334 by Matthew Pickering at 2022-05-19T04:59:03-04:00 hadrian: Don't attempt to build dynamic profiling libraries We only support building static profiling libraries, the transformer was requesting things like a dynamic, threaded, debug, profiling RTS, which we have never produced nor distributed. Fixes #21567 - - - - - 35bdab1c by Ben Gamari at 2022-05-19T04:59:39-04:00 configure: Check CC_STAGE0 for --target support We previously only checked the stage 1/2 compiler for --target support. We got away with this for quite a while but it eventually caught up with us in #21579, where `bytestring`'s new NEON implementation was unbuildable on Darwin due to Rosetta's seemingly random logic for determining which executable image to execute. This lead to a confusing failure to build `bytestring`'s cbits, when `clang` tried to compile NEON builtins while targetting x86-64. Fix this by checking CC_STAGE0 for --target support. Fixes #21579. - - - - - 0ccca94b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator analysis of `CmmGraph` This commit adds module `GHC.Cmm.Dominators`, which provides a wrapper around two existing algorithms in GHC: the Lengauer-Tarjan dominator analysis from the X86 back end and the reverse postorder ordering from the Cmm Dataflow framework. Issue #20726 proposes that we evaluate some alternatives for dominator analysis, but for the time being, the best path forward is simply to use the existing analysis on `CmmGraph`s. This commit addresses a bullet in #21200. - - - - - 54f0b578 by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator-tree function - - - - - 05ed917b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add HasDebugCallStack; remove unneeded extensions - - - - - 0b848136 by Andreas Klebinger at 2022-05-20T05:32:32-04:00 document fields of `DominatorSet` - - - - - 8a26e8d6 by Ben Gamari at 2022-05-20T05:33:08-04:00 nonmoving: Fix documentation of GC statistics fields These were previously incorrect. Fixes #21553. - - - - - c1e24e61 by Matthew Pickering at 2022-05-20T05:33:44-04:00 Remove pprTrace from pushCoercionIntoLambda (#21555) This firstly caused spurious output to be emitted (as evidenced by #21555) but even worse caused a massive coercion to be attempted to be printed (> 200k terms) which would invariably eats up all the memory of your computer. The good news is that removing this trace allows the program to compile to completion, the bad news is that the program exhibits a core lint error (on 9.0.2) but not any other releases it seems. Fixes #21577 and #21555 - - - - - a36d12ee by Zubin Duggal at 2022-05-20T10:44:35-04:00 docs: Fix LlvmVersion in manpage (#21280) - - - - - 36b8a57c by Matthew Pickering at 2022-05-20T10:45:10-04:00 validate: Use $make rather than make In the validate script we are careful to use the $make variable as this stores whether we are using gmake, make, quiet mode etc. There was just this one place where we failed to use it. Fixes #21598 - - - - - 4aa3c5bd by Norman Ramsey at 2022-05-21T03:11:04+00:00 Change `Backend` type and remove direct dependencies With this change, `Backend` becomes an abstract type (there are no more exposed value constructors). Decisions that were formerly made by asking "is the current back end equal to (or different from) this named value constructor?" are now made by interrogating the back end about its properties, which are functions exported by `GHC.Driver.Backend`. There is a description of how to migrate code using `Backend` in the user guide. Clients using the GHC API can find a backdoor to access the Backend datatype in GHC.Driver.Backend.Internal. Bumps haddock submodule. Fixes #20927 - - - - - ecf5f363 by Julian Ospald at 2022-05-21T12:51:16-04:00 Respect DESTDIR in hadrian bindist Makefile, fixes #19646 - - - - - 7edd991e by Julian Ospald at 2022-05-21T12:51:16-04:00 Test DESTDIR in test_hadrian() - - - - - ea895b94 by Matthew Pickering at 2022-05-22T21:57:47-04:00 Consider the stage of typeable evidence when checking stage restriction We were considering all Typeable evidence to be "BuiltinInstance"s which meant the stage restriction was going unchecked. In-fact, typeable has evidence and so we need to apply the stage restriction. This is complicated by the fact we don't generate typeable evidence and the corresponding DFunIds until after typechecking is concluded so we introcue a new `InstanceWhat` constructor, BuiltinTypeableInstance which records whether the evidence is going to be local or not. Fixes #21547 - - - - - ffbe28e5 by Dominik Peteler at 2022-05-22T21:58:23-04:00 Modularize GHC.Core.Opt.LiberateCase Progress towards #17957 - - - - - bc723ac2 by Simon Peyton Jones at 2022-05-23T17:09:34+01:00 Improve FloatOut and SpecConstr This patch addresses a relatively obscure situation that arose when chasing perf regressions in !7847, which itself is fixing It does two things: * SpecConstr can specialise on ($df d1 d2) dictionary arguments * FloatOut no longer checks argument strictness See Note [Specialising on dictionaries] in GHC.Core.Opt.SpecConstr. A test case is difficult to construct, but it makes a big difference in nofib/real/eff/VSM, at least when we have the patch for #21286 installed. (The latter stops worker/wrapper for dictionary arguments). There is a spectacular, but slightly illusory, improvement in runtime perf on T15426. I have documented the specifics in T15426 itself. Metric Decrease: T15426 - - - - - 1a4195b0 by John Ericson at 2022-05-23T17:33:59-04:00 Make debug a `Bool` not an `Int` in `StgToCmmConfig` We don't need any more resolution than this. Rename the field to `stgToCmmEmitDebugInfo` to indicate it is no longer conveying any "level" information. - - - - - e9fff12b by Alan Zimmerman at 2022-05-23T21:04:49-04:00 EPA : Remove duplicate comments in DataFamInstD The code data instance Method PGMigration = MigrationQuery Query -- ^ Run a query against the database | MigrationCode (Connection -> IO (Either String ())) -- ^ Run any arbitrary IO code Resulted in two instances of the "-- ^ Run a query against the database" comment appearing in the Exact Print Annotations when it was parsed. Ensure only one is kept. Closes #20239 - - - - - e2520df3 by Alan Zimmerman at 2022-05-23T21:05:27-04:00 EPA: Comment Order Reversed Make sure comments captured in the exact print annotations are in order of increasing location Closes #20718 - - - - - 4b45fd72 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Add test for T21455 - - - - - e2cd1d43 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Allow passing -po outside profiling way Resolves #21455 - - - - - 3b8c413a by Greg Steuck at 2022-05-24T10:49:52-04:00 Fix haddock_*_perf tests on non-GNU-grep systems Using regexp pattern requires `egrep` and straight up `+`. The haddock_parser_perf and haddock_renamer_perf tests now pass on OpenBSD. They previously incorrectly parsed the files and awk complained about invalid syntax. - - - - - 1db877a3 by Ben Gamari at 2022-05-24T10:50:28-04:00 hadrian/bindist: Drop redundant include of install.mk `install.mk` is already included by `config.mk`. Moreover, `install.mk` depends upon `config.mk` to set `RelocatableBuild`, making this first include incorrect. - - - - - f485d267 by Greg Steuck at 2022-05-24T10:51:08-04:00 Remove -z wxneeded for OpenBSD With all the recent W^X fixes in the loader this workaround is not necessary any longer. I verified that the only tests failing for me on OpenBSD 7.1-current are the same (libc++ related) before and after this commit (with --fast). - - - - - 7c51177d by Andreas Klebinger at 2022-05-24T22:13:19-04:00 Use UnionListsOrd instead of UnionLists in most places. This should get rid of most, if not all "Overlong lists" errors and fix #20016 - - - - - 81b3741f by Andreas Klebinger at 2022-05-24T22:13:55-04:00 Fix #21563 by using Word64 for 64bit shift code. We use the 64bit shifts only on 64bit platforms. But we compile the code always so compiling it on 32bit caused a lint error. So use Word64 instead. - - - - - 2c25fff6 by Zubin Duggal at 2022-05-24T22:14:30-04:00 Fix compilation with -haddock on GHC <= 8.10 -haddock on GHC < 9.0 is quite fragile and can result in obtuse parse errors when it encounters invalid haddock syntax. This has started to affect users since 297156e0b8053a28a860e7a18e1816207a59547b enabled -haddock by default on many flavours. Furthermore, since we don't test bootstrapping with 8.10 on CI, this problem managed to slip throught the cracks. - - - - - cfb9faff by sheaf at 2022-05-24T22:15:12-04:00 Hadrian: don't add "lib" for relocatable builds The conditional in hadrian/bindist/Makefile depended on the target OS, but it makes more sense to use whether we are using a relocatable build. (Currently this only gets set to true on Windows, but this ensures that the logic stays correctly coupled.) - - - - - 9973c016 by Andre Marianiello at 2022-05-25T01:36:09-04:00 Remove HscEnv from GHC.HsToCore.Usage (related to #17957) Metric Decrease: T16875 - - - - - 2ff18e39 by sheaf at 2022-05-25T01:36:48-04:00 SimpleOpt: beta-reduce through casts The simple optimiser would sometimes fail to beta-reduce a lambda when there were casts in between the lambda and its arguments. This can cause problems because we rely on representation-polymorphic lambdas getting beta-reduced away (for example, those that arise from newtype constructors with representation-polymorphic arguments, with UnliftedNewtypes). - - - - - e74fc066 by CarrieMY at 2022-05-25T16:43:03+02:00 Desugar RecordUpd in `tcExpr` This patch typechecks record updates by desugaring them inside the typechecker using the HsExpansion mechanism, and then typechecking this desugared result. Example: data T p q = T1 { x :: Int, y :: Bool, z :: Char } | T2 { v :: Char } | T3 { x :: Int } | T4 { p :: Float, y :: Bool, x :: Int } | T5 The record update `e { x=e1, y=e2 }` desugars as follows e { x=e1, y=e2 } ===> let { x' = e1; y' = e2 } in case e of T1 _ _ z -> T1 x' y' z T4 p _ _ -> T4 p y' x' The desugared expression is put into an HsExpansion, and we typecheck that. The full details are given in Note [Record Updates] in GHC.Tc.Gen.Expr. Fixes #2595 #3632 #10808 #10856 #16501 #18311 #18802 #21158 #21289 Updates haddock submodule - - - - - 2b8bdab8 by Eric Lindblad at 2022-05-26T03:21:58-04:00 update README - - - - - 3d7e7e84 by BinderDavid at 2022-05-26T03:22:38-04:00 Replace dead link in Haddock documentation of Control.Monad.Fail (fixes #21602) - - - - - ee61c7f9 by John Ericson at 2022-05-26T03:23:13-04:00 Add Haddocks for `WwOpts` - - - - - da5ccf0e by Dominik Peteler at 2022-05-26T03:23:13-04:00 Avoid global compiler state for `GHC.Core.Opt.WorkWrap` Progress towards #17957 - - - - - 3bd975b4 by sheaf at 2022-05-26T03:23:52-04:00 Optimiser: avoid introducing bad rep-poly The functions `pushCoValArg` and `pushCoercionIntoLambda` could introduce bad representation-polymorphism. Example: type RR :: RuntimeRep type family RR where { RR = IntRep } type F :: TYPE RR type family F where { F = Int# } co = GRefl F (TYPE RR[0]) :: (F :: TYPE RR) ~# (F |> TYPE RR[0] :: TYPE IntRep) f :: F -> () `pushCoValArg` would transform the unproblematic application (f |> (co -> <()>)) (arg :: F |> TYPE RR[0]) into an application in which the argument does not have a fixed `RuntimeRep`: f ((arg |> sym co) :: (F :: TYPE RR)) - - - - - b22979fb by Fraser Tweedale at 2022-05-26T06:14:51-04:00 executablePath test: fix file extension treatment The executablePath test strips the file extension (if any) when comparing the query result with the expected value. This is to handle platforms where GHC adds a file extension to the output program file (e.g. .exe on Windows). After the initial check, the file gets deleted (if supported). However, it tries to delete the *stripped* filename, which is incorrect. The test currently passes only because Windows does not allow deleting the program while any process created from it is alive. Make the test program correct in general by deleting the *non-stripped* executable filename. - - - - - afde4276 by Fraser Tweedale at 2022-05-26T06:14:51-04:00 fix executablePath test for NetBSD executablePath support for NetBSD was added in a172be07e3dce758a2325104a3a37fc8b1d20c9c, but the test was not updated. Update the test so that it works for NetBSD. This requires handling some quirks: - The result of getExecutablePath could include "./" segments. Therefore use System.FilePath.equalFilePath to compare paths. - The sysctl(2) call returns the original executable name even after it was deleted. Add `canQueryAfterDelete :: [FilePath]` and adjust expectations for the post-delete query accordingly. Also add a note to the `executablePath` haddock to advise that NetBSD behaves differently from other OSes when the file has been deleted. Also accept a decrease in memory usage for T16875. On Windows, the metric is -2.2% of baseline, just outside the allowed ±2%. I don't see how this commit could have influenced this metric, so I suppose it's something in the CI environment. Metric Decrease: T16875 - - - - - d0e4355a by John Ericson at 2022-05-26T06:15:30-04:00 Factor out `initArityOps` to `GHC.Driver.Config.*` module We want `DynFlags` only mentioned in `GHC.Driver`. - - - - - 44bb7111 by romes at 2022-05-26T16:27:57+00:00 TTG: Move MatchGroup Origin field and MatchGroupTc to GHC.Hs - - - - - 88e58600 by sheaf at 2022-05-26T17:38:43-04:00 Add tests for eta-expansion of data constructors This patch adds several tests relating to the eta-expansion of data constructors, including UnliftedNewtypes and DataTypeContexts. - - - - - d87530bb by Richard Eisenberg at 2022-05-26T23:20:14-04:00 Generalize breakTyVarCycle to work with TyFamLHS The function breakTyVarCycle_maybe has been installed in a dark corner of GHC to catch some gremlins (a.k.a. occurs-check failures) who lurk there. But it previously only caught gremlins of the form (a ~ ... F a ...), where some of our intrepid users have spawned gremlins of the form (G a ~ ... F (G a) ...). This commit improves breakTyVarCycle_maybe (and renames it to breakTyEqCycle_maybe) to catch the new gremlins. Happily, the change is remarkably small. The gory details are in Note [Type equality cycles]. Test cases: typecheck/should_compile/{T21515,T21473}. - - - - - ed37027f by Hécate Moonlight at 2022-05-26T23:20:52-04:00 [base] Fix the links in the Data.Data module fix #21658 fix #21657 fix #21657 - - - - - 3bd7d5d6 by Krzysztof Gogolewski at 2022-05-27T16:44:48+02:00 Use a class to check validity of withDict This moves handling of the magic 'withDict' function from the desugarer to the typechecker. Details in Note [withDict]. I've extracted a part of T16646Fail to a separate file T16646Fail2, because the new error in 'reify' hides the errors from 'f' and 'g'. WithDict now works with casts, this fixes #21328. Part of #19915 - - - - - b54f6c4f by sheaf at 2022-05-28T21:00:09-04:00 Fix FreeVars computation for mdo Commit acb188e0 introduced a regression in the computation of free variables in mdo statements, as the logic in GHC.Rename.Expr.segmentRecStmts was slightly different depending on whether the recursive do block corresponded to an mdo statement or a rec statment. This patch restores the previous computation for mdo blocks. Fixes #21654 - - - - - 0704295c by Matthew Pickering at 2022-05-28T21:00:45-04:00 T16875: Stabilise (temporarily) by increasing acceptance threshold The theory is that on windows there is some difference in the environment between pipelines on master and merge requests which affects all tests equally but because T16875 barely allocates anything it is the test which is affected the most. See #21557 - - - - - 6341c8ed by Matthew Pickering at 2022-05-28T21:01:20-04:00 make: Fix make maintainer-clean deleting a file tracked by source control Fixes #21659 - - - - - fbf2f254 by Bodigrim at 2022-05-28T21:01:58-04:00 Expand documentation of hIsTerminalDevice - - - - - 0092c67c by Teo Camarasu at 2022-05-29T12:25:39+00:00 export IsList from GHC.IsList it is still re-exported from GHC.Exts - - - - - 91396327 by Sylvain Henry at 2022-05-30T09:40:55-04:00 MachO linker: fix handling of ARM64_RELOC_SUBTRACTOR ARM64_RELOC_SUBTRACTOR relocations are paired with an AMR64_RELOC_UNSIGNED relocation to implement: addend + sym1 - sym2 The linker was doing it in two steps, basically: *addend <- *addend - sym2 *addend <- *addend + sym1 The first operation was likely to overflow. For example when the relocation target was 32-bit and both sym1/sym2 were 64-bit addresses. With the small memory model, (sym1-sym2) would fit in 32 bits but (*addend-sym2) may not. Now the linker does it in one step: *addend <- *addend + sym1 - sym2 - - - - - acc26806 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Some fixes to SRT documentation - reordered the 3 SRT implementation cases from the most general to the most specific one: USE_SRT_POINTER -> USE_SRT_OFFSET -> USE_INLINE_SRT_FIELD - added requirements for each - found and documented a confusion about "SRT inlining" not supported with MachO. (It is fixed in the following commit) - - - - - 5878f439 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Enable USE_INLINE_SRT_FIELD on ARM64 It was previously disabled because of: - a confusion about "SRT inlining" (see removed comment in this commit) - a linker bug (overflow) in the handling of ARM64_RELOC_SUBTRACTOR relocation: fixed by a previous commit. - - - - - 59bd6159 by Matthew Pickering at 2022-05-30T09:41:39-04:00 ci: Make sure to exit promptly if `make install` fails. Due to the vageries of bash, you have to explicitly handle the failure and exit when in a function. This failed to exit promptly when !8247 was failing. See #21358 for the general issue - - - - - 5a5a28da by Sylvain Henry at 2022-05-30T09:42:23-04:00 Split GHC.HsToCore.Foreign.Decl This is preliminary work for JavaScript support. It's better to put the code handling the desugaring of Prim, C and JavaScript declarations into separate modules. - - - - - 6f5ff4fa by Sylvain Henry at 2022-05-30T09:43:05-04:00 Bump hadrian to LTS-19.8 (GHC 9.0.2) - - - - - f2e70707 by Sylvain Henry at 2022-05-30T09:43:05-04:00 Hadrian: remove unused code - - - - - 2f215b9f by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Eta reduction with casted function We want to be able to eta-reduce \x y. ((f x) |> co) y by pushing 'co' inwards. A very small change accommodates this See Note [Eta reduction with casted function] - - - - - f4f6a87a by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Do arity trimming at bindings, rather than in exprArity Sometimes there are very large casts, and coercionRKind can be slow. - - - - - 610a2b83 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make findRhsArity take RecFlag This avoids a fixpoint iteration for the common case of non-recursive bindings. - - - - - 80ba50c7 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Comments and white space - - - - - 0079171b by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make PrimOpId record levity This patch concerns #20155, part (1) The general idea is that since primops have curried bindings (currently in PrimOpWrappers.hs) we don't need to eta-expand them. But we /do/ need to eta-expand the levity-polymorphic ones, because they /don't/ have bindings. This patch makes a start in that direction, by identifying the levity-polymophic primops in the PrimOpId IdDetails constructor. For the moment, I'm still eta-expanding all primops (by saying that hasNoBinding returns True for all primops), because of the bug reported in #20155. But I hope that before long we can tidy that up too, and remove the TEMPORARILY stuff in hasNoBinding. - - - - - 6656f016 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 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: * Move state-hack stuff from GHC.Types.Id (where it never belonged) to GHC.Core.Opt.Arity (which seems much more appropriate). * Add a crucial mkCast in the Cast case of GHC.Core.Opt.Arity.eta_expand; helps with T18223 * Add clarifying notes about eta-reducing to PAPs. See Note [Do not eta reduce PAPs] * I moved tryEtaReduce from GHC.Core.Utils to GHC.Core.Opt.Arity, where it properly belongs. See Note [Eta reduce PAPs] * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, pull out the code for when eta-expansion is wanted, to make wantEtaExpansion, and all that same function in GHC.Core.Opt.Simplify.simplStableUnfolding. It was previously inconsistent, but it's doing the same thing. * I did a substantial refactor of ArityType; see Note [ArityType]. This allowed me to do away with the somewhat mysterious takeOneShots; more generally it allows arityType to describe the function, leaving its clients to decide how to use that information. I made ArityType abstract, so that clients have to use functions to access it. * Make GHC.Core.Opt.Simplify.Utils.rebuildLam (was stupidly called mkLam before) aware of the floats that the simplifier builds up, so that it can still do eta-reduction even if there are some floats. (Previously that would not happen.) That means passing the floats to rebuildLam, and an extra check when eta-reducting (etaFloatOk). * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, make use of call-info in the idDemandInfo of the binder, as well as the CallArity info. The occurrence analyser did this but we were failing to take advantage here. In the end I moved the heavy lifting to GHC.Core.Opt.Arity.findRhsArity; see Note [Combining arityType with demand info], and functions idDemandOneShots and combineWithDemandOneShots. (These changes partly drove my refactoring of ArityType.) * In GHC.Core.Opt.Arity.findRhsArity * I'm now taking account of the demand on the binder to give extra one-shot info. E.g. if the fn is always called with two args, we can give better one-shot info on the binders than if we just look at the RHS. * Don't do any fixpointing in the non-recursive case -- simple short cut. * Trim arity inside the loop. See Note [Trim arity inside the loop] * Make SimpleOpt respect the eta-reduction flag (Some associated refactoring here.) * I made the CallCtxt which the Simplifier uses distinguish between recursive and non-recursive right-hand sides. data CallCtxt = ... | RhsCtxt RecFlag | ... It affects only one thing: - We call an RHS context interesting only if it is non-recursive see Note [RHS of lets] in GHC.Core.Unfold * Remove eta-reduction in GHC.CoreToStg.Prep, a welcome simplification. See Note [No eta reduction needed in rhsToBody] in GHC.CoreToStg.Prep. 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. * Delete dead function GHC.Core.Opt.Simplify.Utils.contIsRhsOrArg Metrics: compile_time/bytes allocated Test Metric Baseline New value Change --------------------------------------------------------------------------------------- MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,743,297,692 2,619,762,992 -4.5% GOOD T18223(normal) ghc/alloc 1,103,161,360 972,415,992 -11.9% GOOD T3064(normal) ghc/alloc 201,222,500 184,085,360 -8.5% GOOD T8095(normal) ghc/alloc 3,216,292,528 3,254,416,960 +1.2% T9630(normal) ghc/alloc 1,514,131,032 1,557,719,312 +2.9% BAD parsing001(normal) ghc/alloc 530,409,812 525,077,696 -1.0% geo. mean -0.1% Nofib: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- banner +0.0% +0.4% -8.9% -8.7% 0.0% exact-reals +0.0% -7.4% -36.3% -37.4% 0.0% fannkuch-redux +0.0% -0.1% -1.0% -1.0% 0.0% fft2 -0.1% -0.2% -17.8% -19.2% 0.0% fluid +0.0% -1.3% -2.1% -2.1% 0.0% gg -0.0% +2.2% -0.2% -0.1% 0.0% spectral-norm +0.1% -0.2% 0.0% 0.0% 0.0% tak +0.0% -0.3% -9.8% -9.8% 0.0% x2n1 +0.0% -0.2% -3.2% -3.2% 0.0% -------------------------------------------------------------------------------- Min -3.5% -7.4% -58.7% -59.9% 0.0% Max +0.1% +2.2% +32.9% +32.9% 0.0% Geometric Mean -0.0% -0.1% -14.2% -14.8% -0.0% Metric Decrease: MultiLayerModulesTH_OneShot T18223 T3064 T15185 T14766 Metric Increase: T9630 - - - - - cac8c7bb by Matthew Pickering at 2022-05-30T13:44:50-04:00 hadrian: Fix building from source-dist without alex/happy This fixes two bugs which were adding dependencies on alex/happy when building from a source dist. * When we try to pass `--with-alex` and `--with-happy` to cabal when configuring but the builders are not set. This is fixed by making them optional. * When we configure, cabal requires alex/happy because of the build-tool-depends fields. These are now made optional with a cabal flag (build-tool-depends) for compiler/hpc-bin/genprimopcode. Fixes #21627 - - - - - a96dccfe by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test the bootstrap without ALEX/HAPPY on path - - - - - 0e5bb3a8 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test bootstrapping in release jobs - - - - - d8901469 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Allow testing bootstrapping on MRs using the "test-bootstrap" label - - - - - 18326ad2 by Matthew Pickering at 2022-05-30T13:45:25-04:00 rts: Remove explicit timescale for deprecating -h flag We originally planned to remove the flag in 9.4 but there's actually no great rush to do so and it's probably less confusing (forever) to keep the message around suggesting an explicit profiling option. Fixes #21545 - - - - - eaaa1389 by Matthew Pickering at 2022-05-30T13:46:01-04:00 Enable -dlint in hadrian lint transformer Now #21563 is fixed we can properly enable `-dlint` in CI rather than a subset of the flags. - - - - - 0544f114 by Ben Gamari at 2022-05-30T19:16:55-04:00 upload-ghc-libs: Allow candidate-only upload - - - - - 83467435 by Sylvain Henry at 2022-05-30T19:17:35-04:00 Avoid using DynFlags in GHC.Linker.Unit (#17957) - - - - - 5c4421b1 by Matthew Pickering at 2022-05-31T08:35:17-04:00 hadrian: Introduce new package database for executables needed to build stage0 These executables (such as hsc2hs) are built using the boot compiler and crucially, most libraries from the global package database. We also move other build-time executables to be built in this stage such as linters which also cleans up which libraries end up in the global package database. This allows us to remove hacks where linters-common is removed from the package database when a bindist is created. This fixes issues caused by infinite recursion due to bytestring adding a dependency on template-haskell. Fixes #21634 - - - - - 0dafd3e7 by Matthew Pickering at 2022-05-31T08:35:17-04:00 Build stage1 with -V as well This helps tracing errors which happen when building stage1 - - - - - 15d42a7a by Matthew Pickering at 2022-05-31T08:35:52-04:00 Revert "packaging: Build perf builds with -split-sections" This reverts commit 699f593532a3cd5ca1c2fab6e6e4ce9d53be2c1f. Split sections causes segfaults in profiling way with old toolchains (deb9) and on windows (#21670) Fixes #21670 - - - - - d4c71f09 by John Ericson at 2022-05-31T16:26:28+00:00 Purge `DynFlags` and `HscEnv` from some `GHC.Core` modules where it's not too hard Progress towards #17957 Because of `CoreM`, I did not move the `DynFlags` and `HscEnv` to other modules as thoroughly as I usually do. This does mean that risk of `DynFlags` "creeping back in" is higher than it usually is. After we do the same process to the other Core passes, and then figure out what we want to do about `CoreM`, we can finish the job started here. That is a good deal more work, however, so it certainly makes sense to land this now. - - - - - a720322f by romes at 2022-06-01T07:44:44-04:00 Restore Note [Quasi-quote overview] - - - - - 392ce3fc by romes at 2022-06-01T07:44:44-04:00 Move UntypedSpliceFlavour from L.H.S to GHC.Hs UntypedSpliceFlavour was only used in the client-specific `GHC.Hs.Expr` but was defined in the client-independent L.H.S.Expr. - - - - - 7975202b by romes at 2022-06-01T07:44:44-04:00 TTG: Rework and improve splices This commit redefines the structure of Splices in the AST. We get rid of `HsSplice` which used to represent typed and untyped splices, quasi quotes, and the result of splicing either an expression, a type or a pattern. Instead we have `HsUntypedSplice` which models an untyped splice or a quasi quoter, which works in practice just like untyped splices. The `HsExpr` constructor `HsSpliceE` which used to be constructed with an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The former is directly constructed with an `HsExpr` and the latter now takes an `HsUntypedSplice`. Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now take an `HsUntypedSplice` instead of a `HsSplice` (remember only /untyped splices/ can be spliced as types or patterns). The result of splicing an expression, type, or pattern is now comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`, `XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult (HsExpr GhcRn)` Overall the TTG extension points are now better used to make invalid states unrepresentable and model the progression between stages better. See Note [Lifecycle of an untyped splice, and PendingRnSplice] and Note [Lifecycle of an typed splice, and PendingTcSplice] for more details. Updates haddock submodule Fixes #21263 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - 320270c2 by Matthew Pickering at 2022-06-01T07:44:44-04:00 Add test for #21619 Fixes #21619 - - - - - ef7ddd73 by Pierre Le Marre at 2022-06-01T07:44:47-04:00 Pure Haskell implementation of GHC.Unicode Switch to a pure Haskell implementation of base:GHC.Unicode, based on the implementation of the package unicode-data (https://github.com/composewell/unicode-data/). Approved by CLC as per https://github.com/haskell/core-libraries-committee/issues/59#issuecomment-1132106691. - Remove current Unicode cbits. - Add generator for Unicode property files from Unicode Character Database. - Generate internal modules. - Update GHC.Unicode. - Add unicode003 test for general categories and case mappings. - Add Python scripts to check 'base' Unicode tests outputs and characters properties. Fixes #21375 ------------------------- Metric Decrease: T16875 Metric Increase: T4029 T18304 haddock.base ------------------------- - - - - - 514a6a28 by Eric Lindblad at 2022-06-01T07:44:51-04:00 typos - - - - - 9004be3c by Matthew Pickering at 2022-06-01T07:44:52-04:00 source-dist: Copy in files created by ./boot Since we started producing source dists with hadrian we stopped copying in the files created by ./boot which adds a dependency on python3 and autoreconf. This adds back in the files which were created by running configure. Fixes #21673 #21672 and #21626 - - - - - a12a3cab by Matthew Pickering at 2022-06-01T07:44:52-04:00 ci: Don't try to run ./boot when testing bootstrap of source dist - - - - - e07f9059 by Shlomo Shuck at 2022-06-01T07:44:55-04:00 Language.Haskell.Syntax: Fix docs for PromotedConsT etc. Fixes ghc/ghc#21675. - - - - - 87295e6d by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump bytestring, process, and text submodules Metric Decrease: T5631 Metric Increase: T18223 (cherry picked from commit 55fcee30cb3281a66f792e8673967d64619643af) - - - - - 24b5bb61 by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump Cabal submodule To current `master`. (cherry picked from commit fbb59c212415188486aafd970eafef170516356a) - - - - - 5433a35e by Matthew Pickering at 2022-06-01T22:26:30-04:00 hadrian/tool-args: Write output to intermediate file rather than via stdout This allows us to see the output of hadrian while it is doing the setup. - - - - - 468f919b by Matthew Pickering at 2022-06-01T22:27:10-04:00 Make -fcompact-unwind the default This is a follow-up to !7247 (closed) making the inclusion of compact unwinding sections the default. Also a slight refactoring/simplification of the flag handling to add -fno-compact-unwind. - - - - - 819fdc61 by Zubin Duggal at 2022-06-01T22:27:47-04:00 hadrian bootstrap: add plans for 9.0.2 and 9.2.3 - - - - - 9fa790b4 by Zubin Duggal at 2022-06-01T22:27:47-04:00 ci: Add matrix for bootstrap sources - - - - - ce9f986b by John Ericson at 2022-06-02T15:42:59+00:00 HsToCore.Coverage: Improve haddocks - - - - - f065804e by John Ericson at 2022-06-02T15:42:59+00:00 Hoist auto `mkModBreaks` and `writeMixEntries` conditions to caller No need to inline traversing a maybe for `mkModBreaks`. And better to make each function do one thing and let the caller deside when than scatter the decision making and make the caller seem more imperative. - - - - - d550d907 by John Ericson at 2022-06-02T15:42:59+00:00 Rename `HsToCore.{Coverage -> Ticks}` The old name made it confusing why disabling HPC didn't disable the entire pass. The name makes it clear --- there are other reasons to add ticks in addition. - - - - - 6520da95 by John Ericson at 2022-06-02T15:42:59+00:00 Split out `GHC.HsToCore.{Breakpoints,Coverage}` and use `SizedSeq` As proposed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_432877 and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_434676, `GHC.HsToCore.Ticks` is about ticks, breakpoints are separate and backend-specific (only for the bytecode interpreter), and mix entry writing is just for HPC. With this split we separate out those interpreter- and HPC-specific its, and keep the main `GHC.HsToCore.Ticks` agnostic. Also, instead of passing the reversed list and count around, we use `SizedSeq` which abstracts over the algorithm. This is much nicer to avoid noise and prevents bugs. (The bugs are not just hypothetical! I missed up the reverses on an earlier draft of this commit.) - - - - - 1838c3d8 by Sylvain Henry at 2022-06-02T15:43:14+00:00 GHC.HsToCore.Breakpoints: Slightly improve perf We have the length already, so we might as well use that rather than O(n) recomputing it. - - - - - 5a3fdcfd by John Ericson at 2022-06-02T15:43:59+00:00 HsToCore.Coverage: Purge DynFlags Finishes what !7467 (closed) started. Progress towards #17957 - - - - - 9ce9ea50 by HaskellMouse at 2022-06-06T09:50:00-04:00 Deprecate TypeInType extension This commit fixes #20312 It deprecates "TypeInType" extension according to the following proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0083-no-type-in-type.rst It has been already implemented. The migration strategy: 1. Disable TypeInType 2. Enable both DataKinds and PolyKinds extensions Metric Decrease: T16875 - - - - - f2e037fd by Aaron Allen at 2022-06-06T09:50:39-04:00 Diagnostics conversions, part 6 (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and `GHC.Tc.Gen.Sig`. - - - - - 04209f2a by Simon Peyton Jones at 2022-06-06T09:51:15-04:00 Ensure floated dictionaries are in scope (again) In the Specialiser, we missed one more call to bringFloatedDictsIntoScope (see #21391). This omission led to #21689. The problem is that the call to `rewriteClassOps` needs to have in scope any dictionaries floated out of the arguments we have just specialised. Easy fix. - - - - - a7fece19 by John Ericson at 2022-06-07T05:04:22+00:00 Don't print the number of deps in count-deps tests It is redundant information and a source of needless version control conflicts when multiple MRs are changing the deps list. Just printing the list and not also its length is fine. - - - - - a1651a3a by John Ericson at 2022-06-07T05:06:38+00:00 Core.Lint: Reduce `DynFlags` and `HscEnv` Co-Authored-By: Andre Marianiello <andremarianiello at users.noreply.github.com> - - - - - 56ebf9a5 by Andreas Klebinger at 2022-06-09T09:11:43-04:00 Fix a CSE shadowing bug. We used to process the rhs of non-recursive bindings and their body using the same env. If we had something like let x = ... x ... this caused trouble because the two xs refer to different binders but we would substitute both for a new binder x2 causing out of scope errors. We now simply use two different envs for the rhs and body in cse_bind. It's all explained in the Note [Separate envs for let rhs and body] Fixes #21685 - - - - - 28880828 by sheaf at 2022-06-09T09:12:19-04:00 Typecheck remaining ValArgs in rebuildHsApps This patch refactors hasFixedRuntimeRep_remainingValArgs, renaming it to tcRemainingValArgs. The logic is moved to rebuildHsApps, which ensures consistent behaviour across tcApp and quickLookArg1/tcEValArg. This patch also refactors the treatment of stupid theta for data constructors, changing the place we drop stupid theta arguments from dsConLike to mkDataConRep (now the datacon wrapper drops these arguments). We decided not to implement PHASE 2 of the FixedRuntimeRep plan for these remaining ValArgs. Future directions are outlined on the wiki: https://gitlab.haskell.org/ghc/ghc/-/wikis/Remaining-ValArgs Fixes #21544 and #21650 - - - - - 1fbba97b by Matthew Pickering at 2022-06-09T09:12:54-04:00 Add test for T21682 Fixes #21682 - - - - - 8727be73 by Andreas Klebinger at 2022-06-09T09:13:29-04:00 Document dataToTag# primop - - - - - 7eab75bb by uhbif19 at 2022-06-09T20:22:47+03:00 Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115 - - - - - 46d2fc65 by uhbif19 at 2022-06-09T20:24:40+03:00 Fix TcRnPragmaWarning meaning - - - - - 69e72ecd by Matthew Pickering at 2022-06-09T19:07:01-04:00 getProcessCPUTime: Fix the getrusage fallback to account for system CPU time clock_gettime reports the combined total or user AND system time so in order to replicate it with getrusage we need to add both system and user time together. See https://stackoverflow.com/questions/7622371/getrusage-vs-clock-gettime Some sample measurements when building Cabal with this patch t1: rusage t2: clock_gettime t1: 62347518000; t2: 62347520873 t1: 62395687000; t2: 62395690171 t1: 62432435000; t2: 62432437313 t1: 62478489000; t2: 62478492465 t1: 62514990000; t2: 62514992534 t1: 62515479000; t2: 62515480327 t1: 62515485000; t2: 62515486344 Fixes #21656 - - - - - 722814ba by Yiyun Liu at 2022-06-10T21:23:03-04:00 Use <br> instead of newline character - - - - - dc202080 by Matthew Craven at 2022-06-13T14:07:12-04:00 Use (fixed_lev = True) in mkDataTyConRhs - - - - - ad70c621 by Matthew Pickering at 2022-06-14T08:40:53-04:00 hadrian: Fix testing stage1 compiler There were various issues with testing the stage1 compiler.. 1. The wrapper was not being built 2. The wrapper was picking up the stage0 package database and trying to load prelude from that. 3. The wrappers never worked on windows so just don't support that for now. Fixes #21072 - - - - - ac83899d by Ben Gamari at 2022-06-14T08:41:30-04:00 validate: Ensure that $make variable is set Currently the `$make` variable is used without being set in `validate`'s Hadrian path, which uses make to install the binary distribution. Fix this. Fixes #21687. - - - - - 59bc6008 by John Ericson at 2022-06-15T18:05:35+00:00 CoreToStg.Prep: Get rid of `DynFlags` and `HscEnv` The call sites in `Driver.Main` are duplicative, but this is good, because the next step is to remove `InteractiveContext` from `Core.Lint` into `Core.Lint.Interactive`. Also further clean up `Core.Lint` to use a better configuration record than the one we initially added. - - - - - aa9d9381 by Ben Gamari at 2022-06-15T20:33:04-04:00 hadrian: Run xattr -rc . on bindist tarball Fixes #21506. - - - - - cdc75a1f by Ben Gamari at 2022-06-15T20:33:04-04:00 configure: Hide spurious warning from ld Previously the check_for_gold_t22266 configure check could result in spurious warnings coming from the linker being blurted to stderr. Suppress these by piping stderr to /dev/null. - - - - - e128b7b8 by Ben Gamari at 2022-06-15T20:33:40-04:00 cmm: Add surface syntax for MO_MulMayOflo - - - - - bde65ea9 by Ben Gamari at 2022-06-15T20:34:16-04:00 configure: Don't attempt to override linker on Darwin Configure's --enable-ld-override functionality is intended to ensure that we don't rely on ld.bfd, which tends to be slow and buggy, on Linux and Windows. However, on Darwin the lack of sensible package management makes it extremely easy for users to have awkward mixtures of toolchain components from, e.g., XCode, the Apple Command-Line Tools package, and homebrew. This leads to extremely confusing problems like #21712. Here we avoid this by simply giving up on linker selection on Darwin altogether. This isn't so bad since the Apple ld64 linker has decent performance and AFAICT fairly reliable. Closes #21712. - - - - - 25b510c3 by Torsten Schmits at 2022-06-16T12:37:45-04:00 replace quadratic nub to fight byte code gen perf explosion Despite this code having been present in the core-to-bytecode implementation, I have observed it in the wild starting with 9.2, causing enormous slowdown in certain situations. My test case produces the following profiles: Before: ``` total time = 559.77 secs (559766 ticks @ 1000 us, 1 processor) total alloc = 513,985,665,640 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes elem_by Data.OldList libraries/base/Data/OldList.hs:429:1-7 67.6 92.9 378282 477447404296 eqInt GHC.Classes libraries/ghc-prim/GHC/Classes.hs:275:8-14 12.4 0.0 69333 32 $c>>= GHC.Data.IOEnv <no location info> 6.9 0.6 38475 3020371232 ``` After: ``` total time = 89.83 secs (89833 ticks @ 1000 us, 1 processor) total alloc = 39,365,306,360 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes $c>>= GHC.Data.IOEnv <no location info> 43.6 7.7 39156 3020403424 doCase GHC.StgToByteCode compiler/GHC/StgToByteCode.hs:(805,1)-(1054,53) 2.5 7.4 2246 2920777088 ``` - - - - - aa7e1f20 by Matthew Pickering at 2022-06-16T12:38:21-04:00 hadrian: Don't install `include/` directory in bindist. The install_includes for the RTS package used to be put in the top-level ./include folder but this would lead to confusing things happening if you installed multiple GHC versions side-by-side. We don't need this folder anymore because install-includes is honoured properly by cabal and the relevant header files already copied in by the cabal installation process. If you want to depend on the header files for the RTS in a Haskell project then you just have to depend on the `rts` package and the correct include directories will be provided for you. If you want to depend on the header files in a standard C project then you should query ghc-pkg to get the right paths. ``` ghc-pkg field rts include-dirs --simple-output ``` Fixes #21609 - - - - - 03172116 by Bryan Richter at 2022-06-16T12:38:57-04:00 Enable eventlogs on nightly perf job - - - - - ecbf8685 by Hécate Moonlight at 2022-06-16T16:30:00-04:00 Repair dead link in TH haddocks Closes #21724 - - - - - 99ff3818 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian: allow configuring Hsc2Hs This patch adds the ability to pass options to Hsc2Hs as Hadrian key/value settings, in the same way as cabal configure options, using the syntax: *.*.hsc2hs.run.opts += ... - - - - - 9c575f24 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian bootstrap: look up hsc2hs Hadrian bootstrapping looks up where to find ghc_pkg, but the same logic was not in place for hsc2hs which meant we could fail to find the appropriate hsc2hs executabe when bootstrapping Hadrian. This patch adds that missing logic. - - - - - 229d741f by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Add (broken) test for #21622 - - - - - cadd7753 by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Don't Box NULL pointers Previously we could construct a `Box` of a NULL pointer from the `link` field of `StgWeak`. Now we take care to avoid ever introducing such pointers in `collect_pointers` and ensure that the `link` field is represented as a `Maybe` in the `Closure` type. Fixes #21622 - - - - - 31c214cc by Tamar Christina at 2022-06-18T10:43:34-04:00 winio: Add support to console handles to handleToHANDLE - - - - - 711cb417 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Add SMUL[LH] instructions These will be needed to fix #21624. - - - - - d05d90d2 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Fix syntax of OpRegShift operands Previously this produced invalid assembly containing a redundant comma. - - - - - a1e1d8ee by Ben Gamari at 2022-06-18T10:44:11-04:00 ncg/aarch64: Fix implementation of IntMulMayOflo The code generated for IntMulMayOflo was previously wrong as it depended upon the overflow flag, which the AArch64 MUL instruction does not set. Fix this. Fixes #21624. - - - - - 26745006 by Ben Gamari at 2022-06-18T10:44:11-04:00 testsuite: Add test for #21624 Ensuring that mulIntMayOflo# behaves as expected. - - - - - 94f2e92a by Sebastian Graf at 2022-06-20T09:40:58+02:00 CprAnal: Set signatures of DFuns to top The recursive DFun in the reproducer for #20836 also triggered a bug in CprAnal that is observable in a debug build. The CPR signature of a recursive DFunId was never updated and hence the optimistic arity 0 bottom signature triggered a mismatch with the arity 1 of the binding in WorkWrap. We never miscompiled any code because WW doesn't exploit bottom CPR signatures. - - - - - b570da84 by Sebastian Graf at 2022-06-20T09:43:29+02:00 CorePrep: Don't speculatively evaluate recursive calls (#20836) In #20836 we have optimised a terminating program into an endless loop, because we speculated the self-recursive call of a recursive DFun. Now we track the set of enclosing recursive binders in CorePrep to prevent speculation of such self-recursive calls. See the updates to Note [Speculative evaluation] for details. Fixes #20836. - - - - - 49fb2f9b by Sebastian Graf at 2022-06-20T09:43:32+02:00 Simplify: Take care with eta reduction in recursive RHSs (#21652) Similar to the fix to #20836 in CorePrep, we now track the set of enclosing recursive binders in the SimplEnv and SimpleOptEnv. See Note [Eta reduction in recursive RHSs] for details. I also updated Note [Arity robustness] with the insights Simon and I had in a call discussing the issue. Fixes #21652. Unfortunately, we get a 5% ghc/alloc regression in T16577. That is due to additional eta reduction in GHC.Read.choose1 and the resulting ANF-isation of a large list literal at the top-level that didn't happen before (presumably because it was too interesting to float to the top-level). There's not much we can do about that. Metric Increase: T16577 - - - - - 2563b95c by Sebastian Graf at 2022-06-20T09:45:09+02:00 Ignore .hie-bios - - - - - e4e44d8d by Simon Peyton Jones at 2022-06-20T12:31:45-04:00 Instantiate top level foralls in partial type signatures The main fix for #21667 is the new call to tcInstTypeBnders in tcHsPartialSigType. It was really a simple omission before. I also moved the decision about whether we need to apply the Monomorphism Restriction, from `decideGeneralisationPlan` to `tcPolyInfer`. That removes a flag from the InferGen constructor, which is good. But more importantly, it allows the new function, checkMonomorphismRestriction called from `tcPolyInfer`, to "see" the `Types` involved rather than the `HsTypes`. And that in turn matters because we invoke the MR for partial signatures if none of the partial signatures in the group have any overloading context; and we can't answer that question for HsTypes. See Note [Partial type signatures and the monomorphism restriction] in GHC.Tc.Gen.Bind. This latter is really a pre-existing bug. - - - - - 262a9f93 by Winston Hartnett at 2022-06-20T12:32:23-04:00 Make Outputable instance for InlineSig print the InlineSpec Fix ghc/ghc#21739 Squash fix ghc/ghc#21739 - - - - - b5590fff by Matthew Pickering at 2022-06-20T12:32:59-04:00 Add NO_BOOT to hackage_doc_tarball job We were attempting to boot a src-tarball which doesn't work as ./boot is not included in the source tarball. This slipped through as the job is only run on nightly. - - - - - d24afd9d by Vladislav Zavialov at 2022-06-20T17:34:44-04:00 HsToken for @-patterns and TypeApplications (#19623) One more step towards the new design of EPA. - - - - - 159b7628 by Tamar Christina at 2022-06-20T17:35:23-04:00 linker: only keep rtl exception tables if they have been relocated - - - - - da5ff105 by Andreas Klebinger at 2022-06-21T17:04:12+02:00 Ticky:Make json info a separate field. - - - - - 1a4ce4b2 by Matthew Pickering at 2022-06-22T09:49:22+01:00 Revert "Ticky:Make json info a separate field." This reverts commit da5ff10503e683e2148c62e36f8fe2f819328862. This was pushed directly without review. - - - - - f89bf85f by Vanessa McHale at 2022-06-22T08:21:32-04:00 Flags to disable local let-floating; -flocal-float-out, -flocal-float-out-top-level CLI flags These flags affect the behaviour of local let floating. If `-flocal-float-out` is disabled (the default) then we disable all local floating. ``` …(let x = let y = e in (a,b) in body)... ===> …(let y = e; x = (a,b) in body)... ``` Further to this, top-level local floating can be disabled on it's own by passing -fno-local-float-out-top-level. ``` x = let y = e in (a,b) ===> y = e; x = (a,b) ``` Note that this is only about local floating, ie, floating two adjacent lets past each other and doesn't say anything about the global floating pass which is controlled by `-fno-float`. Fixes #13663 - - - - - 4ccefc6e by Matthew Craven at 2022-06-22T08:22:12-04:00 Check for Int overflows in Data.Array.Byte - - - - - 2004e3c8 by Matthew Craven at 2022-06-22T08:22:12-04:00 Add a basic test for ByteArray's Monoid instance - - - - - fb36770c by Matthew Craven at 2022-06-22T08:22:12-04:00 Rename `copyByteArray` to `unsafeCopyByteArray` - - - - - ecc9aedc by Ben Gamari at 2022-06-22T08:22:48-04:00 testsuite: Add test for #21719 Happily, this has been fixed since 9.2. - - - - - 19606c42 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Use lookupNameCache instead of lookupOrigIO - - - - - 4c9dfd69 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Break out thNameToGhcNameIO (ref. #21730) - - - - - eb4fb849 by Michael Peyton Jones at 2022-06-22T08:24:07-04:00 Add laws for 'toInteger' and 'toRational' CLC discussion here: https://github.com/haskell/core-libraries-committee/issues/58 - - - - - c1a950c1 by Alexander Esgen at 2022-06-22T12:36:13+00:00 Correct documentation of defaults of the `-V` RTS option - - - - - b7b7d90d by Matthew Pickering at 2022-06-22T21:58:12-04:00 Transcribe discussion from #21483 into a Note In #21483 I had a discussion with Simon Marlow about the memory retention behaviour of -Fd. I have just transcribed that conversation here as it elucidates the potentially subtle assumptions which led to the design of the memory retention behaviours of -Fd. Fixes #21483 - - - - - 980d1954 by Ben Gamari at 2022-06-22T21:58:48-04:00 eventlog: Don't leave dangling pointers hanging around Previously we failed to reset pointers to various eventlog buffers to NULL after freeing them. In principle we shouldn't look at them after they are freed but nevertheless it is good practice to set them to a well-defined value. - - - - - 575ec846 by Eric Lindblad at 2022-06-22T21:59:28-04:00 runhaskell - - - - - e6a69337 by Artem Pelenitsyn at 2022-06-22T22:00:07-04:00 re-export GHC.Natural.minusNaturalMaybe from Numeric.Natural CLC proposal: https://github.com/haskell/core-libraries-committee/issues/45 - - - - - 5d45aa97 by Gergo ERDI at 2022-06-22T22:00:46-04:00 When specialising, look through floatable ticks. Fixes #21697. - - - - - 531205ac by Andreas Klebinger at 2022-06-22T22:01:22-04:00 TagCheck.hs: Properly check if arguments are boxed types. For one by mistake I had been checking against the kind of runtime rep instead of the boxity. This uncovered another bug, namely that we tried to generate the checking code before we had associated the function arguments with a register, so this could never have worked to begin with. This fixes #21729 and both of the above issues. - - - - - c7f9f6b5 by Gleb Popov at 2022-06-22T22:02:00-04:00 Use correct arch for the FreeBSD triple in gen-data-layout.sh Downstream bug for reference: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=261798 Relevant upstream issue: #15718 - - - - - 75f0091b by Andreas Klebinger at 2022-06-22T22:02:35-04:00 Bump nofib submodule. Allows the shake runner to build with 9.2.3 among other things. Fixes #21772 - - - - - 0aa0ce69 by Ben Gamari at 2022-06-27T08:01:03-04:00 Bump ghc-prim and base versions To 0.9.0 and 4.17.0 respectively. Bumps array, deepseq, directory, filepath, haskeline, hpc, parsec, stm, terminfo, text, unix, haddock, and hsc2hs submodules. (cherry picked from commit ba47b95122b7b336ce1cc00896a47b584ad24095) - - - - - 4713abc2 by Ben Gamari at 2022-06-27T08:01:03-04:00 testsuite: Use normalise_version more consistently Previously several tests' output were unnecessarily dependent on version numbers, particularly of `base`. Fix this. - - - - - d7b0642b by Matthew Pickering at 2022-06-27T08:01:03-04:00 linters: Fix lint-submodule-refs when crashing trying to find plausible branches - - - - - 38378be3 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 hadrian: Improve haddocks for ghcDebugAssertions - - - - - ac7a7fc8 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 Don't mark lambda binders as OtherCon We used to put OtherCon unfoldings on lambda binders of workers and sometimes also join points/specializations with with the assumption that since the wrapper would force these arguments once we execute the RHS they would indeed be in WHNF. This was wrong for reasons detailed in #21472. So now we purge evaluated unfoldings from *all* lambda binders. This fixes #21472, but at the cost of sometimes not using as efficient a calling convention. It can also change inlining behaviour as some occurances will no longer look like value arguments when they did before. As consequence we also change how we compute CBV information for arguments slightly. We now *always* determine the CBV convention for arguments during tidy. Earlier in the pipeline we merely mark functions as candidates for having their arguments treated as CBV. As before the process is described in the relevant notes: Note [CBV Function Ids] Note [Attaching CBV Marks to ids] Note [Never put `OtherCon` unfoldigns on lambda binders] ------------------------- Metric Decrease: T12425 T13035 T18223 T18223 T18923 MultiLayerModulesTH_OneShot Metric Increase: WWRec ------------------------- - - - - - 06cf6f4a by Tony Zorman at 2022-06-27T08:02:18-04:00 Add suggestions for unrecognised pragmas (#21589) In case of a misspelled pragma, offer possible corrections as to what the user could have meant. Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/21589 - - - - - 3fbab757 by Greg Steuck at 2022-06-27T08:02:56-04:00 Remove the traces of i386-*-openbsd, long live amd64 OpenBSD will not ship any ghc packages on i386 starting with 7.2 release. This means there will not be a bootstrap compiler easily available. The last available binaries are ghc-8.10.6 which is already not supported as bootstrap for HEAD. See here for more information: https://marc.info/?l=openbsd-ports&m=165060700222580&w=2 - - - - - 58530271 by Bodigrim at 2022-06-27T08:03:34-04:00 Add Foldable1 and Bifoldable1 type classes Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/9 Instances roughly follow https://hackage.haskell.org/package/semigroupoids-5.3.7/docs/Data-Semigroup-Foldable-Class.html#t:Foldable1 but the API of `Foldable1` was expanded in comparison to `semigroupoids`. Compatibility shim is available from https://github.com/phadej/foldable1 (to be released). Closes #13573. - - - - - a51f4ecc by Naomi Liu at 2022-06-27T08:04:13-04:00 add levity polymorphism to addrToAny# - - - - - f4edcdc4 by Naomi Liu at 2022-06-27T08:04:13-04:00 add tests for addrToAny# levity - - - - - 07016fc9 by Matthew Pickering at 2022-06-27T08:04:49-04:00 hadrian: Update main README page This README had some quite out-of-date content about the build system so I did a complete pass deleting old material. I also made the section about flavours more prominent and mentioned flavour transformers. - - - - - 79ae2d89 by Ben Gamari at 2022-06-27T08:05:24-04:00 testsuite: Hide output from test compilations with verbosity==2 Previously the output from test compilations used to determine whether, e.g., profiling libraries are available was shown with verbosity levels >= 2. However, the default level is 2, meaning that most users were often spammed with confusing errors. Fix this by bumping the verbosity threshold for this output to >=3. Fixes #21760. - - - - - 995ea44d by Ben Gamari at 2022-06-27T08:06:00-04:00 configure: Only probe for LD in FIND_LD Since 6be2c5a7e9187fc14d51e1ec32ca235143bb0d8b we would probe for LD rather early in `configure`. However, it turns out that this breaks `configure`'s `ld`-override logic, which assumes that `LD` was set by the user and aborts. Fixes #21778. - - - - - b43d140b by Sergei Trofimovich at 2022-06-27T08:06:39-04:00 `.hs-boot` make rules: add missing order-only dependency on target directory Noticed missing target directory dependency as a build failure in `make --shuffle` mode (added in https://savannah.gnu.org/bugs/index.php?62100): "cp" libraries/base/./GHC/Stack/CCS.hs-boot libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot cp: cannot create regular file 'libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot': No such file or directory libraries/haskeline/ghc.mk:4: libraries/haskeline/dist-install/build/.depend-v-p-dyn.haskell: No such file or directory make[1]: *** [libraries/base/ghc.mk:4: libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot] Error 1 shuffle=1656129254 make: *** [Makefile:128: all] Error 2 shuffle=1656129254 Note that `cp` complains about inability to create target file. The change adds order-only dependency on a target directory (similar to the rest of rules in that file). The bug is lurking there since 2009 commit 34cc75e1a (`GHC new build system megapatch`.) where upfront directory creation was never added to `.hs-boot` files. - - - - - 57a5f88c by Ben Gamari at 2022-06-28T03:24:24-04:00 Mark AArch64/Darwin as requiring sign-extension Apple's AArch64 ABI requires that the caller sign-extend small integer arguments. Set platformCConvNeedsExtension to reflect this fact. Fixes #21773. - - - - - df762ae9 by Ben Gamari at 2022-06-28T03:24:24-04:00 -ddump-llvm shouldn't imply -fllvm Previously -ddump-llvm would change the backend used, which contrasts with all other dump flags. This is quite surprising and cost me quite a bit of time. Dump flags should not change compiler behavior. Fixes #21776. - - - - - 70f0c1f8 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Re-format argument handling logic Previously there were very long, hard to parse lines. Fix this. - - - - - 696d64c3 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Sign-extend narrow C arguments The AArch64/Darwin ABI requires that function arguments narrower than 32-bits must be sign-extended by the caller. We neglected to do this, resulting in #20735. Fixes #20735. - - - - - c006ac0d by Ben Gamari at 2022-06-28T03:24:24-04:00 testsuite: Add test for #20735 - - - - - 16b9100c by Ben Gamari at 2022-06-28T03:24:59-04:00 integer-gmp: Fix cabal file Evidently fields may not come after sections in a cabal file. - - - - - 03cc5d02 by Sergei Trofimovich at 2022-06-28T15:20:45-04:00 ghc.mk: fix 'make install' (`mk/system-cxx-std-lib-1.0.conf.install` does not exist) before the change `make install` was failing as: ``` "mv" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc-stage2" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc" make[1]: *** No rule to make target 'mk/system-cxx-std-lib-1.0.conf.install', needed by 'install_packages'. Stop. ``` I think it's a recent regression caused by 0ef249aa where `system-cxx-std-lib-1.0.conf` is created (somewhat manually), but not the .install varianlt of it. The fix is to consistently use `mk/system-cxx-std-lib-1.0.conf` everywhere. Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/21784 - - - - - eecab8f9 by Simon Peyton Jones at 2022-06-28T15:21:21-04:00 Comments only, about join points This MR just adds some documentation about why casts destroy join points, following #21716. - - - - - 251471e7 by Matthew Pickering at 2022-06-28T19:02:41-04:00 Cleanup BuiltInSyntax vs UserSyntax There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302 - - - - - 0e22f16c by Ben Gamari at 2022-06-28T19:03:16-04:00 template-haskell: Bump version to 2.19.0.0 Bumps text and exceptions submodules due to bounds. - - - - - bbe6f10e by Emily Bourke at 2022-06-29T08:23:13+00:00 Tiny tweak to `IOPort#` documentation The exclamation mark and bracket don’t seem to make sense here. I’ve looked through the history, and I don’t think they’re deliberate – possibly a copy-and-paste error. - - - - - 70e47489 by Dominik Peteler at 2022-06-29T19:26:31-04:00 Remove `CoreOccurAnal` constructor of the `CoreToDo` type It was dead code since the last occurence in an expression context got removed in 71916e1c018dded2e68d6769a2dbb8777da12664. - - - - - d0722170 by nineonine at 2022-07-01T08:15:56-04:00 Fix panic with UnliftedFFITypes+CApiFFI (#14624) When declaring foreign import using CAPI calling convention, using unlifted unboxed types would result in compiler panic. There was an attempt to fix the situation in #9274, however it only addressed some of the ByteArray cases. This patch fixes other missed cases for all prims that may be used as basic foreign types. - - - - - eb043148 by Douglas Wilson at 2022-07-01T08:16:32-04:00 rts: gc stats: account properly for copied bytes in sequential collections We were not updating the [copied,any_work,scav_find_work, max_n_todo_overflow] counters during sequential collections. As well, we were double counting for parallel collections. To fix this we add an `else` clause to the `if (is_par_gc())`. The par_* counters do not need to be updated in the sequential case because they must be 0. - - - - - f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow Enabling `-fhpc` or `-finfo-table-map` would case a tick to end up between the appliation of `neg` to its argument. This defeated the special logic which looks for `NegApp ... (HsOverLit` to warn about possible overflow if a user writes a negative literal (without out NegativeLiterals) in their code. Fixes #21701 - - - - - f25c8d03 by Matthew Pickering at 2022-07-01T19:22:31-04:00 ci: Fix definition of slow-validate flavour (so that -dlint) is passed In this embarassing sequence of events we were running slow-validate without -dlint. - - - - - bf7991b0 by Mike Pilgrem at 2022-07-02T10:12:04-04:00 Identify the extistence of the `runhaskell` command and that it is equivalent to the `runghc` command. Add an entry to the index for `runhaskell`. See https://gitlab.haskell.org/ghc/ghc/-/issues/21411 - - - - - 9e79f6d0 by Simon Jakobi at 2022-07-02T10:12:39-04:00 Data.Foldable1: Remove references to Foldable-specific note ...as discussed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8495#note_439455. - - - - - 3a8970ac by romes at 2022-07-03T14:11:31-04:00 TTG: Move HsModule to L.H.S Move the definition of HsModule defined in GHC.Hs to Language.Haskell.Syntax with an added TTG parameter and corresponding extension fields. This is progress towards having the haskell-syntax package, as described in #21592 - - - - - f9f80995 by romes at 2022-07-03T14:11:31-04:00 TTG: Move ImpExp client-independent bits to L.H.S.ImpExp Move the GHC-independent definitions from GHC.Hs.ImpExp to Language.Haskell.Syntax.ImpExp with the required TTG extension fields such as to keep the AST independent from GHC. This is progress towards having the haskell-syntax package, as described in #21592 Bumps haddock submodule - - - - - c43dbac0 by romes at 2022-07-03T14:11:31-04:00 Refactor ModuleName to L.H.S.Module.Name ModuleName used to live in GHC.Unit.Module.Name. In this commit, the definition of ModuleName and its associated functions are moved to Language.Haskell.Syntax.Module.Name according to the current plan towards making the AST GHC-independent. The instances for ModuleName for Outputable, Uniquable and Binary were moved to the module in which the class is defined because these instances depend on GHC. The instance of Eq for ModuleName is slightly changed to no longer depend on unique explicitly and instead uses FastString's instance of Eq. - - - - - 2635c6f2 by konsumlamm at 2022-07-03T14:12:11-04:00 Expand `Ord` instance for `Down` Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/23#issuecomment-1172932610 - - - - - 36fba0df by Anselm Schüler at 2022-07-04T05:06:42+00:00 Add applyWhen to Data.Function per CLC prop Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/71#issuecomment-1165830233 - - - - - 3b13aab1 by Matthew Pickering at 2022-07-04T15:15:00-04:00 hadrian: Don't read package environments in ghc-stage1 wrapper The stage1 compiler may be on the brink of existence and not have even a working base library. You may have installed packages globally with a similar stage2 compiler which will then lead to arguments such as --show-iface not even working because you are passing too many package flags. The solution is simple, don't read these implicit files. Fixes #21803 - - - - - aba482ea by Andreas Klebinger at 2022-07-04T17:55:55-04:00 Ticky:Make json info a separate field. Fixes #21233 - - - - - 74f3867d by Matthew Pickering at 2022-07-04T17:56:30-04:00 Add docs:<pkg> command to hadrian to build docs for just one package - - - - - 418afaf1 by Matthew Pickering at 2022-07-04T17:56:30-04:00 upload-docs: propagate publish correctly in upload_sdist - - - - - ed793d7a by Matthew Pickering at 2022-07-04T17:56:30-04:00 docs-upload: Fix upload script when no packages are listed - - - - - d002c6e0 by Matthew Pickering at 2022-07-04T17:56:30-04:00 hadrian: Add --haddock-base-url option for specifying base-url when generating docs The motiviation for this flag is to be able to produce documentation which is suitable for uploading for hackage, ie, the cross-package links work correctly. There are basically three values you want to set this to: * off - default, base_url = ../%pkg% which works for local browsing * on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload * on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation. The `%pkg%` string is a template variable which is replaced with the package identifier for the relevant package. This is one step towards fixing #21749 - - - - - 41eb749a by Matthew Pickering at 2022-07-04T17:56:31-04:00 Add nightly job for generating docs suitable for hackage upload - - - - - 620ee7ed by Matthew Pickering at 2022-07-04T17:57:05-04:00 ghci: Support :set prompt in multi repl This adds supports for various :set commands apart from `:set <FLAG>` in multi repl, this includes `:set prompt` and so-on. Fixes #21796 - - - - - b151b65e by Matthew Pickering at 2022-07-05T16:32:31-04:00 Vendor filepath inside template-haskell Adding filepath as a dependency of template-haskell means that it can't be reinstalled if any build-plan depends on template-haskell. This is a temporary solution for the 9.4 release. A longer term solution is to split-up the template-haskell package into the wired-in part and a non-wired-in part which can be reinstalled. This was deemed quite risky on the 9.4 release timescale. Fixes #21738 - - - - - c9347ecf by John Ericson at 2022-07-05T16:33:07-04:00 Factor fields of `CoreDoSimplify` into separate data type This avoids some partiality. The work @mmhat is doing cleaning up and modularizing `Core.Opt` will build on this nicely. - - - - - d0e74992 by Eric Lindblad at 2022-07-06T01:35:48-04:00 https urls - - - - - 803e965c by Eric Lindblad at 2022-07-06T01:35:48-04:00 options and typos - - - - - 5519baa5 by Eric Lindblad at 2022-07-06T01:35:48-04:00 grammar - - - - - 4ddc1d3e by Eric Lindblad at 2022-07-06T01:35:48-04:00 sources - - - - - c95c2026 by Matthew Pickering at 2022-07-06T01:35:48-04:00 Fix lint warnings in bootstrap.py - - - - - 86ced2ad by romes at 2022-07-06T01:36:23-04:00 Restore Eq instance of ImportDeclQualifiedStyle Fixes #21819 - - - - - 3547e264 by romes at 2022-07-06T13:50:27-04:00 Prune L.H.S modules of GHC dependencies Move around datatypes, functions and instances that are GHC-specific out of the `Language.Haskell.Syntax.*` modules to reduce the GHC dependencies in them -- progressing towards #21592 Creates a module `Language.Haskell.Syntax.Basic` to hold basic definitions required by the other L.H.S modules (and don't belong in any of them) - - - - - e4eea07b by romes at 2022-07-06T13:50:27-04:00 TTG: Move CoreTickish out of LHS.Binds Remove the `[CoreTickish]` fields from datatype `HsBindLR idL idR` and move them to the extension point instance, according to the plan outlined in #21592 to separate the base AST from the GHC specific bits. - - - - - acc1816b by romes at 2022-07-06T13:50:27-04:00 TTG for ForeignImport/Export Add a TTG parameter to both `ForeignImport` and `ForeignExport` and, according to #21592, move the GHC-specific bits in them and in the other AST data types related to foreign imports and exports to the TTG extension point. - - - - - 371c5ecf by romes at 2022-07-06T13:50:27-04:00 TTG for HsTyLit Add TTG parameter to `HsTyLit` to move the GHC-specific `SourceText` fields to the extension point and out of the base AST. Progress towards #21592 - - - - - fd379d1b by romes at 2022-07-06T13:50:27-04:00 Remove many GHC dependencies from L.H.S Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC imports according to the plan in the linked issue. Moves more GHC-specific declarations to `GHC.*` and brings more required GHC-independent declarations to `Language.Haskell.Syntax.*` (extending e.g. `Language.Haskell.Syntax.Basic`). Progress towards #21592 Bump haddock submodule for !8308 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - c5415bc5 by Alan Zimmerman at 2022-07-06T13:50:27-04:00 Fix exact printing of the HsRule name Prior to this branch, the HsRule name was XRec pass (SourceText,RuleName) and there is an ExactPrint instance for (SourceText, RuleName). The SourceText has moved to a different location, so synthesise the original to trigger the correct instance when printing. We need both the SourceText and RuleName when exact printing, as it is possible to have a NoSourceText variant, in which case we fall back to the FastString. - - - - - 665fa5a7 by Matthew Pickering at 2022-07-06T13:51:03-04:00 driver: Fix issue with module loops and multiple home units We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 - - - - - bbcaba6a by Andreas Klebinger at 2022-07-06T13:51:39-04:00 Remove a bogus #define from ClosureMacros.h - - - - - fa59223b by Tamar Christina at 2022-07-07T23:23:57-04:00 winio: make consoleReadNonBlocking not wait for any events at all. - - - - - 42c917df by Adam Sandberg Ericsson at 2022-07-07T23:24:34-04:00 rts: allow NULL to be used as an invalid StgStablePtr - - - - - 3739e565 by Andreas Schwab at 2022-07-07T23:25:10-04:00 RTS: Add stack marker to StgCRunAsm.S Every object file must be properly marked for non-executable stack, even if it contains no code. - - - - - a889bc05 by Ben Gamari at 2022-07-07T23:25:45-04:00 Bump unix submodule Adds `config.sub` to unix's `.gitignore`, fixing #19574. - - - - - 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode The most egrarious thing this fixes is the report about the total number of loaded modules after starting a session. Ticket #20889 - - - - - fc183c90 by Matthew Pickering at 2022-07-09T11:11:58-04:00 Enable :edit command in ghci multi-mode. This works after the last change to isLoaded. Ticket #20888 - - - - - 46050534 by Simon Peyton Jones at 2022-07-09T11:12:34-04:00 Fix a scoping bug in the Specialiser In the call to `specLookupRule` in `already_covered`, in `specCalls`, we need an in-scope set that includes the free vars of the arguments. But we simply were not guaranteeing that: did not include the `rule_bndrs`. Easily fixed. I'm not sure how how this bug has lain for quite so long without biting us. Fixes #21828. - - - - - 6e8d9056 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Edit Note [idArity varies independently of dmdTypeDepth] ...and refer to it in GHC.Core.Lint.lintLetBind. Fixes #21452 - - - - - 89ba4655 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Tiny documentation wibbles (comments only) - - - - - 61a46c6d by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix readme - - - - - 61babb5e by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix bootstrap - - - - - 8b417ad5 by Eric Lindblad at 2022-07-13T08:28:29-04:00 tarball - - - - - e9d9f078 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Fix scopes for deriving clauses and instance signatures (#18425) - - - - - c4989131 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Record location of filled in default method bindings This is useful for hie files to reconstruct the evidence that default methods depend on. - - - - - 9c52e7fc by Zubin Duggal at 2022-07-13T14:00:18-04:00 testsuite: Factor out common parts from hiefile tests - - - - - 6a9e4493 by sheaf at 2022-07-13T14:00:56-04:00 Hadrian: update documentation of settings The documentation for key-value settings was a bit out of date. This patch updates it to account for `cabal.configure.opts` and `hsc2hs.run.opts`. The user-settings document was also re-arranged, to make the key-value settings more prominent (as it doesn't involve changing the Hadrian source code, and thus doesn't require any recompilation of Hadrian). - - - - - a2f142f8 by Zubin Duggal at 2022-07-13T20:43:32-04:00 Fix potential space leak that arise from ModuleGraphs retaining references to previous ModuleGraphs, in particular the lazy `mg_non_boot` field. This manifests in `extendMG`. Solution: Delete `mg_non_boot` as it is only used for `mgLookupModule`, which is only called in two places in the compiler, and should only be called at most once for every home unit: GHC.Driver.Make: mainModuleSrcPath :: Maybe String mainModuleSrcPath = do ms <- mgLookupModule mod_graph (mainModIs hue) ml_hs_file (ms_location ms) GHCI.UI: listModuleLine modl line = do graph <- GHC.getModuleGraph let this = GHC.mgLookupModule graph modl Instead `mgLookupModule` can be a linear function that looks through the entire list of `ModuleGraphNodes` Fixes #21816 - - - - - dcf8b30a by Ben Gamari at 2022-07-13T20:44:08-04:00 rts: Fix AdjustorPool bitmap manipulation Previously the implementation of bitmap_first_unset assumed that `__builtin_clz` would accept `uint8_t` however it apparently rather extends its argument to `unsigned int`. To fix this we simply revert to a naive implementation since handling the various corner cases with `clz` is quite tricky. This should be fine given that AdjustorPool isn't particularly hot. Ideally we would have a single, optimised bitmap implementation in the RTS but I'll leave this for future work. Fixes #21838. - - - - - ad8f3e15 by Luite Stegeman at 2022-07-16T07:20:36-04:00 Change GHCi bytecode return convention for unlifted datatypes. This changes the bytecode return convention for unlifted algebraic datatypes to be the same as for lifted types, i.e. ENTER/PUSH_ALTS instead of RETURN_UNLIFTED/PUSH_ALTS_UNLIFTED Fixes #20849 - - - - - 5434d1a3 by Colten Webb at 2022-07-16T07:21:15-04:00 Compute record-dot-syntax types Ensures type information for record-dot-syntax is included in HieASTs. See #21797 - - - - - 89d169ec by Colten Webb at 2022-07-16T07:21:15-04:00 Add record-dot-syntax test - - - - - 4beb9f3c by Ben Gamari at 2022-07-16T07:21:51-04:00 Document RuntimeRep polymorphism limitations of catch#, et al As noted in #21868, several primops accepting continuations producing RuntimeRep-polymorphic results aren't nearly as polymorphic as their types suggest. Document this limitation and adapt the `UnliftedWeakPtr` test to avoid breaking this limitation in `keepAlive#`. - - - - - 4ef1c65d by Ben Gamari at 2022-07-16T07:21:51-04:00 Make keepAlive# out-of-line This is a naive approach to fixing the unsoundness noticed in #21708. Specifically, we remove the lowering of `keepAlive#` via CorePrep and instead turn it into an out-of-line primop. This is simple, inefficient (since the continuation must now be heap allocated), but good enough for 9.4.1. We will revisit this (particiularly via #16098) in a future release. Metric Increase: T4978 T7257 T9203 - - - - - 1bbff35d by Greg Steuck at 2022-07-16T07:22:29-04:00 Suppress extra output from configure check for c++ libraries - - - - - 3acbd7ad by Ben Gamari at 2022-07-16T07:23:04-04:00 rel-notes: Drop mention of #21745 fix Since we have backported the fix to 9.4.1. - - - - - b27c2774 by Dominik Peteler at 2022-07-16T07:23:43-04:00 Align the behaviour of `dopt` and `log_dopt` Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861 - - - - - 28347d71 by Douglas Wilson at 2022-07-16T13:25:06-04:00 rts: forkOn context switches the target capability Fixes #21824 - - - - - f1c44991 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Eliminate orphan Outputable instances Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and `OutputableP` instances for the Cmm AST. This makes it significantly easier to use the Cmm pretty-printers in tracing output without incurring module import cycles. - - - - - f2e5e763 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Move toBlockList to GHC.Cmm - - - - - fa092745 by Ben Gamari at 2022-07-16T13:25:41-04:00 compiler: Add haddock sections to GHC.Utils.Panic - - - - - 097759f9 by Ben Gamari at 2022-07-16T13:26:17-04:00 configure: Don't override Windows CXXFLAGS At some point we used the clang distribution from msys2's `MINGW64` environment for our Windows toolchain. This defaulted to using libgcc and libstdc++ for its runtime library. However, we found for a variety of reasons that compiler-rt, libunwind, and libc++ were more reliable, consequently we explicitly overrode the CXXFLAGS to use these. However, since then we have switched to use the `CLANG64` packaging, which default to these already. Consequently we can drop these arguments, silencing some redundant argument warnings from clang. Fixes #21669. - - - - - e38a2684 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Check that there are no NULL ctors - - - - - 616365b0 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Introduce support for invoking finalizers on unload Addresses #20494. - - - - - cdd3be20 by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add T20494 - - - - - 03c69d8d by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Rename finit field to fini fini is short for "finalizer", which does not contain a "t". - - - - - 033580bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Refactor handling of oc->info Previously we would free oc->info after running initializers. However, we can't do this is we want to also run finalizers. Moreover, freeing oc->info so early was wrong for another reason: we will need it in order to unregister the exception tables (see the call to `RtlDeleteFunctionTable`). In service of #20494. - - - - - f17912e4 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Add finalization support This implements #20494 for the PEi386 linker. Happily, this also appears to fix `T9405`, resolving #21361. - - - - - 2cd75550 by Ben Gamari at 2022-07-16T23:50:36-04:00 Loader: Implement gnu-style -l:$path syntax Gnu ld allows `-l` to be passed an absolute file path, signalled by a `:` prefix. Implement this in the GHC's loader search logic. - - - - - 5781a360 by Ben Gamari at 2022-07-16T23:50:36-04:00 Statically-link against libc++ on Windows Unfortunately on Windows we have no RPATH-like facility, making dynamic linking extremely fragile. Since we cannot assume that the user will add their GHC installation to `$PATH` (and therefore their DLL search path) we cannot assume that the loader will be able to locate our `libc++.dll`. To avoid this, we instead statically link against `libc++.a` on Windows. Fixes #21435. - - - - - 8e2e883b by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Ensure that all .ctors/.dtors sections are run It turns out that PE objects may have multiple `.ctors`/`.dtors` sections but the RTS linker had assumed that there was only one. Fix this. Fixes #21618. - - - - - fba04387 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Respect dtor/ctor priority Previously we would run constructors and destructors in arbitrary order despite explicit priorities. Fixes #21847. - - - - - 1001952f by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add test for #21618 and #21847 - - - - - 6f3816af by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Fix exception unwind unregistration RtlDeleteFunctionTable expects a pointer to the .pdata section yet we passed it the .xdata section. Happily, this fixes #21354. - - - - - d9bff44c by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Drop dead code - - - - - d161e6bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Use section flags to identify initializers - - - - - fbb17110 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Introduce finalizer support - - - - - 5b0ed8a8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Use system-cxx-std-lib instead of config.stdcxx_impl - - - - - 6c476e1a by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker/Elf: Work around GCC 6 init/fini behavior It appears that GCC 6t (at least on i386) fails to give init_array/fini_array sections the correct SHT_INIT_ARRAY/SHT_FINI_ARRAY section types, instead marking them as SHT_PROGBITS. This caused T20494 to fail on Debian. - - - - - 5f8203b8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Mark T13366Cxx as unbroken on Darwin - - - - - 1fd2f851 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Fix resolution of __dso_handle on Darwin Darwin expects a leading underscore. - - - - - a2dc00f3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Clean up section kinds - - - - - aeb1a7c3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Ensure that __cxa_finalize is called on code unload - - - - - 028f081e by Ben Gamari at 2022-07-16T23:51:12-04:00 testsuite: Fix T11829 on Centos 7 It appears that Centos 7 has a more strict C++ compiler than most distributions since std::runtime_error is defined in <stdexcept> rather than <exception>. In T11829 we mistakenly imported the latter. - - - - - a10584e8 by Ben Gamari at 2022-07-17T22:30:32-04:00 hadrian: Rename documentation directories for consistency with make * Rename `docs` to `doc` * Place pdf documentation in `doc/` instead of `doc/pdfs/` Fixes #21164. - - - - - b27c5947 by Anselm Schüler at 2022-07-17T22:31:11-04:00 Fix incorrect proof of applyWhen’s properties - - - - - eb031a5b by Matthew Pickering at 2022-07-18T08:04:47-04:00 hadrian: Add multi:<pkg> and multi targets for starting a multi-repl This patch adds support to hadrian for starting a multi-repl containing all the packages which stage0 can build. In particular, there is the new user-facing command: ``` ./hadrian/ghci-multi ``` which when executed will start a multi-repl containing the `ghc` package and all it's dependencies. This is implemented by two new hadrian targets: ``` ./hadrian/build multi:<pkg> ``` Construct the arguments for a multi-repl session where the top-level package is <pkg>. For example, `./hadrian/ghci-multi` is implemented using `multi:ghc` target. There is also the `multi` command which constructs a repl for everything in stage0 which we can build. - - - - - 19e7cac9 by Eric Lindblad at 2022-07-18T08:05:27-04:00 changelog typo - - - - - af6731a4 by Eric Lindblad at 2022-07-18T08:05:27-04:00 typos - - - - - 415468fe by Simon Peyton Jones at 2022-07-18T16:36:54-04:00 Refactor SpecConstr to use treat bindings uniformly This patch, provoked by #21457, simplifies SpecConstr by treating top-level and nested bindings uniformly (see the new scBind). * Eliminates the mysterious scTopBindEnv * Refactors scBind to handle top-level and nested definitions uniformly. * But, for now at least, continues the status quo of not doing SpecConstr for top-level non-recursive bindings. (In contrast we do specialise nested non-recursive bindings, although the original paper did not; see Note [Local let bindings].) I tried the effect of specialising top-level non-recursive bindings (which is now dead easy to switch on, unlike before) but found some regressions, so I backed off. See !8135. It's a pure refactoring. I think it'll do a better job in a few cases, but there is no regression test. - - - - - d4d3fe6e by Andreas Klebinger at 2022-07-18T16:37:29-04:00 Rule matching: Don't compute the FVs if we don't look at them. - - - - - 5f907371 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 White space only in FamInstEnv - - - - - ae3b3b62 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make transferPolyIdInfo work for CPR I don't know why this hasn't bitten us before, but it was plain wrong. - - - - - 9bdfdd98 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Inline mapAccumLM This function is called in inner loops in the compiler, and it's overloaded and higher order. Best just to inline it. This popped up when I was looking at something else. I think perhaps GHC is delicately balanced on the cusp of inlining this automatically. - - - - - d0b806ff by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make SetLevels honour floatConsts This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though. - - - - - d1c25a48 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Refactor wantToUnboxArg a bit * Rename GHC.Core.Opt.WorkWrap.Utils.wantToUnboxArg to canUnboxArg and similarly wantToUnboxResult to canUnboxResult. * Add GHC.Core.Opt.DmdAnal.wantToUnboxArg as a wrapper for the (new) GHC.Core.Opt.WorkWrap.Utils.canUnboxArg, avoiding some yukky duplication. I decided it was clearer to give it a new data type for its return type, because I nedeed the FD_RecBox case which was not otherwise readiliy expressible. * Add dcpc_args to WorkWrap.Utils.DataConPatContext for the payload * Get rid of the Unlift constructor of UnboxingDecision, eliminate two panics, and two arguments to canUnboxArg (new name). Much nicer now. - - - - - 6d8a715e by Teo Camarasu at 2022-07-18T16:38:44-04:00 Allow running memInventory when the concurrent nonmoving gc is enabled If the nonmoving gc is enabled and we are using a threaded RTS, we now try to grab the collector mutex to avoid memInventory and the collection racing. Before memInventory was disabled. - - - - - aa75bbde by Ben Gamari at 2022-07-18T16:39:20-04:00 gitignore: don't ignore all aclocal.m4 files While GHC's own aclocal.m4 is generated by the aclocal tool, other packages' aclocal.m4 are committed in the repository. Previously `.gitignore` included an entry which covered *any* file named `aclocal.m4`, which lead to quite some confusion (e.g. see #21740). Fix this by modifying GHC's `.gitignore` to only cover GHC's own `aclocal.m4`. - - - - - 4b98c5ce by Boris Lykah at 2022-07-19T02:34:12-04:00 Add mapAccumM, forAccumM to Data.Traversable Approved by Core Libraries Committee in https://github.com/haskell/core-libraries-committee/issues/65#issuecomment-1186275433 - - - - - bd92182c by Ben Gamari at 2022-07-19T02:34:47-04:00 configure: Use AC_PATH_TOOL to detect tools Previously we used AC_PATH_PROG which, as noted by #21601, does not look for tools with a target prefix, breaking cross-compilation. Fixes #21601. - - - - - e8c07aa9 by Matthew Pickering at 2022-07-19T10:07:53-04:00 driver: Fix implementation of -S We were failing to stop before running the assembler so the object file was also created. Fixes #21869 - - - - - e2f0094c by Ben Gamari at 2022-07-19T10:08:28-04:00 rts/ProfHeap: Ensure new Censuses are zeroed When growing the Census array ProfHeap previously neglected to zero the new part of the array. Consequently `freeEra` would attempt to free random words that often looked suspiciously like pointers. Fixes #21880. - - - - - 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 6 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/gen_ci.hs - + .gitlab/generate_jobs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2915d1e690af5a8b38daab949362e42c8fb332fa...20457d775885d6c3df020d204da9a7acfb3c2e5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2915d1e690af5a8b38daab949362e42c8fb332fa...20457d775885d6c3df020d204da9a7acfb3c2e5a You're receiving 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 Aug 8 19:41:29 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Mon, 08 Aug 2022 15:41:29 -0400 Subject: [Git][ghc/ghc][wip/21611-move-corem] Removed CoreDoNothing and CoreDoPasses Message-ID: <62f166e9132ea_25b0164cff458675e@gitlab.mail> Dominik Peteler pushed to branch wip/21611-move-corem at Glasgow Haskell Compiler / GHC Commits: 16f3cbad by Dominik Peteler at 2022-08-02T20:37:17+02:00 Removed CoreDoNothing and CoreDoPasses Rewrote the getCoreToDo function using a Writer monad. This makes these data constructors superfluous. - - - - - 4 changed files: - compiler/GHC/Core/Opt.hs - compiler/GHC/Core/Opt/Config.hs - compiler/GHC/Driver/Config/Core/EndPass.hs - compiler/GHC/Driver/Config/Core/Opt.hs Changes: ===================================== compiler/GHC/Core/Opt.hs ===================================== @@ -95,8 +95,6 @@ runCorePasses env passes guts = foldM do_pass guts passes where do_pass :: ModGuts -> CoreToDo -> SimplCountM ModGuts - do_pass res CoreDoNothing = return res - do_pass guts (CoreDoPasses ps) = runCorePasses env ps guts do_pass guts pass = do let end_pass_cfg = co_endPassCfg env pass let lint_anno_cfg = co_lintAnnotationsCfg env pass @@ -183,10 +181,6 @@ doCorePass env pass guts = do CoreDoRuleCheck opts -> {-# SCC "RuleCheck" #-} liftIO $ ruleCheckPass (co_logger env) opts (co_hptRuleBase env) (co_visOrphans env) guts - CoreDoNothing -> return guts - - CoreDoPasses passes -> runCorePasses env passes guts - CoreDoPluginPass _ p -> {-# SCC "Plugin" #-} co_liftCoreM env (co_debugSetting env) guts $ p guts where ===================================== compiler/GHC/Core/Opt/Config.hs ===================================== @@ -55,11 +55,6 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoSpecConstr !SpecConstrOpts | CoreCSE | CoreDoRuleCheck !RuleCheckOpts - | -- | Useful when building up - CoreDoNothing - | -- | lists of these things - CoreDoPasses [CoreToDo] - | CoreAddCallerCcs !CallerCCOpts | CoreAddLateCcs !Bool -- ^ '-fprof-count-entries' @@ -82,8 +77,6 @@ instance Outputable CoreToDo where ppr (CoreAddLateCcs _) = text "Add late core cost-centres" ppr CoreDoPrintCore = text "Print core" ppr (CoreDoRuleCheck {}) = text "Rule check" - ppr CoreDoNothing = text "CoreDoNothing" - ppr (CoreDoPasses passes) = text "CoreDoPasses" <+> ppr passes pprPassDetails :: CoreToDo -> SDoc pprPassDetails (CoreDoSimplify cfg) = vcat [ text "Max iterations =" <+> int n ===================================== compiler/GHC/Driver/Config/Core/EndPass.hs ===================================== @@ -46,5 +46,3 @@ coreDumpFlag (CoreAddCallerCcs {}) = Nothing coreDumpFlag (CoreAddLateCcs {}) = Nothing coreDumpFlag CoreDoPrintCore = Nothing coreDumpFlag (CoreDoRuleCheck {}) = Nothing -coreDumpFlag CoreDoNothing = Nothing -coreDumpFlag (CoreDoPasses {}) = Nothing ===================================== compiler/GHC/Driver/Config/Core/Opt.hs ===================================== @@ -29,6 +29,10 @@ import GHC.Types.Var ( Var ) import qualified GHC.LanguageExtensions as LangExt +import Control.Monad +import Control.Monad.Trans.Writer.Strict ( Writer, execWriter, tell ) +import Data.Foldable + {- ************************************************************************ * * @@ -38,8 +42,184 @@ import qualified GHC.LanguageExtensions as LangExt -} getCoreToDo :: DynFlags -> [Var] -> [CoreToDo] -getCoreToDo dflags extra_vars - = flatten_todos core_todo +getCoreToDo dflags extra_vars = execWriter $ do + -- We want to do the static argument transform before full laziness as it + -- may expose extra opportunities to float things outwards. However, to fix + -- up the output of the transformation we need at do at least one simplify + -- after this before anything else + when static_args $ do + simpl_gently + enqueue CoreDoStaticArgs + + -- initial simplify: make specialiser happy: minimum effort please + when do_presimplify $ + simpl_gently + + -- Specialisation is best done before full laziness + -- so that overloaded functions have all their dictionary lambdas manifest + when do_specialise $ + enqueue $ coreDoSpecialising dflags + + if full_laziness then + -- Was: gentleFloatOutSwitches + -- + -- I have no idea why, but not floating constants to + -- top level is very bad in some cases. + -- + -- Notably: p_ident in spectral/rewrite + -- Changing from "gentle" to "constantsOnly" + -- improved rewrite's allocation by 19%, and + -- made 0.0% difference to any other nofib + -- benchmark + -- + -- Not doing floatOutOverSatApps yet, we'll do + -- that later on when we've had a chance to get more + -- accurate arity information. In fact it makes no + -- difference at all to performance if we do it here, + -- but maybe we save some unnecessary to-and-fro in + -- the simplifier. + enqueue $ CoreDoFloatOutwards FloatOutSwitches + { floatOutLambdas = Just 0 + , floatOutConstants = True + , floatOutOverSatApps = False + , floatToTopLevelOnly = False + } + + else + -- Even with full laziness turned off, we still need to float static + -- forms to the top level. See Note [Grand plan for static forms] in + -- GHC.Iface.Tidy.StaticPtrTable. + -- + when static_ptrs $ do + -- Float Out can't handle type lets (sometimes created + -- by simpleOptPgm via mkParallelBindings) + simpl_gently + -- Static forms are moved to the top level with the FloatOut pass. + -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. + enqueue $ CoreDoFloatOutwards FloatOutSwitches + { floatOutLambdas = Just 0 + , floatOutConstants = True + , floatOutOverSatApps = False + , floatToTopLevelOnly = True + } + + -- Run the simplier phases 2,1,0 to allow rewrite rules to fire + when do_simpl3 $ do + for_ [phases, phases-1 .. 1] $ \phase -> + simpl_phase (Phase phase) "main" max_iter + + -- Phase 0: allow all Ids to be inlined now + -- This gets foldr inlined before strictness analysis + + -- At least 3 iterations because otherwise we land up with + -- huge dead expressions because of an infelicity in the + -- simplifier. + -- let k = BIG in foldr k z xs + -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs + -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs + -- Don't stop now! + simpl_phase (Phase 0) "main" (max max_iter 3) + + -- Run float-inwards immediately before the strictness analyser + -- Doing so pushes bindings nearer their use site and hence makes + -- them more likely to be strict. These bindings might only show + -- up after the inlining from simplification. Example in fulsom, + -- Csg.calc, where an arg of timesDouble thereby becomes strict. + when do_float_in $ + enqueue $ CoreDoFloatInwards platform + + when call_arity $ do + enqueue CoreDoCallArity + simplify "post-call-arity" + + -- Strictness analysis + when strictness $ do + dmd_cpr_ww + simplify "post-worker-wrapper" + + -- See Note [Placement of the exitification pass] + when exitification $ + enqueue CoreDoExitify + + when full_laziness $ + enqueue $ CoreDoFloatOutwards FloatOutSwitches + { floatOutLambdas = floatLamArgs dflags + , floatOutConstants = True + , floatOutOverSatApps = True + , floatToTopLevelOnly = False + } + -- nofib/spectral/hartel/wang doubles in speed if you + -- do full laziness late in the day. It only happens + -- after fusion and other stuff, so the early pass doesn't + -- catch it. For the record, the redex is + -- f_el22 (f_el21 r_midblock) + + -- We want CSE to follow the final full-laziness pass, because it may + -- succeed in commoning up things floated out by full laziness. + -- CSE used to rely on the no-shadowing invariant, but it doesn't any more + when cse $ + enqueue CoreCSE + + when do_float_in $ + enqueue $ CoreDoFloatInwards platform + + -- Final tidy-up + simplify "final" + + maybe_rule_check FinalPhase + + -------- After this we have -O2 passes ----------------- + -- None of them run with -O + + -- Case-liberation for -O2. This should be after + -- strictness analysis and the simplification which follows it. + when liberate_case $ do + enqueue $ CoreLiberateCase (initLiberateCaseOpts dflags) + -- Run the simplifier after LiberateCase to vastly + -- reduce the possibility of shadowing + -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr + simplify "post-liberate-case" + + when spec_constr $ do + enqueue $ CoreDoSpecConstr (initSpecConstrOpts dflags) + -- See Note [Simplify after SpecConstr] + simplify "post-spec-constr" + + maybe_rule_check FinalPhase + + when late_specialise $ do + enqueue $ coreDoSpecialising dflags + simplify "post-late-spec" + + -- LiberateCase can yield new CSE opportunities because it peels + -- off one layer of a recursive function (concretely, I saw this + -- in wheel-sieve1), and I'm guessing that SpecConstr can too + -- And CSE is a very cheap pass. So it seems worth doing here. + when ((liberate_case || spec_constr) && cse) $ do + enqueue CoreCSE + simplify "post-final-cse" + + --------- End of -O2 passes -------------- + + when late_dmd_anal $ do + dmd_cpr_ww + simplify "post-late-ww" + + -- Final run of the demand_analyser, ensures that one-shot thunks are + -- really really one-shot thunks. Only needed if the demand analyser + -- has run at all. See Note [Final Demand Analyser run] in GHC.Core.Opt.DmdAnal + -- It is EXTREMELY IMPORTANT to run this pass, otherwise execution + -- can become /exponentially/ more expensive. See #11731, #12996. + when (strictness || late_dmd_anal) $ + enqueue $ coreDoDemand dflags + + maybe_rule_check FinalPhase + + when profiling $ do + when (not (null $ callerCcFilters dflags)) $ + enqueue $ CoreAddCallerCcs (initCallerCCOpts dflags) + when (gopt Opt_ProfLateCcs dflags) $ + enqueue $ CoreAddLateCcs (gopt Opt_ProfCountEntries dflags) where phases = simplPhases dflags max_iter = maxSimplIterations dflags @@ -66,228 +246,39 @@ getCoreToDo dflags extra_vars do_presimplify = do_specialise -- TODO: any other optimizations benefit from pre-simplification? do_simpl3 = const_fold || rules_on -- TODO: any other optimizations benefit from three-phase simplification? - maybe_rule_check phase = runMaybe rule_check $ - CoreDoRuleCheck . initRuleCheckOpts dflags phase + maybe_rule_check phase = for_ (rule_check) $ + enqueue . CoreDoRuleCheck . initRuleCheckOpts dflags phase maybe_strictness_before (Phase phase) - | phase `elem` strictnessBefore dflags = coreDoDemand dflags - maybe_strictness_before _ - = CoreDoNothing + | phase `elem` strictnessBefore dflags = enqueue $ coreDoDemand dflags + maybe_strictness_before _ = return () - simpl_phase phase name iter - = CoreDoPasses - $ [ maybe_strictness_before phase - , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter - (initSimplMode dflags phase name) - , maybe_rule_check phase ] + simpl_phase phase name iter = do + maybe_strictness_before phase + enqueue $ CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) + maybe_rule_check phase -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic simplify name = simpl_phase FinalPhase name max_iter - -- initial simplify: mk specialiser happy: minimum effort please + -- initial simplify: make specialiser happy: minimum effort please -- See Note [Inline in InitialPhase] -- See Note [RULEs enabled in InitialPhase] - simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter - (initGentleSimplMode dflags) - - dmd_cpr_ww = [coreDoDemand dflags, CoreDoCpr] ++ - if ww_on then [CoreDoWorkerWrapper (initWorkWrapOpts dflags)] - else [] - - - demand_analyser = (CoreDoPasses ( - dmd_cpr_ww ++ - [simplify "post-worker-wrapper"] - )) - - -- Static forms are moved to the top level with the FloatOut pass. - -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. - static_ptrs_float_outwards = - runWhen static_ptrs $ CoreDoPasses - [ simpl_gently -- Float Out can't handle type lets (sometimes created - -- by simpleOptPgm via mkParallelBindings) - , CoreDoFloatOutwards FloatOutSwitches - { floatOutLambdas = Just 0 - , floatOutConstants = True - , floatOutOverSatApps = False - , floatToTopLevelOnly = True - } - ] - - add_caller_ccs = - runWhen (profiling && not (null $ callerCcFilters dflags)) $ - CoreAddCallerCcs (initCallerCCOpts dflags) - - add_late_ccs = - runWhen (profiling && gopt Opt_ProfLateCcs dflags) $ - CoreAddLateCcs (gopt Opt_ProfCountEntries dflags) - - core_todo = - [ - -- We want to do the static argument transform before full laziness as it - -- may expose extra opportunities to float things outwards. However, to fix - -- up the output of the transformation we need at do at least one simplify - -- after this before anything else - runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]), - - -- initial simplify: mk specialiser happy: minimum effort please - runWhen do_presimplify simpl_gently, - - -- Specialisation is best done before full laziness - -- so that overloaded functions have all their dictionary lambdas manifest - runWhen do_specialise $ coreDoSpecialising dflags, - - if full_laziness then - CoreDoFloatOutwards FloatOutSwitches { - floatOutLambdas = Just 0, - floatOutConstants = True, - floatOutOverSatApps = False, - floatToTopLevelOnly = False } - -- Was: gentleFloatOutSwitches - -- - -- I have no idea why, but not floating constants to - -- top level is very bad in some cases. - -- - -- Notably: p_ident in spectral/rewrite - -- Changing from "gentle" to "constantsOnly" - -- improved rewrite's allocation by 19%, and - -- made 0.0% difference to any other nofib - -- benchmark - -- - -- Not doing floatOutOverSatApps yet, we'll do - -- that later on when we've had a chance to get more - -- accurate arity information. In fact it makes no - -- difference at all to performance if we do it here, - -- but maybe we save some unnecessary to-and-fro in - -- the simplifier. - else - -- Even with full laziness turned off, we still need to float static - -- forms to the top level. See Note [Grand plan for static forms] in - -- GHC.Iface.Tidy.StaticPtrTable. - static_ptrs_float_outwards, - - -- Run the simplier phases 2,1,0 to allow rewrite rules to fire - runWhen do_simpl3 - (CoreDoPasses $ [ simpl_phase (Phase phase) "main" max_iter - | phase <- [phases, phases-1 .. 1] ] ++ - [ simpl_phase (Phase 0) "main" (max max_iter 3) ]), - -- Phase 0: allow all Ids to be inlined now - -- This gets foldr inlined before strictness analysis - - -- At least 3 iterations because otherwise we land up with - -- huge dead expressions because of an infelicity in the - -- simplifier. - -- let k = BIG in foldr k z xs - -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs - -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs - -- Don't stop now! - - runWhen do_float_in (CoreDoFloatInwards platform), - -- Run float-inwards immediately before the strictness analyser - -- Doing so pushes bindings nearer their use site and hence makes - -- them more likely to be strict. These bindings might only show - -- up after the inlining from simplification. Example in fulsom, - -- Csg.calc, where an arg of timesDouble thereby becomes strict. - - runWhen call_arity $ CoreDoPasses - [ CoreDoCallArity - , simplify "post-call-arity" - ], - - -- Strictness analysis - runWhen strictness demand_analyser, - - runWhen exitification CoreDoExitify, - -- See Note [Placement of the exitification pass] - - runWhen full_laziness $ - CoreDoFloatOutwards FloatOutSwitches { - floatOutLambdas = floatLamArgs dflags, - floatOutConstants = True, - floatOutOverSatApps = True, - floatToTopLevelOnly = False }, - -- nofib/spectral/hartel/wang doubles in speed if you - -- do full laziness late in the day. It only happens - -- after fusion and other stuff, so the early pass doesn't - -- catch it. For the record, the redex is - -- f_el22 (f_el21 r_midblock) - - - runWhen cse CoreCSE, - -- We want CSE to follow the final full-laziness pass, because it may - -- succeed in commoning up things floated out by full laziness. - -- CSE used to rely on the no-shadowing invariant, but it doesn't any more - - runWhen do_float_in (CoreDoFloatInwards platform), - - simplify "final", -- Final tidy-up - - maybe_rule_check FinalPhase, - - -------- After this we have -O2 passes ----------------- - -- None of them run with -O - - -- Case-liberation for -O2. This should be after - -- strictness analysis and the simplification which follows it. - runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase (initLiberateCaseOpts dflags) - , simplify "post-liberate-case" ], - -- Run the simplifier after LiberateCase to vastly - -- reduce the possibility of shadowing - -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr - - runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr (initSpecConstrOpts dflags) - , simplify "post-spec-constr"], - -- See Note [Simplify after SpecConstr] - - maybe_rule_check FinalPhase, - - runWhen late_specialise $ CoreDoPasses - [ coreDoSpecialising dflags, simplify "post-late-spec"], - - -- LiberateCase can yield new CSE opportunities because it peels - -- off one layer of a recursive function (concretely, I saw this - -- in wheel-sieve1), and I'm guessing that SpecConstr can too - -- And CSE is a very cheap pass. So it seems worth doing here. - runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify "post-final-cse" ], - - --------- End of -O2 passes -------------- - - runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify "post-late-ww"] - ), - - -- Final run of the demand_analyser, ensures that one-shot thunks are - -- really really one-shot thunks. Only needed if the demand analyser - -- has run at all. See Note [Final Demand Analyser run] in GHC.Core.Opt.DmdAnal - -- It is EXTREMELY IMPORTANT to run this pass, otherwise execution - -- can become /exponentially/ more expensive. See #11731, #12996. - runWhen (strictness || late_dmd_anal) $ coreDoDemand dflags, - - maybe_rule_check FinalPhase, - - add_caller_ccs, - add_late_ccs - ] - - -- Remove 'CoreDoNothing' and flatten 'CoreDoPasses' for clarity. - flatten_todos [] = [] - flatten_todos (CoreDoNothing : rest) = flatten_todos rest - flatten_todos (CoreDoPasses passes : rest) = - flatten_todos passes ++ flatten_todos rest - flatten_todos (todo : rest) = todo : flatten_todos rest - --- The core-to-core pass ordering is derived from the DynFlags: -runWhen :: Bool -> CoreToDo -> CoreToDo -runWhen True do_this = do_this -runWhen False _ = CoreDoNothing - -runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo -runMaybe (Just x) f = f x -runMaybe Nothing _ = CoreDoNothing + simpl_gently = enqueue $ CoreDoSimplify $ + initSimplifyOpts dflags extra_vars max_iter (initGentleSimplMode dflags) + + dmd_cpr_ww = do + enqueue $ coreDoDemand dflags + enqueue CoreDoCpr + when ww_on $ + enqueue $ CoreDoWorkerWrapper (initWorkWrapOpts dflags) + + + +enqueue :: CoreToDo -> Writer [CoreToDo] () +enqueue pass = tell [pass] coreDoDemand :: DynFlags -> CoreToDo coreDoDemand dflags = CoreDoDemand $ initDmdAnalOpts dflags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16f3cbad85f3f52355a4b4faf807a85936a5d806 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16f3cbad85f3f52355a4b4faf807a85936a5d806 You're receiving 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 Aug 12 17:01:31 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 Aug 2022 13:01:31 -0400 Subject: [Git][ghc/ghc][wip/T21847] rts/linker: Consolidate initializer/finalizer handling Message-ID: <62f6876b3944f_3d8149488785840fc@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: 9ae87307 by Ben Gamari at 2022-08-12T13:01:20-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,63 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +904,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2023,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2034,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,196 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last (that + * is, are given a priority of 0xffff). + * + * In general, we run finalizers in the reverse order of the associated + * initializers. That is to say, e.g., .init_array entries are run from first + * to last entry and therefore .fini_array entries are run from last-to-first. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors (last entry to first entry) + * - then run .init_arrays (first-to-last) + * + * and on unload we run in opposite order: + * + * - first run fini_arrays (first-to-last) + * - then run .dtors (last-to-first) + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)init == -1) { + continue; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + continue; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + // .fini_array finalizers are run backwards + for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,22 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,28 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = 0; + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->init = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->fini = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1594,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2128,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ae873075c31d4ccd841f2e253ed6ee3d730164b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ae873075c31d4ccd841f2e253ed6ee3d730164b You're receiving 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 Aug 9 17:49:05 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 Aug 2022 13:49:05 -0400 Subject: [Git][ghc/ghc][wip/T21964] ncg/aarch64: Don't use x18 register on AArch64/Darwin Message-ID: <62f29e11cf87b_182c4e5062c3240aa@gitlab.mail> Ben Gamari pushed to branch wip/T21964 at Glasgow Haskell Compiler / GHC Commits: 7c3b4193 by normalcoder at 2022-08-09T13:48:59-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 1 changed file: - compiler/CodeGen.Platform.h Changes: ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c3b4193b07bea8e2f7820d731c74e4057c1f9ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c3b4193b07bea8e2f7820d731c74e4057c1f9ff You're receiving 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 Aug 8 04:30:51 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 00:30:51 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] temp Message-ID: <62f0917be4d6d_25b0164bfdc381716@gitlab.mail> Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: 2afc5ef6 by Ben Gamari at 2022-08-08T00:30:44-04:00 temp - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -271,7 +271,9 @@ function setup() { } function fetch_ghc() { - if [ ! -e "$GHC" ]; then + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + elif [ ! -e "$GHC" ]; then local v="$GHC_VERSION" if [[ -z "$v" ]]; then fail "neither GHC nor GHC_VERSION are not set" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2afc5ef6f761f8e649592e612eb4e389121d0d22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2afc5ef6f761f8e649592e612eb4e389121d0d22 You're receiving 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 Aug 10 07:52:02 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 03:52:02 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: testsuite: 21651 add test for closeFdWith + setNumCapabilities Message-ID: <62f363a2a52fe_d27044b7bc153460@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: df61652c by Douglas Wilson at 2022-08-10T03:51:39-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - d46fe18b by Douglas Wilson at 2022-08-10T03:51:39-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - 2e27ca42 by Trevis Elser at 2022-08-10T03:51:44-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 5c8dd6ff by Jens Petersen at 2022-08-10T03:51:48-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - 30 changed files: - docs/users_guide/bugs.rst - docs/users_guide/exts/binary_literals.rst - docs/users_guide/exts/constrained_class_methods.rst - docs/users_guide/exts/constraint_kind.rst - docs/users_guide/exts/datatype_contexts.rst - docs/users_guide/exts/deriving_extra.rst - docs/users_guide/exts/duplicate_record_fields.rst - docs/users_guide/exts/empty_case.rst - docs/users_guide/exts/empty_data_deriving.rst - docs/users_guide/exts/existential_quantification.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/explicit_namespaces.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/field_selectors.rst - docs/users_guide/exts/flexible_contexts.rst - docs/users_guide/exts/functional_dependencies.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/generics.rst - docs/users_guide/exts/hex_float_literals.rst - docs/users_guide/exts/import_qualified_post.rst - docs/users_guide/exts/instances.rst - docs/users_guide/exts/kind_signatures.rst - docs/users_guide/exts/let_generalisation.rst - docs/users_guide/exts/linear_types.rst - docs/users_guide/exts/multi_param_type_classes.rst - docs/users_guide/exts/newtype_deriving.rst - docs/users_guide/exts/nk_patterns.rst - docs/users_guide/exts/nullary_type_classes.rst - docs/users_guide/exts/nullary_types.rst - docs/users_guide/exts/numeric_underscores.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/051628b4589e0c5e8bae78aaa7698201a5f1071d...5c8dd6ffcf2d07c626a652153aac8613e823d2fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/051628b4589e0c5e8bae78aaa7698201a5f1071d...5c8dd6ffcf2d07c626a652153aac8613e823d2fb You're receiving 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 Aug 10 16:03:00 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 10 Aug 2022 12:03:00 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Fix Outputable instances for JExpr/JVal Message-ID: <62f3d6b4266f6_142b49517fc894f9@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 5f286bfa by Sylvain Henry at 2022-08-10T18:05:43+02:00 Fix Outputable instances for JExpr/JVal - Put orphan instances in JS.Ppr - Also fix some redundant imports - - - - - 7 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Types.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -142,8 +142,6 @@ import qualified Data.Map as M import qualified Data.List as List import GHC.Utils.Outputable (Outputable (..)) -import qualified GHC.Data.ShortText as ST -import GHC.Data.ShortText (ShortText) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Utils.Panic ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -7,6 +7,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +-- For Outputable instances for JS syntax +{-# OPTIONS_GHC -Wno-orphans #-} + -- | Pretty-printing JavaScript module GHC.JS.Ppr ( renderJs @@ -31,20 +34,23 @@ import GHC.JS.Syntax import GHC.JS.Transform -import Data.Function import Data.Char (isControl, ord) -import qualified Data.Map as M -import Data.List -import Data.Ord +import Data.List (sortOn) import Numeric(showHex) +import GHC.Utils.Outputable (Outputable (..), docToSDoc) import GHC.Utils.Ppr as PP -import qualified GHC.Data.ShortText as ST -import GHC.Data.ShortText (ShortText) import GHC.Data.FastString import GHC.Types.Unique.Map +instance Outputable JExpr where + ppr = docToSDoc . renderJs + +instance Outputable JVal where + ppr = docToSDoc . renderJs + + ($$$) :: Doc -> Doc -> Doc --x $$$ y = align (nest 2 $ x $+$ y) -- FIXME (Sylvain, 2022/02) x $$$ y = nest 2 $ x $+$ y ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -94,7 +94,6 @@ import GHC.Prelude import Control.DeepSeq import Data.Function -import qualified Data.Map as M import qualified Data.Set as Set import Data.Data import Data.Word @@ -102,12 +101,9 @@ import qualified Data.Semigroup as Semigroup import GHC.Generics -import GHC.Utils.Outputable (Outputable (..)) -import qualified GHC.Utils.Outputable as O import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map -import GHC.Utils.Binary -- FIXME: Jeff (2022,03): This state monad is strict, but uses a lazy list as -- the state, since the strict state monad evaluates to WHNF, this state monad @@ -255,9 +251,6 @@ data JExpr -- See 'pseudoSaturate' deriving (Eq, Typeable, Generic) -instance Outputable JExpr where - ppr x = undefined -- O.text (show x) - -- * Useful pattern synonyms to ease programming with the deeply embedded JS -- AST. Each pattern wraps @JUOp@ and @JOp@ into a @JExpr at s to save typing and -- for convienience. In addition we include a string wrapper for JS string @@ -362,10 +355,6 @@ data JVal | UnsatVal (IdentSupply JVal) -- ^ An /Unsaturated/ value, see 'pseudoSaturate' deriving (Eq, Typeable, Generic) -instance Outputable JVal where - ppr x = undefined -- O.text (show x) - - -------------------------------------------------------------------------------- -- Operators -------------------------------------------------------------------------------- ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -41,12 +41,9 @@ import Data.Functor.Identity import Control.Monad import Data.Semigroup import Data.Bifunctor -import Data.List import Data.Set (Set) import qualified Data.Set as Set -import qualified GHC.Data.ShortText as ST -import GHC.Data.ShortText (ShortText) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Utils.Panic ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -20,24 +20,22 @@ module GHC.StgToJS.Printer ( pretty , ghcjsRenderJs , prettyBlock - ) where + ) +where + +import GHC.Prelude import GHC.JS.Syntax import GHC.JS.Ppr -import qualified GHC.Data.ShortText as T -import GHC.Utils.Ppr as PP -import GHC.Data.FastString -import GHC.Types.Unique.Map - -import qualified Data.Map as M -import Data.List +import GHC.Utils.Ppr as PP +import GHC.Data.FastString +import GHC.Types.Unique.Map +import Data.List (sortOn) import Data.Char (isAlpha,isDigit) -import GHC.Prelude - pretty :: JStat -> Doc pretty = jsToDocR ghcjsRenderJs ===================================== compiler/GHC/StgToJS/Regs.hs ===================================== @@ -24,7 +24,6 @@ import GHC.Prelude import GHC.JS.Syntax import GHC.JS.Make -import qualified GHC.Data.ShortText as ST import GHC.Data.FastString import Data.Array ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Prelude import GHC.JS.Syntax import GHC.JS.Make +import GHC.JS.Ppr import GHC.Stg.Syntax import GHC.Core.TyCon View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f286bfa0818126790ffcb6082402af6e4d7c57c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f286bfa0818126790ffcb6082402af6e4d7c57c You're receiving 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 Aug 12 12:20:23 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 Aug 2022 08:20:23 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] 2 commits: fix test Message-ID: <62f6458719fc7_3d81494899048592d@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 348e764f by Matthew Pickering at 2022-08-12T12:54:30+01:00 fix test - - - - - c1911369 by Matthew Pickering at 2022-08-12T13:20:12+01:00 fixes - - - - - 9 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Unit/Home/ModInfo.hs - testsuite/tests/driver/fat-iface/Makefile - testsuite/tests/driver/fat-iface/fat001.stdout - testsuite/tests/driver/fat-iface/fat006.stdout Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1105,10 +1105,10 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h } Just desugared_guts | gopt Opt_WriteFatInterface dflags -> do - -- If -fno-code is enabled (hence we fall through to this case) then - -- -O0 is implied, so this simplifier pass will be quite gentle. Running - -- the simplifier once is necessary before doing byte code generation - -- in order to inline data con wrappers. + -- If -fno-code is enabled (hence we fall through to this case) + -- Running the simplifier once is necessary before doing byte code generation + -- in order to inline data con wrappers but we honour whatever level of simplificication the + -- user requested. See #22008 for some discussion. plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result) simplified_guts <- hscSimplify' plugins desugared_guts (cg_guts, _) <- ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1799,14 +1799,19 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = bytecode_and_enable enable_spec ms = -- In the situation where we **would** need to enable dynamic-too - dynamic_too_enable enable_spec ms + -- IF we had decided we needed objects + dynamic_too_enable EnableObject ms -- but we prefer to use bytecode rather than objects && prefer_bytecode -- and we haven't already turned it on && not generate_both where lcl_dflags = ms_hspp_opts ms - prefer_bytecode = EnableByteCodeAndObject == enable_spec + prefer_bytecode = case enable_spec of + EnableByteCodeAndObject -> True + EnableByteCode -> True + EnableObject -> False + generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags -- #8180 - when using TemplateHaskell, switch on -dynamic-too so ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -572,22 +572,6 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do bc <- generateFreshByteCode hsc_env mod_name (mkCgInteractiveGuts cgguts) mod_location return ([], final_iface, emptyHomeModInfoLinkable { homeMod_bytecode = Just bc } , panic "interpreter") -{- - (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location - - stub_o <- case hasStub of - Nothing -> return [] - Just stub_c -> do - stub_o <- compileStub hsc_env stub_c - return [DotO stub_o] - - let hs_unlinked = [BCOs comp_bc spt_entries] - unlinked_time <- getCurrentTime - let !linkable = LM unlinked_time (mkHomeModule (hsc_home_unit hsc_env) mod_name) - (hs_unlinked ++ stub_o) - return ([], final_iface, Just linkable, panic "interpreter") - -} - runUnlitPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath runUnlitPhase hsc_env input_fn output_fn = do ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -596,6 +596,7 @@ data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDetails | IfGblTopBndr IfaceTopBndr +-- See Note [Fat Interface: Sharing RHSs] data IfaceMaybeRhs = IfUseUnfoldingRhs | IfRhs IfaceExpr data IfaceJoinInfo = IfaceNotJoinPoint ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -158,6 +158,7 @@ data Unlinked | DotA FilePath -- ^ Static archive file (.a) | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) | FI FatIface -- ^ Serialised core which we can turn into BCOs (or object files), or used by some other backend + -- See Note [Fat Interface Files] | LoadedBCOs [Unlinked] -- ^ A list of BCOs, but hidden behind extra indirection to avoid -- being too strict. | BCOs CompiledByteCode ===================================== compiler/GHC/Unit/Home/ModInfo.hs ===================================== @@ -104,7 +104,9 @@ bytecodeAndObjects bc o = (HomeModLinkable (Just bc) (Just o)) -{- Note [Home module build products] +{- +Note [Home module build products] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When compiling a home module we can produce some combination of the following build products. ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -10,7 +10,7 @@ clean: fat001: clean "$(TEST_HC)" $(TEST_HC_OPTS) -c Fat.hs -fwrite-fat-interface -dno-typeable-binds test -f Fat.hi - "$(TEST_HC)" $(TEST_HC_OPTS) --show-iface Fat.hi | grep -A3 extra-decls + "$(TEST_HC)" $(TEST_HC_OPTS) --show-iface Fat.hi | grep -A3 "extra decls" # If -fbyte-code-and-object-code is set then we should generate bytecode as the Linkable. fat005: clean @@ -25,7 +25,7 @@ fat007: clean fat006: clean "$(TEST_HC)" $(TEST_HC_OPTS) -c Fat.hs -dno-typeable-binds -fno-code -fwrite-fat-interface test -f Fat.hi - "$(TEST_HC)" $(TEST_HC_OPTS) --show-iface Fat.hi | grep -A3 extra-decls + "$(TEST_HC)" $(TEST_HC_OPTS) --show-iface Fat.hi | grep -A3 "extra decls" test ! -f Fat.o fat006a: clean ===================================== testsuite/tests/driver/fat-iface/fat001.stdout ===================================== @@ -1,4 +1,4 @@ -extra-decls +extra decls: a = GHC.Types.C# 'a'# f = GHC.Types.C# 'f'# t = GHC.Types.C# 't'# ===================================== testsuite/tests/driver/fat-iface/fat006.stdout ===================================== @@ -1,4 +1,4 @@ -extra-decls +extra decls: a = GHC.Types.C# 'a'# f = GHC.Types.C# 'f'# t = GHC.Types.C# 't'# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dec02917c0a6c57e5164b0f0b5f6fb1d9e5128d9...c1911369f41815bb243b110865d17c34225e2d9a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dec02917c0a6c57e5164b0f0b5f6fb1d9e5128d9...c1911369f41815bb243b110865d17c34225e2d9a You're receiving 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 Aug 12 12:21:43 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Fri, 12 Aug 2022 08:21:43 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 347 commits: desugar: Look through ticks when warning about possible literal overflow Message-ID: <62f645d719b89_3d8149488a0487062@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: doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow [...] Content analysis details: (5.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.5 DATE_IN_PAST_06_12 Date: is 6 to 12 hours before Received: date 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 0.5 URI_NOVOWEL URI: URI hostname has long non-vowel sequence -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 1.5 BODY_8BITS BODY: Body includes 8 consecutive 8-bit characters 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid 3.1 GAPPY_HTML HTML body with much useless whitespace 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: "doyougnu (@doyougnu)" Subject: [Git][ghc/ghc][wip/js-staging] 347 commits: desugar: Look through ticks when warning about possible literal overflow Date: Fri, 12 Aug 2022 08:21:43 -0400 Size: 448926 URL: From gitlab at gitlab.haskell.org Wed Aug 10 13:45:41 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 09:45:41 -0400 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Fix ARMv7 build Message-ID: <62f3b685b8999_142b495215c34882@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -325,8 +325,15 @@ opsysVariables _ FreeBSD13 = mconcat ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -494,6 +501,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -514,6 +522,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -785,7 +795,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -232,7 +232,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -271,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -329,7 +332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -392,7 +395,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -451,7 +454,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -510,7 +513,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -529,7 +532,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -569,7 +575,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -628,7 +634,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -693,7 +699,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -754,7 +760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -816,7 +822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -878,7 +884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -938,7 +944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -997,7 +1003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1056,7 +1062,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1116,7 +1122,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1175,7 +1181,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1234,7 +1240,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1293,7 +1299,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1352,7 +1358,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1413,7 +1419,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1474,7 +1480,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1533,7 +1539,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1592,7 +1598,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1659,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1715,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1776,7 +1782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1831,7 +1837,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1890,7 +1896,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1953,7 +1959,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2017,7 +2023,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2077,7 +2083,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2137,7 +2143,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2156,8 +2162,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -2197,7 +2206,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2257,7 +2266,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2323,7 +2332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2385,7 +2394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2448,7 +2457,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2511,7 +2520,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2572,7 +2581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2632,7 +2641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2692,7 +2701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2752,7 +2761,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2812,7 +2821,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2874,7 +2883,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2936,7 +2945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2999,7 +3008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3055,7 +3064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3115,7 +3124,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3179,7 +3188,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3243,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3303,7 +3312,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3364,7 +3373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3425,7 +3434,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3484,7 +3493,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3543,7 +3552,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3601,7 +3610,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3660,7 +3669,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3718,7 +3727,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3776,7 +3785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3834,7 +3843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3893,7 +3902,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3953,7 +3962,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -4013,7 +4022,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4071,7 +4080,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4129,7 +4138,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -4189,7 +4198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4250,7 +4259,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4310,7 +4319,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4364,7 +4373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4422,7 +4431,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f95bbdcae3e6710a92dd8244321677eef91890de...596db9a5f966643bcc9994d45f2f6ffb4037ad74 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f95bbdcae3e6710a92dd8244321677eef91890de...596db9a5f966643bcc9994d45f2f6ffb4037ad74 You're receiving 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 Aug 10 13:45:08 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 09:45:08 -0400 Subject: [Git][ghc/ghc][master] Add support for external static plugins (#20964) Message-ID: <62f3b664d7f95_142b49521703155d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 18 changed files: - compiler/GHC/Driver/Plugins.hs - + compiler/GHC/Driver/Plugins/External.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/ghc.cabal.in - docs/users_guide/extending_ghc.rst - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/plugins/Makefile - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/plugins-external.hs - + testsuite/tests/plugins/plugins-external.stderr - + testsuite/tests/plugins/plugins-external.stdout - + testsuite/tests/plugins/shared-plugin/LICENSE - + testsuite/tests/plugins/shared-plugin/Makefile - + testsuite/tests/plugins/shared-plugin/Setup.hs - + testsuite/tests/plugins/shared-plugin/Simple/Plugin.hs - + testsuite/tests/plugins/shared-plugin/shared-plugin.cabal Changes: ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -1,4 +1,11 @@ {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} + +#if defined(HAVE_INTERNAL_INTERPRETER) +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE UnboxedTuples #-} +#endif -- | Definitions for writing /plugins/ for GHC. Plugins can hook into @@ -14,6 +21,10 @@ module GHC.Driver.Plugins ( , CommandLineOption , PsMessages(..) , ParsedResult(..) + + -- * External plugins + , loadExternalPlugins + -- ** Recompilation checking , purePlugin, impurePlugin, flagRecompile , PluginRecompile(..) @@ -52,6 +63,7 @@ module GHC.Driver.Plugins ( , PluginWithArgs(..), pluginsWithArgs, pluginRecompile' , LoadedPlugin(..), lpModuleName , StaticPlugin(..) + , ExternalPlugin(..) , mapPlugins, withPlugins, withPlugins_ ) where @@ -60,6 +72,7 @@ import GHC.Prelude import GHC.Driver.Env import GHC.Driver.Monad import GHC.Driver.Phases +import GHC.Driver.Plugins.External import GHC.Unit.Module import GHC.Unit.Module.ModIface @@ -75,8 +88,12 @@ import GHC.Core.Opt.Monad ( CoreM ) import GHC.Core.Opt.Pipeline.Types ( CoreToDo ) import GHC.Hs import GHC.Types.Error (Messages) +import GHC.Linker.Types +import GHC.Types.Unique.DFM + import GHC.Utils.Fingerprint -import GHC.Utils.Outputable (Outputable(..), text, (<+>)) +import GHC.Utils.Outputable +import GHC.Utils.Panic import Data.List (sort) @@ -85,8 +102,13 @@ import Data.List (sort) import qualified Data.Semigroup import Control.Monad -import GHC.Linker.Types -import GHC.Types.Unique.DFM + +#if defined(HAVE_INTERNAL_INTERPRETER) +import GHCi.ObjLink +import GHC.Exts (addrToAny#, Ptr(..)) +import GHC.Utils.Encoding +#endif + -- | Command line options gathered from the -PModule.Name:stuff syntax -- are given to you as this type @@ -196,6 +218,14 @@ data LoadedPlugin = LoadedPlugin -- ^ the module containing the plugin } +-- | External plugin loaded directly from a library without loading module +-- interfaces +data ExternalPlugin = ExternalPlugin + { epPlugin :: PluginWithArgs -- ^ Plugin with its arguments + , epUnit :: String -- ^ UnitId + , epModule :: String -- ^ Module name + } + -- | A static plugin with its arguments. For registering compiled-in plugins -- through the GHC API. data StaticPlugin = StaticPlugin @@ -285,6 +315,10 @@ data Plugins = Plugins -- To add dynamically loaded plugins through the GHC API see -- 'addPluginModuleName' instead. + , externalPlugins :: ![ExternalPlugin] + -- ^ External plugins loaded directly from libraries without loading + -- module interfaces. + , loadedPlugins :: ![LoadedPlugin] -- ^ Plugins dynamically loaded after processing arguments. What -- will be loaded here is directed by DynFlags.pluginModNames. @@ -299,12 +333,17 @@ data Plugins = Plugins } emptyPlugins :: Plugins -emptyPlugins = Plugins [] [] ([], emptyUDFM) - +emptyPlugins = Plugins + { staticPlugins = [] + , externalPlugins = [] + , loadedPlugins = [] + , loadedPluginDeps = ([], emptyUDFM) + } pluginsWithArgs :: Plugins -> [PluginWithArgs] pluginsWithArgs plugins = map lpPlugin (loadedPlugins plugins) ++ + map epPlugin (externalPlugins plugins) ++ map spPlugin (staticPlugins plugins) -- | Perform an operation by using all of the plugins in turn. @@ -328,3 +367,53 @@ data FrontendPlugin = FrontendPlugin { } defaultFrontendPlugin :: FrontendPlugin defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () } + + +-- | Load external plugins +loadExternalPlugins :: [ExternalPluginSpec] -> IO [ExternalPlugin] +loadExternalPlugins [] = return [] +#if !defined(HAVE_INTERNAL_INTERPRETER) +loadExternalPlugins _ = do + panic "loadExternalPlugins: can't load external plugins with GHC built without internal interpreter" +#elif !defined(CAN_LOAD_DLL) +loadExternalPlugins _ = do + panic "loadExternalPlugins: loading shared libraries isn't supported by this compiler" +#else +loadExternalPlugins ps = do + -- initialize the linker + initObjLinker RetainCAFs + -- load plugins + forM ps $ \(ExternalPluginSpec path unit mod_name opts) -> do + loadExternalPluginLib path + -- lookup symbol + let ztmp = zEncodeString mod_name ++ "_plugin_closure" + symbol + | null unit = ztmp + | otherwise = zEncodeString unit ++ "_" ++ ztmp + plugin <- lookupSymbol symbol >>= \case + Nothing -> pprPanic "loadExternalPlugins" + (vcat [ text "Symbol not found" + , text " Library path: " <> text path + , text " Symbol : " <> text symbol + ]) + Just (Ptr addr) -> case addrToAny# addr of + (# a #) -> pure a + + pure $ ExternalPlugin (PluginWithArgs plugin opts) unit mod_name + +loadExternalPluginLib :: FilePath -> IO () +loadExternalPluginLib path = do + -- load library + loadDLL path >>= \case + Just errmsg -> pprPanic "loadExternalPluginLib" + (vcat [ text "Can't load plugin library" + , text " Library path: " <> text path + , text " Error : " <> text errmsg + ]) + Nothing -> do + -- resolve objects + resolveObjs >>= \case + True -> return () + False -> pprPanic "loadExternalPluginLib" (text "Unable to resolve objects for library: " <> text path) + +#endif ===================================== compiler/GHC/Driver/Plugins/External.hs ===================================== @@ -0,0 +1,79 @@ +-- | External plugins +-- +-- GHC supports two kinds of "static" plugins: +-- 1. internal: setup with GHC-API +-- 2. external: setup as explained below and loaded from shared libraries +-- +-- The intended use case for external static plugins is with cross compilers: at +-- the time of writing, GHC is mono-target and a GHC cross-compiler (i.e. when +-- host /= target) can't build nor load plugins for the host using the +-- "non-static" plugin approach. Fixing this is tracked in #14335. If you're not +-- using a cross-compiler, you'd better use non-static plugins which are easier +-- to build and and safer to use (see below). +-- +-- External static plugins can be configured via the command-line with +-- the -fplugin-library flag. Syntax is: +-- +-- -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ +-- +-- Example: +-- -fplugin-library=path/to/plugin;package-123;Plugin.Module;["Argument","List"] +-- +-- Building the plugin library: +-- 1. link with the libraries used to build the compiler you target. If you +-- target a cross-compiler (stage2), you can't directly use it to build the +-- plugin library. Use the stage1 compiler instead. +-- +-- 2. if you use cabal to build the library, its unit-id will be set by cabal +-- and will contain a hash (e.g. "my-plugin-unit-1345656546ABCDEF"). To force +-- the unit id, use GHC's `-this-unit-id` command line flag: +-- e.g. -this-unit-id my-plugin-unit +-- You can set this in the .cabal file of your library with the following +-- stanza: `ghc-options: -this-unit-id my-plugin-unit` +-- +-- 3. To make your plugin easier to distribute, you may want to link it +-- statically with all its dependencies. You would need to use `-shared` +-- without `-dynamic` when building your library. +-- +-- However, all the static dependencies have to be built with `-fPIC` and it's +-- not done by default. See +-- https://www.hobson.space/posts/haskell-foreign-library/ for a way to modify +-- the compiler to do it. +-- +-- In any case, don't link your plugin library statically with the RTS (e.g. +-- use `-fno-link-rts`) as there are some global variables in the RTS that must +-- be shared between the plugin and the compiler. +-- +-- With external static plugins we don't check the type of the `plugin` closure +-- we look up. If it's not a valid `Plugin` value, it will probably crash badly. +-- + +module GHC.Driver.Plugins.External + ( ExternalPluginSpec (..) + , parseExternalPluginSpec + ) +where + +import GHC.Prelude +import Text.Read + +-- | External plugin spec +data ExternalPluginSpec = ExternalPluginSpec + { esp_lib :: !FilePath + , esp_unit_id :: !String + , esp_module :: !String + , esp_args :: ![String] + } + +-- | Parser external static plugin specification from command-line flag +parseExternalPluginSpec :: String -> Maybe ExternalPluginSpec +parseExternalPluginSpec optflag = + case break (== ';') optflag of + (libPath, _:rest) -> case break (== ';') rest of + (libName, _:pack) -> case break (== ';') pack of + (modName, _:args) -> case readMaybe args of + Just as -> Just (ExternalPluginSpec libPath libName modName as) + Nothing -> Nothing + _ -> Nothing + _ -> Nothing + _ -> Nothing ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -229,6 +229,7 @@ import GHC.Builtin.Names ( mAIN_NAME ) import GHC.Driver.Phases ( Phase(..), phaseInputExt ) 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 @@ -590,6 +591,9 @@ data DynFlags = DynFlags { -- ^ 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, @@ -1176,6 +1180,8 @@ defaultDynFlags mySettings = pluginModNameOpts = [], frontendPluginOpts = [], + externalPluginSpecs = [], + outputFile_ = Nothing, dynOutputFile_ = Nothing, outputHi = Nothing, @@ -1715,6 +1721,11 @@ addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, o [] -> "" -- should probably signal an error (_:plug_opt) -> plug_opt -- ignore the ':' from break +addExternalPlugin :: String -> DynFlags -> DynFlags +addExternalPlugin optflag d = case parseExternalPluginSpec optflag of + Just r -> d { externalPluginSpecs = r : externalPluginSpecs d } + Nothing -> cmdLineError $ "Couldn't parse external plugin specification: " ++ optflag + addFrontendPluginOption :: String -> DynFlags -> DynFlags addFrontendPluginOption s d = d { frontendPluginOpts = s : frontendPluginOpts d } @@ -2695,6 +2706,8 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "fclear-plugins" (noArg clearPluginModuleNames) , make_ord_flag defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption) + , make_ord_flag defGhcFlag "fplugin-library" (hasArg addExternalPlugin) + ------ Optimisation flags ------------------------------------------ , make_dep_flag defGhcFlag "Onot" (noArgM $ setOptLevel 0 ) "Use -O0 instead" ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Driver.Hooks import GHC.Driver.Plugins +import GHC.Driver.Plugins.External import GHC.Linker.Loader ( loadModule, loadName ) import GHC.Runtime.Interpreter ( wormhole ) @@ -75,22 +76,48 @@ import Data.List (unzip4) -- pluginModNames or pluginModNameOpts changes. initializePlugins :: HscEnv -> IO HscEnv initializePlugins hsc_env - -- plugins not changed + -- check that plugin specifications didn't change + + -- dynamic plugins | loaded_plugins <- loadedPlugins (hsc_plugins hsc_env) , map lpModuleName loaded_plugins == reverse (pluginModNames dflags) - -- arguments not changed , all same_args loaded_plugins - = return hsc_env -- no need to reload plugins FIXME: doesn't take static plugins into account + + -- external plugins + , external_plugins <- externalPlugins (hsc_plugins hsc_env) + , check_external_plugins external_plugins (externalPluginSpecs dflags) + + -- FIXME: we should check static plugins too + + = return hsc_env -- no change, no need to reload plugins + | otherwise = do (loaded_plugins, links, pkgs) <- loadPlugins hsc_env - let plugins' = (hsc_plugins hsc_env) { loadedPlugins = loaded_plugins, loadedPluginDeps = (links, pkgs) } + external_plugins <- loadExternalPlugins (externalPluginSpecs dflags) + let plugins' = (hsc_plugins hsc_env) { staticPlugins = staticPlugins (hsc_plugins hsc_env) + , externalPlugins = external_plugins + , loadedPlugins = loaded_plugins + , loadedPluginDeps = (links, pkgs) + } let hsc_env' = hsc_env { hsc_plugins = plugins' } withPlugins (hsc_plugins hsc_env') driverPlugin hsc_env' where + dflags = hsc_dflags hsc_env + -- dynamic plugins plugin_args = pluginModNameOpts dflags same_args p = paArguments (lpPlugin p) == argumentsForPlugin p plugin_args argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst) - dflags = hsc_dflags hsc_env + -- external plugins + check_external_plugin p spec = and + [ epUnit p == esp_unit_id spec + , epModule p == esp_module spec + , paArguments (epPlugin p) == esp_args spec + ] + check_external_plugins eps specs = case (eps,specs) of + ([] , []) -> True + (_ , []) -> False -- some external plugin removed + ([] , _ ) -> False -- some external plugin added + (p:ps,s:ss) -> check_external_plugin p s && check_external_plugins ps ss loadPlugins :: HscEnv -> IO ([LoadedPlugin], [Linkable], PkgsLoaded) loadPlugins hsc_env ===================================== compiler/ghc.cabal.in ===================================== @@ -441,6 +441,7 @@ Library GHC.Driver.Pipeline.Phases GHC.Driver.Pipeline.Monad GHC.Driver.Plugins + GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session GHC.Hs ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -268,7 +268,6 @@ option. The list of enabled plugins can be reset with the the command line is not possible. Instead ``:set -fclear-plugins`` can be used. - As an example, in order to load the plugin exported by ``Foo.Plugin`` in the package ``foo-ghc-plugin``, and give it the parameter "baz", we would invoke GHC like this: @@ -286,6 +285,19 @@ would invoke GHC like this: Linking Test ... $ + +Plugins can be also be loaded from libraries directly. It allows plugins to be +loaded in cross-compilers (as a workaround for #14335). + +.. ghc-flag:: -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ + :shortdesc: Load a pre-compiled static plugin from an external library + :type: dynamic + :category: plugins + + Arguments are specified in a list form, so a plugin specified to + :ghc-flag:`-fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩` will look + like ``'path/to/plugin;package-123;Plugin.Module;["Argument","List"]'``. + Alternatively, core plugins can be specified with Template Haskell. :: ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -116,6 +116,7 @@ GHC.Driver.Phases GHC.Driver.Pipeline.Monad GHC.Driver.Pipeline.Phases GHC.Driver.Plugins +GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session GHC.Hs ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -117,6 +117,7 @@ GHC.Driver.Phases GHC.Driver.Pipeline.Monad GHC.Driver.Pipeline.Phases GHC.Driver.Plugins +GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session GHC.Hs ===================================== testsuite/tests/plugins/Makefile ===================================== @@ -205,3 +205,18 @@ test-echo-in-turn-many-args: .PHONY: test-echo-in-line-many-args test-echo-in-line-many-args: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 test-echo-in-line-many-args.hs -package-db echo-plugin/pkg.test-echo-in-line-many-args/local.package.conf + + +ifeq "$(WINDOWS)" "YES" +DLL = $1.dll +else ifeq "$(DARWIN)" "YES" +DLL = lib$1.dylib +else +DLL = lib$1.so +endif + +.PHONY: plugins-external +plugins-external: + cp shared-plugin/pkg.plugins01/dist/build/$(call DLL,HSsimple-plugin*) $(call DLL,HSsimple-plugin) + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -fplugin-library "$(PWD)/$(call DLL,HSsimple-plugin);simple-plugin-1234;Simple.Plugin;[\"Plugin\",\"loaded\",\"from\",\"a shared lib\"]" plugins-external.hs + ./plugins-external ===================================== testsuite/tests/plugins/all.T ===================================== @@ -311,3 +311,8 @@ test('test-echo-in-line-many-args', [extra_files(['echo-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C echo-plugin package.test-echo-in-line-many-args TOP={top}')], makefile_test, []) + +test('plugins-external', + [extra_files(['shared-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C shared-plugin package.plugins01 TOP={top}')], + makefile_test, []) ===================================== testsuite/tests/plugins/plugins-external.hs ===================================== @@ -0,0 +1,4 @@ +-- Intended to test that we can load plugins as external shared libraries +module Main where + +main = putStrLn "Hello World" ===================================== testsuite/tests/plugins/plugins-external.stderr ===================================== @@ -0,0 +1,2 @@ +Simple Plugin Passes Queried +Got options: Plugin loaded from a shared lib ===================================== testsuite/tests/plugins/plugins-external.stdout ===================================== @@ -0,0 +1 @@ +Hello World ===================================== testsuite/tests/plugins/shared-plugin/LICENSE ===================================== @@ -0,0 +1,10 @@ +Copyright (c) 2008, Max Bolingbroke +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + * Neither the name of Max Bolingbroke nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== testsuite/tests/plugins/shared-plugin/Makefile ===================================== @@ -0,0 +1,20 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean.%: + rm -rf pkg.$* + +HERE := $(abspath .) +$(eval $(call canonicalise,HERE)) + +package.%: + $(MAKE) -s --no-print-directory clean.$* + mkdir pkg.$* + "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs + + "$(GHC_PKG)" init pkg.$*/local.package.conf + + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) + pkg.$*/setup build --distdir pkg.$*/dist -v0 + pkg.$*/setup install --distdir pkg.$*/dist -v0 ===================================== testsuite/tests/plugins/shared-plugin/Setup.hs ===================================== @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain ===================================== testsuite/tests/plugins/shared-plugin/Simple/Plugin.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Simple.Plugin(plugin) where + +import GHC.Types.Unique.FM +import GHC.Plugins +import qualified GHC.Utils.Error + +import Control.Monad +import Data.Monoid hiding (Alt) +import Data.Dynamic +import qualified Language.Haskell.TH as TH + +plugin :: Plugin +plugin = defaultPlugin { + installCoreToDos = install, + pluginRecompile = purePlugin + } + +install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] +install options todos = do + putMsgS $ "Simple Plugin Passes Queried" + putMsgS $ "Got options: " ++ unwords options + + -- Create some actual passes to continue the test. + return todos ===================================== testsuite/tests/plugins/shared-plugin/shared-plugin.cabal ===================================== @@ -0,0 +1,21 @@ +Name: simple-plugin +Version: 0.1 +Synopsis: A demonstration of the GHC plugin system. +Cabal-Version: >= 1.2 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Author: Max Bolingbroke +Homepage: http://blog.omega-prime.co.uk + +Library + Extensions: CPP + Build-Depends: + base, + template-haskell, + ghc >= 6.11 + Exposed-Modules: + Simple.Plugin + + -- explicitly set the unit-id to allow loading from a shared library + ghc-options: -this-unit-id simple-plugin-1234 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f95bbdcae3e6710a92dd8244321677eef91890de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f95bbdcae3e6710a92dd8244321677eef91890de You're receiving 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 Aug 10 19:38:46 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 15:38:46 -0400 Subject: [Git][ghc/ghc][master] ncg/aarch64: Don't use x18 register on AArch64/Darwin Message-ID: <62f409466d9af_142b49521ac190795@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 1 changed file: - compiler/CodeGen.Platform.h Changes: ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67575f2004340564d6e52af055ed6fb43d3f9711 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67575f2004340564d6e52af055ed6fb43d3f9711 You're receiving 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 Aug 12 13:36:17 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 12 Aug 2022 09:36:17 -0400 Subject: [Git][ghc/ghc][wip/andreask/deep_discounts] Fix docs Message-ID: <62f65751d4f56_3d814948850515611@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/deep_discounts at Glasgow Haskell Compiler / GHC Commits: 715daf11 by Andreas Klebinger at 2022-08-12T15:35:56+02:00 Fix docs - - - - - 2 changed files: - docs/users_guide/hints.rst - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/hints.rst ===================================== @@ -404,7 +404,8 @@ decision about inlining a specific binding. * :ghc-flag:`-funfolding-case-scaling=⟨n⟩` * :ghc-flag:`-funfolding-dict-discount=⟨n⟩` * :ghc-flag:`-funfolding-fun-discount=⟨n⟩` -* :ghc-flag:`-funfolding-max-app-depth=⟨n⟩` +* :ghc-flag:`-funfolding-max-guide-depth=⟨n⟩` +* :ghc-flag:`-funfolding-max-arg-depth=⟨n⟩` Should the simplifier run out of ticks because of a inlining loop users are encouraged to try decreasing :ghc-flag:`-funfolding-case-threshold=⟨n⟩` ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1662,9 +1662,7 @@ by saying ``-fno-wombat``. single: inlining, controlling single: unfolding, controlling - If we have a function application `f (Succ (Succ Zero))` with the function `f`: - - .. code-block:: hs + If we have a function application `f (Succ (Succ Zero))` with the function `f`:: f x = case x of @@ -1690,9 +1688,7 @@ by saying ``-fno-wombat``. single: inlining, controlling single: unfolding, controlling - If we have a function f: - - .. code-block:: hs + If we have a function f:: f x = case x of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/715daf11e4395668c4ab78afc0dfc94752fdd487 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/715daf11e4395668c4ab78afc0dfc94752fdd487 You're receiving 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 Aug 8 03:24:53 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 07 Aug 2022 23:24:53 -0400 Subject: [Git][ghc/ghc][wip/bindist-install] 2 commits: hadrian: Drop diagnostics output from bindist installation Message-ID: <62f082059d23b_25b0164c07c373448@gitlab.mail> Ben Gamari pushed to branch wip/bindist-install at Glasgow Haskell Compiler / GHC Commits: c29f4e57 by Ben Gamari at 2022-08-07T18:24:06-04:00 hadrian: Drop diagnostics output from bindist installation - - - - - e47fb9b0 by Ben Gamari at 2022-08-07T23:20:49-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 2 changed files: - .gitlab/darwin/toolchain.nix - hadrian/bindist/Makefile Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== hadrian/bindist/Makefile ===================================== @@ -39,7 +39,6 @@ endif # of program names. For hadrian build this will work as programs have a # consistent naming procedure. define installscript - echo "installscript $1 -> $2" @if [ -L 'wrappers/$1' ]; then \ $(CP) -RP 'wrappers/$1' '$2' ; \ else \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0613678fd502fdef86f7729fb450f16100862ea...e47fb9b0932848b5cb986b6274756e762db165a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0613678fd502fdef86f7729fb450f16100862ea...e47fb9b0932848b5cb986b6274756e762db165a1 You're receiving 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 Aug 10 17:18:22 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 13:18:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add support for external static plugins (#20964) Message-ID: <62f3e85e79f8c_142b494c57c123091@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - c0dfdf86 by Ben Gamari at 2022-08-10T13:17:54-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 74351150 by normalcoder at 2022-08-10T13:17:54-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 22 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Driver/Plugins.hs - + compiler/GHC/Driver/Plugins/External.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/ghc.cabal.in - docs/users_guide/extending_ghc.rst - hadrian/bindist/Makefile - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/plugins/Makefile - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/plugins-external.hs - + testsuite/tests/plugins/plugins-external.stderr - + testsuite/tests/plugins/plugins-external.stdout - + testsuite/tests/plugins/shared-plugin/LICENSE - + testsuite/tests/plugins/shared-plugin/Makefile - + testsuite/tests/plugins/shared-plugin/Setup.hs - + testsuite/tests/plugins/shared-plugin/Simple/Plugin.hs - + testsuite/tests/plugins/shared-plugin/shared-plugin.cabal Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -325,8 +325,15 @@ opsysVariables _ FreeBSD13 = mconcat ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -494,6 +501,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -514,6 +522,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -785,7 +795,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , disableValidate (standardBuilds AArch64 (Linux Debian11)) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -232,7 +232,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -271,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -329,7 +332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -392,7 +395,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -451,7 +454,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -510,7 +513,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -529,7 +532,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -569,7 +575,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -628,7 +634,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -693,7 +699,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -754,7 +760,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -816,7 +822,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -878,7 +884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -938,7 +944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -997,7 +1003,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1056,7 +1062,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1116,7 +1122,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1175,7 +1181,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1234,7 +1240,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1293,7 +1299,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1352,7 +1358,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1413,7 +1419,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1474,7 +1480,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1533,7 +1539,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1592,7 +1598,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1659,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1715,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1776,7 +1782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1831,7 +1837,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1890,7 +1896,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1953,7 +1959,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2017,7 +2023,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2077,7 +2083,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2137,7 +2143,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2156,8 +2162,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -2197,7 +2206,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2257,7 +2266,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2323,7 +2332,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2385,7 +2394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2448,7 +2457,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2511,7 +2520,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2572,7 +2581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2632,7 +2641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2692,7 +2701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2752,7 +2761,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2812,7 +2821,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2874,7 +2883,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2936,7 +2945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2999,7 +3008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3055,7 +3064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3115,7 +3124,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3179,7 +3188,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3243,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3303,7 +3312,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3364,7 +3373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3425,7 +3434,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3484,7 +3493,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3543,7 +3552,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3601,7 +3610,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3660,7 +3669,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3718,7 +3727,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3776,7 +3785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3834,7 +3843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3893,7 +3902,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3953,7 +3962,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -4013,7 +4022,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4071,7 +4080,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4129,7 +4138,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -4189,7 +4198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4250,7 +4259,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4310,7 +4319,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4364,7 +4373,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4422,7 +4431,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -1,4 +1,11 @@ {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} + +#if defined(HAVE_INTERNAL_INTERPRETER) +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE UnboxedTuples #-} +#endif -- | Definitions for writing /plugins/ for GHC. Plugins can hook into @@ -14,6 +21,10 @@ module GHC.Driver.Plugins ( , CommandLineOption , PsMessages(..) , ParsedResult(..) + + -- * External plugins + , loadExternalPlugins + -- ** Recompilation checking , purePlugin, impurePlugin, flagRecompile , PluginRecompile(..) @@ -52,6 +63,7 @@ module GHC.Driver.Plugins ( , PluginWithArgs(..), pluginsWithArgs, pluginRecompile' , LoadedPlugin(..), lpModuleName , StaticPlugin(..) + , ExternalPlugin(..) , mapPlugins, withPlugins, withPlugins_ ) where @@ -60,6 +72,7 @@ import GHC.Prelude import GHC.Driver.Env import GHC.Driver.Monad import GHC.Driver.Phases +import GHC.Driver.Plugins.External import GHC.Unit.Module import GHC.Unit.Module.ModIface @@ -75,8 +88,12 @@ import GHC.Core.Opt.Monad ( CoreM ) import GHC.Core.Opt.Pipeline.Types ( CoreToDo ) import GHC.Hs import GHC.Types.Error (Messages) +import GHC.Linker.Types +import GHC.Types.Unique.DFM + import GHC.Utils.Fingerprint -import GHC.Utils.Outputable (Outputable(..), text, (<+>)) +import GHC.Utils.Outputable +import GHC.Utils.Panic import Data.List (sort) @@ -85,8 +102,13 @@ import Data.List (sort) import qualified Data.Semigroup import Control.Monad -import GHC.Linker.Types -import GHC.Types.Unique.DFM + +#if defined(HAVE_INTERNAL_INTERPRETER) +import GHCi.ObjLink +import GHC.Exts (addrToAny#, Ptr(..)) +import GHC.Utils.Encoding +#endif + -- | Command line options gathered from the -PModule.Name:stuff syntax -- are given to you as this type @@ -196,6 +218,14 @@ data LoadedPlugin = LoadedPlugin -- ^ the module containing the plugin } +-- | External plugin loaded directly from a library without loading module +-- interfaces +data ExternalPlugin = ExternalPlugin + { epPlugin :: PluginWithArgs -- ^ Plugin with its arguments + , epUnit :: String -- ^ UnitId + , epModule :: String -- ^ Module name + } + -- | A static plugin with its arguments. For registering compiled-in plugins -- through the GHC API. data StaticPlugin = StaticPlugin @@ -285,6 +315,10 @@ data Plugins = Plugins -- To add dynamically loaded plugins through the GHC API see -- 'addPluginModuleName' instead. + , externalPlugins :: ![ExternalPlugin] + -- ^ External plugins loaded directly from libraries without loading + -- module interfaces. + , loadedPlugins :: ![LoadedPlugin] -- ^ Plugins dynamically loaded after processing arguments. What -- will be loaded here is directed by DynFlags.pluginModNames. @@ -299,12 +333,17 @@ data Plugins = Plugins } emptyPlugins :: Plugins -emptyPlugins = Plugins [] [] ([], emptyUDFM) - +emptyPlugins = Plugins + { staticPlugins = [] + , externalPlugins = [] + , loadedPlugins = [] + , loadedPluginDeps = ([], emptyUDFM) + } pluginsWithArgs :: Plugins -> [PluginWithArgs] pluginsWithArgs plugins = map lpPlugin (loadedPlugins plugins) ++ + map epPlugin (externalPlugins plugins) ++ map spPlugin (staticPlugins plugins) -- | Perform an operation by using all of the plugins in turn. @@ -328,3 +367,53 @@ data FrontendPlugin = FrontendPlugin { } defaultFrontendPlugin :: FrontendPlugin defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () } + + +-- | Load external plugins +loadExternalPlugins :: [ExternalPluginSpec] -> IO [ExternalPlugin] +loadExternalPlugins [] = return [] +#if !defined(HAVE_INTERNAL_INTERPRETER) +loadExternalPlugins _ = do + panic "loadExternalPlugins: can't load external plugins with GHC built without internal interpreter" +#elif !defined(CAN_LOAD_DLL) +loadExternalPlugins _ = do + panic "loadExternalPlugins: loading shared libraries isn't supported by this compiler" +#else +loadExternalPlugins ps = do + -- initialize the linker + initObjLinker RetainCAFs + -- load plugins + forM ps $ \(ExternalPluginSpec path unit mod_name opts) -> do + loadExternalPluginLib path + -- lookup symbol + let ztmp = zEncodeString mod_name ++ "_plugin_closure" + symbol + | null unit = ztmp + | otherwise = zEncodeString unit ++ "_" ++ ztmp + plugin <- lookupSymbol symbol >>= \case + Nothing -> pprPanic "loadExternalPlugins" + (vcat [ text "Symbol not found" + , text " Library path: " <> text path + , text " Symbol : " <> text symbol + ]) + Just (Ptr addr) -> case addrToAny# addr of + (# a #) -> pure a + + pure $ ExternalPlugin (PluginWithArgs plugin opts) unit mod_name + +loadExternalPluginLib :: FilePath -> IO () +loadExternalPluginLib path = do + -- load library + loadDLL path >>= \case + Just errmsg -> pprPanic "loadExternalPluginLib" + (vcat [ text "Can't load plugin library" + , text " Library path: " <> text path + , text " Error : " <> text errmsg + ]) + Nothing -> do + -- resolve objects + resolveObjs >>= \case + True -> return () + False -> pprPanic "loadExternalPluginLib" (text "Unable to resolve objects for library: " <> text path) + +#endif ===================================== compiler/GHC/Driver/Plugins/External.hs ===================================== @@ -0,0 +1,79 @@ +-- | External plugins +-- +-- GHC supports two kinds of "static" plugins: +-- 1. internal: setup with GHC-API +-- 2. external: setup as explained below and loaded from shared libraries +-- +-- The intended use case for external static plugins is with cross compilers: at +-- the time of writing, GHC is mono-target and a GHC cross-compiler (i.e. when +-- host /= target) can't build nor load plugins for the host using the +-- "non-static" plugin approach. Fixing this is tracked in #14335. If you're not +-- using a cross-compiler, you'd better use non-static plugins which are easier +-- to build and and safer to use (see below). +-- +-- External static plugins can be configured via the command-line with +-- the -fplugin-library flag. Syntax is: +-- +-- -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ +-- +-- Example: +-- -fplugin-library=path/to/plugin;package-123;Plugin.Module;["Argument","List"] +-- +-- Building the plugin library: +-- 1. link with the libraries used to build the compiler you target. If you +-- target a cross-compiler (stage2), you can't directly use it to build the +-- plugin library. Use the stage1 compiler instead. +-- +-- 2. if you use cabal to build the library, its unit-id will be set by cabal +-- and will contain a hash (e.g. "my-plugin-unit-1345656546ABCDEF"). To force +-- the unit id, use GHC's `-this-unit-id` command line flag: +-- e.g. -this-unit-id my-plugin-unit +-- You can set this in the .cabal file of your library with the following +-- stanza: `ghc-options: -this-unit-id my-plugin-unit` +-- +-- 3. To make your plugin easier to distribute, you may want to link it +-- statically with all its dependencies. You would need to use `-shared` +-- without `-dynamic` when building your library. +-- +-- However, all the static dependencies have to be built with `-fPIC` and it's +-- not done by default. See +-- https://www.hobson.space/posts/haskell-foreign-library/ for a way to modify +-- the compiler to do it. +-- +-- In any case, don't link your plugin library statically with the RTS (e.g. +-- use `-fno-link-rts`) as there are some global variables in the RTS that must +-- be shared between the plugin and the compiler. +-- +-- With external static plugins we don't check the type of the `plugin` closure +-- we look up. If it's not a valid `Plugin` value, it will probably crash badly. +-- + +module GHC.Driver.Plugins.External + ( ExternalPluginSpec (..) + , parseExternalPluginSpec + ) +where + +import GHC.Prelude +import Text.Read + +-- | External plugin spec +data ExternalPluginSpec = ExternalPluginSpec + { esp_lib :: !FilePath + , esp_unit_id :: !String + , esp_module :: !String + , esp_args :: ![String] + } + +-- | Parser external static plugin specification from command-line flag +parseExternalPluginSpec :: String -> Maybe ExternalPluginSpec +parseExternalPluginSpec optflag = + case break (== ';') optflag of + (libPath, _:rest) -> case break (== ';') rest of + (libName, _:pack) -> case break (== ';') pack of + (modName, _:args) -> case readMaybe args of + Just as -> Just (ExternalPluginSpec libPath libName modName as) + Nothing -> Nothing + _ -> Nothing + _ -> Nothing + _ -> Nothing ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -229,6 +229,7 @@ import GHC.Builtin.Names ( mAIN_NAME ) import GHC.Driver.Phases ( Phase(..), phaseInputExt ) 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 @@ -590,6 +591,9 @@ data DynFlags = DynFlags { -- ^ 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, @@ -1176,6 +1180,8 @@ defaultDynFlags mySettings = pluginModNameOpts = [], frontendPluginOpts = [], + externalPluginSpecs = [], + outputFile_ = Nothing, dynOutputFile_ = Nothing, outputHi = Nothing, @@ -1715,6 +1721,11 @@ addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, o [] -> "" -- should probably signal an error (_:plug_opt) -> plug_opt -- ignore the ':' from break +addExternalPlugin :: String -> DynFlags -> DynFlags +addExternalPlugin optflag d = case parseExternalPluginSpec optflag of + Just r -> d { externalPluginSpecs = r : externalPluginSpecs d } + Nothing -> cmdLineError $ "Couldn't parse external plugin specification: " ++ optflag + addFrontendPluginOption :: String -> DynFlags -> DynFlags addFrontendPluginOption s d = d { frontendPluginOpts = s : frontendPluginOpts d } @@ -2695,6 +2706,8 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "fclear-plugins" (noArg clearPluginModuleNames) , make_ord_flag defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption) + , make_ord_flag defGhcFlag "fplugin-library" (hasArg addExternalPlugin) + ------ Optimisation flags ------------------------------------------ , make_dep_flag defGhcFlag "Onot" (noArgM $ setOptLevel 0 ) "Use -O0 instead" ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Driver.Hooks import GHC.Driver.Plugins +import GHC.Driver.Plugins.External import GHC.Linker.Loader ( loadModule, loadName ) import GHC.Runtime.Interpreter ( wormhole ) @@ -75,22 +76,48 @@ import Data.List (unzip4) -- pluginModNames or pluginModNameOpts changes. initializePlugins :: HscEnv -> IO HscEnv initializePlugins hsc_env - -- plugins not changed + -- check that plugin specifications didn't change + + -- dynamic plugins | loaded_plugins <- loadedPlugins (hsc_plugins hsc_env) , map lpModuleName loaded_plugins == reverse (pluginModNames dflags) - -- arguments not changed , all same_args loaded_plugins - = return hsc_env -- no need to reload plugins FIXME: doesn't take static plugins into account + + -- external plugins + , external_plugins <- externalPlugins (hsc_plugins hsc_env) + , check_external_plugins external_plugins (externalPluginSpecs dflags) + + -- FIXME: we should check static plugins too + + = return hsc_env -- no change, no need to reload plugins + | otherwise = do (loaded_plugins, links, pkgs) <- loadPlugins hsc_env - let plugins' = (hsc_plugins hsc_env) { loadedPlugins = loaded_plugins, loadedPluginDeps = (links, pkgs) } + external_plugins <- loadExternalPlugins (externalPluginSpecs dflags) + let plugins' = (hsc_plugins hsc_env) { staticPlugins = staticPlugins (hsc_plugins hsc_env) + , externalPlugins = external_plugins + , loadedPlugins = loaded_plugins + , loadedPluginDeps = (links, pkgs) + } let hsc_env' = hsc_env { hsc_plugins = plugins' } withPlugins (hsc_plugins hsc_env') driverPlugin hsc_env' where + dflags = hsc_dflags hsc_env + -- dynamic plugins plugin_args = pluginModNameOpts dflags same_args p = paArguments (lpPlugin p) == argumentsForPlugin p plugin_args argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst) - dflags = hsc_dflags hsc_env + -- external plugins + check_external_plugin p spec = and + [ epUnit p == esp_unit_id spec + , epModule p == esp_module spec + , paArguments (epPlugin p) == esp_args spec + ] + check_external_plugins eps specs = case (eps,specs) of + ([] , []) -> True + (_ , []) -> False -- some external plugin removed + ([] , _ ) -> False -- some external plugin added + (p:ps,s:ss) -> check_external_plugin p s && check_external_plugins ps ss loadPlugins :: HscEnv -> IO ([LoadedPlugin], [Linkable], PkgsLoaded) loadPlugins hsc_env ===================================== compiler/ghc.cabal.in ===================================== @@ -441,6 +441,7 @@ Library GHC.Driver.Pipeline.Phases GHC.Driver.Pipeline.Monad GHC.Driver.Plugins + GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session GHC.Hs ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -268,7 +268,6 @@ option. The list of enabled plugins can be reset with the the command line is not possible. Instead ``:set -fclear-plugins`` can be used. - As an example, in order to load the plugin exported by ``Foo.Plugin`` in the package ``foo-ghc-plugin``, and give it the parameter "baz", we would invoke GHC like this: @@ -286,6 +285,19 @@ would invoke GHC like this: Linking Test ... $ + +Plugins can be also be loaded from libraries directly. It allows plugins to be +loaded in cross-compilers (as a workaround for #14335). + +.. ghc-flag:: -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ + :shortdesc: Load a pre-compiled static plugin from an external library + :type: dynamic + :category: plugins + + Arguments are specified in a list form, so a plugin specified to + :ghc-flag:`-fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩` will look + like ``'path/to/plugin;package-123;Plugin.Module;["Argument","List"]'``. + Alternatively, core plugins can be specified with Template Haskell. :: ===================================== hadrian/bindist/Makefile ===================================== @@ -184,10 +184,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -116,6 +116,7 @@ GHC.Driver.Phases GHC.Driver.Pipeline.Monad GHC.Driver.Pipeline.Phases GHC.Driver.Plugins +GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session GHC.Hs ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -117,6 +117,7 @@ GHC.Driver.Phases GHC.Driver.Pipeline.Monad GHC.Driver.Pipeline.Phases GHC.Driver.Plugins +GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session GHC.Hs ===================================== testsuite/tests/plugins/Makefile ===================================== @@ -205,3 +205,18 @@ test-echo-in-turn-many-args: .PHONY: test-echo-in-line-many-args test-echo-in-line-many-args: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 test-echo-in-line-many-args.hs -package-db echo-plugin/pkg.test-echo-in-line-many-args/local.package.conf + + +ifeq "$(WINDOWS)" "YES" +DLL = $1.dll +else ifeq "$(DARWIN)" "YES" +DLL = lib$1.dylib +else +DLL = lib$1.so +endif + +.PHONY: plugins-external +plugins-external: + cp shared-plugin/pkg.plugins01/dist/build/$(call DLL,HSsimple-plugin*) $(call DLL,HSsimple-plugin) + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -fplugin-library "$(PWD)/$(call DLL,HSsimple-plugin);simple-plugin-1234;Simple.Plugin;[\"Plugin\",\"loaded\",\"from\",\"a shared lib\"]" plugins-external.hs + ./plugins-external ===================================== testsuite/tests/plugins/all.T ===================================== @@ -311,3 +311,8 @@ test('test-echo-in-line-many-args', [extra_files(['echo-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C echo-plugin package.test-echo-in-line-many-args TOP={top}')], makefile_test, []) + +test('plugins-external', + [extra_files(['shared-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C shared-plugin package.plugins01 TOP={top}')], + makefile_test, []) ===================================== testsuite/tests/plugins/plugins-external.hs ===================================== @@ -0,0 +1,4 @@ +-- Intended to test that we can load plugins as external shared libraries +module Main where + +main = putStrLn "Hello World" ===================================== testsuite/tests/plugins/plugins-external.stderr ===================================== @@ -0,0 +1,2 @@ +Simple Plugin Passes Queried +Got options: Plugin loaded from a shared lib ===================================== testsuite/tests/plugins/plugins-external.stdout ===================================== @@ -0,0 +1 @@ +Hello World ===================================== testsuite/tests/plugins/shared-plugin/LICENSE ===================================== @@ -0,0 +1,10 @@ +Copyright (c) 2008, Max Bolingbroke +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + * Neither the name of Max Bolingbroke nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== testsuite/tests/plugins/shared-plugin/Makefile ===================================== @@ -0,0 +1,20 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean.%: + rm -rf pkg.$* + +HERE := $(abspath .) +$(eval $(call canonicalise,HERE)) + +package.%: + $(MAKE) -s --no-print-directory clean.$* + mkdir pkg.$* + "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs + + "$(GHC_PKG)" init pkg.$*/local.package.conf + + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) + pkg.$*/setup build --distdir pkg.$*/dist -v0 + pkg.$*/setup install --distdir pkg.$*/dist -v0 ===================================== testsuite/tests/plugins/shared-plugin/Setup.hs ===================================== @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain ===================================== testsuite/tests/plugins/shared-plugin/Simple/Plugin.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Simple.Plugin(plugin) where + +import GHC.Types.Unique.FM +import GHC.Plugins +import qualified GHC.Utils.Error + +import Control.Monad +import Data.Monoid hiding (Alt) +import Data.Dynamic +import qualified Language.Haskell.TH as TH + +plugin :: Plugin +plugin = defaultPlugin { + installCoreToDos = install, + pluginRecompile = purePlugin + } + +install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] +install options todos = do + putMsgS $ "Simple Plugin Passes Queried" + putMsgS $ "Got options: " ++ unwords options + + -- Create some actual passes to continue the test. + return todos ===================================== testsuite/tests/plugins/shared-plugin/shared-plugin.cabal ===================================== @@ -0,0 +1,21 @@ +Name: simple-plugin +Version: 0.1 +Synopsis: A demonstration of the GHC plugin system. +Cabal-Version: >= 1.2 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Author: Max Bolingbroke +Homepage: http://blog.omega-prime.co.uk + +Library + Extensions: CPP + Build-Depends: + base, + template-haskell, + ghc >= 6.11 + Exposed-Modules: + Simple.Plugin + + -- explicitly set the unit-id to allow loading from a shared library + ghc-options: -this-unit-id simple-plugin-1234 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad23cf018d60114800361644e690065c340b1234...74351150d32aff4866352757ac69b4eecc6b245b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad23cf018d60114800361644e690065c340b1234...74351150d32aff4866352757ac69b4eecc6b245b You're receiving 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 Aug 8 13:55:45 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 Aug 2022 09:55:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: hadrian: Extend xattr Darwin hack to cover /lib Message-ID: <62f115e17fe5b_25b0164d24c482012@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 4e8aee4e by Andreas Klebinger at 2022-08-08T09:55:32-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 709ad7c3 by Ben Gamari at 2022-08-08T09:55:32-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 4 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - docs/users_guide/bugs.rst - hadrian/bindist/Makefile Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -769,6 +769,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) ===================================== .gitlab/jobs.yaml ===================================== @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -358,6 +416,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1864,6 +1981,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== docs/users_guide/bugs.rst ===================================== @@ -115,6 +115,10 @@ Lexical syntax varid → small {idchar} ⟨reservedid⟩ conid → large {idchar} +- GHC allows redundant parantheses around the function name in the `funlhs` part of declarations. + That is GHC will succeed in parsing a declaration like `((f)) x = ` for any number + of parantheses around `f`. + .. _infelicities-syntax: Context-free syntax ===================================== hadrian/bindist/Makefile ===================================== @@ -178,7 +178,9 @@ install_bin_libdir: $(INSTALL_PROGRAM) $$i "$(DESTDIR)$(ActualBinsDir)"; \ done # Work around #17418 on Darwin - if [ -e "${XATTR}" ]; then "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; fi + if [ -e "${XATTR}" ]; then \ + "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; \ + fi install_bin_direct: @echo "Copying binaries to $(DESTDIR)$(WrapperBinsDir)" @@ -209,6 +211,10 @@ install_lib: lib/settings esac; \ done; \ chmod ugo+rx "$$dest"/bin/* + # Work around #17418 on Darwin + if [ -e "${XATTR}" ]; then \ + "${XATTR}" -c -r "$(DESTDIR)$(ActualLibsDir)"; \ + fi install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/277654d69b7e67b1a20924073dbc4f55a6ebd026...709ad7c3de1931c8760a92bf7d49b6a0587977be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/277654d69b7e67b1a20924073dbc4f55a6ebd026...709ad7c3de1931c8760a92bf7d49b6a0587977be You're receiving 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 Aug 10 16:05:23 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 Aug 2022 12:05:23 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] 2 commits: fix tests Message-ID: <62f3d74318e80_142b49521708966@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: 0a64c894 by Matthew Pickering at 2022-08-10T16:08:44+01:00 fix tests - - - - - 12313f9e by Matthew Pickering at 2022-08-10T17:04:04+01:00 tweaks - - - - - 9 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/phases.rst - testsuite/tests/driver/fat-iface/Makefile - testsuite/tests/driver/fat-iface/all.T - testsuite/tests/ghci/T16670/Makefile - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -857,12 +857,12 @@ hscRecompStatus let just_bc = justBytecode <$> bc_linkable just_o = justObjects <$> obj_linkable - maybe_both_os = case (bc_linkable, obj_linkable) of + _maybe_both_os = case (bc_linkable, obj_linkable) of (UpToDateItem bc, UpToDateItem o) -> UpToDateItem (bytecodeAndObjects bc o) -- If missing object code, just say we need to recompile because of object code. (_, OutOfDateItem reason _) -> OutOfDateItem reason Nothing -- If just missing byte code, just use the object code - -- so you should use -fprefer-bytecode with -fwrite-fat-interface or you'll + -- so you should use -fprefer-byte-code with -fwrite-fat-interface or you'll -- end up using bytecode on recompilation (_, UpToDateItem {} ) -> just_o @@ -871,7 +871,7 @@ hscRecompStatus -- If missing object code, just say we need to recompile because of object code. (_, OutOfDateItem reason _) -> OutOfDateItem reason Nothing -- If just missing byte code, just use the object code - -- so you should use -fprefer-bytecode with -fwrite-fat-interface or you'll + -- so you should use -fprefer-byte-code with -fwrite-fat-interface or you'll -- end up using bytecode on recompilation (OutOfDateItem reason _, _ ) -> OutOfDateItem reason Nothing @@ -891,9 +891,9 @@ hscRecompStatus if gopt Opt_ByteCodeAndObjectCode lcl_dflags -- We say we are going to write both, so recompile unless we have both then definitely_both_os - -- Well, we need the object file so definitely need that but load bytecode - -- as well if we have it, a module later might "prefer" it. - else maybe_both_os + -- Only load the object file unless we are saying we need to produce both. + -- Unless we do this then you can end up using byte-code for a module you specify -fobject-code for. + else just_o | otherwise -> pprPanic "hscRecompStatus" (text $ show $ backend lcl_dflags) case recomp_linkable_result of UpToDateItem linkable -> do @@ -946,7 +946,6 @@ checkByteCode iface mod_sum mb_old_linkable = -> return $ (UpToDateItem old_linkable) _ -> loadByteCode iface mod_sum --- TODO: MP TODO Fat Iface is just in normal IFace loadByteCode :: ModIface -> ModSummary -> IO (MaybeValidated Linkable) loadByteCode iface mod_sum = do let ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1742,7 +1742,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) - -- Setting --interactive sets -fprefer-bytecode so we use interpreterBackend + -- Setting --interactive sets -fprefer-byte-code so we use interpreterBackend -- when using -fno-code with --interactive let new_backend = if gopt Opt_UseBytecodeRatherThanObjects dflags then interpreterBackend @@ -1758,7 +1758,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- Recursive call to catch the other cases enable_code_gen (ModuleNode deps ms') - -- If -fprefer-bytecode then satisfy dependency by enabling bytecode (if normal object not enough) + -- If -fprefer-byte-code then satisfy dependency by enabling bytecode (if normal object not enough) -- we only get to this case if the default backend is already generating object files, but we need dynamic -- objects | bytecode_and_enable ms -> do ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3486,8 +3486,8 @@ fFlagsDeps = [ flagSpec "keep-cafs" Opt_KeepCAFs, flagSpec "link-rts" Opt_LinkRts, flagSpec "byte-code-and-object-code" Opt_ByteCodeAndObjectCode, - flagSpec "prefer-bytecode" Opt_UseBytecodeRatherThanObjects, - flagSpec' "compact-unwind" Opt_CompactUnwind + flagSpec "prefer-byte-code" Opt_UseBytecodeRatherThanObjects, + 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.") ===================================== docs/users_guide/phases.rst ===================================== @@ -670,7 +670,7 @@ Options affecting code generation :category: codegen Generate object code and byte code. This is useful with the flags - :ghc-flag:`-fprefer-bytecode` and :ghc-flag:`-fwrite-fat-interface`. + :ghc-flag:`-fprefer-byte-code` and :ghc-flag:`-fwrite-fat-interface`. :ghc-flag:`-fbyte-code` and :ghc-flag:`-fobject-code` disable this flag as they specify that GHC should *only* write object code or byte-code respectively. @@ -771,7 +771,7 @@ Options affecting code generation file sizes at the expense of debuggability. -.. ghc-flag:: -fprefer-bytecode +.. ghc-flag:: -fprefer-byte-code :shortdesc: Use bytecode if it is available to run TH splices :type: dynamic :category: codegen ===================================== testsuite/tests/driver/fat-iface/Makefile ===================================== @@ -32,10 +32,10 @@ fat006: clean test ! -f Fat.o fat008: clean - "$(TEST_HC)" $(TEST_HC_OPTS) FatTH.hs -fwrite-fat-interface -fprefer-bytecode + "$(TEST_HC)" $(TEST_HC_OPTS) FatTH.hs -fwrite-fat-interface -fprefer-byte-code echo >> "FatTH.hs" # Observe that FatQuote.hs is not recompiled and the fat interface is used. - "$(TEST_HC)" $(TEST_HC_OPTS) FatTH.hs -fwrite-fat-interface -fprefer-bytecode + "$(TEST_HC)" $(TEST_HC_OPTS) FatTH.hs -fwrite-fat-interface -fprefer-byte-code # Same as fat008 but with ghci, broken due to recompilation checking wibbles @@ -45,9 +45,9 @@ fat009: clean echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) FatTH.hs -fwrite-fat-interface fat010: clean - "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-fat-interface -fprefer-bytecode + "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-fat-interface -fprefer-byte-code echo >> "THB.hs" - "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-fat-interface -fprefer-bytecode + "$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-fat-interface -fprefer-byte-code fat014: clean echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -v0 -fno-code < fat014.script ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -2,15 +2,15 @@ test('fat001', [extra_files(['Fat.hs'])], makefile_test, ['fat001']) test('fat005', [extra_files(['Fat.hs']), filter_stdout_lines(r'= Proto-BCOs')], makefile_test, ['fat005']) test('fat007', [extra_files(['Fat.hs'])], makefile_test, ['fat007']) test('fat006', [extra_files(['Fat.hs'])], makefile_test, ['fat006']) -test('fat008', [extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat008']) +test('fat008', [unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat008']) test('fat009', [extra_files(['FatTH.hs', 'FatQuote.hs']), copy_files], makefile_test, ['fat009']) test('fat010', [extra_files(['THA.hs', 'THB.hs', 'THC.hs']), copy_files], makefile_test, ['fat010']) # Check linking works when using -fbyte-code-and-object-code -test('fat011', [extra_files(['FatMain.hs', 'FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatMain', '-fbyte-code-and-object-code -fprefer-bytecode']) +test('fat011', [extra_files(['FatMain.hs', 'FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatMain', '-fbyte-code-and-object-code -fprefer-byte-code']) # Check that we use interpreter rather than enable dynamic-too if needed for TH -test('fat012', [extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fprefer-bytecode']) -# Check that no objects are generated if using -fno-code and -fprefer-bytecode -test('fat013', [extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fno-code -fprefer-bytecode']) +test('fat012', [unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fprefer-byte-code']) +# Check that no objects are generated if using -fno-code and -fprefer-byte-code +test('fat013', [extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fno-code -fprefer-byte-code']) # When using interpreter should not produce objects test('fat014', [extra_files(['FatTH.hs', 'FatQuote.hs'])], makefile_test, ['fat014']) ===================================== testsuite/tests/ghci/T16670/Makefile ===================================== @@ -19,6 +19,6 @@ T16670_th: $(MAKE) -s --no-print-directory clean mkdir my-odir echo ":load T16670_th.hs" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) \ - -v0 -fno-code -fno-prefer-bytecode -fwrite-interface -odir my-odir + -v0 -fno-code -fno-prefer-byte-code -fwrite-interface -odir my-odir find . -name T16670_th.o test -f my-odir/T16670_th.o ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -13,7 +13,7 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fkeep-going -fshow-warning-groups - -fprefer-bytecode + -fprefer-byte-code warning settings: -Wsemigroup -Wstar-is-type ===================================== testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 ===================================== @@ -12,6 +12,7 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fkeep-going -fshow-warning-groups + -fprefer-byte-code warning settings: -Wsemigroup -Wstar-is-type View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2680ed9cda3637400a45984e19c515f5e1b0ede6...12313f9ebccfff32c5d4f276ec9d9a67a84e00a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2680ed9cda3637400a45984e19c515f5e1b0ede6...12313f9ebccfff32c5d4f276ec9d9a67a84e00a8 You're receiving 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 Aug 10 12:38:56 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 08:38:56 -0400 Subject: [Git][ghc/ghc][wip/T21976] Apply 1 suggestion(s) to 1 file(s) Message-ID: <62f3a6e0c3a26_d27044b820265137@gitlab.mail> Ben Gamari pushed to branch wip/T21976 at Glasgow Haskell Compiler / GHC Commits: e754f7ce by Jens Petersen at 2022-08-10T12:38:54+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -187,8 +187,8 @@ install_docs: if [ -d doc ]; then \ cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`";' \ - sh '{}' ';' \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ fi if [ -d docs-utils ]; then \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e754f7ce76545ef9af12e247ed4764ee29fdf787 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e754f7ce76545ef9af12e247ed4764ee29fdf787 You're receiving 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 Aug 8 13:56:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 09:56:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21965 Message-ID: <62f11606cdcad_25b01650d5c4875c5@gitlab.mail> Ben Gamari pushed new branch wip/T21965 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21965 You're receiving 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 Aug 12 17:04:31 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 Aug 2022 13:04:31 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] 74 commits: driver: Don't create LinkNodes when -no-link is enabled Message-ID: <62f6881f807a_3d8149489a4586577@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - 9d284bc8 by Matthew Pickering at 2022-08-12T18:02:50+01:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - 2e0329b3 by Matthew Pickering at 2022-08-12T18:04:12+01:00 Fat Interface Files This commit adds three new flags * -fwrite-fat-interface: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for a fat interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of fat interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 6bdfda1a by Matthew Pickering at 2022-08-12T18:04:15+01:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Data.hs - + compiler/GHC/Core.hs-boot - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91498f0b50fc29c9bb69d324df6964c8da821d94...6bdfda1ac79916487b7a64f4bbd611ca7ed7a86a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91498f0b50fc29c9bb69d324df6964c8da821d94...6bdfda1ac79916487b7a64f4bbd611ca7ed7a86a You're receiving 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 Aug 9 21:27:20 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 09 Aug 2022 17:27:20 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble Message-ID: <62f2d138258cc_182c4e4b85c36547f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 081540f8 by Simon Peyton Jones at 2022-08-09T22:27:40+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Coercion.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1450,20 +1450,18 @@ promoteCoercion :: Coercion -> CoercionN -- First cases handles anything that should yield refl. promoteCoercion co = case co of - _ | ki1 `eqType` ki2 - -> mkNomReflCo (typeKind ty1) - -- no later branch should return refl - -- The assert (False )s throughout - -- are these cases explicitly, but they should never fire. + Refl _ -> mkNomReflCo ki1 - Refl _ -> assert False $ - mkNomReflCo ki1 - - GRefl _ _ MRefl -> assert False $ - mkNomReflCo ki1 + GRefl _ _ MRefl -> mkNomReflCo ki1 GRefl _ _ (MCo co) -> co + _ | ki1 `eqType` ki2 + -> mkNomReflCo (typeKind ty1) + -- No later branch should return refl + -- The assert (False )s throughout + -- are these cases explicitly, but they should never fire. + TyConAppCo _ tc args | Just co' <- instCoercions (mkNomReflCo (tyConKind tc)) args -> co' @@ -1481,13 +1479,19 @@ promoteCoercion co = case co of | isTyVar tv -> promoteCoercion g - ForAllCo _ _ _ + ForAllCo {} -> assert False $ + -- (ForAllCo {} :: (forall cv.t1) ~ (forall cv.t2) + -- The tyvar case is handled above, so the bound var is a + -- a coercion variable. So both sides have kind Type + -- (Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep). + -- So the result is Refl, and that should have been caught by + -- the first equation above mkNomReflCo liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - FunCo {} -> assert False $ - mkNomReflCo liftedTypeKind + FunCo {} -> mkKindCo co + -- We can get Type~Constraint or Constraint~Type + -- from FunCo {} :: (a -> (b::Type)) ~ (a -=> (b'::Constraint)) CoVarCo {} -> mkKindCo co HoleCo {} -> mkKindCo co @@ -1531,7 +1535,7 @@ promoteCoercion co = case co of -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep KindCo _ - -> assert False $ + -> assert False $ -- See the first equation above mkNomReflCo liftedTypeKind SubCo g @@ -1541,6 +1545,9 @@ promoteCoercion co = case co of Pair ty1 ty2 = coercionKind co ki1 = typeKind ty1 ki2 = typeKind ty2 + doc = vcat[ ppr co + , text "ty1" <+> ppr ty1 <+> dcolon <+> ppr ki1 + , text "ty2" <+> ppr ty2 <+> dcolon <+> ppr ki2 ] -- | say @g = promoteCoercion h at . Then, @instCoercion g w@ yields @Just g'@, -- where @g' = promoteCoercion (h w)@. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/081540f8954ba95e61acda35227f5e7de89bbaf4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/081540f8954ba95e61acda35227f5e7de89bbaf4 You're receiving 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 Aug 10 19:38:14 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 Aug 2022 15:38:14 -0400 Subject: [Git][ghc/ghc][master] hadrian: Don't attempt to install documentation if doc/ doesn't exist Message-ID: <62f40926277fb_142b49521ac1874c8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -184,10 +184,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cabea7c9b10d2d15a4798be9f3130994393dd9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cabea7c9b10d2d15a4798be9f3130994393dd9c You're receiving 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 Aug 8 22:06:54 2022 From: gitlab at gitlab.haskell.org (Norman Ramsey (@nrnrnr)) Date: Mon, 08 Aug 2022 18:06:54 -0400 Subject: [Git][ghc/ghc][wip/nr/typed-wasm-control-flow] add builder case for fallthrough Message-ID: <62f188fe81d9f_25b0164bfa0624462@gitlab.mail> Norman Ramsey pushed to branch wip/nr/typed-wasm-control-flow at Glasgow Haskell Compiler / GHC Commits: c5c02967 by Norman Ramsey at 2022-08-08T18:06:40-04:00 add builder case for fallthrough - - - - - 1 changed file: - compiler/GHC/Wasm/Builder.hs Changes: ===================================== compiler/GHC/Wasm/Builder.hs ===================================== @@ -65,6 +65,8 @@ printWithIndent indent s = print s print (WasmActions as) = myActions as print (s `WasmSeq` s') = print s `newline` print s' + print WasmFallthrough = "// fallthrough" -- hopefully rare + newline s s' = s <> "\n" <> indent <> s' outdent s = defaultIndent <> printWithIndent (indent <> defaultIndent) s s <+> s' = s <> " " <> s' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5c029678376197ddd365ba2665c361dd908502d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5c029678376197ddd365ba2665c361dd908502d You're receiving 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 Aug 8 23:19:47 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 19:19:47 -0400 Subject: [Git][ghc/ghc][wip/bindist-install] 7 commits: NCG(x86): Compile add+shift as lea if possible. Message-ID: <62f19a13ba981_25b0164c15863482@gitlab.mail> Ben Gamari pushed to branch wip/bindist-install at Glasgow Haskell Compiler / GHC Commits: 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 7bd11fad by Ben Gamari at 2022-08-08T19:19:35-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 82eeb5f1 by Ben Gamari at 2022-08-08T19:19:36-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 20 changed files: - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Expr.hs - docs/users_guide/bugs.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - + mk/install_script.sh - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_compile/T21710a.hs - + testsuite/tests/codeGen/should_compile/T21710a.stderr - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm - + testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs - testsuite/tests/codeGen/should_gen_asm/all.T Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -769,6 +769,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) + , disableValidate (standardBuilds AArch64 (Linux Debian11)) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) ===================================== .gitlab/jobs.yaml ===================================== @@ -120,6 +120,64 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -358,6 +416,65 @@ "XZ_OPT": "-9" } }, + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1864,6 +1981,66 @@ "XZ_OPT": "-9" } }, + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1048,10 +1048,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -------------------- add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register + -- x + imm add_code rep x (CmmLit (CmmInt y _)) | is32BitInteger y , rep /= W8 -- LEA doesn't support byte size (#18614) = add_int rep x y + -- x + (y << imm) + add_code rep x y + -- Byte size is not supported and 16bit size is slow when computed via LEA + | rep /= W8 && rep /= W16 + -- 2^3 = 8 is the highest multiplicator supported by LEA. + , Just (x,y,shift_bits) <- get_shift x y + = add_shiftL rep x y (fromIntegral shift_bits) + where + -- x + (y << imm) + get_shift x (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) + | shift_bits <= 3 + = Just (x, y, shift_bits) + -- (y << imm) + x + get_shift (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) x + | shift_bits <= 3 + = Just (x, y, shift_bits) + get_shift _ _ + = Nothing add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y where format = intFormat rep -- TODO: There are other interesting patterns we want to replace @@ -1066,6 +1085,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y -- our three-operand add instruction: + add_int :: (Width -> CmmExpr -> Integer -> NatM Register) add_int width x y = do (x_reg, x_code) <- getSomeReg x let @@ -1079,6 +1099,22 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -- return (Any format code) + -- x + (y << shift_bits) using LEA + add_shiftL :: (Width -> CmmExpr -> CmmExpr -> Int -> NatM Register) + add_shiftL width x y shift_bits = do + (x_reg, x_code) <- getSomeReg x + (y_reg, y_code) <- getSomeReg y + let + format = intFormat width + imm = ImmInt 0 + code dst + = (x_code `appOL` y_code) `snocOL` + LEA format + (OpAddr (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg (2 ^ shift_bits)) imm)) + (OpReg dst) + -- + return (Any format code) + ---------------------- -- See Note [DIV/IDIV for bytes] ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -20,6 +20,7 @@ where import GHC.Prelude +import GHC.Builtin.PrimOps ( PrimOp(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply @@ -346,6 +347,19 @@ fvArgs args = do type IsScrut = Bool +rewriteArgs :: [StgArg] -> RM [StgArg] +rewriteArgs = mapM rewriteArg +rewriteArg :: StgArg -> RM StgArg +rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v +rewriteArg (lit at StgLitArg{}) = return lit + +-- Attach a tagSig if it's tagged +rewriteId :: Id -> RM Id +rewriteId v = do + is_tagged <- isTagged v + if is_tagged then return $! setIdTagSig v (TagSig TagProper) + else return v + rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr rewriteExpr _ (e at StgCase {}) = rewriteCase e rewriteExpr _ (e at StgLet {}) = rewriteLet e @@ -355,8 +369,11 @@ rewriteExpr _ e@(StgConApp {}) = rewriteConApp e rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e rewriteExpr _ (StgLit lit) = return $! (StgLit lit) +rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do + (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) + rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ @@ -415,6 +432,7 @@ rewriteApp True (StgApp f []) = do -- isTagged looks at more than the result of our analysis. -- So always update here if useful. let f' = if f_tagged + -- TODO: We might consisder using a subst env instead of setting the sig only for select places. then setIdTagSig f (TagSig TagProper) else f return $! StgApp f' [] ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -76,6 +76,8 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = -- dataToTag# :: a -> Int# -- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold +-- TODO: There are some more optimization ideas for this code path +-- in #21710 cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do platform <- getPlatform emitComment (mkFastString "dataToTag#") @@ -92,15 +94,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do -- the constructor index is too large to fit in the pointer and therefore -- we must look in the info table. See Note [Tagging big families]. - slow_path <- getCode $ do - tmp <- newTemp (bWord platform) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - profile <- getProfile - align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig - emitAssign (CmmLocal result_reg) - $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) - - fast_path <- getCode $ do + (fast_path :: CmmAGraph) <- getCode $ do -- Return the constructor index from the pointer tag return_ptr_tag <- getCode $ do emitAssign (CmmLocal result_reg) @@ -113,8 +107,22 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do $ getConstrTag profile align_check (cmmUntag platform amode) emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False) - - emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) + -- If we know the argument is already tagged there is no need to generate code to evaluate it + -- so we skip straight to the fast path. If we don't know if there is a tag we take the slow + -- path which evaluates the argument before fetching the tag. + case (idTagSig_maybe a) of + Just sig + | isTaggedSig sig + -> emit fast_path + _ -> do + slow_path <- getCode $ do + tmp <- newTemp (bWord platform) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + profile <- getProfile + align_check <- stgToCmmAlignCheck <$> getStgToCmmConfig + emitAssign (CmmLocal result_reg) + $ getConstrTag profile align_check (cmmUntag platform (CmmReg (CmmLocal tmp))) + emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) emitReturn [CmmReg $ CmmLocal result_reg] ===================================== docs/users_guide/bugs.rst ===================================== @@ -115,6 +115,10 @@ Lexical syntax varid → small {idchar} ⟨reservedid⟩ conid → large {idchar} +- GHC allows redundant parantheses around the function name in the `funlhs` part of declarations. + That is GHC will succeed in parsing a declaration like `((f)) x = ` for any number + of parantheses around `f`. + .. _infelicities-syntax: Context-free syntax ===================================== hadrian/bindist/Makefile ===================================== @@ -23,43 +23,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -230,12 +193,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/bindist/config.mk.in ===================================== @@ -93,9 +93,6 @@ ghcheaderdir = $(ghclibdir)/rts/include #----------------------------------------------------------------------------- # Utilities needed by the installation Makefile -GENERATED_FILE = chmod a-w -EXECUTABLE_FILE = chmod +x -CP = cp FIND = @FindCmd@ INSTALL = @INSTALL@ INSTALL := $(subst .././install-sh,$(TOP)/install-sh,$(INSTALL)) @@ -103,6 +100,8 @@ LN_S = @LN_S@ MV = mv SED = @SedCmd@ SHELL = @SHELL@ +RANLIB_CMD = @RanlibCmd@ +STRIP_CMD = @StripCmd@ # # Invocations of `install' for different classes @@ -117,9 +116,6 @@ INSTALL_MAN = $(INSTALL) -m 644 INSTALL_DOC = $(INSTALL) -m 644 INSTALL_DIR = $(INSTALL) -m 755 -d -CREATE_SCRIPT = create () { touch "$$1" && chmod 755 "$$1" ; } && create -CREATE_DATA = create () { touch "$$1" && chmod 644 "$$1" ; } && create - #----------------------------------------------------------------------------- # Build configuration ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -352,6 +352,7 @@ bindistInstallFiles = , "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/PrimOps.cmm ===================================== @@ -2801,21 +2801,6 @@ stg_getApStackValzh ( P_ ap_stack, W_ offset ) } } -// Write the cost center stack of the first argument on stderr; return -// the second. Possibly only makes sense for already evaluated -// things? -stg_traceCcszh ( P_ obj, P_ ret ) -{ - W_ ccs; - -#if defined(PROFILING) - ccs = StgHeader_ccs(UNTAG(obj)); - ccall fprintCCS_stderr(ccs "ptr"); -#endif - - jump stg_ap_0_fast(ret); -} - stg_getSparkzh () { W_ spark; ===================================== rts/RtsSymbols.c ===================================== @@ -1015,7 +1015,6 @@ extern char **environ; SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(enabled_capabilities) \ - SymI_HasDataProto(stg_traceCcszh) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -566,7 +566,6 @@ RTS_FUN_DECL(stg_numSparkszh); RTS_FUN_DECL(stg_noDuplicatezh); -RTS_FUN_DECL(stg_traceCcszh); RTS_FUN_DECL(stg_clearCCSzh); RTS_FUN_DECL(stg_traceEventzh); RTS_FUN_DECL(stg_traceBinaryEventzh); ===================================== testsuite/tests/codeGen/should_compile/T21710a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# OPTIONS_GHC -O #-} + +module M where + +import GHC.Exts + +data E = A | B | C | D | E + +foo x = + case x of + A -> 2# + B -> 42# + -- In this branch we already now `x` is evaluated, so we shouldn't generate an extra `call` for it. + _ -> dataToTag# x ===================================== testsuite/tests/codeGen/should_compile/T21710a.stderr ===================================== @@ -0,0 +1,446 @@ + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'E2_bytes" { + M.$tc'E2_bytes: + I8[] "'E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'D2_bytes" { + M.$tc'D2_bytes: + I8[] "'D" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'C2_bytes" { + M.$tc'C2_bytes: + I8[] "'C" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'B2_bytes" { + M.$tc'B2_bytes: + I8[] "'B" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tc'A3_bytes" { + M.$tc'A3_bytes: + I8[] "'A" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$tcE2_bytes" { + M.$tcE2_bytes: + I8[] "E" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule2_bytes" { + M.$trModule2_bytes: + I8[] "M" + }] + + + +==================== Output Cmm ==================== +[section ""cstring" . M.$trModule4_bytes" { + M.$trModule4_bytes: + I8[] "main" + }] + + + +==================== Output Cmm ==================== +[M.foo_entry() { // [R2] + { info_tbls: [(cBa, + label: block_cBa_info + rep: StackRep [] + srt: Nothing), + (cBi, + label: M.foo_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cBi: // global + if ((Sp + -8) < SpLim) (likely: False) goto cBj; else goto cBk; // CmmCondBranch + cBj: // global + R1 = M.foo_closure; // CmmAssign + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; // CmmCall + cBk: // global + I64[Sp - 8] = cBa; // CmmStore + R1 = R2; // CmmAssign + Sp = Sp - 8; // CmmAssign + if (R1 & 7 != 0) goto cBa; else goto cBb; // CmmCondBranch + cBb: // global + call (I64[R1])(R1) returns to cBa, args: 8, res: 8, upd: 8; // CmmCall + cBa: // global + _cBh::P64 = R1 & 7; // CmmAssign + if (_cBh::P64 != 1) goto uBz; else goto cBf; // CmmCondBranch + uBz: // global + if (_cBh::P64 != 2) goto cBe; else goto cBg; // CmmCondBranch + cBe: // global + // dataToTag# + _cBn::P64 = R1 & 7; // CmmAssign + if (_cBn::P64 == 7) (likely: False) goto cBs; else goto cBr; // CmmCondBranch + cBs: // global + _cBo::I64 = %MO_UU_Conv_W32_W64(I32[I64[R1 & (-8)] - 4]); // CmmAssign + goto cBq; // CmmBranch + cBr: // global + _cBo::I64 = _cBn::P64 - 1; // CmmAssign + goto cBq; // CmmBranch + cBq: // global + R1 = _cBo::I64; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBg: // global + R1 = 42; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + cBf: // global + R1 = 2; // CmmAssign + Sp = Sp + 8; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }, + section ""data" . M.foo_closure" { + M.foo_closure: + const M.foo_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule3_closure" { + M.$trModule3_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule4_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule1_closure" { + M.$trModule1_closure: + const GHC.Types.TrNameS_con_info; + const M.$trModule2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$trModule_closure" { + M.$trModule_closure: + const GHC.Types.Module_con_info; + const M.$trModule3_closure+1; + const M.$trModule1_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE1_closure" { + M.$tcE1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tcE2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tcE_closure" { + M.$tcE_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tcE1_closure+1; + const GHC.Types.krep$*_closure+5; + const 10475418246443540865; + const 12461417314693222409; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A1_closure" { + M.$tc'A1_closure: + const GHC.Types.KindRepTyConApp_con_info; + const M.$tcE_closure+1; + const GHC.Types.[]_closure+1; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A2_closure" { + M.$tc'A2_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'A3_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'A_closure" { + M.$tc'A_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'A2_closure+1; + const M.$tc'A1_closure+1; + const 10991425535368257265; + const 3459663971500179679; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B1_closure" { + M.$tc'B1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'B2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'B_closure" { + M.$tc'B_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'B1_closure+1; + const M.$tc'A1_closure+1; + const 13038863156169552918; + const 13430333535161531545; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C1_closure" { + M.$tc'C1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'C2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'C_closure" { + M.$tc'C_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'C1_closure+1; + const M.$tc'A1_closure+1; + const 8482817676735632621; + const 8146597712321241387; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D1_closure" { + M.$tc'D1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'D2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'D_closure" { + M.$tc'D_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'D1_closure+1; + const M.$tc'A1_closure+1; + const 7525207739284160575; + const 13746130127476219356; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E1_closure" { + M.$tc'E1_closure: + const GHC.Types.TrNameS_con_info; + const M.$tc'E2_bytes; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.$tc'E_closure" { + M.$tc'E_closure: + const GHC.Types.TyCon_con_info; + const M.$trModule_closure+1; + const M.$tc'E1_closure+1; + const M.$tc'A1_closure+1; + const 6748545530683684316; + const 10193016702094081137; + const 0; + const 3; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.A_closure" { + M.A_closure: + const M.A_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.B_closure" { + M.B_closure: + const M.B_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.C_closure" { + M.C_closure: + const M.C_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.D_closure" { + M.D_closure: + const M.D_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""data" . M.E_closure" { + M.E_closure: + const M.E_con_info; + }] + + + +==================== Output Cmm ==================== +[section ""relreadonly" . M.E_closure_tbl" { + M.E_closure_tbl: + const M.A_closure+1; + const M.B_closure+2; + const M.C_closure+3; + const M.D_closure+4; + const M.E_closure+5; + }] + + + +==================== Output Cmm ==================== +[M.A_con_entry() { // [] + { info_tbls: [(cC5, + label: M.A_con_info + rep: HeapRep 1 nonptrs { Con {tag: 0 descr:"main:M.A"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cC5: // global + R1 = R1 + 1; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.B_con_entry() { // [] + { info_tbls: [(cCa, + label: M.B_con_info + rep: HeapRep 1 nonptrs { Con {tag: 1 descr:"main:M.B"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCa: // global + R1 = R1 + 2; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.C_con_entry() { // [] + { info_tbls: [(cCf, + label: M.C_con_info + rep: HeapRep 1 nonptrs { Con {tag: 2 descr:"main:M.C"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCf: // global + R1 = R1 + 3; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.D_con_entry() { // [] + { info_tbls: [(cCk, + label: M.D_con_info + rep: HeapRep 1 nonptrs { Con {tag: 3 descr:"main:M.D"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCk: // global + R1 = R1 + 4; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + + +==================== Output Cmm ==================== +[M.E_con_entry() { // [] + { info_tbls: [(cCp, + label: M.E_con_info + rep: HeapRep 1 nonptrs { Con {tag: 4 descr:"main:M.E"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cCp: // global + R1 = R1 + 5; // CmmAssign + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; // CmmCall + } + }] + + ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -108,3 +108,4 @@ test('T18614', normal, compile, ['']) test('mk-big-obj', [unless(opsys('mingw32'), skip), pre_cmd('$PYTHON mk-big-obj.py > mk-big-obj.c')], multimod_compile, ['mk-big-obj.c', '-c -v0 -no-hs-main']) +test('T21710a', [ only_ways(['optasm']), when(wordsize(32), skip), grep_errmsg('(call)',[1]) ], compile, ['-ddump-cmm -dno-typeable-binds']) ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm ===================================== @@ -0,0 +1,46 @@ +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_f_info +.type AddMulX86_f_info, @function +AddMulX86_f_info: +.LcAx: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_f_info, .-AddMulX86_f_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_f_closure +.type AddMulX86_f_closure, @object +AddMulX86_f_closure: + .quad AddMulX86_f_info +.section .text +.align 8 +.align 8 + .quad 8589934604 + .quad 0 + .long 14 + .long 0 +.globl AddMulX86_g_info +.type AddMulX86_g_info, @function +AddMulX86_g_info: +.LcAL: + leaq (%r14,%rsi,8),%rbx + jmp *(%rbp) + .size AddMulX86_g_info, .-AddMulX86_g_info +.section .data +.align 8 +.align 1 +.globl AddMulX86_g_closure +.type AddMulX86_g_closure, @object +AddMulX86_g_closure: + .quad AddMulX86_g_info +.section .note.GNU-stack,"", at progbits +.ident "GHC 9.3.20220228" + + ===================================== testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash #-} + +module AddMulX86 where + +import GHC.Exts + +f :: Int# -> Int# -> Int# +f x y = + x +# (y *# 8#) -- Should result in a lea instruction, which we grep the assembly output for. + +g x y = + (y *# 8#) +# x -- Should result in a lea instruction, which we grep the assembly output for. ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -10,3 +10,4 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', '']) test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, '']) test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections']) +test('AddMulX86', is_amd64_codegen, compile_cmp_asm, ['hs', '-dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b230cda34119557ba4e8a01f3081d8d64ce38aaa...82eeb5f1025d1f93b287db163329ce9d715ab6e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b230cda34119557ba4e8a01f3081d8d64ce38aaa...82eeb5f1025d1f93b287db163329ce9d715ab6e1 You're receiving 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 Aug 10 13:52:23 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 Aug 2022 09:52:23 -0400 Subject: [Git][ghc/ghc][wip/T21976] 5 commits: testsuite: 21651 add test for closeFdWith + setNumCapabilities Message-ID: <62f3b817ea78e_142b49517fc4427f@gitlab.mail> Ben Gamari pushed to branch wip/T21976 at Glasgow Haskell Compiler / GHC Commits: 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - b2faa987 by Ben Gamari at 2022-08-10T09:07:15-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 30 changed files: - docs/users_guide/bugs.rst - docs/users_guide/exts/binary_literals.rst - docs/users_guide/exts/constrained_class_methods.rst - docs/users_guide/exts/constraint_kind.rst - docs/users_guide/exts/datatype_contexts.rst - docs/users_guide/exts/deriving_extra.rst - docs/users_guide/exts/duplicate_record_fields.rst - docs/users_guide/exts/empty_case.rst - docs/users_guide/exts/empty_data_deriving.rst - docs/users_guide/exts/existential_quantification.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/explicit_namespaces.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/field_selectors.rst - docs/users_guide/exts/flexible_contexts.rst - docs/users_guide/exts/functional_dependencies.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/generics.rst - docs/users_guide/exts/hex_float_literals.rst - docs/users_guide/exts/import_qualified_post.rst - docs/users_guide/exts/instances.rst - docs/users_guide/exts/kind_signatures.rst - docs/users_guide/exts/let_generalisation.rst - docs/users_guide/exts/linear_types.rst - docs/users_guide/exts/multi_param_type_classes.rst - docs/users_guide/exts/newtype_deriving.rst - docs/users_guide/exts/nk_patterns.rst - docs/users_guide/exts/nullary_type_classes.rst - docs/users_guide/exts/nullary_types.rst - docs/users_guide/exts/numeric_underscores.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e754f7ce76545ef9af12e247ed4764ee29fdf787...b2faa987c39bf344f5a4caba7c146cf01c00c306 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e754f7ce76545ef9af12e247ed4764ee29fdf787...b2faa987c39bf344f5a4caba7c146cf01c00c306 You're receiving 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 Aug 11 17:50:05 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 Aug 2022 13:50:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Note [Trimming auto-rules]: State that this improves compiler perf. Message-ID: <62f5414d94e2c_142b494c57c439659@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - 2006d9eb by Alan Zimmerman at 2022-08-11T13:49:50-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - 5a02854f by Matthew Pickering at 2022-08-11T13:49:51-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name/Reader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e4a58b0d2cc16652f1e72aaf5f2b38757a488b7...5a02854fe872f5709292ca48dbd4b0f9ce9ee9ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e4a58b0d2cc16652f1e72aaf5f2b38757a488b7...5a02854fe872f5709292ca48dbd4b0f9ce9ee9ca You're receiving 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 Aug 8 04:40:26 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 Aug 2022 00:40:26 -0400 Subject: [Git][ghc/ghc][wip/freebsd-ci] temp Message-ID: <62f093ba9b4c_25b0164c040384376@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: Ben Gamari pushed to branch wip/freebsd-ci at Glasgow Haskell Compiler / GHC Commits: bb1ec58c by Ben Gamari at 2022-08-08T00:40:20-04:00 temp - - - - - [...] Content analysis details: (7.6 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 3.4 DATE_IN_PAST_96_XX Date: is 96 hours or more before Received: date -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 -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 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: "Ben Gamari (@bgamari)" Subject: [Git][ghc/ghc][wip/freebsd-ci] temp Date: Mon, 08 Aug 2022 00:40:26 -0400 Size: 19674 URL: From gitlab at gitlab.haskell.org Fri Aug 12 23:13:05 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 12 Aug 2022 19:13:05 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble to optCoercion Message-ID: <62f6de81659e0_3d8149488506973dc@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 69767270 by Simon Peyton Jones at 2022-08-13T00:04:05+01:00 Wibble to optCoercion - - - - - 2 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkNthCo, getNthFun, nthCoRole, mkLRCo, + mkNthCo, getNthFun, getNthFromType, nthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunResCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkPhantomCo, @@ -1087,18 +1087,7 @@ mkNthCo_maybe r n co go n co | Just (ty, _) <- isReflCo_maybe co - = case splitForAllTyCoVar_maybe ty of { - Just (tv,_) | n == 0 - -> -- Works for both tyvar and covar - -- nth:0 pulls out a kind coercion from a hetero forall - assert (r == Nominal) $ - Just (mkNomReflCo (varType tv)) ; - _ -> case splitTyConApp_maybe ty of { - - Just (_, tys) | tys `lengthExceeds` n - -> Just (mkReflCo r (tys `getNth` n)) ; - - _ -> Nothing } } + = Just (mkReflCo r (getNthFromType n ty)) go 0 (ForAllCo _ kind_co _) = assert (r == Nominal) @@ -2375,7 +2364,7 @@ coercionLKind co go (InstCo aco arg) = go_app aco [go arg] go (KindCo co) = typeKind (go co) go (SubCo co) = go co - go (NthCo _ d co) = go_nth d (go co) + go (NthCo _ d co) = getNthFromType d (go co) go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos) go (AxiomRuleCo ax cos) = pFst $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos @@ -2398,14 +2387,10 @@ coercionLKind co go_app (InstCo co arg) args = go_app co (go arg:args) go_app co args = piResultTys (go co) args -go_nth :: HasDebugCallStack => Int -> Type -> Type -go_nth d ty +getNthFromType :: HasDebugCallStack => Int -> Type -> Type +getNthFromType d ty | Just (_af, mult, arg, res) <- splitFunTy_maybe ty - = case d of - 0 -> mult - 1 -> arg - 2 -> res - _ -> pprPanic "coercionKind1" bad_doc + = getNthFun d mult arg res | Just args <- tyConAppArgs_maybe ty = assertPpr (args `lengthExceeds` d) bad_doc $ @@ -2413,11 +2398,12 @@ go_nth d ty | d == 0 , Just (tv,_) <- splitForAllTyCoVar_maybe ty + -- Works for both tyvar and covar + -- nth:0 pulls out a kind coercion from a hetero forall = tyVarKind tv | otherwise - = pprPanic "coercionKind2" bad_doc - + = pprPanic "getNthFromType" bad_doc where bad_doc = ppr d $$ ppr ty @@ -2440,7 +2426,7 @@ coercionRKind co go (InstCo aco arg) = go_app aco [go arg] go (KindCo co) = typeKind (go co) go (SubCo co) = go co - go (NthCo _ d co) = go_nth d (go co) + go (NthCo _ d co) = getNthFromType d (go co) go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos) go (AxiomRuleCo ax cos) = pSnd $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Core.Unify import GHC.Types.Var.Set import GHC.Types.Var.Env +import GHC.Types.Unique.Set import GHC.Data.Pair import GHC.Data.List.SetOps ( getNth ) @@ -145,12 +146,14 @@ optCoercion' env co , text "out_ty2:" <+> ppr out_ty2 , text "in_role:" <+> ppr in_role , text "out_role:" <+> ppr out_role + , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co , text "subst:" <+> ppr env ])) - out_co + out_co | otherwise = opt_co1 lc False co where lc = mkSubstLiftingContext env + ppr_one cv = ppr cv <+> dcolon <+> ppr (coVarKind cv) type NormalCo = Coercion @@ -338,20 +341,7 @@ opt_co4 env sym rep r (TransCo co1 co2) opt_co4 env _sym rep r (NthCo _r n co) | Just (ty, _) <- isReflCo_maybe co = assert (r == _r ) $ - let arg_ty | n == 0 - , Just (tv, _) <- splitForAllTyCoVar_maybe ty - = varType tv -- works for both tyvar and covar - - | Just (_af, mult, arg, res) <- splitFunTy_maybe ty - = getNthFun n mult arg res - - | Just (_tc, args) <- splitTyConApp_maybe ty - = args `getNth` n - - | otherwise - = pprPanic "opt_co4" (ppr n $$ ppr ty) - - in liftCoSubst (chooseRole rep r) env arg_ty + liftCoSubst (chooseRole rep r) env (getNthFromType n ty) opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos)) = assert (r == r1 ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/697672709d5be6ace8e1d44c689acbf5f9b059ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/697672709d5be6ace8e1d44c689acbf5f9b059ae You're receiving 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 Aug 13 00:07:05 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Fri, 12 Aug 2022 20:07:05 -0400 Subject: [Git][ghc/ghc][wip/21611-move-corem] 5 commits: Removed CoreDoNothing and CoreDoPasses Message-ID: <62f6eb294dd3a_3d8149489906999e6@gitlab.mail> Dominik Peteler pushed to branch wip/21611-move-corem at Glasgow Haskell Compiler / GHC Commits: 11c0b085 by Dominik Peteler at 2022-08-13T02:06:16+02:00 Removed CoreDoNothing and CoreDoPasses Rewrote the getCoreToDo function using a Writer monad. This makes these data constructors superfluous. - - - - - 6507925f by Dominik Peteler at 2022-08-13T02:06:26+02:00 Renamed endPassIO to endPass - - - - - 8de857c4 by Dominik Peteler at 2022-08-13T02:06:27+02:00 Renamed hscSimplify/hscSimplify' to optimizeCoreIO/optimizeCoreHsc - - - - - 5f7bcd6d by Dominik Peteler at 2022-08-13T02:06:27+02:00 Run simplifyPgm in SimplCountM - - - - - dd0a2286 by Dominik Peteler at 2022-08-13T02:06:28+02:00 Added note on the architecture of the Core optimizer - - - - - 12 changed files: - compiler/GHC.hs - compiler/GHC/Core/EndPass.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt.hs - compiler/GHC/Core/Opt/Config.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/Core/EndPass.hs - compiler/GHC/Driver/Config/Core/Opt.hs - compiler/GHC/Driver/Core/Opt.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -1285,7 +1285,7 @@ compileCore simplify fn = do hsc_env <- getSession simpl_guts <- liftIO $ do plugins <- readIORef (tcg_th_coreplugins tcg) - hscSimplify hsc_env plugins mod_guts + optimizeCoreIO hsc_env plugins mod_guts tidy_guts <- liftIO $ hscTidy hsc_env simpl_guts return $ Left tidy_guts else ===================================== compiler/GHC/Core/EndPass.hs ===================================== @@ -10,7 +10,7 @@ compilation pass that returns Core. Heavily leverages `GHC.Core.Lint`. module GHC.Core.EndPass ( EndPassConfig (..), - endPassIO, + endPass, dumpPassResult ) where @@ -57,12 +57,14 @@ data EndPassConfig = EndPassConfig , ep_passDetails :: !SDoc } -endPassIO :: Logger - -> EndPassConfig - -> CoreProgram -> [CoreRule] - -> IO () --- Used by the IO-is CorePrep too -endPassIO logger cfg binds rules +-- | Check the correctness of a Core program after running an optimization pass. +-- Used by CorePrep too. +-- See Note [The architecture of the Core optimizer]. +endPass :: Logger + -> EndPassConfig + -> CoreProgram -> [CoreRule] + -> IO () +endPass logger cfg binds rules = do { dumpPassResult logger (ep_dumpCoreSizes cfg) (ep_printUnqual cfg) mb_flag (renderWithContext defaultSDocContext (ep_prettyPass cfg)) (ep_passDetails cfg) binds rules ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -9,6 +9,7 @@ A ``lint'' pass to check for Core correctness. See Note [Core Lint guarantee]. +See Note [The architecture of the Core optimizer]. -} module GHC.Core.Lint ( ===================================== compiler/GHC/Core/Opt.hs ===================================== @@ -1,7 +1,7 @@ {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -\section[SimplCore]{Driver for simplifying @Core@ programs} +\section[GHC.Core.Opt]{Driver for optimizing @Core@ programs} -} {-# LANGUAGE CPP #-} @@ -11,7 +11,7 @@ module GHC.Core.Opt ( CoreOptEnv (..), runCorePasses ) where import GHC.Prelude import GHC.Core -import GHC.Core.EndPass ( EndPassConfig, endPassIO ) +import GHC.Core.EndPass ( EndPassConfig, endPass ) import GHC.Core.Opt.CSE ( cseProgram ) import GHC.Core.Ppr ( pprCoreBindings ) import GHC.Core.Lint ( LintAnnotationsConfig, DebugSetting(..), lintAnnots ) @@ -30,7 +30,7 @@ import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.SpecConstr ( specConstrProgram ) import GHC.Core.Opt.Specialise ( specProgram ) import GHC.Core.Opt.StaticArgs ( doStaticArgs ) -import GHC.Core.Opt.Stats ( SimplCountM, addCounts ) +import GHC.Core.Opt.Stats ( SimplCountM ) import GHC.Core.Opt.WorkWrap ( wwTopBinds ) import GHC.Core.LateCC ( addLateCostCentresMG ) import GHC.Core.Rules ( extendRuleBaseList, extendRuleEnv ) @@ -87,6 +87,7 @@ data CoreOptEnv = CoreOptEnv -- creation of the '[CoreToDo]') happens in -- 'GHC.Driver.Config.Core.Opt'. Then this function "executes" that -- plan. +-- See Note [The architecture of the Core optimizer]. runCorePasses :: CoreOptEnv -> [CoreToDo] -> ModGuts @@ -95,8 +96,6 @@ runCorePasses env passes guts = foldM do_pass guts passes where do_pass :: ModGuts -> CoreToDo -> SimplCountM ModGuts - do_pass res CoreDoNothing = return res - do_pass guts (CoreDoPasses ps) = runCorePasses env ps guts do_pass guts pass = do let end_pass_cfg = co_endPassCfg env pass let lint_anno_cfg = co_lintAnnotationsCfg env pass @@ -106,7 +105,7 @@ runCorePasses env passes guts withTiming (co_logger env) (ppr pass <+> brackets (ppr this_mod)) (const ()) $ do guts' <- lintAnnots (co_logger env) lint_anno_cfg doCorePassWithoutDebug guts - liftIO $ endPassIO (co_logger env) end_pass_cfg (mg_binds guts') (mg_rules guts') + liftIO $ endPass (co_logger env) end_pass_cfg (mg_binds guts') (mg_rules guts') return guts' this_mod = mg_module guts @@ -128,10 +127,8 @@ doCorePass env pass guts = do let !read_ruleenv = readRuleEnv env guts case pass of - CoreDoSimplify opts -> {-# SCC "Simplify" #-} do - (guts', sc) <- liftIO $ simplifyPgm (co_logger env) read_ruleenv (co_unitEnv env) opts guts - addCounts sc - return guts' + CoreDoSimplify opts -> {-# SCC "Simplify" #-} + simplifyPgm (co_logger env) read_ruleenv (co_unitEnv env) opts guts CoreCSE -> {-# SCC "CommonSubExpr" #-} updateBinds cseProgram @@ -183,10 +180,6 @@ doCorePass env pass guts = do CoreDoRuleCheck opts -> {-# SCC "RuleCheck" #-} liftIO $ ruleCheckPass (co_logger env) opts (co_hptRuleBase env) (co_visOrphans env) guts - CoreDoNothing -> return guts - - CoreDoPasses passes -> runCorePasses env passes guts - CoreDoPluginPass _ p -> {-# SCC "Plugin" #-} co_liftCoreM env (co_debugSetting env) guts $ p guts where ===================================== compiler/GHC/Core/Opt/Config.hs ===================================== @@ -34,10 +34,10 @@ import GHC.Utils.Outputable as Outputable -- | A description of the plugin pass itself type CorePluginPass = ModGuts -> CoreM ModGuts -data CoreToDo -- These are diff core-to-core passes, - -- which may be invoked in any order, - -- as many times as you like. - +-- | These are diff core-to-core passes, which may be invoked in any order, as +-- many times as you like. +-- See Note [The architecture of the Core optimizer]. +data CoreToDo = -- | The core-to-core simplifier. CoreDoSimplify !SimplifyOpts | CoreDoPluginPass String CorePluginPass @@ -55,11 +55,6 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoSpecConstr !SpecConstrOpts | CoreCSE | CoreDoRuleCheck !RuleCheckOpts - | -- | Useful when building up - CoreDoNothing - | -- | lists of these things - CoreDoPasses [CoreToDo] - | CoreAddCallerCcs !CallerCCOpts | CoreAddLateCcs !Bool -- ^ '-fprof-count-entries' @@ -82,8 +77,6 @@ instance Outputable CoreToDo where ppr (CoreAddLateCcs _) = text "Add late core cost-centres" ppr CoreDoPrintCore = text "Print core" ppr (CoreDoRuleCheck {}) = text "Rule check" - ppr CoreDoNothing = text "CoreDoNothing" - ppr (CoreDoPasses passes) = text "CoreDoPasses" <+> ppr passes pprPassDetails :: CoreToDo -> SDoc pprPassDetails (CoreDoSimplify cfg) = vcat [ text "Max iterations =" <+> int n ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules import GHC.Core.Opt.Simplify.Utils ( activeRule, activeUnfolding ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Monad -import GHC.Core.Opt.Stats ( simplCountN ) +import GHC.Core.Opt.Stats ( SimplCountM, addCounts, simplCountN ) import GHC.Core.FamInstEnv import GHC.Utils.Error ( withTiming ) @@ -44,6 +44,7 @@ import GHC.Types.Unique.FM import GHC.Types.Name.Ppr import Control.Monad +import Control.Monad.IO.Class ( liftIO ) import Data.Foldable ( for_ ) #if __GLASGOW_HASKELL__ <= 810 @@ -144,9 +145,20 @@ simplifyPgm :: Logger -> UnitEnv -> SimplifyOpts -> ModGuts - -> IO (ModGuts, SimplCount) -- New bindings - -simplifyPgm logger read_ruleenv unit_env opts + -> SimplCountM ModGuts -- New bindings +simplifyPgm logger read_ruleenv unit_env opts guts = do + (nguts, sc) <- liftIO $ simplifyPgmIO logger read_ruleenv unit_env opts guts + addCounts sc + return nguts + +simplifyPgmIO :: Logger + -> IO RuleEnv -- ^ Action to get the current RuleEnv + -> UnitEnv + -> SimplifyOpts + -> ModGuts + -> IO (ModGuts, SimplCount) -- New bindings + +simplifyPgmIO logger read_ruleenv unit_env opts guts@(ModGuts { mg_module = this_mod , mg_rdr_env = rdr_env , mg_binds = binds, mg_rules = rules ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -32,7 +32,7 @@ import GHC.Builtin.Types import GHC.Core.Utils import GHC.Core.Opt.Arity -import GHC.Core.EndPass ( EndPassConfig(..), endPassIO ) +import GHC.Core.EndPass ( EndPassConfig(..), endPass ) import GHC.Core import GHC.Core.Make hiding( FloatBind(..) ) -- We use our own FloatBind here import GHC.Core.Type @@ -258,8 +258,7 @@ corePrepPgm logger cp_cfg pgm_cfg floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds return (deFloatTop (floats1 `appendFloats` floats2)) - endPassIO logger (cpPgm_endPassConfig pgm_cfg) - binds_out [] + endPass logger (cpPgm_endPassConfig pgm_cfg) binds_out [] return binds_out corePrepExpr :: Logger -> CorePrepConfig -> CoreExpr -> IO CoreExpr ===================================== compiler/GHC/Driver/Config/Core/EndPass.hs ===================================== @@ -46,5 +46,3 @@ coreDumpFlag (CoreAddCallerCcs {}) = Nothing coreDumpFlag (CoreAddLateCcs {}) = Nothing coreDumpFlag CoreDoPrintCore = Nothing coreDumpFlag (CoreDoRuleCheck {}) = Nothing -coreDumpFlag CoreDoNothing = Nothing -coreDumpFlag (CoreDoPasses {}) = Nothing ===================================== compiler/GHC/Driver/Config/Core/Opt.hs ===================================== @@ -1,7 +1,7 @@ {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -\section[SimplCore]{Configuration of the driver for simplifying @Core@ programs} +\section[GHC.Driver.Config.Core.Opt]{Configuration of the driver for optimizing @Core@ programs} -} {-# LANGUAGE CPP #-} @@ -29,6 +29,10 @@ import GHC.Types.Var ( Var ) import qualified GHC.LanguageExtensions as LangExt +import Control.Monad +import Control.Monad.Trans.Writer.Strict ( Writer, execWriter, tell ) +import Data.Foldable + {- ************************************************************************ * * @@ -37,9 +41,187 @@ import qualified GHC.LanguageExtensions as LangExt ************************************************************************ -} +-- | Construct the main optimisation pipeline from the driver's session state. +-- See Note [The architecture of the Core optimizer]. getCoreToDo :: DynFlags -> [Var] -> [CoreToDo] -getCoreToDo dflags extra_vars - = flatten_todos core_todo +getCoreToDo dflags extra_vars = execWriter $ do + -- We want to do the static argument transform before full laziness as it + -- may expose extra opportunities to float things outwards. However, to fix + -- up the output of the transformation we need at do at least one simplify + -- after this before anything else + when static_args $ do + simpl_gently + enqueue CoreDoStaticArgs + + -- initial simplify: make specialiser happy: minimum effort please + when do_presimplify $ + simpl_gently + + -- Specialisation is best done before full laziness + -- so that overloaded functions have all their dictionary lambdas manifest + when do_specialise $ + enqueue $ coreDoSpecialising dflags + + if full_laziness then + -- Was: gentleFloatOutSwitches + -- + -- I have no idea why, but not floating constants to + -- top level is very bad in some cases. + -- + -- Notably: p_ident in spectral/rewrite + -- Changing from "gentle" to "constantsOnly" + -- improved rewrite's allocation by 19%, and + -- made 0.0% difference to any other nofib + -- benchmark + -- + -- Not doing floatOutOverSatApps yet, we'll do + -- that later on when we've had a chance to get more + -- accurate arity information. In fact it makes no + -- difference at all to performance if we do it here, + -- but maybe we save some unnecessary to-and-fro in + -- the simplifier. + enqueue $ CoreDoFloatOutwards FloatOutSwitches + { floatOutLambdas = Just 0 + , floatOutConstants = True + , floatOutOverSatApps = False + , floatToTopLevelOnly = False + } + + else + -- Even with full laziness turned off, we still need to float static + -- forms to the top level. See Note [Grand plan for static forms] in + -- GHC.Iface.Tidy.StaticPtrTable. + -- + when static_ptrs $ do + -- Float Out can't handle type lets (sometimes created + -- by simpleOptPgm via mkParallelBindings) + simpl_gently + -- Static forms are moved to the top level with the FloatOut pass. + -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. + enqueue $ CoreDoFloatOutwards FloatOutSwitches + { floatOutLambdas = Just 0 + , floatOutConstants = True + , floatOutOverSatApps = False + , floatToTopLevelOnly = True + } + + -- Run the simplier phases 2,1,0 to allow rewrite rules to fire + when do_simpl3 $ do + for_ [phases, phases-1 .. 1] $ \phase -> + simpl_phase (Phase phase) "main" max_iter + + -- Phase 0: allow all Ids to be inlined now + -- This gets foldr inlined before strictness analysis + + -- At least 3 iterations because otherwise we land up with + -- huge dead expressions because of an infelicity in the + -- simplifier. + -- let k = BIG in foldr k z xs + -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs + -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs + -- Don't stop now! + simpl_phase (Phase 0) "main" (max max_iter 3) + + -- Run float-inwards immediately before the strictness analyser + -- Doing so pushes bindings nearer their use site and hence makes + -- them more likely to be strict. These bindings might only show + -- up after the inlining from simplification. Example in fulsom, + -- Csg.calc, where an arg of timesDouble thereby becomes strict. + when do_float_in $ + enqueue $ CoreDoFloatInwards platform + + when call_arity $ do + enqueue CoreDoCallArity + simplify "post-call-arity" + + -- Strictness analysis + when strictness $ do + dmd_cpr_ww + simplify "post-worker-wrapper" + + -- See Note [Placement of the exitification pass] + when exitification $ + enqueue CoreDoExitify + + when full_laziness $ + enqueue $ CoreDoFloatOutwards FloatOutSwitches + { floatOutLambdas = floatLamArgs dflags + , floatOutConstants = True + , floatOutOverSatApps = True + , floatToTopLevelOnly = False + } + -- nofib/spectral/hartel/wang doubles in speed if you + -- do full laziness late in the day. It only happens + -- after fusion and other stuff, so the early pass doesn't + -- catch it. For the record, the redex is + -- f_el22 (f_el21 r_midblock) + + -- We want CSE to follow the final full-laziness pass, because it may + -- succeed in commoning up things floated out by full laziness. + -- CSE used to rely on the no-shadowing invariant, but it doesn't any more + when cse $ + enqueue CoreCSE + + when do_float_in $ + enqueue $ CoreDoFloatInwards platform + + -- Final tidy-up + simplify "final" + + maybe_rule_check FinalPhase + + -------- After this we have -O2 passes ----------------- + -- None of them run with -O + + -- Case-liberation for -O2. This should be after + -- strictness analysis and the simplification which follows it. + when liberate_case $ do + enqueue $ CoreLiberateCase (initLiberateCaseOpts dflags) + -- Run the simplifier after LiberateCase to vastly + -- reduce the possibility of shadowing + -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr + simplify "post-liberate-case" + + when spec_constr $ do + enqueue $ CoreDoSpecConstr (initSpecConstrOpts dflags) + -- See Note [Simplify after SpecConstr] + simplify "post-spec-constr" + + maybe_rule_check FinalPhase + + when late_specialise $ do + enqueue $ coreDoSpecialising dflags + simplify "post-late-spec" + + -- LiberateCase can yield new CSE opportunities because it peels + -- off one layer of a recursive function (concretely, I saw this + -- in wheel-sieve1), and I'm guessing that SpecConstr can too + -- And CSE is a very cheap pass. So it seems worth doing here. + when ((liberate_case || spec_constr) && cse) $ do + enqueue CoreCSE + simplify "post-final-cse" + + --------- End of -O2 passes -------------- + + when late_dmd_anal $ do + dmd_cpr_ww + simplify "post-late-ww" + + -- Final run of the demand_analyser, ensures that one-shot thunks are + -- really really one-shot thunks. Only needed if the demand analyser + -- has run at all. See Note [Final Demand Analyser run] in GHC.Core.Opt.DmdAnal + -- It is EXTREMELY IMPORTANT to run this pass, otherwise execution + -- can become /exponentially/ more expensive. See #11731, #12996. + when (strictness || late_dmd_anal) $ + enqueue $ coreDoDemand dflags + + maybe_rule_check FinalPhase + + when profiling $ do + when (not (null $ callerCcFilters dflags)) $ + enqueue $ CoreAddCallerCcs (initCallerCCOpts dflags) + when (gopt Opt_ProfLateInlineCcs dflags) $ + enqueue $ CoreAddLateCcs (gopt Opt_ProfCountEntries dflags) where phases = simplPhases dflags max_iter = maxSimplIterations dflags @@ -66,228 +248,39 @@ getCoreToDo dflags extra_vars do_presimplify = do_specialise -- TODO: any other optimizations benefit from pre-simplification? do_simpl3 = const_fold || rules_on -- TODO: any other optimizations benefit from three-phase simplification? - maybe_rule_check phase = runMaybe rule_check $ - CoreDoRuleCheck . initRuleCheckOpts dflags phase + maybe_rule_check phase = for_ rule_check $ + enqueue . CoreDoRuleCheck . initRuleCheckOpts dflags phase maybe_strictness_before (Phase phase) - | phase `elem` strictnessBefore dflags = coreDoDemand dflags - maybe_strictness_before _ - = CoreDoNothing + | phase `elem` strictnessBefore dflags = enqueue $ coreDoDemand dflags + maybe_strictness_before _ = return () - simpl_phase phase name iter - = CoreDoPasses - $ [ maybe_strictness_before phase - , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter - (initSimplMode dflags phase name) - , maybe_rule_check phase ] + simpl_phase phase name iter = do + maybe_strictness_before phase + enqueue $ CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter + (initSimplMode dflags phase name) + maybe_rule_check phase -- Run GHC's internal simplification phase, after all rules have run. -- See Note [Compiler phases] in GHC.Types.Basic simplify name = simpl_phase FinalPhase name max_iter - -- initial simplify: mk specialiser happy: minimum effort please + -- initial simplify: make specialiser happy: minimum effort please -- See Note [Inline in InitialPhase] -- See Note [RULEs enabled in InitialPhase] - simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter - (initGentleSimplMode dflags) - - dmd_cpr_ww = [coreDoDemand dflags, CoreDoCpr] ++ - if ww_on then [CoreDoWorkerWrapper (initWorkWrapOpts dflags)] - else [] - - - demand_analyser = (CoreDoPasses ( - dmd_cpr_ww ++ - [simplify "post-worker-wrapper"] - )) - - -- Static forms are moved to the top level with the FloatOut pass. - -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. - static_ptrs_float_outwards = - runWhen static_ptrs $ CoreDoPasses - [ simpl_gently -- Float Out can't handle type lets (sometimes created - -- by simpleOptPgm via mkParallelBindings) - , CoreDoFloatOutwards FloatOutSwitches - { floatOutLambdas = Just 0 - , floatOutConstants = True - , floatOutOverSatApps = False - , floatToTopLevelOnly = True - } - ] - - add_caller_ccs = - runWhen (profiling && not (null $ callerCcFilters dflags)) $ - CoreAddCallerCcs (initCallerCCOpts dflags) - - add_late_ccs = - runWhen (profiling && gopt Opt_ProfLateInlineCcs dflags) $ - CoreAddLateCcs (gopt Opt_ProfCountEntries dflags) - - core_todo = - [ - -- We want to do the static argument transform before full laziness as it - -- may expose extra opportunities to float things outwards. However, to fix - -- up the output of the transformation we need at do at least one simplify - -- after this before anything else - runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]), - - -- initial simplify: mk specialiser happy: minimum effort please - runWhen do_presimplify simpl_gently, - - -- Specialisation is best done before full laziness - -- so that overloaded functions have all their dictionary lambdas manifest - runWhen do_specialise $ coreDoSpecialising dflags, - - if full_laziness then - CoreDoFloatOutwards FloatOutSwitches { - floatOutLambdas = Just 0, - floatOutConstants = True, - floatOutOverSatApps = False, - floatToTopLevelOnly = False } - -- Was: gentleFloatOutSwitches - -- - -- I have no idea why, but not floating constants to - -- top level is very bad in some cases. - -- - -- Notably: p_ident in spectral/rewrite - -- Changing from "gentle" to "constantsOnly" - -- improved rewrite's allocation by 19%, and - -- made 0.0% difference to any other nofib - -- benchmark - -- - -- Not doing floatOutOverSatApps yet, we'll do - -- that later on when we've had a chance to get more - -- accurate arity information. In fact it makes no - -- difference at all to performance if we do it here, - -- but maybe we save some unnecessary to-and-fro in - -- the simplifier. - else - -- Even with full laziness turned off, we still need to float static - -- forms to the top level. See Note [Grand plan for static forms] in - -- GHC.Iface.Tidy.StaticPtrTable. - static_ptrs_float_outwards, - - -- Run the simplier phases 2,1,0 to allow rewrite rules to fire - runWhen do_simpl3 - (CoreDoPasses $ [ simpl_phase (Phase phase) "main" max_iter - | phase <- [phases, phases-1 .. 1] ] ++ - [ simpl_phase (Phase 0) "main" (max max_iter 3) ]), - -- Phase 0: allow all Ids to be inlined now - -- This gets foldr inlined before strictness analysis - - -- At least 3 iterations because otherwise we land up with - -- huge dead expressions because of an infelicity in the - -- simplifier. - -- let k = BIG in foldr k z xs - -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs - -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs - -- Don't stop now! - - runWhen do_float_in (CoreDoFloatInwards platform), - -- Run float-inwards immediately before the strictness analyser - -- Doing so pushes bindings nearer their use site and hence makes - -- them more likely to be strict. These bindings might only show - -- up after the inlining from simplification. Example in fulsom, - -- Csg.calc, where an arg of timesDouble thereby becomes strict. - - runWhen call_arity $ CoreDoPasses - [ CoreDoCallArity - , simplify "post-call-arity" - ], - - -- Strictness analysis - runWhen strictness demand_analyser, - - runWhen exitification CoreDoExitify, - -- See Note [Placement of the exitification pass] - - runWhen full_laziness $ - CoreDoFloatOutwards FloatOutSwitches { - floatOutLambdas = floatLamArgs dflags, - floatOutConstants = True, - floatOutOverSatApps = True, - floatToTopLevelOnly = False }, - -- nofib/spectral/hartel/wang doubles in speed if you - -- do full laziness late in the day. It only happens - -- after fusion and other stuff, so the early pass doesn't - -- catch it. For the record, the redex is - -- f_el22 (f_el21 r_midblock) - - - runWhen cse CoreCSE, - -- We want CSE to follow the final full-laziness pass, because it may - -- succeed in commoning up things floated out by full laziness. - -- CSE used to rely on the no-shadowing invariant, but it doesn't any more - - runWhen do_float_in (CoreDoFloatInwards platform), - - simplify "final", -- Final tidy-up - - maybe_rule_check FinalPhase, - - -------- After this we have -O2 passes ----------------- - -- None of them run with -O - - -- Case-liberation for -O2. This should be after - -- strictness analysis and the simplification which follows it. - runWhen liberate_case $ CoreDoPasses - [ CoreLiberateCase (initLiberateCaseOpts dflags) - , simplify "post-liberate-case" ], - -- Run the simplifier after LiberateCase to vastly - -- reduce the possibility of shadowing - -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr - - runWhen spec_constr $ CoreDoPasses - [ CoreDoSpecConstr (initSpecConstrOpts dflags) - , simplify "post-spec-constr"], - -- See Note [Simplify after SpecConstr] - - maybe_rule_check FinalPhase, - - runWhen late_specialise $ CoreDoPasses - [ coreDoSpecialising dflags, simplify "post-late-spec"], - - -- LiberateCase can yield new CSE opportunities because it peels - -- off one layer of a recursive function (concretely, I saw this - -- in wheel-sieve1), and I'm guessing that SpecConstr can too - -- And CSE is a very cheap pass. So it seems worth doing here. - runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses - [ CoreCSE, simplify "post-final-cse" ], - - --------- End of -O2 passes -------------- - - runWhen late_dmd_anal $ CoreDoPasses ( - dmd_cpr_ww ++ [simplify "post-late-ww"] - ), - - -- Final run of the demand_analyser, ensures that one-shot thunks are - -- really really one-shot thunks. Only needed if the demand analyser - -- has run at all. See Note [Final Demand Analyser run] in GHC.Core.Opt.DmdAnal - -- It is EXTREMELY IMPORTANT to run this pass, otherwise execution - -- can become /exponentially/ more expensive. See #11731, #12996. - runWhen (strictness || late_dmd_anal) $ coreDoDemand dflags, - - maybe_rule_check FinalPhase, - - add_caller_ccs, - add_late_ccs - ] - - -- Remove 'CoreDoNothing' and flatten 'CoreDoPasses' for clarity. - flatten_todos [] = [] - flatten_todos (CoreDoNothing : rest) = flatten_todos rest - flatten_todos (CoreDoPasses passes : rest) = - flatten_todos passes ++ flatten_todos rest - flatten_todos (todo : rest) = todo : flatten_todos rest - --- The core-to-core pass ordering is derived from the DynFlags: -runWhen :: Bool -> CoreToDo -> CoreToDo -runWhen True do_this = do_this -runWhen False _ = CoreDoNothing - -runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo -runMaybe (Just x) f = f x -runMaybe Nothing _ = CoreDoNothing + simpl_gently = enqueue $ CoreDoSimplify $ + initSimplifyOpts dflags extra_vars max_iter (initGentleSimplMode dflags) + + dmd_cpr_ww = do + enqueue $ coreDoDemand dflags + enqueue CoreDoCpr + when ww_on $ + enqueue $ CoreDoWorkerWrapper (initWorkWrapOpts dflags) + + + +enqueue :: CoreToDo -> Writer [CoreToDo] () +enqueue pass = tell [pass] coreDoDemand :: DynFlags -> CoreToDo coreDoDemand dflags = CoreDoDemand $ initDmdAnalOpts dflags @@ -295,7 +288,7 @@ coreDoDemand dflags = CoreDoDemand $ initDmdAnalOpts dflags coreDoSpecialising :: DynFlags -> CoreToDo coreDoSpecialising dflags = CoreDoSpecialising (initSpecialiseOpts dflags simplMask) --- TODO DEDUp!!!! +-- TODO: Deduplication simplMask :: Char simplMask = 's' ===================================== compiler/GHC/Driver/Core/Opt.hs ===================================== @@ -1,4 +1,4 @@ -module GHC.Driver.Core.Opt ( hscSimplify, hscSimplify' ) where +module GHC.Driver.Core.Opt ( optimizeCoreHsc, optimizeCoreIO ) where import GHC.Prelude @@ -34,27 +34,27 @@ import GHC.Utils.Logger as Logger import Control.Monad.IO.Class -------------------------------------------------------------- --- Simplifiers +-- Core optimization entrypoints -------------------------------------------------------------- --- | Run Core2Core simplifier. The list of String is a list of (Core) plugin +-- | Run Core optimizer. The list of String is a list of (Core) plugin -- module names added via TH (cf 'addCorePlugin'). -hscSimplify :: HscEnv -> [String] -> ModGuts -> IO ModGuts -hscSimplify hsc_env plugins modguts = - runHsc hsc_env $ hscSimplify' plugins modguts - --- | Run Core2Core simplifier. The list of String is a list of (Core) plugin --- module names added via TH (cf 'addCorePlugin'). -hscSimplify' :: [String] -> ModGuts -> Hsc ModGuts -hscSimplify' plugins ds_result = do - hsc_env <- getHscEnv +optimizeCoreIO :: HscEnv -> [String] -> ModGuts -> IO ModGuts +optimizeCoreIO hsc_env plugins guts = do hsc_env_with_plugins <- if null plugins -- fast path then return hsc_env - else liftIO $ initializePlugins - $ hscUpdateFlags (\dflags -> foldr addPluginModuleName dflags plugins) - hsc_env + else initializePlugins + $ hscUpdateFlags (\dflags -> foldr addPluginModuleName dflags plugins) + hsc_env {-# SCC "Core2Core" #-} - liftIO $ core2core hsc_env_with_plugins ds_result + core2core hsc_env_with_plugins guts + +-- | Run Core optimizer. The list of String is a list of (Core) plugin +-- module names added via TH (cf 'addCorePlugin'). +optimizeCoreHsc :: [String] -> ModGuts -> Hsc ModGuts +optimizeCoreHsc plugins guts = do + hsc_env <- getHscEnv + liftIO $ optimizeCoreIO hsc_env plugins guts core2core :: HscEnv -> ModGuts -> IO ModGuts core2core hsc_env guts@(ModGuts { mg_module = mod @@ -84,11 +84,6 @@ core2core hsc_env guts@(ModGuts { mg_module = mod , gwib_isBoot = NotBoot }) hpt_rule_base = mkRuleBase home_pkg_rules - -- mod: get the module out of the current HscEnv so we can retrieve it from the monad. - -- This is very convienent for the users of the monad (e.g. plugins do not have to - -- consume the ModGuts to find the module) but somewhat ugly because mg_module may - -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which - -- would mean our cached value would go out of date. env = CoreOptEnv { co_logger = logger , co_debugSetting = InheritDebugLevel @@ -111,6 +106,11 @@ liftCoreMToSimplCountM hsc_env debug_settings guts m = do return a where mod = mg_module guts + -- mod: get the module out of the ModGuts so we can retrieve it from the monad. + -- This is very convienent for the users of the monad (e.g. plugins do not have to + -- consume the ModGuts to find the module) but somewhat ugly because mg_module may + -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which + -- would mean our cached value would go out of date. loc = mg_loc guts orph_mods = mkModuleSet (mod : dep_orphs (mg_deps guts)) gwib = GWIB { gwib_mod = moduleName mod, gwib_isBoot = NotBoot } @@ -122,3 +122,56 @@ liftCoreMToSimplCountM hsc_env debug_settings guts m = do NoDebugging -> let dflags' = (hsc_dflags hsc_env) { debugLevel = 0 } in hsc_env { hsc_dflags = dflags' } + +{- +Note [The architecture of the Core optimizer] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Conceptually the Core optimizer consists of two stages: + + 1. The planning stage. + 2. The execution stage. + +This division is mirrored in the interface of the different optimizations. For +each of those optimzations we have + + 1. a configuration record bundeling the options for a particular optimization + pass. + 2. an initialization function used to obtain such a configuration from + `DynFlags`. This function typically lives in a module named after the pass + in the `GHC.Driver.Config.Core.Opt` namespace and is used in the planning + stage. + 3. the actual optimization pass itself, with an entrypoint that takes the + configuration of the pass along with the execution context as arguments. + This entrypoint is called in the execution stage. + +The plan that is the result of the first stage is constructed by the +`getCoreToDo` function found in the `GHC.Driver.Config.Core.Opt` module. This +function determines the sequence of optimization passes run on the module in +question and derives the configuration for each pass from the session's state +(`DynFlags`) using the aforementioned initialization functions. The `CoreToDo` +type that is finally used to wrap this configuration value is a sum type +enumerating all the optimizations available in GHC. + +The entrypoint of the second stage are the `optimizeCore*` functions found in +GHC.Driver.Core.Opt. These functions is part of the Application Layer and +utilize the `runCorePasses` function from `GHC.Core.Opt` which is the +counterpart of these functions in the Domain Layer. In other words, while the +`optimizeCore*` know about `HscEnv` and are therefore bound to a concrete +driver, `runCorePasses` is more independent as it is a component of its own. + +`runCorePasses` is essentially an interpreter for the `CoreToDo`s constructed in +the planning phase. It calls the entrypoints of the passes with their respective +configurations as arguments as well as some execution context like the unit +environment, the rules and the type family instance in scope, and most notably +the module we wish to compile (`ModGuts`). + +A similar split in functionality is done for the Core Linting: After each pass +we may check the sanity of the resulting Core running a so-called EndPass check. +The entrypoint for this check is the `endPass` function found in +GHC.Core.EndPass. It comes as well with a configuration record and a +corresponding initialization function for it in GHC.Driver.Core.EndPass. The +definition of what actually is a correct Core program is defined by the linting +functions in GHC.Core.Lint. These are used by the EndPass to check the program. + +-} ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Driver.Main , hscTypecheckAndGetWarnings , hscDesugar , makeSimpleDetails - , hscSimplify -- ToDo, shouldn't really export this + , optimizeCoreIO -- TODO: shouldn't really export this , hscDesugarAndSimplify -- * Safe Haskell @@ -88,7 +88,7 @@ module GHC.Driver.Main , hscCompileCoreExpr' -- We want to make sure that we export enough to be able to redefine -- hsc_typecheck in client code - , hscParse', hscSimplify', hscDesugar', tcRnModule', doCodeGen + , hscParse', optimizeCoreHsc, hscDesugar', tcRnModule', doCodeGen , getHscEnv , hscSimpleIface' , oneShotMsg @@ -123,7 +123,7 @@ import GHC.Driver.Config.Stg.Ppr (initStgPprOpts) import GHC.Driver.Config.Stg.Pipeline (initStgPipelineOpts) import GHC.Driver.Config.StgToCmm (initStgToCmmConfig) import GHC.Driver.Config.Cmm (initCmmConfig) -import GHC.Driver.Core.Opt ( hscSimplify, hscSimplify' ) +import GHC.Driver.Core.Opt ( optimizeCoreHsc, optimizeCoreIO ) import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Tidy import GHC.Driver.Hooks @@ -158,7 +158,7 @@ import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result) import GHC.Iface.Ext.Debug ( diffFile, validateScopes ) import GHC.Core -import GHC.Core.EndPass ( EndPassConfig(..), endPassIO ) +import GHC.Core.EndPass ( EndPassConfig(..), endPass ) import GHC.Core.Lint ( LintFlags(..), StaticPtrCheck(..) ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Tidy ( tidyExpr ) @@ -1008,7 +1008,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h -- Just cause we desugared doesn't mean we are generating code, see above. Just desugared_guts | backendGeneratesCode bcknd -> do plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result) - simplified_guts <- hscSimplify' plugins desugared_guts + simplified_guts <- optimizeCoreHsc plugins desugared_guts (cg_guts, details) <- liftIO $ hscTidy hsc_env simplified_guts @@ -2098,7 +2098,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Simplify -} simpl_mg <- liftIO $ do plugins <- readIORef (tcg_th_coreplugins tc_gblenv) - hscSimplify hsc_env plugins ds_result + optimizeCoreIO hsc_env plugins ds_result {- Tidy -} (tidy_cg, mod_details) <- liftIO $ hscTidy hsc_env simpl_mg @@ -2317,7 +2317,7 @@ hscTidy hsc_env guts = do , ep_prettyPass = tidy_ppr , ep_passDetails = empty } - endPassIO logger tidy_cfg all_tidy_binds tidy_rules + endPass logger tidy_cfg all_tidy_binds tidy_rules -- If the endPass didn't print the rules, but ddump-rules is -- on, print now ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -48,7 +48,7 @@ import GHC.Core.Type import GHC.Core.TyCon ( tyConDataCons ) import GHC.Core import GHC.Core.FVs ( exprsSomeFreeVarsList ) -import GHC.Core.EndPass ( EndPassConfig(..), endPassIO ) +import GHC.Core.EndPass ( EndPassConfig(..), endPass ) import GHC.Core.Lint ( LintFlags(..) ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr ) @@ -240,7 +240,7 @@ deSugar hsc_env , ep_prettyPass = desugar_before_ppr , ep_passDetails = empty } - ; endPassIO (hsc_logger hsc_env) desugar_before_cfg final_pgm rules_for_imps + ; endPass (hsc_logger hsc_env) desugar_before_cfg final_pgm rules_for_imps ; let simpl_opts = initSimpleOpts dflags ; let (ds_binds, ds_rules_for_imps, occ_anald_binds) @@ -267,7 +267,7 @@ deSugar hsc_env , ep_prettyPass = desugar_after_ppr , ep_passDetails = empty } - ; endPassIO (hsc_logger hsc_env) desugar_after_cfg ds_binds ds_rules_for_imps + ; endPass (hsc_logger hsc_env) desugar_after_cfg ds_binds ds_rules_for_imps ; let used_names = mkUsedNames tcg_env pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5af6eb1172804ac05d7f5b0b0f7151e64df14fb9...dd0a2286a2a9abb93e4984e2441c31967f4e57a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5af6eb1172804ac05d7f5b0b0f7151e64df14fb9...dd0a2286a2a9abb93e4984e2441c31967f4e57a5 You're receiving 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 Aug 13 08:57:38 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Sat, 13 Aug 2022 04:57:38 -0400 Subject: [Git][ghc/ghc][wip/ghc-fat-interface] 2 commits: Fat Interface Files Message-ID: <62f767823b109_3d814948878726929@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC Commits: dd5a0897 by Matthew Pickering at 2022-08-13T09:57:32+01:00 Fat Interface Files This commit adds three new flags * -fwrite-fat-interface: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for a fat interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of fat interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 87339811 by Matthew Pickering at 2022-08-13T09:57:32+01:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - 30 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Backpack.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/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Unit/Home/ModInfo.hs - + compiler/GHC/Unit/Module/FatIface.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Status.hs - compiler/ghc.cabal.in - docs/users_guide/phases.rst - ghc/GHCi/Leak.hs - ghc/Main.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T20300/T20300.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51f6ab03a43df1a3eb422e9688b90518c40331ed...8733981155a47e18f3d25f1c40fd525168641928 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51f6ab03a43df1a3eb422e9688b90518c40331ed...8733981155a47e18f3d25f1c40fd525168641928 You're receiving 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 Aug 13 11:02:21 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 13 Aug 2022 07:02:21 -0400 Subject: [Git][ghc/ghc][wip/andreask/infer_exprs] 2 commits: Tag inference: Fix #21954 by retaining tagsigs of vars in function position. Message-ID: <62f784bd7a0d8_3d8149488a073714@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/infer_exprs at Glasgow Haskell Compiler / GHC Commits: 18eaf69f by Andreas Klebinger at 2022-08-13T13:01:46+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - ac810f99 by Andreas Klebinger at 2022-08-13T13:01:53+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 4 changed files: - compiler/GHC/Stg/InferTags/Rewrite.hs - testsuite/tests/simplStg/should_compile/all.T - + testsuite/tests/simplStg/should_compile/inferTags002.hs - + testsuite/tests/simplStg/should_compile/inferTags002.stderr Changes: ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -128,7 +128,7 @@ getMap :: RM (UniqFM Id TagSig) getMap = RM $ ((\(fst,_,_,_) -> fst) <$> get) setMap :: (UniqFM Id TagSig) -> RM () -setMap m = RM $ do +setMap !m = RM $ do (_,us,mod,lcls) <- get put (m, us,mod,lcls) @@ -139,7 +139,7 @@ getFVs :: RM IdSet getFVs = RM $ ((\(_,_,_,lcls) -> lcls) <$> get) setFVs :: IdSet -> RM () -setFVs fvs = RM $ do +setFVs !fvs = RM $ do (tag_map,us,mod,_lcls) <- get put (tag_map, us,mod,fvs) @@ -195,9 +195,9 @@ withBinders NotTopLevel sigs cont = do withClosureLcls :: DIdSet -> RM a -> RM a withClosureLcls fvs act = do old_fvs <- getFVs - let fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs + let !fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs setFVs fvs' - r <- act + !r <- act setFVs old_fvs return r @@ -206,9 +206,9 @@ withClosureLcls fvs act = do withLcl :: Id -> RM a -> RM a withLcl fv act = do old_fvs <- getFVs - let fvs' = extendVarSet old_fvs fv + let !fvs' = extendVarSet old_fvs fv setFVs fvs' - r <- act + !r <- act setFVs old_fvs return r @@ -222,7 +222,7 @@ isTagged v = do | otherwise -> do -- Local binding !s <- getMap let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v - return $ case sig of + return $! case sig of TagSig info -> case info of TagDunno -> False @@ -234,7 +234,7 @@ isTagged v = do , isNullaryRepDataCon con -> return True | Just lf_info <- idLFInfo_maybe v - -> return $ + -> return $! -- Can we treat the thing as tagged based on it's LFInfo? case lf_info of -- Function, applied not entered. @@ -336,7 +336,7 @@ rewriteRhs (_id, _tagSig) (StgRhsCon ccs con cn ticks args) = {-# SCC rewriteRhs rewriteRhs _binding (StgRhsClosure fvs ccs flag args body) = do withBinders NotTopLevel args $ withClosureLcls fvs $ - StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr False body + StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr body -- return (closure) fvArgs :: [StgArg] -> RM DVarSet @@ -345,40 +345,36 @@ fvArgs args = do -- pprTraceM "fvArgs" (text "args:" <> ppr args $$ text "lcls:" <> pprVarSet (fv_lcls) (braces . fsep . map ppr) ) return $ mkDVarSet [ v | StgVarArg v <- args, elemVarSet v fv_lcls] -type IsScrut = Bool - rewriteArgs :: [StgArg] -> RM [StgArg] rewriteArgs = mapM rewriteArg rewriteArg :: StgArg -> RM StgArg rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v rewriteArg (lit at StgLitArg{}) = return lit --- Attach a tagSig if it's tagged rewriteId :: Id -> RM Id rewriteId v = do - is_tagged <- isTagged v + !is_tagged <- isTagged v if is_tagged then return $! setIdTagSig v (TagSig TagProper) else return v -rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr -rewriteExpr _ (e at StgCase {}) = rewriteCase e -rewriteExpr _ (e at StgLet {}) = rewriteLet e -rewriteExpr _ (e at StgLetNoEscape {}) = rewriteLetNoEscape e -rewriteExpr isScrut (StgTick t e) = StgTick t <$!> rewriteExpr isScrut e -rewriteExpr _ e@(StgConApp {}) = rewriteConApp e - -rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e -rewriteExpr _ (StgLit lit) = return $! (StgLit lit) -rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do +rewriteExpr :: InferStgExpr -> RM TgStgExpr +rewriteExpr (e at StgCase {}) = rewriteCase e +rewriteExpr (e at StgLet {}) = rewriteLet e +rewriteExpr (e at StgLetNoEscape {}) = rewriteLetNoEscape e +rewriteExpr (StgTick t e) = StgTick t <$!> rewriteExpr e +rewriteExpr e@(StgConApp {}) = rewriteConApp e +rewriteExpr e@(StgApp {}) = rewriteApp e +rewriteExpr (StgLit lit) = return $! (StgLit lit) +rewriteExpr (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty -rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) +rewriteExpr (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ pure StgCase <*> - rewriteExpr True scrut <*> + rewriteExpr scrut <*> pure (fst bndr) <*> pure alt_type <*> mapM rewriteAlt alts @@ -388,7 +384,7 @@ rewriteCase _ = panic "Impossible: nodeCase" rewriteAlt :: InferStgAlt -> RM TgStgAlt rewriteAlt alt at GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs} = withBinders NotTopLevel bndrs $ do - !rhs' <- rewriteExpr False rhs + !rhs' <- rewriteExpr rhs return $! alt {alt_bndrs = map fst bndrs, alt_rhs = rhs'} rewriteLet :: InferStgExpr -> RM TgStgExpr @@ -396,7 +392,7 @@ rewriteLet (StgLet xt bind expr) = do (!bind') <- rewriteBinds NotTopLevel bind withBind NotTopLevel bind $ do -- pprTraceM "withBindLet" (ppr $ bindersOfX bind) - !expr' <- rewriteExpr False expr + !expr' <- rewriteExpr expr return $! (StgLet xt bind' expr') rewriteLet _ = panic "Impossible" @@ -404,7 +400,7 @@ rewriteLetNoEscape :: InferStgExpr -> RM TgStgExpr rewriteLetNoEscape (StgLetNoEscape xt bind expr) = do (!bind') <- rewriteBinds NotTopLevel bind withBind NotTopLevel bind $ do - !expr' <- rewriteExpr False expr + !expr' <- rewriteExpr expr return $! (StgLetNoEscape xt bind' expr') rewriteLetNoEscape _ = panic "Impossible" @@ -424,19 +420,12 @@ rewriteConApp (StgConApp con cn args tys) = do rewriteConApp _ = panic "Impossible" --- Special case: Expressions like `case x of { ... }` -rewriteApp :: IsScrut -> InferStgExpr -> RM TgStgExpr -rewriteApp True (StgApp f []) = do - -- pprTraceM "rewriteAppScrut" (ppr f) - f_tagged <- isTagged f - -- isTagged looks at more than the result of our analysis. - -- So always update here if useful. - let f' = if f_tagged - -- TODO: We might consisder using a subst env instead of setting the sig only for select places. - then setIdTagSig f (TagSig TagProper) - else f +-- Special case: Atomic binders, usually in a case context like `case f of ...`. +rewriteApp :: InferStgExpr -> RM TgStgExpr +rewriteApp (StgApp f []) = do + f' <- rewriteId f return $! StgApp f' [] -rewriteApp _ (StgApp f args) +rewriteApp (StgApp f args) -- pprTrace "rewriteAppOther" (ppr f <+> ppr args) False -- = undefined | Just marks <- idCbvMarks_maybe f @@ -457,8 +446,8 @@ rewriteApp _ (StgApp f args) cbvArgIds = [x | StgVarArg x <- map fstOf3 cbvArgInfo] :: [Id] mkSeqs args cbvArgIds (\cbv_args -> StgApp f cbv_args) -rewriteApp _ (StgApp f args) = return $ StgApp f args -rewriteApp _ _ = panic "Impossible" +rewriteApp (StgApp f args) = return $ StgApp f args +rewriteApp _ = panic "Impossible" -- `mkSeq` x x' e generates `case x of x' -> e` -- We could also substitute x' for x in e but that's so rarely beneficial ===================================== testsuite/tests/simplStg/should_compile/all.T ===================================== @@ -11,3 +11,4 @@ setTestOpts(f) test('T13588', [ grep_errmsg('case') ] , compile, ['-dverbose-stg2stg -fno-worker-wrapper']) test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typeable-binds']) +test('inferTags002', [ only_ways(['optasm']), grep_errmsg('(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O']) ===================================== testsuite/tests/simplStg/should_compile/inferTags002.hs ===================================== @@ -0,0 +1,7 @@ +module M where + +data T a = MkT !Bool !a + +-- The rhs of the case alternative should not result in a call std_ap_0_fast. +f x = case x of + MkT y z -> z ===================================== testsuite/tests/simplStg/should_compile/inferTags002.stderr ===================================== @@ -0,0 +1,171 @@ + +==================== Output Cmm ==================== +[M.$WMkT_entry() { // [R3, R2] + { info_tbls: [(cym, + label: block_cym_info + rep: StackRep [False] + srt: Nothing), + (cyp, + label: M.$WMkT_info + rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } + srt: Nothing), + (cys, + label: block_cys_info + rep: StackRep [False] + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cyp: // global + if ((Sp + -16) < SpLim) (likely: False) goto cyv; else goto cyw; + cyv: // global + R1 = M.$WMkT_closure; + call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; + cyw: // global + I64[Sp - 16] = cym; + R1 = R2; + P64[Sp - 8] = R3; + Sp = Sp - 16; + if (R1 & 7 != 0) goto cym; else goto cyn; + cyn: // global + call (I64[R1])(R1) returns to cym, args: 8, res: 8, upd: 8; + cym: // global + I64[Sp] = cys; + _sy8::P64 = R1; + R1 = P64[Sp + 8]; + P64[Sp + 8] = _sy8::P64; + call stg_ap_0_fast(R1) returns to cys, args: 8, res: 8, upd: 8; + cys: // global + Hp = Hp + 24; + if (Hp > HpLim) (likely: False) goto cyA; else goto cyz; + cyA: // global + HpAlloc = 24; + call stg_gc_unpt_r1(R1) returns to cys, args: 8, res: 8, upd: 8; + cyz: // global + I64[Hp - 16] = M.MkT_con_info; + P64[Hp - 8] = P64[Sp + 8]; + P64[Hp] = R1; + R1 = Hp - 15; + Sp = Sp + 16; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }, + section ""data" . M.$WMkT_closure" { + M.$WMkT_closure: + const M.$WMkT_info; + }] + + + +==================== Output Cmm ==================== +[M.f_entry() { // [R2] + { info_tbls: [(cyK, + label: block_cyK_info + rep: StackRep [] + srt: Nothing), + (cyN, + label: M.f_info + rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cyN: // global + if ((Sp + -8) < SpLim) (likely: False) goto cyO; else goto cyP; + cyO: // global + R1 = M.f_closure; + call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; + cyP: // global + I64[Sp - 8] = cyK; + R1 = R2; + Sp = Sp - 8; + if (R1 & 7 != 0) goto cyK; else goto cyL; + cyL: // global + call (I64[R1])(R1) returns to cyK, args: 8, res: 8, upd: 8; + cyK: // global + R1 = P64[R1 + 15]; + Sp = Sp + 8; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }, + section ""data" . M.f_closure" { + M.f_closure: + const M.f_info; + }] + + + +==================== Output Cmm ==================== +[M.MkT_entry() { // [R3, R2] + { info_tbls: [(cz1, + label: block_cz1_info + rep: StackRep [False] + srt: Nothing), + (cz4, + label: M.MkT_info + rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } + srt: Nothing), + (cz7, + label: block_cz7_info + rep: StackRep [False] + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + cz4: // global + if ((Sp + -16) < SpLim) (likely: False) goto cza; else goto czb; + cza: // global + R1 = M.MkT_closure; + call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; + czb: // global + I64[Sp - 16] = cz1; + R1 = R2; + P64[Sp - 8] = R3; + Sp = Sp - 16; + if (R1 & 7 != 0) goto cz1; else goto cz2; + cz2: // global + call (I64[R1])(R1) returns to cz1, args: 8, res: 8, upd: 8; + cz1: // global + I64[Sp] = cz7; + _tyf::P64 = R1; + R1 = P64[Sp + 8]; + P64[Sp + 8] = _tyf::P64; + call stg_ap_0_fast(R1) returns to cz7, args: 8, res: 8, upd: 8; + cz7: // global + Hp = Hp + 24; + if (Hp > HpLim) (likely: False) goto czf; else goto cze; + czf: // global + HpAlloc = 24; + call stg_gc_unpt_r1(R1) returns to cz7, args: 8, res: 8, upd: 8; + cze: // global + I64[Hp - 16] = M.MkT_con_info; + P64[Hp - 8] = P64[Sp + 8]; + P64[Hp] = R1; + R1 = Hp - 15; + Sp = Sp + 16; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }, + section ""data" . M.MkT_closure" { + M.MkT_closure: + const M.MkT_info; + }] + + + +==================== Output Cmm ==================== +[M.MkT_con_entry() { // [] + { info_tbls: [(czl, + label: M.MkT_con_info + rep: HeapRep 2 ptrs { Con {tag: 0 descr:"main:M.MkT"} } + srt: Nothing)] + stack_info: arg_space: 8 + } + {offset + czl: // global + R1 = R1 + 1; + call (P64[Sp])(R1) args: 8, res: 0, upd: 8; + } + }] + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04a6a5586785f52ed48fd5545e553e008f2165c...ac810f994792c79acef386136aafe4c3a0f1e1a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04a6a5586785f52ed48fd5545e553e008f2165c...ac810f994792c79acef386136aafe4c3a0f1e1a1 You're receiving 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 Aug 13 12:58:39 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 13 Aug 2022 08:58:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/opt-calcUnfolding Message-ID: <62f79fff3dbfc_3d81494886474503c@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/opt-calcUnfolding at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/opt-calcUnfolding You're receiving 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 Aug 13 13:09:24 2022 From: gitlab at gitlab.haskell.org (John Ericson (@Ericson2314)) Date: Sat, 13 Aug 2022 09:09:24 -0400 Subject: [Git][ghc/ghc][wip/wither-eq1-and-friends] 4 commits: EPA: DotFieldOcc does not have exact print annotations Message-ID: <62f7a284eea7c_3d814948864748697@gitlab.mail> John Ericson pushed to branch wip/wither-eq1-and-friends at Glasgow Haskell Compiler / GHC Commits: ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - a3a23ca5 by John Ericson at 2022-08-13T09:08:17-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - a6e18362 by John Ericson at 2022-08-13T09:09:07-04:00 Relax instances for Functor combinators; put superclass on Class1 to make non-breaking The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Basic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5749029ece7a328650e3cffb48da4e1c23aada18...a6e183622920c8f32d5bd8e86f324e65432c55f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5749029ece7a328650e3cffb48da4e1c23aada18...a6e183622920c8f32d5bd8e86f324e65432c55f1 You're receiving 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 Aug 13 13:10:12 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 13 Aug 2022 09:10:12 -0400 Subject: [Git][ghc/ghc][wip/andreask/opt-calcUnfolding] Optimize calcUnfoldingGuidance to avoid eagerly evaluating expression size. Message-ID: <62f7a2b41d752_3d8149488a07504c2@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt-calcUnfolding at Glasgow Haskell Compiler / GHC Commits: 7e004b05 by Andreas Klebinger at 2022-08-13T15:08:38+02:00 Optimize calcUnfoldingGuidance to avoid eagerly evaluating expression size. There is also no point in calcUnfoldingGuidance handling Ticks since it's handlined inside sizeExpr already. So I removed that as well. - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -57,7 +57,6 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Types.ForeignCall import GHC.Types.Name -import GHC.Types.Tickish import qualified Data.ByteString as BS import Data.List (isPrefixOf) @@ -231,44 +230,42 @@ calcUnfoldingGuidance -> Bool -- Definitely a top-level, bottoming binding -> CoreExpr -- Expression to look at -> UnfoldingGuidance -calcUnfoldingGuidance opts is_top_bottoming (Tick t expr) - | not (tickishIsCode t) -- non-code ticks don't matter for unfolding - = calcUnfoldingGuidance opts is_top_bottoming expr -calcUnfoldingGuidance opts is_top_bottoming expr - = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of - TooBig -> UnfNever - SizeIs size cased_bndrs scrut_discount - | uncondInline expr n_val_bndrs size - -> UnfWhen { ug_unsat_ok = unSaturatedOk - , ug_boring_ok = boringCxtOk - , ug_arity = n_val_bndrs } -- Note [INLINE for small functions] - - | is_top_bottoming - -> UnfNever -- See Note [Do not inline top-level bottoming functions] - - | otherwise - -> UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs - , ug_size = size - , ug_res = scrut_discount } - +calcUnfoldingGuidance !opts is_top_bottoming !expr + -- See Note [Do not inline top-level bottoming functions] + | is_top_bottoming = UnfNever + | otherwise = calc opts expr where + calc opts expr + = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of + TooBig -> UnfNever + SizeIs size cased_bndrs scrut_discount + | uncondInline expr n_val_bndrs size + -> UnfWhen { ug_unsat_ok = unSaturatedOk + , ug_boring_ok = boringCxtOk + , ug_arity = n_val_bndrs } -- Note [INLINE for small functions] + + | otherwise + -> UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs + , ug_size = size + , ug_res = scrut_discount } + (bndrs, body) = collectBinders expr bOMB_OUT_SIZE = unfoldingCreationThreshold opts - -- Bomb out if size gets bigger than this + -- Bomb out if size gets bigger than this val_bndrs = filter isId bndrs n_val_bndrs = length val_bndrs mk_discount :: Bag (Id,Int) -> Id -> Int mk_discount cbs bndr = foldl' combine 0 cbs - where - combine acc (bndr', disc) - | bndr == bndr' = acc `plus_disc` disc - | otherwise = acc - - plus_disc :: Int -> Int -> Int - plus_disc | isFunTy (idType bndr) = max - | otherwise = (+) - -- See Note [Function and non-function discounts] + where + combine acc (bndr', disc) + | bndr == bndr' = acc `plus_disc` disc + | otherwise = acc + + plus_disc :: Int -> Int -> Int + plus_disc | isFunTy (idType bndr) = max + | otherwise = (+) + -- See Note [Function and non-function discounts] {- Note [Inline unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e004b05598d68d32de047235cee6a0150c03e46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e004b05598d68d32de047235cee6a0150c03e46 You're receiving 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 Aug 13 17:25:46 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 13 Aug 2022 13:25:46 -0400 Subject: [Git][ghc/ghc][wip/andreask/opt-calcUnfolding] Optimize calcUnfoldingGuidance to avoid eagerly evaluating expression size. Message-ID: <62f7de9a5bfc0_3d814948828766975@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt-calcUnfolding at Glasgow Haskell Compiler / GHC Commits: 3372c54c by Andreas Klebinger at 2022-08-13T19:25:24+02:00 Optimize calcUnfoldingGuidance to avoid eagerly evaluating expression size. There is also no point in calcUnfoldingGuidance handling Ticks since it's handlined inside sizeExpr already. So I removed that as well. - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -57,7 +57,6 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Types.ForeignCall import GHC.Types.Name -import GHC.Types.Tickish import qualified Data.ByteString as BS import Data.List (isPrefixOf) @@ -231,44 +230,42 @@ calcUnfoldingGuidance -> Bool -- Definitely a top-level, bottoming binding -> CoreExpr -- Expression to look at -> UnfoldingGuidance -calcUnfoldingGuidance opts is_top_bottoming (Tick t expr) - | not (tickishIsCode t) -- non-code ticks don't matter for unfolding - = calcUnfoldingGuidance opts is_top_bottoming expr calcUnfoldingGuidance opts is_top_bottoming expr - = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of - TooBig -> UnfNever - SizeIs size cased_bndrs scrut_discount - | uncondInline expr n_val_bndrs size - -> UnfWhen { ug_unsat_ok = unSaturatedOk - , ug_boring_ok = boringCxtOk - , ug_arity = n_val_bndrs } -- Note [INLINE for small functions] - - | is_top_bottoming - -> UnfNever -- See Note [Do not inline top-level bottoming functions] - - | otherwise - -> UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs - , ug_size = size - , ug_res = scrut_discount } - + -- See Note [Do not inline top-level bottoming functions] + | is_top_bottoming = UnfNever + | otherwise = calc opts expr where + calc !opts !expr + = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of + TooBig -> UnfNever + SizeIs size cased_bndrs scrut_discount + | uncondInline expr n_val_bndrs size + -> UnfWhen { ug_unsat_ok = unSaturatedOk + , ug_boring_ok = boringCxtOk + , ug_arity = n_val_bndrs } -- Note [INLINE for small functions] + + | otherwise + -> UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs + , ug_size = size + , ug_res = scrut_discount } + (bndrs, body) = collectBinders expr bOMB_OUT_SIZE = unfoldingCreationThreshold opts - -- Bomb out if size gets bigger than this + -- Bomb out if size gets bigger than this val_bndrs = filter isId bndrs n_val_bndrs = length val_bndrs mk_discount :: Bag (Id,Int) -> Id -> Int mk_discount cbs bndr = foldl' combine 0 cbs - where - combine acc (bndr', disc) - | bndr == bndr' = acc `plus_disc` disc - | otherwise = acc - - plus_disc :: Int -> Int -> Int - plus_disc | isFunTy (idType bndr) = max - | otherwise = (+) - -- See Note [Function and non-function discounts] + where + combine acc (bndr', disc) + | bndr == bndr' = acc `plus_disc` disc + | otherwise = acc + + plus_disc :: Int -> Int -> Int + plus_disc | isFunTy (idType bndr) = max + | otherwise = (+) + -- See Note [Function and non-function discounts] {- Note [Inline unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3372c54cadb9b4fdf74c909de36d43bc2309a8c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3372c54cadb9b4fdf74c909de36d43bc2309a8c8 You're receiving 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 Aug 14 00:43:06 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 13 Aug 2022 20:43:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/opt-bindersof Message-ID: <62f8451a59641_3d814948850785360@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/opt-bindersof at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/opt-bindersof You're receiving 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 Aug 14 01:31:15 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 13 Aug 2022 21:31:15 -0400 Subject: [Git][ghc/ghc][wip/andreask/opt-bindersof] Avoid unknown call, probably Message-ID: <62f8506315563_3d8149489a4789376@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt-bindersof at Glasgow Haskell Compiler / GHC Commits: ccd9cdfe by Andreas Klebinger at 2022-08-14T03:30:55+02:00 Avoid unknown call, probably - - - - - 1 changed file: - compiler/GHC/Core.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1955,14 +1955,16 @@ bindersOf (Rec pairs) = [binder | (binder, _) <- pairs] bindersOfBinds :: [Bind b] -> [b] bindersOfBinds binds = foldr ((++) . bindersOf) [] binds -{-# INLINABLE foldBindersOfStrict #-} +{-# INLINE foldBindersOfStrict #-} foldBindersOfStrict :: (a -> b -> a) -> a -> Bind b -> a -foldBindersOfStrict f z (NonRec binder _) = f z binder -foldBindersOfStrict f z (Rec pairs) = foldl' f z $ map fst pairs +foldBindersOfStrict f = \z bndr -> + case bndr of + (NonRec binder _) -> f z binder + (Rec pairs) -> foldl' f z $ map fst pairs -{-# INLINABLE foldBindersOfBindsStrict #-} +{-# INLINE foldBindersOfBindsStrict #-} foldBindersOfBindsStrict :: (a -> b -> a) -> a -> [Bind b] -> a -foldBindersOfBindsStrict f z binds = foldl' (foldBindersOfStrict f) z binds +foldBindersOfBindsStrict f = \z binds -> foldl' (foldBindersOfStrict f) z binds rhssOfBind :: Bind b -> [Expr b] rhssOfBind (NonRec _ rhs) = [rhs] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd9cdfece6886521cafc1c9fcade0edac7c9108 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd9cdfece6886521cafc1c9fcade0edac7c9108 You're receiving 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 Aug 14 10:44:19 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sun, 14 Aug 2022 06:44:19 -0400 Subject: [Git][ghc/ghc][wip/andreask/opt-bindersof] Avoid unknown call, probably Message-ID: <62f8d203ac15d_3d814948878810675@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/opt-bindersof at Glasgow Haskell Compiler / GHC Commits: 64456eb2 by Andreas Klebinger at 2022-08-14T12:26:15+02:00 Avoid unknown call, probably - - - - - 1 changed file: - compiler/GHC/Core.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -122,8 +122,6 @@ import Data.Data hiding (TyCon) import Data.Int import Data.Word -import GHC.Exts (inline) - infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps` -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys) @@ -1955,14 +1953,16 @@ bindersOf (Rec pairs) = [binder | (binder, _) <- pairs] bindersOfBinds :: [Bind b] -> [b] bindersOfBinds binds = foldr ((++) . bindersOf) [] binds -{-# INLINABLE foldBindersOfStrict #-} +{-# INLINE foldBindersOfStrict #-} foldBindersOfStrict :: (a -> b -> a) -> a -> Bind b -> a -foldBindersOfStrict f z (NonRec binder _) = f z binder -foldBindersOfStrict f z (Rec pairs) = foldl' f z $ map fst pairs +foldBindersOfStrict f = \z bndr -> + case bndr of + (NonRec binder _) -> f z binder + (Rec pairs) -> foldl' f z $ map fst pairs -{-# INLINABLE foldBindersOfBindsStrict #-} +{-# INLINE foldBindersOfBindsStrict #-} foldBindersOfBindsStrict :: (a -> b -> a) -> a -> [Bind b] -> a -foldBindersOfBindsStrict f z binds = foldl' (foldBindersOfStrict f) z binds +foldBindersOfBindsStrict f = \z binds -> foldl' (foldBindersOfStrict f) z binds rhssOfBind :: Bind b -> [Expr b] rhssOfBind (NonRec _ rhs) = [rhs] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64456eb20a691536c97643a71dbdc0f099ba9f68 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64456eb20a691536c97643a71dbdc0f099ba9f68 You're receiving 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 Aug 14 14:37:40 2022 From: gitlab at gitlab.haskell.org (John Ericson (@Ericson2314)) Date: Sun, 14 Aug 2022 10:37:40 -0400 Subject: [Git][ghc/ghc][wip/wither-eq1-and-friends] Relax instances for Functor combinators; put superclass on Class1 to make non-breaking Message-ID: <62f908b47e799_3d81494883c820642@gitlab.mail> John Ericson pushed to branch wip/wither-eq1-and-friends at Glasgow Haskell Compiler / GHC Commits: 00161be6 by John Ericson at 2022-08-14T10:36:58-04:00 Relax instances for Functor combinators; put superclass on Class1 to make non-breaking The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 5 changed files: - libraries/base/Data/Functor/Classes.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/Functor/Product.hs - libraries/base/Data/Functor/Sum.hs - utils/haddock Changes: ===================================== libraries/base/Data/Functor/Classes.hs ===================================== @@ -1,7 +1,10 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE QuantifiedConstraints #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Classes @@ -91,8 +94,18 @@ import Text.Show (showListWith) -- | Lifting of the 'Eq' class to unary type constructors. -- +-- Any instance should be subject to the following law that canonicity +-- is preserved: +-- +-- @liftEq (==)@ = @(==)@ +-- +-- This class therefore represents the generalization of 'Eq' by +-- decomposing its main method into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class Eq1 f where +class (forall a. Eq a => Eq (f a)) => Eq1 f where -- | Lift an equality test through the type constructor. -- -- The function will usually be applied to an equality function, @@ -102,6 +115,10 @@ class Eq1 f where -- -- @since 4.9.0.0 liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool + default liftEq + :: (f ~ f' c, Eq2 f', Eq c) + => (a -> b -> Bool) -> f a -> f b -> Bool + liftEq = liftEq2 (==) -- | Lift the standard @('==')@ function through the type constructor. -- @@ -111,8 +128,18 @@ eq1 = liftEq (==) -- | Lifting of the 'Ord' class to unary type constructors. -- +-- Any instance should be subject to the following law that canonicity +-- is preserved: +-- +-- @liftCompare compare@ = 'compare' +-- +-- This class therefore represents the generalization of 'Ord' by +-- decomposing its main method into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class (Eq1 f) => Ord1 f where +class (Eq1 f, forall a. Ord a => Ord (f a)) => Ord1 f where -- | Lift a 'compare' function through the type constructor. -- -- The function will usually be applied to a comparison function, @@ -122,6 +149,10 @@ class (Eq1 f) => Ord1 f where -- -- @since 4.9.0.0 liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering + default liftCompare + :: (f ~ f' c, Ord2 f', Ord c) + => (a -> b -> Ordering) -> f a -> f b -> Ordering + liftCompare = liftCompare2 compare -- | Lift the standard 'compare' function through the type constructor. -- @@ -131,6 +162,22 @@ compare1 = liftCompare compare -- | Lifting of the 'Read' class to unary type constructors. -- +-- Any instance should be subject to the following laws that canonicity +-- is preserved: +-- +-- @liftReadsPrec readsPrec readList@ = 'readsPrec' +-- +-- @liftReadList readsPrec readList@ = 'readList' +-- +-- @liftReadPrec readPrec readListPrec@ = 'readPrec' +-- +-- @liftReadListPrec readPrec readListPrec@ = 'readListPrec' +-- +-- This class therefore represents the generalization of 'Read' by +-- decomposing it's methods into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface -- provided in the 'Read' type class, but it is recommended to implement -- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since @@ -145,7 +192,7 @@ compare1 = liftCompare compare -- For more information, refer to the documentation for the 'Read' class. -- -- @since 4.9.0.0 -class Read1 f where +class (forall a. Read a => Read (f a)) => Read1 f where {-# MINIMAL liftReadsPrec | liftReadPrec #-} -- | 'readsPrec' function for an application of the type constructor @@ -219,14 +266,30 @@ liftReadListPrecDefault rp rl = list (liftReadPrec rp rl) -- | Lifting of the 'Show' class to unary type constructors. -- +-- Any instance should be subject to the following laws that canonicity +-- is preserved: +-- +-- @liftShowsPrec showsPrec showList@ = 'showsPrec' +-- +-- @liftShowList showsPrec showList@ = 'showList' +-- +-- This class therefore represents the generalization of 'Show' by +-- decomposing it's methods into a canonical lifting on a canonical +-- inner method, so that the lifting can be reused for other arguments +-- than the canonical one. +-- -- @since 4.9.0.0 -class Show1 f where +class (forall a. Show a => Show (f a)) => Show1 f where -- | 'showsPrec' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument type. -- -- @since 4.9.0.0 liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS + default liftShowsPrec + :: (f ~ f' b, Show2 f', Show b) + => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS + liftShowsPrec = liftShowsPrec2 showsPrec showList -- | 'showList' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument type. @@ -248,7 +311,7 @@ showsPrec1 = liftShowsPrec showsPrec showList -- | Lifting of the 'Eq' class to binary type constructors. -- -- @since 4.9.0.0 -class Eq2 f where +class (forall a. Eq a => Eq1 (f a)) => Eq2 f where -- | Lift equality tests through the type constructor. -- -- The function will usually be applied to equality functions, @@ -268,7 +331,7 @@ eq2 = liftEq2 (==) (==) -- | Lifting of the 'Ord' class to binary type constructors. -- -- @since 4.9.0.0 -class (Eq2 f) => Ord2 f where +class (Eq2 f, forall a. Ord a => Ord1 (f a)) => Ord2 f where -- | Lift 'compare' functions through the type constructor. -- -- The function will usually be applied to comparison functions, @@ -302,7 +365,7 @@ compare2 = liftCompare2 compare compare -- For more information, refer to the documentation for the 'Read' class. -- -- @since 4.9.0.0 -class Read2 f where +class (forall a. Read a => Read1 (f a)) => Read2 f where {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-} -- | 'readsPrec' function for an application of the type constructor @@ -385,7 +448,7 @@ liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2) -- | Lifting of the 'Show' class to binary type constructors. -- -- @since 4.9.0.0 -class Show2 f where +class (forall a. Show a => Show1 (f a)) => Show2 f where -- | 'showsPrec' function for an application of the type constructor -- based on 'showsPrec' and 'showList' functions for the argument types. -- ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -32,7 +33,7 @@ import Data.Coerce (coerce) import Data.Data (Data) import Data.Type.Equality (TestEquality(..), (:~:)(..)) import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () infixr 9 `Compose` @@ -47,6 +48,17 @@ newtype Compose f g a = Compose { getCompose :: f (g a) } , Monoid -- ^ @since 4.16.0.0 ) +-- Instances of Prelude classes + +-- | @since 4.18.0.0 +deriving instance Eq (f (g a)) => Eq (Compose f g a) +-- | @since 4.18.0.0 +deriving instance Ord (f (g a)) => Ord (Compose f g a) +-- | @since 4.18.0.0 +deriving instance Read (f (g a)) => Read (Compose f g a) +-- | @since 4.18.0.0 +deriving instance Show (f (g a)) => Show (Compose f g a) + -- Instances of lifted Prelude classes -- | @since 4.9.0.0 @@ -77,27 +89,6 @@ instance (Show1 f, Show1 g) => Show1 (Compose f g) where sp' = liftShowsPrec sp sl sl' = liftShowList sp sl --- Instances of Prelude classes - --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where - (==) = eq1 - --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where - compare = compare1 - --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault - --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where - showsPrec = showsPrec1 - -- Functor instances -- | @since 4.9.0.0 ===================================== libraries/base/Data/Functor/Product.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Product @@ -28,7 +29,7 @@ import Control.Monad.Zip (MonadZip(mzipWith)) import Data.Data (Data) import Data.Functor.Classes import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () -- | Lifted product of functors. data Product f g a = Pair (f a) (g a) @@ -37,6 +38,15 @@ data Product f g a = Pair (f a) (g a) , Generic1 -- ^ @since 4.9.0.0 ) +-- | @since 4.18.0.0 +deriving instance (Eq (f a), Eq (g a)) => Eq (Product f g a) +-- | @since 4.18.0.0 +deriving instance (Ord (f a), Ord (g a)) => Ord (Product f g a) +-- | @since 4.18.0.0 +deriving instance (Read (f a), Read (g a)) => Read (Product f g a) +-- | @since 4.18.0.0 +deriving instance (Show (f a), Show (g a)) => Show (Product f g a) + -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2 @@ -59,25 +69,6 @@ instance (Show1 f, Show1 g) => Show1 (Product f g) where liftShowsPrec sp sl d (Pair x y) = showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) - where (==) = eq1 - --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where - compare = compare1 - --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault - --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where - showsPrec = showsPrec1 - -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Product f g) where fmap f (Pair x y) = Pair (fmap f x) (fmap f y) ===================================== libraries/base/Data/Functor/Sum.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Sum @@ -25,7 +26,7 @@ import Control.Applicative ((<|>)) import Data.Data (Data) import Data.Functor.Classes import GHC.Generics (Generic, Generic1) -import Text.Read (Read(..), readListDefault, readListPrecDefault) +import Text.Read () -- | Lifted sum of functors. data Sum f g a = InL (f a) | InR (g a) @@ -34,6 +35,15 @@ data Sum f g a = InL (f a) | InR (g a) , Generic1 -- ^ @since 4.9.0.0 ) +-- | @since 4.18.0.0 +deriving instance (Eq (f a), Eq (g a)) => Eq (Sum f g a) +-- | @since 4.18.0.0 +deriving instance (Ord (f a), Ord (g a)) => Ord (Sum f g a) +-- | @since 4.18.0.0 +deriving instance (Read (f a), Read (g a)) => Read (Sum f g a) +-- | @since 4.18.0.0 +deriving instance (Show (f a), Show (g a)) => Show (Sum f g a) + -- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2 @@ -64,22 +74,6 @@ instance (Show1 f, Show1 g) => Show1 (Sum f g) where liftShowsPrec sp sl d (InR y) = showsUnaryWith (liftShowsPrec sp sl) "InR" d y --- | @since 4.9.0.0 -instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where - (==) = eq1 --- | @since 4.9.0.0 -instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where - compare = compare1 --- | @since 4.9.0.0 -instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where - readPrec = readPrec1 - - readListPrec = readListPrecDefault - readList = readListDefault --- | @since 4.9.0.0 -instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where - showsPrec = showsPrec1 - -- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Sum f g) where fmap f (InL x) = InL (fmap f x) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit a8277fc42c832769b6245ff3f4ad5626c779280c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00161be6942ed3d9b51954518d6100d815dcbd4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00161be6942ed3d9b51954518d6100d815dcbd4a You're receiving 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 Aug 14 23:50:14 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 14 Aug 2022 19:50:14 -0400 Subject: [Git][ghc/ghc][wip/T21623] Replace SORT with TYPE and CONSTRAINT Message-ID: <62f98a36821a1_3d81494886485627a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 1fc503f4 by Simon Peyton Jones at 2022-08-15T00:48:31+01:00 Replace SORT with TYPE and CONSTRAINT - - - - - 11 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - libraries/base/GHC/Err.hs - libraries/ghc-prim/GHC/Types.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1895,15 +1895,13 @@ nonEmptyTyConKey = mkPreludeTyConUnique 86 -- Kind constructors liftedTypeKindTyConKey, unliftedTypeKindTyConKey, - tYPETyConKey, liftedRepTyConKey, unliftedRepTyConKey, + tYPETyConKey, cONSTRAINTTyConKey, + liftedRepTyConKey, unliftedRepTyConKey, constraintKindTyConKey, levityTyConKey, runtimeRepTyConKey, vecCountTyConKey, vecElemTyConKey, - zeroBitRepTyConKey, zeroBitTypeTyConKey, - typeOrConstraintTyConKey, sORTTyConKey, cONSTRAINTTyConKey :: Unique -typeOrConstraintTyConKey = mkPreludeTyConUnique 87 + zeroBitRepTyConKey, zeroBitTypeTyConKey :: Unique liftedTypeKindTyConKey = mkPreludeTyConUnique 88 unliftedTypeKindTyConKey = mkPreludeTyConUnique 89 -sORTTyConKey = mkPreludeTyConUnique 90 tYPETyConKey = mkPreludeTyConUnique 91 cONSTRAINTTyConKey = mkPreludeTyConUnique 92 constraintKindTyConKey = mkPreludeTyConUnique 93 @@ -2129,10 +2127,6 @@ fingerprintDataConKey = mkPreludeDataConUnique 35 srcLocDataConKey :: Unique srcLocDataConKey = mkPreludeDataConUnique 37 -typeLikeDataConKey, constraintLikeDataConKey :: Unique -typeLikeDataConKey = mkPreludeDataConUnique 38 -constraintLikeDataConKey = mkPreludeDataConUnique 39 - trTyConDataConKey, trModuleDataConKey, trNameSDataConKey, trNameDDataConKey, trGhcPrimModuleKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -130,11 +130,6 @@ module GHC.Builtin.Types ( liftedDataConTyCon, unliftedDataConTyCon, liftedDataConTy, unliftedDataConTy, - -- * TypeOrConstraint - typeOrConstraintTyCon, typeOrConstraintTy, - typeLikeDataConTyCon, constraintLikeDataConTyCon, - typeLikeDataConTy, constraintLikeDataConTy, - intRepDataConTy, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, wordRepDataConTy, @@ -183,12 +178,12 @@ import GHC.Core.Coercion.Axiom import GHC.Types.Id import GHC.Types.TyThing import GHC.Types.SourceText -import GHC.Types.Var ( VarBndr (Bndr), visArgTypeLike ) +import GHC.Types.Var ( VarBndr (Bndr) ) import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) -import GHC.Core.TyCo.Rep ( RuntimeRepType, mkNakedKindFunTy ) +import GHC.Core.TyCo.Rep ( RuntimeRepType ) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -315,14 +310,11 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they , typeSymbolKindCon , runtimeRepTyCon , levityTyCon - , typeOrConstraintTyCon , vecCountTyCon , vecElemTyCon , constraintKindTyCon , liftedTypeKindTyCon , unliftedTypeKindTyCon - , tYPETyCon - , cONSTRAINTTyCon , multiplicityTyCon , naturalTyCon , integerTyCon @@ -1472,12 +1464,12 @@ unrestrictedFunTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "-> * * Type synonyms (all declared in ghc-prim:GHC.Types) - type CONSTRAINT = SORT ConstraintLike :: RuntimeRep -> Type -- cONSTRAINTKind - type Constraint = CONSTRAINT LiftedRep :: Type -- constraintKind + type CONSTRAINT :: RuntimeRep -> Type -- primitive; cONSTRAINTKind + type Constraint = CONSTRAINT LiftedRep :: Type -- constraintKind - type TYPE = SORT TypeLike :: RuntimeRep -> Type -- tYPEKind - type Type = TYPE LiftedRep :: Type -- liftedTypeKind - type UnliftedType = TYPE UnliftedRep :: Type -- unliftedTypeKind + type TYPE :: RuntimeRep -> Type -- primitive; tYPEKind + type Type = TYPE LiftedRep :: Type -- liftedTypeKind + type UnliftedType = TYPE UnliftedRep :: Type -- unliftedTypeKind type LiftedRep = BoxedRep Lifted :: RuntimeRep -- liftedRepTy type UnliftedRep = BoxedRep Unlifted :: RuntimeRep -- unliftedRepTy @@ -1501,37 +1493,6 @@ so the check will loop infinitely. Hence the use of a naked FunTy constructor in tTYPETyCon and cONSTRAINTTyCon. -} ----------------------- --- type TYPE = SORT TypeLike -tYPETyCon :: TyCon -tYPETyCon = buildSynTyCon tYPETyConName [] kind [] rhs - where - rhs = TyCoRep.TyConApp sORTTyCon [typeLikeDataConTy] - -- See Note [Naked FunTy] - kind = mkNakedKindFunTy visArgTypeLike runtimeRepTy liftedTypeKind - -tYPETyConName :: Name -tYPETyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TYPE") - tYPETyConKey tYPETyCon - -tYPEKind :: Type -tYPEKind = mkTyConTy tYPETyCon - ----------------------- --- type CONSTRAINT = SORT ConstraintLike -cONSTRAINTTyCon :: TyCon -cONSTRAINTTyCon = buildSynTyCon cONSTRAINTTyConName [] kind [] rhs - where - rhs = TyCoRep.TyConApp sORTTyCon [constraintLikeDataConTy] - -- See Note [Naked FunTy] - kind = mkNakedKindFunTy visArgTypeLike runtimeRepTy liftedTypeKind - -cONSTRAINTTyConName :: Name -cONSTRAINTTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "CONSTRAINT") - cONSTRAINTTyConKey cONSTRAINTTyCon - -cONSTRAINTKind :: Type -cONSTRAINTKind = mkTyConTy cONSTRAINTTyCon ---------------------- -- type Constraint = CONSTRAINT LiftedRep @@ -1582,45 +1543,6 @@ unliftedTypeKind :: Type unliftedTypeKind = mkTyConTy unliftedTypeKindTyCon -{- ********************************************************************* -* * - data TypeOrConstraint = TypeLike | ConstraintLike -* * -********************************************************************* -} - -typeOrConstraintTyConName, typeLikeDataConName, constraintLikeDataConName :: Name -typeOrConstraintTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TypeOrConstraint") - typeOrConstraintTyConKey typeOrConstraintTyCon -typeLikeDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TypeLike") - typeLikeDataConKey typeLikeDataCon -constraintLikeDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "ConstraintLike") - constraintLikeDataConKey constraintLikeDataCon - -typeOrConstraintTyCon :: TyCon -typeOrConstraintTyCon = pcTyCon typeOrConstraintTyConName Nothing [] - [typeLikeDataCon, constraintLikeDataCon] - -typeOrConstraintTy :: Type -typeOrConstraintTy = mkTyConTy typeOrConstraintTyCon - -typeLikeDataCon, constraintLikeDataCon :: DataCon -typeLikeDataCon = pcSpecialDataCon typeLikeDataConName - [] typeOrConstraintTyCon (TypeOrConstraint TypeLike) -constraintLikeDataCon = pcSpecialDataCon constraintLikeDataConName - [] typeOrConstraintTyCon (TypeOrConstraint ConstraintLike) - -typeLikeDataConTyCon :: TyCon -typeLikeDataConTyCon = promoteDataCon typeLikeDataCon - -constraintLikeDataConTyCon :: TyCon -constraintLikeDataConTyCon = promoteDataCon constraintLikeDataCon - -typeLikeDataConTy :: Type -typeLikeDataConTy = mkTyConTy typeLikeDataConTyCon - -constraintLikeDataConTy :: Type -constraintLikeDataConTy = mkTyConTy constraintLikeDataConTyCon - {- ********************************************************************* * * data Levity = Lifted | Unlifted ===================================== compiler/GHC/Builtin/Types.hs-boot ===================================== @@ -12,14 +12,10 @@ typeSymbolKind :: Type charTy :: Type mkBoxedTupleTy :: [Type] -> Type -tYPETyCon, cONSTRAINTTyCon :: TyCon - coercibleTyCon, heqTyCon :: TyCon unitTy :: Type -typeOrConstraintTy :: Type - liftedTypeKindTyConName :: Name liftedTypeKind, unliftedTypeKind, zeroBitTypeKind :: Kind ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -43,7 +43,8 @@ module GHC.Builtin.Types.Prim( multiplicityTyVar1, multiplicityTyVar2, -- Kind constructors... - sORTTyCon, sORTTyConName, + tYPETyCon, tYPETyConName, tYPEKind, + cONSTRAINTTyCon, cONSTRAINTTyConName, cONSTRAINTKind, -- Arrows fUNTyCon, fUNTyConName, @@ -109,7 +110,6 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Builtin.Types ( runtimeRepTy, levityTy, unboxedTupleKind, liftedTypeKind, unliftedTypeKind - , typeOrConstraintTy , boxedRepDataConTyCon, vecRepDataConTyCon , liftedRepTy, unliftedRepTy, zeroBitRepTy , intRepDataConTy @@ -125,7 +125,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy , doubleElemRepDataConTy , multiplicityTy - , constraintKind, cONSTRAINTTyCon ) + , constraintKind ) import GHC.Types.Var ( TyVarBinder, TyVar , mkTyVar, mkTyVarBinder, mkTyVarBinders ) @@ -150,6 +150,12 @@ import Data.Char * * ********************************************************************* -} +mk_TYPE_app :: Type -> Type +mk_TYPE_app rep = mkTyConApp tYPETyCon [rep] + +mk_CONSTRAINT_app :: Type -> Type +mk_CONSTRAINT_app rep = mkTyConApp cONSTRAINTTyCon [rep] + mkPrimTc :: FastString -> Unique -> TyCon -> Name mkPrimTc = mkGenPrimTc UserSyntax @@ -175,7 +181,7 @@ pcPrimTyCon name roles res_rep where bndr_kis = liftedTypeKind <$ roles binders = mkTemplateAnonTyConBinders bndr_kis - result_kind = mkTYPEapp res_rep + result_kind = mk_TYPE_app res_rep -- | Create a primitive nullary 'TyCon' with the given 'Name' -- and result kind representation. @@ -198,14 +204,15 @@ pcPrimTyCon_LevPolyLastArg :: Name pcPrimTyCon_LevPolyLastArg name roles res_rep = mkPrimTyCon name binders result_kind (Nominal : roles) where - result_kind = mkTYPEapp res_rep + result_kind = mk_TYPE_app res_rep lev_bndr = mkNamedTyConBinder Inferred levity1TyVar binders = lev_bndr : mkTemplateAnonTyConBinders anon_bndr_kis lev_tv = mkTyVarTy (binderVar lev_bndr) -- [ Type, ..., Type, TYPE (BoxedRep l) ] - anon_bndr_kis = changeLast (liftedTypeKind <$ roles) - (mkTYPEapp $ mkTyConApp boxedRepDataConTyCon [lev_tv]) + anon_bndr_kis = changeLast (liftedTypeKind <$ roles) $ + mk_TYPE_app $ + mkTyConApp boxedRepDataConTyCon [lev_tv] {- ********************************************************************* @@ -267,7 +274,8 @@ exposedPrimTyCons , stackSnapshotPrimTyCon , fUNTyCon - , sORTTyCon + , tYPETyCon + , cONSTRAINTTyCon #include "primop-vector-tycons.hs-incl" ] @@ -477,7 +485,9 @@ openAlphaTyVar, openBetaTyVar, openGammaTyVar :: TyVar -- beta :: TYPE r2 -- gamma :: TYPE r3 [openAlphaTyVar,openBetaTyVar,openGammaTyVar] - = mkTemplateTyVars [mkTYPEapp runtimeRep1Ty, mkTYPEapp runtimeRep2Ty, mkTYPEapp runtimeRep3Ty] + = mkTemplateTyVars [ mk_TYPE_app runtimeRep1Ty + , mk_TYPE_app runtimeRep2Ty + , mk_TYPE_app runtimeRep3Ty] openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec :: TyVarBinder openAlphaTyVarSpec = mkTyVarBinder Specified openAlphaTyVar @@ -506,8 +516,8 @@ levity2Ty = mkTyVarTy levity2TyVar levPolyAlphaTyVar, levPolyBetaTyVar :: TyVar [levPolyAlphaTyVar, levPolyBetaTyVar] = mkTemplateTyVars - [mkTYPEapp (mkTyConApp boxedRepDataConTyCon [levity1Ty]) - ,mkTYPEapp (mkTyConApp boxedRepDataConTyCon [levity2Ty])] + [ mk_TYPE_app (mkTyConApp boxedRepDataConTyCon [levity1Ty]) + , mk_TYPE_app (mkTyConApp boxedRepDataConTyCon [levity2Ty])] -- alpha :: TYPE ('BoxedRep l) -- beta :: TYPE ('BoxedRep k) @@ -599,8 +609,8 @@ fUNTyCon = mkPrimTyCon fUNTyConName tc_bndrs liftedTypeKind tc_roles tc_bndrs = [ mkNamedTyConBinder Required multiplicityTyVar1 , mkNamedTyConBinder Inferred runtimeRep1TyVar , mkNamedTyConBinder Inferred runtimeRep2TyVar ] - ++ mkTemplateAnonTyConBinders [ mkTYPEapp runtimeRep1Ty - , mkTYPEapp runtimeRep2Ty ] + ++ mkTemplateAnonTyConBinders [ mk_TYPE_app runtimeRep1Ty + , mk_TYPE_app runtimeRep2Ty ] tc_roles = [Nominal, Nominal, Nominal, Representational, Representational] -- (=>) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. @@ -611,8 +621,8 @@ ctArrowTyCon = mkPrimTyCon ctArrowTyConName tc_bndrs liftedTypeKind tc_roles -- See also unrestrictedFunTyCon tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar , mkNamedTyConBinder Inferred runtimeRep2TyVar ] - ++ mkTemplateAnonTyConBinders [ mkCONSTRAINTapp runtimeRep1Ty - , mkTYPEapp runtimeRep2Ty ] + ++ mkTemplateAnonTyConBinders [ mk_CONSTRAINT_app runtimeRep1Ty + , mk_TYPE_app runtimeRep2Ty ] tc_roles = [Nominal, Nominal, Representational, Representational] -- (==>) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. @@ -623,8 +633,8 @@ ccArrowTyCon = mkPrimTyCon ccArrowTyConName tc_bndrs constraintKind tc_roles -- See also unrestrictedFunTyCon tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar , mkNamedTyConBinder Inferred runtimeRep2TyVar ] - ++ mkTemplateAnonTyConBinders [ mkCONSTRAINTapp runtimeRep1Ty - , mkCONSTRAINTapp runtimeRep2Ty ] + ++ mkTemplateAnonTyConBinders [ mk_CONSTRAINT_app runtimeRep1Ty + , mk_CONSTRAINT_app runtimeRep2Ty ] tc_roles = [Nominal, Nominal, Representational, Representational] -- (-=>) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. @@ -635,8 +645,8 @@ tcArrowTyCon = mkPrimTyCon tcArrowTyConName tc_bndrs constraintKind tc_roles -- See also unrestrictedFunTyCon tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar , mkNamedTyConBinder Inferred runtimeRep2TyVar ] - ++ mkTemplateAnonTyConBinders [ mkTYPEapp runtimeRep1Ty - , mkCONSTRAINTapp runtimeRep2Ty ] + ++ mkTemplateAnonTyConBinders [ mk_TYPE_app runtimeRep1Ty + , mk_CONSTRAINT_app runtimeRep2Ty ] tc_roles = [Nominal, Nominal, Representational, Representational] {- @@ -731,18 +741,18 @@ either. Reason (c.f. #7451): bad; but it's fine provide they are not Apart. So we ensure that Type and Constraint are not apart; or, more -precisely, that TypeLike and ConstraintLike are not apart. This +precisely, that TYPE and CONSTRAINT are not apart. This non-apart-ness check is implemented in GHC.Core.Unify.unify_ty: look for `maybeApart MARTypeVsConstraint`. -Note taht before, nothing prevents writing instances like: +Note that, as before, nothing prevents writing instances like: instance C (Proxy @Type a) where ... -In particular, SORT and TypeLike and ConstraintLike (and the synonyms -TYPE, CONSTRAINT etc) are all allowed in instance heads. It's just -that TypeLike is not apart from ConstraintLike so that instance would -irretrievably overlap with: +In particular, TYPE and CONSTRAINT (and the synonyms Type, Constraint +etc) are all allowed in instance heads. It's just that TYPE +apart from CONSTRAINT so that instance would irretrievably overlap +with: instance C (Proxy @Constraint a) where ... @@ -775,15 +785,32 @@ generator never has to manipulate a value of type 'a :: TYPE rr'. a -> b -> TYPE ('TupleRep '[r1, r2]) -} -sORTTyCon :: TyCon -sORTTyConName :: Name - --- SORT :: TypeOrConstraint -> RuntimeRep -> Type -sORTTyCon = mkPrimTyCon sORTTyConName - (mkTemplateAnonTyConBinders [typeOrConstraintTy, runtimeRepTy]) +---------------------- +tYPETyCon :: TyCon +tYPETyCon = mkPrimTyCon tYPETyConName + (mkTemplateAnonTyConBinders [runtimeRepTy]) liftedTypeKind [Nominal] -sORTTyConName = mkPrimTc (fsLit "SORT") sORTTyConKey sORTTyCon + +tYPETyConName :: Name +tYPETyConName = mkPrimTc (fsLit "TYPE") tYPETyConKey tYPETyCon + +tYPEKind :: Type +tYPEKind = mkTyConTy tYPETyCon + +---------------------- +-- type CONSTRAINT = SORT ConstraintLike +cONSTRAINTTyCon :: TyCon +cONSTRAINTTyCon = mkPrimTyCon cONSTRAINTTyConName + (mkTemplateAnonTyConBinders [runtimeRepTy]) + liftedTypeKind + [Nominal] + +cONSTRAINTTyConName :: Name +cONSTRAINTTyConName = mkPrimTc (fsLit "CONSTRAINT") cONSTRAINTTyConKey cONSTRAINTTyCon + +cONSTRAINTKind :: Type +cONSTRAINTKind = mkTyConTy cONSTRAINTTyCon {- ********************************************************************* ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -65,11 +65,6 @@ module GHC.Core.TyCo.Rep ( -- * Functions over coercions pickLR, - -- * Space-saving construction - mkTYPEapp, mkTYPEapp_maybe, - mkCONSTRAINTapp, mkCONSTRAINTapp_maybe, - mkBoxedRepApp_maybe, mkTupleRepApp_maybe, - -- ** Analyzing types TyCoFolder(..), foldTyCo, noView, @@ -2122,149 +2117,4 @@ constructors for these. type Mult = Type -{- ********************************************************************* -* * - Space-saving construction -* * -********************************************************************* -} - -{- Note [Using synonyms to compress types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Was: Prefer Type over TYPE (BoxedRep Lifted)] - -The Core of nearly any program will have numerous occurrences of the Types - - TyConApp BoxedRep [TyConApp Lifted []] -- Synonym LiftedRep - TyConApp BoxedRep [TyConApp Unlifted []] -- Synonym UnliftedREp - TyConApp TYPE [TyConApp LiftedRep []] -- Synonym Type - TyConApp TYPE [TyConApp UnliftedRep []] -- Synonym UnliftedType - -While investigating #17292 we found that these constituted a majority -of all TyConApp constructors on the heap: - - (From a sample of 100000 TyConApp closures) - 0x45f3523 - 28732 - `Type` - 0x420b840702 - 9629 - generic type constructors - 0x42055b7e46 - 9596 - 0x420559b582 - 9511 - 0x420bb15a1e - 9509 - 0x420b86c6ba - 9501 - 0x42055bac1e - 9496 - 0x45e68fd - 538 - `TYPE ...` - -Consequently, we try hard to ensure that operations on such types are -efficient. Specifically, we strive to - - a. Avoid heap allocation of such types; use a single static TyConApp - b. Use a small (shallow in the tree-depth sense) representation - for such types - -Goal (b) is particularly useful as it makes traversals (e.g. free variable -traversal, substitution, and comparison) more efficient. -Comparison in particular takes special advantage of nullary type synonym -applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing -nullary type synonyms] in "GHC.Core.Type". - -To accomplish these we use a number of tricks, implemented by mkTyConApp. - - 1. Instead of (TyConApp BoxedRep [TyConApp Lifted []]), - we prefer a statically-allocated (TyConApp LiftedRep []) - where `LiftedRep` is a type synonym: - type LiftedRep = BoxedRep Lifted - Similarly for UnliftedRep - - 2. Instead of (TyConApp TYPE [TyConApp LiftedRep []]) - we prefer the statically-allocated (TyConApp Type []) - where `Type` is a type synonym - type Type = TYPE LiftedRep - Similarly for UnliftedType - -These serve goal (b) since there are no applied type arguments to traverse, -e.g., during comparison. - - 3. We have a single, statically allocated top-level binding to - represent `TyConApp GHC.Types.Type []` (namely - 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we don't - need to allocate such types (goal (a)). See functions - mkTYPEapp and mkBoxedRepApp - - 4. We use the sharing mechanism described in Note [Sharing nullary TyConApps] - in GHC.Core.TyCon to ensure that we never need to allocate such - nullary applications (goal (a)). - -See #17958, #20541 --} - -mkTYPEapp :: RuntimeRepType -> Type -mkTYPEapp rr - = case mkTYPEapp_maybe rr of - Just ty -> ty - Nothing -> TyConApp tYPETyCon [rr] - -mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type --- ^ Given a @RuntimeRep@, applies @TYPE@ to it. --- On the fly it rewrites --- TYPE LiftedRep --> liftedTypeKind (a synonym) --- TYPE UnliftedRep --> unliftedTypeKind (ditto) --- TYPE ZeroBitRep --> zeroBitTypeKind (ditto) --- NB: no need to check for TYPE (BoxedRep Lifted), TYPE (BoxedRep Unlifted) --- because those inner types should already have been rewritten --- to LiftedRep and UnliftedRep respectively, by mkTyConApp --- --- see Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. --- See Note [Using synonyms to compress types] in GHC.Core.Type -{-# NOINLINE mkTYPEapp_maybe #-} -mkTYPEapp_maybe (TyConApp tc args) - | key == liftedRepTyConKey = assert (null args) $ Just liftedTypeKind -- TYPE LiftedRep - | key == unliftedRepTyConKey = assert (null args) $ Just unliftedTypeKind -- TYPE UnliftedRep - | key == zeroBitRepTyConKey = assert (null args) $ Just zeroBitTypeKind -- TYPE ZeroBitRep - where - key = tyConUnique tc -mkTYPEapp_maybe _ = Nothing - ------------------- -mkCONSTRAINTapp :: RuntimeRepType -> Type --- ^ Just like mkTYPEapp -mkCONSTRAINTapp rr - = case mkCONSTRAINTapp_maybe rr of - Just ty -> ty - Nothing -> TyConApp cONSTRAINTTyCon [rr] - -mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe Type --- ^ Just like mkTYPEapp_maybe -{-# NOINLINE mkCONSTRAINTapp_maybe #-} -mkCONSTRAINTapp_maybe (TyConApp tc args) - | key == liftedRepTyConKey = assert (null args) $ Just constraintKind -- CONSTRAINT LiftedRep - where - key = tyConUnique tc -mkCONSTRAINTapp_maybe _ = Nothing - ------------------- -mkBoxedRepApp_maybe :: Type -> Maybe Type --- ^ Given a `Levity`, apply `BoxedRep` to it --- On the fly, rewrite --- BoxedRep Lifted --> liftedRepTy (a synonym) --- BoxedRep Unlifted --> unliftedRepTy (ditto) --- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. --- See Note [Using synonyms to compress types] in GHC.Core.Type -{-# NOINLINE mkBoxedRepApp_maybe #-} -mkBoxedRepApp_maybe (TyConApp tc args) - | key == liftedDataConKey = assert (null args) $ Just liftedRepTy -- BoxedRep Lifted - | key == unliftedDataConKey = assert (null args) $ Just unliftedRepTy -- BoxedRep Unlifted - where - key = tyConUnique tc -mkBoxedRepApp_maybe _ = Nothing - -mkTupleRepApp_maybe :: Type -> Maybe Type --- ^ Given a `[RuntimeRep]`, apply `TupleRep` to it --- On the fly, rewrite --- TupleRep [] -> zeroBitRepTy (a synonym) --- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. --- See Note [Using synonyms to compress types] in GHC.Core.Type -{-# NOINLINE mkTupleRepApp_maybe #-} -mkTupleRepApp_maybe (TyConApp tc args) - | key == nilDataConKey = assert (isSingleton args) $ Just zeroBitRepTy -- ZeroBitRep - where - key = tyConUnique tc -mkTupleRepApp_maybe _ = Nothing ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -521,8 +521,9 @@ mkTyConKind :: [TyConBinder] -> Kind -> Kind mkTyConKind bndrs res_kind = foldr mk res_kind bndrs where mk :: TyConBinder -> Kind -> Kind - mk (Bndr tv (AnonTCB af)) k = mkNakedKindFunTy af (varType tv) k mk (Bndr tv (NamedTCB vis)) k = mkForAllTy tv vis k + mk (Bndr tv (AnonTCB af)) k = mkNakedKindFunTy af (varType tv) k + -- mkNakedKindFunTy: see Note [Naked FunTy] in GHC.Builtin.Types tyConInvisTVBinders :: [TyConBinder] -- From the TyCon -> [InvisTVBinder] -- Suitable for the foralls of a term function @@ -1240,8 +1241,6 @@ data PromDataConInfo | Levity Levity -- ^ A constructor of `Levity` - | TypeOrConstraint TypeOrConstraint -- ^ A constructor of `TypeOrConstraint` - -- | Extract those 'DataCon's that we are able to learn about. Note -- that visibility in this sense does not correspond to visibility in -- the context of any particular user program! ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Core.Type ( funTyAnonArgFlag, anonArgTyCon, mkFunctionType, mkScaledFunctionTys, chooseAnonArgFlag, - mkTyConApp, mkTyConTy, mkTYPEapp, mkCONSTRAINTapp, + mkTyConApp, mkTyConTy, tyConAppTyCon_maybe, tyConAppTyConPicky_maybe, tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs, @@ -119,6 +119,11 @@ module GHC.Core.Type ( isValidJoinPointType, tyConAppNeedsKindSig, + -- * Space-saving construction + mkTYPEapp, mkTYPEapp_maybe, + mkCONSTRAINTapp, mkCONSTRAINTapp_maybe, + mkBoxedRepApp_maybe, mkTupleRepApp_maybe, + -- *** Levity and boxity sORTKind_maybe, typeTypeOrConstraint, typeLevity_maybe, @@ -260,14 +265,18 @@ import GHC.Types.Unique.Set import GHC.Core.TyCon import GHC.Builtin.Types.Prim + import {-# SOURCE #-} GHC.Builtin.Types - ( charTy, naturalTy - , typeSymbolKind, liftedTypeKind, unliftedTypeKind - , boxedRepDataConTyCon, constraintKind - , manyDataConTy, oneDataConTy ) + ( charTy, naturalTy + , typeSymbolKind, liftedTypeKind, unliftedTypeKind + , boxedRepDataConTyCon, constraintKind, zeroBitTypeKind + , manyDataConTy, oneDataConTy + , liftedRepTy, unliftedRepTy, zeroBitRepTy ) + import GHC.Types.Name( Name ) import GHC.Builtin.Names import GHC.Core.Coercion.Axiom + import {-# SOURCE #-} GHC.Core.Coercion ( mkNomReflCo, mkGReflCo, mkReflCo , mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo @@ -1525,7 +1534,6 @@ applyTysX tvs body_ty arg_tys (arg_tys_prefix, arg_tys_rest) = splitAtList tvs arg_tys - {- Note [Care with kind instantiation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have @@ -1648,6 +1656,70 @@ tcSplitTyConApp_maybe ty -> funTyConAppTy_maybe af w arg res _ -> Nothing +--------------------------- +-- | (mkTyConTy tc) returns (TyConApp tc []) +-- but arranges to share that TyConApp among all calls +-- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon +mkTyConTy :: TyCon -> Type +mkTyConTy tycon = tyConNullaryTy tycon + +-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to +-- its arguments. Applies its arguments to the constructor from left to right. +mkTyConApp :: TyCon -> [Type] -> Type +mkTyConApp tycon [] + = -- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon + mkTyConTy tycon + +mkTyConApp tycon tys@(ty1:rest) + | Just (af, mult, arg, res) <- tyConAppFun_maybe id tycon tys + = FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res } + + -- See Note [Using synonyms to compress types] + | key == tYPETyConKey + = assert (null rest) $ +-- mkTYPEapp_maybe ty1 `orElse` bale_out + case mkTYPEapp_maybe ty1 of + Just ty -> ty -- pprTrace "mkTYPEapp:yes" (ppr ty) ty + Nothing -> bale_out -- pprTrace "mkTYPEapp:no" (ppr bale_out) bale_out + + -- See Note [Using synonyms to compress types] + | key == boxedRepDataConTyConKey + = assert (null rest) $ +-- mkBoxedRepApp_maybe ty1 `orElse` bale_out + case mkBoxedRepApp_maybe ty1 of + Just ty -> ty -- pprTrace "mkBoxedRepApp:yes" (ppr ty) ty + Nothing -> bale_out -- pprTrace "mkBoxedRepApp:no" (ppr bale_out) bale_out + + | key == tupleRepDataConTyConKey + = case mkTupleRepApp_maybe ty1 of + Just ty -> ty -- pprTrace "mkTupleRepApp:yes" (ppr ty) ty + Nothing -> bale_out -- pprTrace "mkTupleRepApp:no" (ppr bale_out) bale_out + + -- The catch-all case + | otherwise + = bale_out + where + key = tyConUnique tycon + bale_out = TyConApp tycon tys + + +{- Note [Care using synonyms to compress types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Using a synonym to compress a types has a tricky wrinkle. Consider +coreView applied to (TyConApp LiftedRep []) + +* coreView expands the LiftedRep synonym: + type LiftedRep = BoxedRep Lifted + +* Danger: we might apply the empty substitution to the RHS of the + synonym. And substTy calls mkTyConApp BoxedRep [Lifted]. And + mkTyConApp compresses that back to LiftedRep. Loop! + +* Solution: in expandSynTyConApp_maybe, don't call substTy for nullary + type synonyms. That's more efficient anyway. +-} + + ------------------- newTyConInstRhs :: TyCon -> [Type] -> Type -- ^ Unwrap one 'layer' of newtype on a type constructor and its @@ -1732,77 +1804,6 @@ The solution is easy: just use `coreView` when establishing (EQ3) and (EQ4) in `mk_cast_ty`. -} -tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder] --- Return the tyConBinders in TyCoBinder form -tyConBindersTyCoBinders = map to_tyb - where - to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis) - to_tyb (Bndr tv (AnonTCB af)) = Anon af (tymult (varType tv)) - --- | (mkTyConTy tc) returns (TyConApp tc []) --- but arranges to share that TyConApp among all calls --- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon -mkTyConTy :: TyCon -> Type -mkTyConTy tycon = tyConNullaryTy tycon - --- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to --- its arguments. Applies its arguments to the constructor from left to right. -mkTyConApp :: TyCon -> [Type] -> Type -mkTyConApp tycon [] - = -- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon - mkTyConTy tycon - -mkTyConApp tycon tys@(ty1:rest) - | Just (af, mult, arg, res) <- tyConAppFun_maybe id tycon tys - = FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res } - - -- See Note [Using synonyms to compress types] - | key == tYPETyConKey - = assert (null rest) $ --- mkTYPEapp_maybe ty1 `orElse` bale_out - case mkTYPEapp_maybe ty1 of - Just ty -> ty -- pprTrace "mkTYPEapp:yes" (ppr ty) ty - Nothing -> bale_out -- pprTrace "mkTYPEapp:no" (ppr bale_out) bale_out - - -- See Note [Using synonyms to compress types] - | key == boxedRepDataConTyConKey - = assert (null rest) $ --- mkBoxedRepApp_maybe ty1 `orElse` bale_out - case mkBoxedRepApp_maybe ty1 of - Just ty -> ty -- pprTrace "mkBoxedRepApp:yes" (ppr ty) ty - Nothing -> bale_out -- pprTrace "mkBoxedRepApp:no" (ppr bale_out) bale_out - - | key == tupleRepDataConTyConKey - = case mkTupleRepApp_maybe ty1 of - Just ty -> ty -- pprTrace "mkTupleRepApp:yes" (ppr ty) ty - Nothing -> bale_out -- pprTrace "mkTupleRepApp:no" (ppr bale_out) bale_out - - -- The catch-all case - | otherwise - = bale_out - where - key = tyConUnique tycon - bale_out = TyConApp tycon tys - - -{- Note [Care using synonyms to compress types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Using a synonym to compress a types has a tricky wrinkle. Consider -coreView applied to (TyConApp LiftedRep []) - -* coreView expands the LiftedRep synonym: - type LiftedRep = BoxedRep Lifted - -* Danger: we might apply the empty substitution to the RHS of the - synonym. And substTy calls mkTyConApp BoxedRep [Lifted]. And - mkTyConApp compresses that back to LiftedRep. Loop! - -* Solution: in expandSynTyConApp_maybe, don't call substTy for nullary - type synonyms. That's more efficient anyway. --} - - - {- ********************************************************************* * * CoercionTy @@ -1833,6 +1834,13 @@ stripCoercionTy ty = pprPanic "stripCoercionTy" (ppr ty) * * ********************************************************************* -} +tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder] +-- Return the tyConBinders in TyCoBinder form +tyConBindersTyCoBinders = map to_tyb + where + to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis) + to_tyb (Bndr tv (AnonTCB af)) = Anon af (tymult (varType tv)) + -- | Make a dependent forall over an 'Inferred' variable mkTyCoInvForAllTy :: TyCoVar -> Type -> Type mkTyCoInvForAllTy tv ty @@ -3042,17 +3050,14 @@ tcTypeKind ty@(ForAllTy {}) -} sORTKind_maybe :: Kind -> Maybe (TypeOrConstraint, Type) --- Sees if the argument is if form (SORT type_or_constraint runtime_rep) --- and if so returns those components --- --- We do not have type-or-constraint polymorphism, so the --- argument to SORT should always be TypeLike or ConstraintLike +-- Sees if the argument is of form (TYPE rep) or (CONSTRAINT rep) +-- and if so returns which, and the runtime rep sORTKind_maybe kind = case splitTyConApp_maybe kind of - Just (tc, tys) | tc `hasKey` sORTTyConKey - , [torc_ty, rep] <- tys - , Just torc <- getTypeOrConstraint_maybe torc_ty - -> Just (torc, rep) + Just (tc, tys) | tc `hasKey` tYPETyConKey, [rep] <- tys + -> Just (TypeLike, rep) + | tc `hasKey` cONSTRAINTTyConKey, [rep] <- tys + -> Just (ConstraintLike, rep) _ -> Nothing typeTypeOrConstraint :: HasDebugCallStack => Type -> TypeOrConstraint @@ -3081,15 +3086,6 @@ classifiesTypeWithValues :: Kind -> Bool -- ^ True of a kind `SORT _ _` classifiesTypeWithValues k = isJust (sORTKind_maybe k) -getTypeOrConstraint_maybe :: Type -> Maybe TypeOrConstraint --- The argument is a type of kind TypeOrConstraint -getTypeOrConstraint_maybe ty - | Just (tc,args) <- splitTyConApp_maybe ty - , TypeOrConstraint torc <- tyConPromDataConInfo tc - = assert (null args) $ Just torc - | otherwise - = Nothing - isConstraintKind :: Kind -> Bool -- True of (SORT ConstraintLike _) isConstraintKind kind @@ -3890,3 +3886,149 @@ isLinearType ty = case ty of FunTy _ _ _ _ -> True ForAllTy _ res -> isLinearType res _ -> False + +{- ********************************************************************* +* * + Space-saving construction +* * +********************************************************************* -} + +{- Note [Using synonyms to compress types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Was: Prefer Type over TYPE (BoxedRep Lifted)] + +The Core of nearly any program will have numerous occurrences of the Types + + TyConApp BoxedRep [TyConApp Lifted []] -- Synonym LiftedRep + TyConApp BoxedRep [TyConApp Unlifted []] -- Synonym UnliftedREp + TyConApp TYPE [TyConApp LiftedRep []] -- Synonym Type + TyConApp TYPE [TyConApp UnliftedRep []] -- Synonym UnliftedType + +While investigating #17292 we found that these constituted a majority +of all TyConApp constructors on the heap: + + (From a sample of 100000 TyConApp closures) + 0x45f3523 - 28732 - `Type` + 0x420b840702 - 9629 - generic type constructors + 0x42055b7e46 - 9596 + 0x420559b582 - 9511 + 0x420bb15a1e - 9509 + 0x420b86c6ba - 9501 + 0x42055bac1e - 9496 + 0x45e68fd - 538 - `TYPE ...` + +Consequently, we try hard to ensure that operations on such types are +efficient. Specifically, we strive to + + a. Avoid heap allocation of such types; use a single static TyConApp + b. Use a small (shallow in the tree-depth sense) representation + for such types + +Goal (b) is particularly useful as it makes traversals (e.g. free variable +traversal, substitution, and comparison) more efficient. +Comparison in particular takes special advantage of nullary type synonym +applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing +nullary type synonyms] in "GHC.Core.Type". + +To accomplish these we use a number of tricks, implemented by mkTyConApp. + + 1. Instead of (TyConApp BoxedRep [TyConApp Lifted []]), + we prefer a statically-allocated (TyConApp LiftedRep []) + where `LiftedRep` is a type synonym: + type LiftedRep = BoxedRep Lifted + Similarly for UnliftedRep + + 2. Instead of (TyConApp TYPE [TyConApp LiftedRep []]) + we prefer the statically-allocated (TyConApp Type []) + where `Type` is a type synonym + type Type = TYPE LiftedRep + Similarly for UnliftedType + +These serve goal (b) since there are no applied type arguments to traverse, +e.g., during comparison. + + 3. We have a single, statically allocated top-level binding to + represent `TyConApp GHC.Types.Type []` (namely + 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we don't + need to allocate such types (goal (a)). See functions + mkTYPEapp and mkBoxedRepApp + + 4. We use the sharing mechanism described in Note [Sharing nullary TyConApps] + in GHC.Core.TyCon to ensure that we never need to allocate such + nullary applications (goal (a)). + +See #17958, #20541 +-} + +mkTYPEapp :: RuntimeRepType -> Type +mkTYPEapp rr + = case mkTYPEapp_maybe rr of + Just ty -> ty + Nothing -> TyConApp tYPETyCon [rr] + +mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type +-- ^ Given a @RuntimeRep@, applies @TYPE@ to it. +-- On the fly it rewrites +-- TYPE LiftedRep --> liftedTypeKind (a synonym) +-- TYPE UnliftedRep --> unliftedTypeKind (ditto) +-- TYPE ZeroBitRep --> zeroBitTypeKind (ditto) +-- NB: no need to check for TYPE (BoxedRep Lifted), TYPE (BoxedRep Unlifted) +-- because those inner types should already have been rewritten +-- to LiftedRep and UnliftedRep respectively, by mkTyConApp +-- +-- see Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. +-- See Note [Using synonyms to compress types] in GHC.Core.Type +{-# NOINLINE mkTYPEapp_maybe #-} +mkTYPEapp_maybe (TyConApp tc args) + | key == liftedRepTyConKey = assert (null args) $ Just liftedTypeKind -- TYPE LiftedRep + | key == unliftedRepTyConKey = assert (null args) $ Just unliftedTypeKind -- TYPE UnliftedRep + | key == zeroBitRepTyConKey = assert (null args) $ Just zeroBitTypeKind -- TYPE ZeroBitRep + where + key = tyConUnique tc +mkTYPEapp_maybe _ = Nothing + +------------------ +mkCONSTRAINTapp :: RuntimeRepType -> Type +-- ^ Just like mkTYPEapp +mkCONSTRAINTapp rr + = case mkCONSTRAINTapp_maybe rr of + Just ty -> ty + Nothing -> TyConApp cONSTRAINTTyCon [rr] + +mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe Type +-- ^ Just like mkTYPEapp_maybe +{-# NOINLINE mkCONSTRAINTapp_maybe #-} +mkCONSTRAINTapp_maybe (TyConApp tc args) + | key == liftedRepTyConKey = assert (null args) $ Just constraintKind -- CONSTRAINT LiftedRep + where + key = tyConUnique tc +mkCONSTRAINTapp_maybe _ = Nothing + +------------------ +mkBoxedRepApp_maybe :: Type -> Maybe Type +-- ^ Given a `Levity`, apply `BoxedRep` to it +-- On the fly, rewrite +-- BoxedRep Lifted --> liftedRepTy (a synonym) +-- BoxedRep Unlifted --> unliftedRepTy (ditto) +-- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. +-- See Note [Using synonyms to compress types] in GHC.Core.Type +{-# NOINLINE mkBoxedRepApp_maybe #-} +mkBoxedRepApp_maybe (TyConApp tc args) + | key == liftedDataConKey = assert (null args) $ Just liftedRepTy -- BoxedRep Lifted + | key == unliftedDataConKey = assert (null args) $ Just unliftedRepTy -- BoxedRep Unlifted + where + key = tyConUnique tc +mkBoxedRepApp_maybe _ = Nothing + +mkTupleRepApp_maybe :: Type -> Maybe Type +-- ^ Given a `[RuntimeRep]`, apply `TupleRep` to it +-- On the fly, rewrite +-- TupleRep [] -> zeroBitRepTy (a synonym) +-- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. +-- See Note [Using synonyms to compress types] in GHC.Core.Type +{-# NOINLINE mkTupleRepApp_maybe #-} +mkTupleRepApp_maybe (TyConApp tc args) + | key == nilDataConKey = assert (isSingleton args) $ Just zeroBitRepTy -- ZeroBitRep + where + key = tyConUnique tc +mkTupleRepApp_maybe _ = Nothing ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1081,14 +1081,6 @@ unify_ty env ty1 (TyVarTy tv2) kco = uVar (umSwapRn env) tv2 ty1 (mkSymCo kco) unify_ty env ty1 ty2 _kco - -- Type and Constraint are not Apart - -- See Note [Type vs Constraint] in GHC.Builtin.Types.Prim - | Just (tc1,_) <- mb_tc_app1 - , TypeOrConstraint {} <- tyConPromDataConInfo tc1 - , Just (tc2,_) <- mb_tc_app2 - , TypeOrConstraint {} <- tyConPromDataConInfo tc2 - = maybeApart MARTypeVsConstraint - | Just (tc1, tys1) <- mb_tc_app1 , Just (tc2, tys2) <- mb_tc_app2 , tc1 == tc2 @@ -1124,6 +1116,13 @@ unify_ty env ty1 ty2 _kco -- NB: we have already dealt with the 'ty1 = variable' case = maybeApart MARTypeFamily + -- TYPE and CONSTRAINT are not Apart + -- See Note [Type vs Constraint] in GHC.Builtin.Types.Prim + -- NB: at this point we know that the two TyCons do not match + | Just {} <- sORTKind_maybe ty1 + , Just {} <- sORTKind_maybe ty2 + = maybeApart MARTypeVsConstraint + where mb_tc_app1 = splitTyConApp_maybe ty1 mb_tc_app2 = splitTyConApp_maybe ty2 ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Builtin.Names import GHC.Builtin.Types -import GHC.Builtin.Types.Prim (sORTTyCon) import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Subst (elemSubst) import GHC.Core.Type @@ -146,10 +145,10 @@ updRcm f (RCM vanilla pragmas) -- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ vanillaCompleteMatchTC :: TyCon -> Maybe CompleteMatch vanillaCompleteMatchTC tc = - let -- SORT acts like an empty data type on the term-level (#14086), but + let -- TYPE acts like an empty data type on the term-level (#14086), but -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a -- special case. - mb_dcs | tc == sORTTyCon = Just [] + mb_dcs | tc == tYPETyCon = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== libraries/base/GHC/Err.hs ===================================== @@ -23,7 +23,7 @@ ----------------------------------------------------------------------------- module GHC.Err( absentErr, error, errorWithoutStackTrace, undefined ) where -import GHC.Types (Char, RuntimeRep, TYPE) +import GHC.Types (Char, RuntimeRep) import GHC.Stack.Types import GHC.Prim import {-# SOURCE #-} GHC.Exception ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -106,12 +106,6 @@ type UnliftedRep = 'BoxedRep 'Unlifted type ZeroBitRep = 'TupleRep '[] ------------------------- --- | The kind of types -type TYPE = SORT TypeLike - --- | The kind of constraints -type CONSTRAINT = SORT ConstraintLike - -- | The kind of lifted constraints type Constraint = CONSTRAINT LiftedRep View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fc503f463d69e3b04535bda8de995fa7a5f797d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fc503f463d69e3b04535bda8de995fa7a5f797d You're receiving 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 Aug 14 23:57:15 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 14 Aug 2022 19:57:15 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble Message-ID: <62f98bdb9c772_3d814948850856675@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: b3f02921 by Simon Peyton Jones at 2022-08-15T00:57:41+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Coercion.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -620,14 +620,14 @@ eqTyConRole tc | otherwise = pprPanic "eqTyConRole: unknown tycon" (ppr tc) --- | Given a coercion @co1 :: (a :: SORT t_or_c1 r1) ~ (b :: SORT t_or_c2 r2)@, +-- | Given a coercion @co1 :: (a :: TYPE r1) ~ (b :: TYPE r2)@, +-- (or CONSTRAINT instead of TPYE) -- produce a coercion @rep_co :: r1 ~ r2 at . mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion mkRuntimeRepCo co - = mkNthCo Nominal 1 kind_co + = mkNthCo Nominal 0 kind_co where - kind_co = mkKindCo co -- kind_co :: SORT t_or_c1 r1 ~ SORT t_or_c2 r2 - -- (up to silliness with Constraint) + kind_co = mkKindCo co -- kind_co :: TYPE r1 ~ TYPE r2 isReflCoVar_maybe :: Var -> Maybe Coercion -- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3f029217e48270d11839b9c503039c52ad58857 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3f029217e48270d11839b9c503039c52ad58857 You're receiving 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 Aug 15 08:05:46 2022 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Mon, 15 Aug 2022 04:05:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21492-rm-monoidal-containers Message-ID: <62f9fe5a9d619_3d8149489048797f3@gitlab.mail> Bryan R pushed new branch wip/T21492-rm-monoidal-containers at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21492-rm-monoidal-containers You're receiving 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 Aug 15 08:07:52 2022 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Mon, 15 Aug 2022 04:07:52 -0400 Subject: [Git][ghc/ghc][wip/T21492-rm-monoidal-containers] 18 commits: rts/linker: Resolve iconv_* on FreeBSD Message-ID: <62f9fed8876d_3d8149489a488473d@gitlab.mail> Bryan R pushed to branch wip/T21492-rm-monoidal-containers at Glasgow Haskell Compiler / GHC Commits: 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - 7b682d17 by Bryan Richter at 2022-08-15T11:07:43+03:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/Plugins.hs - + compiler/GHC/Driver/Plugins/External.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebf2897e7a332d13aa02aba1d143829e8ca34186...7b682d171e20284da248ab1a73b5340980d4c508 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebf2897e7a332d13aa02aba1d143829e8ca34186...7b682d171e20284da248ab1a73b5340980d4c508 You're receiving 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 Aug 15 08:08:33 2022 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Mon, 15 Aug 2022 04:08:33 -0400 Subject: [Git][ghc/ghc][wip/T21492-rm-monoidal-containers] run_ci: remove monoidal-containers Message-ID: <62f9ff01a5527_3d814948828885065@gitlab.mail> Bryan R pushed to branch wip/T21492-rm-monoidal-containers at Glasgow Haskell Compiler / GHC Commits: 445d93e5 by Bryan Richter at 2022-08-15T11:08:24+03:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 1 changed file: - .gitlab/gen_ci.hs Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -2,13 +2,17 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeApplications #-} {- cabal: -build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring +build-depends: base, aeson >= 1.8.1, containers, bytestring -} +import Data.Coerce import Data.String (String) import Data.Aeson as A -import qualified Data.Map.Monoidal as M +import qualified Data.Map as Map +import Data.Map (Map) import qualified Data.ByteString.Lazy as B hiding (putStrLn) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) @@ -307,10 +311,22 @@ dockerImage _ _ = Nothing -- The "proper" solution would be to use a dependent monoidal map where each key specifies -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error -- or they should be combined. -type Variables = M.MonoidalMap String [String] +newtype MonoidalMap k v = MonoidalMap (Map k v) + deriving (Eq, Show, Functor, ToJSON) + +instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where + (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b) + +instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where + mempty = MonoidalMap (Map.empty) + +mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a +mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m) + +type Variables = MonoidalMap String [String] (=:) :: String -> String -> Variables -a =: b = M.singleton a [b] +a =: b = MonoidalMap (Map.singleton a [b]) opsysVariables :: Arch -> Opsys -> Variables opsysVariables _ FreeBSD13 = mconcat @@ -566,7 +582,7 @@ instance ToJSON Job where , "allow_failure" A..= jobAllowFailure -- Joining up variables like this may well be the wrong thing to do but -- at least it doesn't lose information silently by overriding. - , "variables" A..= (M.map (intercalate " ") jobVariables) + , "variables" A..= fmap (intercalate " ") jobVariables , "artifacts" A..= jobArtifacts , "cache" A..= jobCache , "after_script" A..= jobAfterScript @@ -621,9 +637,9 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) - , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty + , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) + , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty ] jobArtifacts = Artifacts @@ -669,7 +685,7 @@ addJobRule :: Rule -> Job -> Job addJobRule r j = j { jobRules = enableRule r (jobRules j) } addVariable :: String -> String -> Job -> Job -addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) } +addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } -- Building the standard jobs -- @@ -765,8 +781,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b] -- | Specification for all the jobs we want to build. -jobs :: M.MonoidalMap String Job -jobs = M.fromList $ concatMap flattenJobGroup $ +jobs :: Map String Job +jobs = Map.fromList $ concatMap flattenJobGroup $ [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , (validateBuilds Amd64 (Linux Debian10) nativeInt) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/445d93e5eab62461352dedc69161e3ee136a26b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/445d93e5eab62461352dedc69161e3ee136a26b3 You're receiving 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 Aug 15 08:09:13 2022 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Mon, 15 Aug 2022 04:09:13 -0400 Subject: [Git][ghc/ghc][wip/T21492-rm-monoidal-containers] run_ci: remove monoidal-containers Message-ID: <62f9ff2999989_3d8149488288853b4@gitlab.mail> Bryan R pushed to branch wip/T21492-rm-monoidal-containers at Glasgow Haskell Compiler / GHC Commits: bf18af9b by Bryan Richter at 2022-08-15T11:09:03+03:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 1 changed file: - .gitlab/gen_ci.hs Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -2,13 +2,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- cabal: -build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring +build-depends: base, aeson >= 1.8.1, containers, bytestring -} +import Data.Coerce import Data.String (String) import Data.Aeson as A -import qualified Data.Map.Monoidal as M +import qualified Data.Map as Map +import Data.Map (Map) import qualified Data.ByteString.Lazy as B hiding (putStrLn) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) @@ -307,10 +310,22 @@ dockerImage _ _ = Nothing -- The "proper" solution would be to use a dependent monoidal map where each key specifies -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error -- or they should be combined. -type Variables = M.MonoidalMap String [String] +newtype MonoidalMap k v = MonoidalMap (Map k v) + deriving (Eq, Show, Functor, ToJSON) + +instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where + (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b) + +instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where + mempty = MonoidalMap (Map.empty) + +mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a +mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m) + +type Variables = MonoidalMap String [String] (=:) :: String -> String -> Variables -a =: b = M.singleton a [b] +a =: b = MonoidalMap (Map.singleton a [b]) opsysVariables :: Arch -> Opsys -> Variables opsysVariables _ FreeBSD13 = mconcat @@ -566,7 +581,7 @@ instance ToJSON Job where , "allow_failure" A..= jobAllowFailure -- Joining up variables like this may well be the wrong thing to do but -- at least it doesn't lose information silently by overriding. - , "variables" A..= (M.map (intercalate " ") jobVariables) + , "variables" A..= fmap (intercalate " ") jobVariables , "artifacts" A..= jobArtifacts , "cache" A..= jobCache , "after_script" A..= jobAfterScript @@ -621,9 +636,9 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) - , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty + , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) + , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty ] jobArtifacts = Artifacts @@ -669,7 +684,7 @@ addJobRule :: Rule -> Job -> Job addJobRule r j = j { jobRules = enableRule r (jobRules j) } addVariable :: String -> String -> Job -> Job -addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) } +addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } -- Building the standard jobs -- @@ -765,8 +780,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b] -- | Specification for all the jobs we want to build. -jobs :: M.MonoidalMap String Job -jobs = M.fromList $ concatMap flattenJobGroup $ +jobs :: Map String Job +jobs = Map.fromList $ concatMap flattenJobGroup $ [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , (validateBuilds Amd64 (Linux Debian10) nativeInt) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf18af9b6b292020c5eb216ca8d55e40ffae5877 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf18af9b6b292020c5eb216ca8d55e40ffae5877 You're receiving 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 Aug 15 09:11:01 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 15 Aug 2022 05:11:01 -0400 Subject: [Git][ghc/ghc][wip/T21623] Delete unused import Message-ID: <62fa0da53b1eb_3d814948878926064@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: e1ab5263 by Simon Peyton Jones at 2022-08-15T10:11:18+01:00 Delete unused import - - - - - 1 changed file: - compiler/GHC/Core/TyCo/Rep.hs Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -97,7 +97,6 @@ import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic -import GHC.Utils.Panic.Plain( assert ) -- libraries import qualified Data.Data as Data hiding ( TyCon ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1ab5263dfe2f1017d1e73199287578b624aec8e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1ab5263dfe2f1017d1e73199287578b624aec8e You're receiving 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 Aug 15 10:08:09 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 15 Aug 2022 06:08:09 -0400 Subject: [Git][ghc/ghc][wip/T21623] Delete TypeOrConstraint from ghc-prim:GHC.Types Message-ID: <62fa1b099e2d_3d8149488a09569b9@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 64ccaf1d by Simon Peyton Jones at 2022-08-15T11:08:23+01:00 Delete TypeOrConstraint from ghc-prim:GHC.Types - - - - - 1 changed file: - libraries/ghc-prim/GHC/Types.hs Changes: ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Types ( type (~), type (~~), Coercible, -- * Representation polymorphism - TYPE, CONSTRAINT, TypeOrConstraint, + TYPE, CONSTRAINT, Levity(..), RuntimeRep(..), LiftedRep, UnliftedRep, Type, UnliftedType, Constraint, @@ -119,9 +119,6 @@ type UnliftedType = TYPE UnliftedRep -- | The kind of the empty unboxed tuple type (# #) type ZeroBitType = TYPE ZeroBitRep -------------------------- -data TypeOrConstraint = TypeLike | ConstraintLike - ------------------------- data Multiplicity = Many | One View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64ccaf1d70ec630a2f36f2b576e66d6b8427c456 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64ccaf1d70ec630a2f36f2b576e66d6b8427c456 You're receiving 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 Aug 15 10:12:36 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 15 Aug 2022 06:12:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-tso-ghc-heap Message-ID: <62fa1c14c6048_3d814948878964269@gitlab.mail> Matthew Pickering pushed new branch wip/fix-tso-ghc-heap at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-tso-ghc-heap You're receiving 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 Aug 15 10:23:47 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 15 Aug 2022 06:23:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/rules-omit-fix Message-ID: <62fa1eb3dc60e_3d81494883c969312@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/rules-omit-fix You're receiving 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 Aug 15 10:24:34 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 15 Aug 2022 06:24:34 -0400 Subject: [Git][ghc/ghc][wip/andreask/rules-omit-fix] Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Message-ID: <62fa1ee26b07e_3d81494885097273b@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC Commits: 1f2d7439 by Andreas Klebinger at 2022-08-15T12:24:12+02:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 3 changed files: - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -ddump-simpl -ddump-to-file -O2 #-} {-# LANGUAGE NamedFieldPuns #-} {- @@ -1048,7 +1049,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} \ No newline at end of file ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22048', [grep_errmsg("_rule")], compile, ["-fomit-interface-pragmas -ddump-simpl"]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f2d74398ff7558d9d82de1c29b2068447bcc9dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f2d74398ff7558d9d82de1c29b2068447bcc9dc You're receiving 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 Aug 15 10:25:25 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 15 Aug 2022 06:25:25 -0400 Subject: [Git][ghc/ghc][wip/andreask/rules-omit-fix] Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Message-ID: <62fa1f152a658_3d8149488a097306b@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC Commits: f6e4a197 by Andreas Klebinger at 2022-08-15T12:25:05+02:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 3 changed files: - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -ddump-simpl -ddump-to-file -O2 #-} {-# LANGUAGE NamedFieldPuns #-} {- @@ -1048,7 +1049,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22048', [grep_errmsg("_rule")], compile, ["-fomit-interface-pragmas -ddump-simpl"]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6e4a1976b53a9940ab2cc1790f1f7a14cc080c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6e4a1976b53a9940ab2cc1790f1f7a14cc080c7 You're receiving 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 Aug 15 10:25:48 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 15 Aug 2022 06:25:48 -0400 Subject: [Git][ghc/ghc][wip/andreask/rules-omit-fix] Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Message-ID: <62fa1f2c11641_3d8149488a0973328@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC Commits: c81dc89b by Andreas Klebinger at 2022-08-15T12:25:28+02:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 3 changed files: - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1048,7 +1048,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22048', [grep_errmsg("_rule")], compile, ["-fomit-interface-pragmas -ddump-simpl"]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c81dc89b29981abfca3b7174c8c5287375dbf11d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c81dc89b29981abfca3b7174c8c5287375dbf11d You're receiving 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 Aug 15 10:31:35 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 15 Aug 2022 06:31:35 -0400 Subject: [Git][ghc/ghc][wip/andreask/rules-omit-fix] Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Message-ID: <62fa2087104dc_3d8149488509816ad@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC Commits: ad2fc62c by Andreas Klebinger at 2022-08-15T12:31:11+02:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 3 changed files: - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1048,7 +1048,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22048', [only_ways(['normal'], grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad2fc62c576708cb6404e855dccaf00d20d5bf2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad2fc62c576708cb6404e855dccaf00d20d5bf2b You're receiving 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 Aug 15 11:03:52 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 15 Aug 2022 07:03:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/compact-share Message-ID: <62fa28185dbf_3d81494886410147c6@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/compact-share at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/compact-share You're receiving 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 Aug 15 13:37:06 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 15 Aug 2022 09:37:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22044 Message-ID: <62fa4c02c0c01_3d8149489a410560b9@gitlab.mail> Matthew Pickering pushed new branch wip/T22044 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22044 You're receiving 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 Aug 15 14:44:52 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 15 Aug 2022 10:44:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-9.4-bootstrap Message-ID: <62fa5be4e0d5e_3d8149488dc1133078@gitlab.mail> Matthew Pickering pushed new branch wip/fix-9.4-bootstrap at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-9.4-bootstrap You're receiving 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 Aug 15 16:09:21 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 12:09:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21114 Message-ID: <62fa6fb1659e7_3d814948878119719b@gitlab.mail> Ben Gamari pushed new branch wip/T21114 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21114 You're receiving 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 Aug 15 18:05:50 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 14:05:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22052 Message-ID: <62fa8afe8bb79_3d81494887812555f@gitlab.mail> Ben Gamari pushed new branch wip/T22052 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22052 You're receiving 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 Aug 15 18:15:26 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 14:15:26 -0400 Subject: [Git][ghc/ghc][wip/T22052] users-guide: Fix incorrect reference to `:extension: role Message-ID: <62fa8d3e9e442_3d8149488641265252@gitlab.mail> Ben Gamari pushed to branch wip/T22052 at Glasgow Haskell Compiler / GHC Commits: 1a47977b by Ben Gamari at 2022-08-15T14:15:02-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 1 changed file: - docs/users_guide/exts/gadt_syntax.rst Changes: ===================================== docs/users_guide/exts/gadt_syntax.rst ===================================== @@ -6,7 +6,7 @@ Declaring data types with explicit constructor signatures .. extension:: GADTSyntax :shortdesc: Enable generalised algebraic data type syntax. - :implied by: :extensions:`GADTs` + :implied by: :extension:`GADTs` :since: 7.2.1 :status: Included in :extension:`GHC2021` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a47977bb407dd7b021d800a5194a107156cc727 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a47977bb407dd7b021d800a5194a107156cc727 You're receiving 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 Aug 15 18:24:39 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Mon, 15 Aug 2022 14:24:39 -0400 Subject: [Git][ghc/ghc][wip/js-staging] base: GHCJS.Prim directory --> GHC.JS.Prim Message-ID: <62fa8f6726d5c_3d814948864126811e@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: fe37fe71 by doyougnu at 2022-08-15T14:20:09-04:00 base: GHCJS.Prim directory --> GHC.JS.Prim - - - - - 6 changed files: - compiler/GHC/StgToJS/Linker/Linker.hs - libraries/base/GHCJS/Prim.hs → libraries/base/GHC/JS/Prim.hs - libraries/base/GHCJS/Prim/Internal.hs → libraries/base/GHC/JS/Prim/Internal.hs - libraries/base/GHCJS/Prim/Internal/Build.hs → libraries/base/GHC/JS/Prim/Internal/Build.hs - libraries/base/base.cabal - libraries/unix Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -707,7 +707,6 @@ readArObject ar_state mod ar_file = do ++ " in " ++ ar_file) (BL.fromStrict . Ar.filedata) (find matchTag entries) - -- mapM_ (\e -> putStrLn ("found file: " ++ Ar.filename e)) entries {- | Static dependencies are symbols that need to be linked regardless of whether the linked program refers to them. For example @@ -721,29 +720,6 @@ newtype StaticDeps = noStaticDeps :: StaticDeps noStaticDeps = StaticDeps [] -{- | The input file format for static deps is a yaml document with a - package/module/symbol tree where symbols can be either a list or - just a single string, for example: - - base: - GHC.Conc.Sync: reportError - Control.Exception.Base: nonTermination - ghcjs-prim: - GHCJS.Prim: - - JSVal - - JSException - -} --- instance FromJSON StaticDeps where --- parseJSON (Object v) = StaticDeps . concat <$> mapM (uncurry parseMod) (HM.toList v) --- where --- parseMod p (Object v) = concat <$> mapM (uncurry (parseSymb p)) (HM.toList v) --- parseMod _ _ = mempty --- parseSymb p m (String s) = pure [(p,m,s)] --- parseSymb p m (Array v) = mapM (parseSingleSymb p m) (V.toList v) --- parseSymb _ _ _ = mempty --- parseSingleSymb p m (String s) = pure (p,m,s) --- parseSingleSymb _ _ _ = mempty --- parseJSON _ = mempty -- | dependencies for the RTS, these need to be always linked rtsDeps :: [UnitId] -> IO ([UnitId], Set ExportedFun) @@ -782,7 +758,7 @@ readSystemDeps' file -- wired-in just like in GHC and thus we should make them top level -- definitions | file == "thdeps.yaml" = pure ( [ baseUnitId ] - , S.fromList $ d baseUnitId "GHCJS.Prim.TH.Eval" ["runTHServer"]) + , S.fromList $ d baseUnitId "GHC.JS.Prim.TH.Eval" ["runTHServer"]) | file == "rtsdeps.yaml" = pure ( [ baseUnitId , primUnitId , bignumUnitId @@ -800,8 +776,8 @@ readSystemDeps' file -- FIXME Sylvain (2022,05): no longer valid -- integer constructors -- , d bignumUnitId "GHC.Integer.Type" ["S#", "Jp#", "Jn#"] - , d baseUnitId "GHCJS.Prim" ["JSVal", "JSException", "$fShowJSException", "$fExceptionJSException", "resolve", "resolveIO", "toIO"] - , d baseUnitId "GHCJS.Prim.Internal" ["wouldBlock", "blockedIndefinitelyOnMVar", "blockedIndefinitelyOnSTM", "ignoreException", "setCurrentThreadResultException", "setCurrentThreadResultValue"] + , d baseUnitId "GHC.JS.Prim" ["JSVal", "JSException", "$fShowJSException", "$fExceptionJSException", "resolve", "resolveIO", "toIO"] + , d baseUnitId "GHC.JS.Prim.Internal" ["wouldBlock", "blockedIndefinitelyOnMVar", "blockedIndefinitelyOnSTM", "ignoreException", "setCurrentThreadResultException", "setCurrentThreadResultValue"] ] ) | otherwise = pure (mempty, mempty) ===================================== libraries/base/GHCJS/Prim.hs → libraries/base/GHC/JS/Prim.hs ===================================== @@ -5,9 +5,9 @@ UnboxedTuples #-} -module GHCJS.Prim ( JSVal(..), JSVal# - , JSException(..) - , WouldBlockException(..) +module GHC.JS.Prim ( JSVal(..), JSVal# + , JSException(..) + , WouldBlockException(..) #ifdef js_HOST_ARCH , toIO , resolve @@ -112,9 +112,9 @@ toJSString :: String -> JSVal toJSString = js_toJSString . unsafeCoerce . seqList {-# INLINE [0] toJSString #-} {-# RULES -"GHCJSPRIM toJSString/literal" forall a. +"GHC.JS.PRIM toJSString/literal" forall a. toJSString (GHC.unpackCString# a) = JSVal (unsafeUnpackJSStringUtf8## a) -"GHCJSPRIM toJSString/literalUtf8" forall a. +"GHC.JS.PRIM toJSString/literalUtf8" forall a. toJSString (GHC.unpackCStringUtf8# a) = JSVal (unsafeUnpackJSStringUtf8## a) #-} @@ -152,9 +152,9 @@ getProp :: JSVal -> String -> IO JSVal getProp o p = js_getProp o (unsafeCoerce $ seqList p) {-# INLINE [0] getProp #-} {-# RULES -"GHCJSPRIM getProp/literal" forall o a. +"GHC.JS.PRIM getProp/literal" forall o a. getProp o (GHC.unpackCString# a) = getProp# o a -"GHCJSPRIM getProp/literalUtf8" forall o a. +"GHC.JS.PRIM getProp/literalUtf8" forall o a. getProp o (GHC.unpackCStringUtf8# a) = getPropUtf8# o a #-} @@ -163,9 +163,9 @@ unsafeGetProp :: JSVal -> String -> JSVal unsafeGetProp o p = js_unsafeGetProp o (unsafeCoerce $ seqList p) {-# INLINE [0] unsafeGetProp #-} {-# RULES -"GHCJSPRIM unsafeGetProp/literal" forall o a. +"GHC.JS.PRIM unsafeGetProp/literal" forall o a. unsafeGetProp o (GHC.unpackCString# a) = unsafeGetProp# o a -"GHCJSPRIM unsafeGetProp/literalUtf8" forall o a. +"GHC.JS.PRIM unsafeGetProp/literalUtf8" forall o a. unsafeGetProp o (GHC.unpackCStringUtf8# a) = unsafeGetPropUtf8# o a #-} @@ -173,9 +173,9 @@ getProp' :: JSVal -> JSVal -> IO JSVal getProp' o p = js_getProp' o p {-# INLINE [0] getProp' #-} {-# RULES -"GHCJSPRIM getProp'/literal" forall o a. +"GHC.JS.PRIM getProp'/literal" forall o a. getProp' o (unsafeUnpackJSString# a) = getProp# o a -"GHCJSPRIM getProp'/literalUtf8" forall o a. +"GHC.JS.PRIM getProp'/literalUtf8" forall o a. getProp' o (unsafeUnpackJSStringUtf8# a) = getPropUtf8# o a #-} @@ -184,9 +184,9 @@ unsafeGetProp' :: JSVal -> JSVal -> JSVal unsafeGetProp' o p = js_unsafeGetProp' o p {-# INLINE [0] unsafeGetProp' #-} {-# RULES -"GHCJSPRIM unsafeGetProp'/literal" forall o a. +"GHC.JS.PRIM unsafeGetProp'/literal" forall o a. unsafeGetProp' o (unsafeUnpackJSString# a) = unsafeGetPropUtf8# o a -"GHCJSPRIM unsafeGetProp'/literalUtf8" forall o a. +"GHC.JS.PRIM unsafeGetProp'/literalUtf8" forall o a. unsafeGetProp' o (unsafeUnpackJSStringUtf8# a) = unsafeGetPropUtf8# o a #-} ===================================== libraries/base/GHCJS/Prim/Internal.hs → libraries/base/GHC/JS/Prim/Internal.hs ===================================== @@ -2,17 +2,17 @@ -} -module GHCJS.Prim.Internal ( blockedIndefinitelyOnMVar - , blockedIndefinitelyOnSTM - , wouldBlock - , ignoreException - , setCurrentThreadResultException - , setCurrentThreadResultValue - ) where +module GHC.JS.Prim.Internal ( blockedIndefinitelyOnMVar + , blockedIndefinitelyOnSTM + , wouldBlock + , ignoreException + , setCurrentThreadResultException + , setCurrentThreadResultValue + ) where import Control.Exception -import GHCJS.Prim +import GHC.JS.Prim wouldBlock :: SomeException wouldBlock = toException WouldBlockException ===================================== libraries/base/GHCJS/Prim/Internal/Build.hs → libraries/base/GHC/JS/Prim/Internal/Build.hs ===================================== @@ -2,10 +2,10 @@ -- no Template Haskell available yet, generated by utils/genBuildObject.hs {-# LANGUAGE CPP #-} #ifndef js_HOST_ARCH -module GHCJS.Prim.Internal.Build () where +module GHC.JS.Prim.Internal.Build () where #else {-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, GHCForeignImportPrim #-} -module GHCJS.Prim.Internal.Build +module GHC.JS.Prim.Internal.Build ( buildArrayI , buildArrayM , buildObjectI @@ -140,7 +140,7 @@ module GHCJS.Prim.Internal.Build , buildObjectM32 ) where -import GHCJS.Prim +import GHC.JS.Prim import GHC.Exts import Unsafe.Coerce import System.IO.Unsafe ===================================== libraries/base/base.cabal ===================================== @@ -461,10 +461,9 @@ Library if arch(js) exposed-modules: - -- FIXME: Luite (2022,05): remove GHCJS name - GHCJS.Prim - GHCJS.Prim.Internal - GHCJS.Prim.Internal.Build + GHC.JS.Prim + GHC.JS.Prim.Internal + GHC.JS.Prim.Internal.Build -- We need to set the unit id to base (without a version number) -- as it's magic. ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit 23edd4537e9051824a5683b324e6fb8abed5d6b3 +Subproject commit f018fe126c5f1dbbd3431c7214337ccbb38230ce View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe37fe7113b42e305bb18703686c07887c1321f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe37fe7113b42e305bb18703686c07887c1321f9 You're receiving 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 Aug 15 18:49:14 2022 From: gitlab at gitlab.haskell.org (Luite Stegeman (@luite)) Date: Mon, 15 Aug 2022 14:49:14 -0400 Subject: [Git][ghc/ghc][wip/js-staging] implement KeepAlive primop Message-ID: <62fa952a34656_3d8149488641268732@gitlab.mail> Luite Stegeman pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 3c523b3a by Luite Stegeman at 2022-08-15T20:42:39+02:00 implement KeepAlive primop - - - - - 3 changed files: - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Rts/Rts.hs - js/rts.js.pp Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -930,6 +930,8 @@ genPrim prof ty op = case op of ] FinalizeWeakOp -> \[fl,fin] [w] -> PrimInline $ appT [fin, fl] "h$finalizeWeak" [w] TouchOp -> \[] [_e] -> PrimInline mempty -- fixme what to do? + KeepAliveOp -> \[_r] [x, f] -> PRPrimCall $ ReturnStat (app "h$keepAlive" [x, f]) + ------------------------------ Stable pointers and names ------------------------ @@ -1109,8 +1111,6 @@ genPrim prof ty op = case op of ReadIOPortOp -> unhandledPrimop op WriteIOPortOp -> unhandledPrimop op - KeepAliveOp -> unhandledPrimop op - GetSparkOp -> unhandledPrimop op AnyToAddrOp -> unhandledPrimop op MkApUpd0_Op -> unhandledPrimop op ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -523,6 +523,11 @@ rts' s = , adjSpN' 1 , returnS (app "h$ap_0_0_fast" []) ] + , closure (ClosureInfo "h$keepAlive_e" (CIRegs 0 [PtrV]) "keepAlive" (CILayoutFixed 1 [PtrV]) CIStackFrame mempty) + (mconcat [ adjSpN' 2 + , returnS (stack .! sp) + ] + ) -- a thunk that just raises a synchronous exception , closure (ClosureInfo "h$raise_e" (CIRegs 0 [PtrV]) "h$raise_e" (CILayoutFixed 0 []) CIThunk mempty) (returnS (app "h$throw" [closureField1 r1, false_])) ===================================== js/rts.js.pp ===================================== @@ -703,3 +703,11 @@ function h$catch(a, handler) { h$r1 = a; return h$ap_1_0_fast(); } + +function h$keepAlive(x, f) { + h$sp += 2; + h$stack[h$sp-1] = x; + h$stack[h$sp] = h$keepAlive_e; + h$r1 = f; + return h$ap_1_0_fast(); +} \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c523b3af8f2a5a158455042fe00a279437495f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c523b3af8f2a5a158455042fe00a279437495f9 You're receiving 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 Aug 15 18:51:18 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 14:51:18 -0400 Subject: [Git][ghc/ghc][wip/T22052] 2 commits: users-guide: Add :ghc-flag: reference Message-ID: <62fa95a626961_3d8149489041268913@gitlab.mail> Ben Gamari pushed to branch wip/T22052 at Glasgow Haskell Compiler / GHC Commits: 14853adf by Ben Gamari at 2022-08-15T14:49:57-04:00 users-guide: Add :ghc-flag: reference - - - - - 37c61cc0 by Ben Gamari at 2022-08-15T14:50:34-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 2 changed files: - docs/users_guide/phases.rst - hadrian/src/Rules/Documentation.hs Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -467,7 +467,7 @@ defined by your local GHC installation, the following trick is useful: .. index:: single: __GLASGOW_HASKELL_LLVM__ - Only defined when ``-fllvm`` is specified. When GHC is using version + Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero is added, so for example when using version 3.7 of LLVM, ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -41,7 +41,7 @@ archiveRoot :: FilePath archiveRoot = docRoot -/- "archives" manPageBuildPath :: FilePath -manPageBuildPath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1" -- TODO: Get rid of this hack. docContext :: Context View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a47977bb407dd7b021d800a5194a107156cc727...37c61cc05f82f4cdc43aece152df8630b7c0419d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a47977bb407dd7b021d800a5194a107156cc727...37c61cc05f82f4cdc43aece152df8630b7c0419d You're receiving 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 Aug 15 18:54:02 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 14:54:02 -0400 Subject: [Git][ghc/ghc][wip/T22052] Bump haddock submodule Message-ID: <62fa964a6ef5f_3d8149488dc1271014@gitlab.mail> Ben Gamari pushed to branch wip/T22052 at Glasgow Haskell Compiler / GHC Commits: e8a746ce by Ben Gamari at 2022-08-15T14:53:50-04:00 Bump haddock submodule - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit 4d9827479a14e1a7d063f1a3cacd73eaf2945318 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8a746cedd0b6748b96f0c5a990eabc5c4822c58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8a746cedd0b6748b96f0c5a990eabc5c4822c58 You're receiving 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 Aug 15 18:57:36 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 14:57:36 -0400 Subject: [Git][ghc/ghc][wip/T22052] 2 commits: base: Add changelog entries from ghc-9.2 Message-ID: <62fa9720e0e2f_3d81494890412715a3@gitlab.mail> Ben Gamari pushed to branch wip/T22052 at Glasgow Haskell Compiler / GHC Commits: 84a8ff07 by Ben Gamari at 2022-08-15T14:55:45-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - d07e58c2 by Ben Gamari at 2022-08-15T14:57:12-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - 2 changed files: - docs/users_guide/9.6.1-notes.rst - libraries/base/changelog.md Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -87,3 +87,50 @@ Compiler ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ + + +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 + ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. @@ -66,14 +66,55 @@ A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md) is available. - * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to - `Debug.Trace`, per - [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36). - * Re-export `augment` and `build` function from `GHC.List` * Re-export the `IsList` typeclass from the new `GHC.IsList` module. + * There's a new special function ``withDict`` in ``GHC.Exts``: :: + + withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r + + where ``cls`` must be a class containing exactly one method, whose type + must be ``meth``. + + This function converts ``meth`` to a type class dictionary. + It removes the need for ``unsafeCoerce`` in implementation of reflection + libraries. It should be used with care, because it can introduce + incoherent instances. + + For example, the ``withTypeable`` function from the + ``Type.Reflection`` module can now be defined as: :: + + withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () + => TypeRep a -> (Typeable a => r) -> r + withTypeable rep k = withDict @(Typeable a) rep k + + Note that the explicit type application is required, as the call to + ``withDict`` would be ambiguous otherwise. + + This replaces the old ``GHC.Exts.magicDict``, which required + an intermediate data type and was less reliable. + + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by + `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these + were rather represented by `Word#` and `Int#`. See GHC #11953. + +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes + ## 4.16.1.0 *Feb 2022* * Shipped with GHC 9.2.2 @@ -498,7 +539,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8a746cedd0b6748b96f0c5a990eabc5c4822c58...d07e58c29a9878aa57b6d4ea070ce21de294a3f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8a746cedd0b6748b96f0c5a990eabc5c4822c58...d07e58c29a9878aa57b6d4ea070ce21de294a3f9 You're receiving 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 Aug 15 19:00:09 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Mon, 15 Aug 2022 15:00:09 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: base: GHCJS.Prim directory --> GHC.JS.Prim Message-ID: <62fa97b932baf_3d81494882812720e5@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 37d31fe2 by doyougnu at 2022-08-15T14:58:10-04:00 base: GHCJS.Prim directory --> GHC.JS.Prim - - - - - 9f2e853f by Luite Stegeman at 2022-08-15T14:58:10-04:00 implement KeepAlive primop - - - - - 8 changed files: - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Rts/Rts.hs - js/rts.js.pp - libraries/base/GHCJS/Prim.hs → libraries/base/GHC/JS/Prim.hs - libraries/base/GHCJS/Prim/Internal.hs → libraries/base/GHC/JS/Prim/Internal.hs - libraries/base/GHCJS/Prim/Internal/Build.hs → libraries/base/GHC/JS/Prim/Internal/Build.hs - libraries/base/base.cabal Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -707,7 +707,6 @@ readArObject ar_state mod ar_file = do ++ " in " ++ ar_file) (BL.fromStrict . Ar.filedata) (find matchTag entries) - -- mapM_ (\e -> putStrLn ("found file: " ++ Ar.filename e)) entries {- | Static dependencies are symbols that need to be linked regardless of whether the linked program refers to them. For example @@ -721,29 +720,6 @@ newtype StaticDeps = noStaticDeps :: StaticDeps noStaticDeps = StaticDeps [] -{- | The input file format for static deps is a yaml document with a - package/module/symbol tree where symbols can be either a list or - just a single string, for example: - - base: - GHC.Conc.Sync: reportError - Control.Exception.Base: nonTermination - ghcjs-prim: - GHCJS.Prim: - - JSVal - - JSException - -} --- instance FromJSON StaticDeps where --- parseJSON (Object v) = StaticDeps . concat <$> mapM (uncurry parseMod) (HM.toList v) --- where --- parseMod p (Object v) = concat <$> mapM (uncurry (parseSymb p)) (HM.toList v) --- parseMod _ _ = mempty --- parseSymb p m (String s) = pure [(p,m,s)] --- parseSymb p m (Array v) = mapM (parseSingleSymb p m) (V.toList v) --- parseSymb _ _ _ = mempty --- parseSingleSymb p m (String s) = pure (p,m,s) --- parseSingleSymb _ _ _ = mempty --- parseJSON _ = mempty -- | dependencies for the RTS, these need to be always linked rtsDeps :: [UnitId] -> IO ([UnitId], Set ExportedFun) @@ -782,7 +758,7 @@ readSystemDeps' file -- wired-in just like in GHC and thus we should make them top level -- definitions | file == "thdeps.yaml" = pure ( [ baseUnitId ] - , S.fromList $ d baseUnitId "GHCJS.Prim.TH.Eval" ["runTHServer"]) + , S.fromList $ d baseUnitId "GHC.JS.Prim.TH.Eval" ["runTHServer"]) | file == "rtsdeps.yaml" = pure ( [ baseUnitId , primUnitId , bignumUnitId @@ -800,8 +776,8 @@ readSystemDeps' file -- FIXME Sylvain (2022,05): no longer valid -- integer constructors -- , d bignumUnitId "GHC.Integer.Type" ["S#", "Jp#", "Jn#"] - , d baseUnitId "GHCJS.Prim" ["JSVal", "JSException", "$fShowJSException", "$fExceptionJSException", "resolve", "resolveIO", "toIO"] - , d baseUnitId "GHCJS.Prim.Internal" ["wouldBlock", "blockedIndefinitelyOnMVar", "blockedIndefinitelyOnSTM", "ignoreException", "setCurrentThreadResultException", "setCurrentThreadResultValue"] + , d baseUnitId "GHC.JS.Prim" ["JSVal", "JSException", "$fShowJSException", "$fExceptionJSException", "resolve", "resolveIO", "toIO"] + , d baseUnitId "GHC.JS.Prim.Internal" ["wouldBlock", "blockedIndefinitelyOnMVar", "blockedIndefinitelyOnSTM", "ignoreException", "setCurrentThreadResultException", "setCurrentThreadResultValue"] ] ) | otherwise = pure (mempty, mempty) ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -930,6 +930,8 @@ genPrim prof ty op = case op of ] FinalizeWeakOp -> \[fl,fin] [w] -> PrimInline $ appT [fin, fl] "h$finalizeWeak" [w] TouchOp -> \[] [_e] -> PrimInline mempty -- fixme what to do? + KeepAliveOp -> \[_r] [x, f] -> PRPrimCall $ ReturnStat (app "h$keepAlive" [x, f]) + ------------------------------ Stable pointers and names ------------------------ @@ -1109,8 +1111,6 @@ genPrim prof ty op = case op of ReadIOPortOp -> unhandledPrimop op WriteIOPortOp -> unhandledPrimop op - KeepAliveOp -> unhandledPrimop op - GetSparkOp -> unhandledPrimop op AnyToAddrOp -> unhandledPrimop op MkApUpd0_Op -> unhandledPrimop op ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -523,6 +523,11 @@ rts' s = , adjSpN' 1 , returnS (app "h$ap_0_0_fast" []) ] + , closure (ClosureInfo "h$keepAlive_e" (CIRegs 0 [PtrV]) "keepAlive" (CILayoutFixed 1 [PtrV]) CIStackFrame mempty) + (mconcat [ adjSpN' 2 + , returnS (stack .! sp) + ] + ) -- a thunk that just raises a synchronous exception , closure (ClosureInfo "h$raise_e" (CIRegs 0 [PtrV]) "h$raise_e" (CILayoutFixed 0 []) CIThunk mempty) (returnS (app "h$throw" [closureField1 r1, false_])) ===================================== js/rts.js.pp ===================================== @@ -703,3 +703,11 @@ function h$catch(a, handler) { h$r1 = a; return h$ap_1_0_fast(); } + +function h$keepAlive(x, f) { + h$sp += 2; + h$stack[h$sp-1] = x; + h$stack[h$sp] = h$keepAlive_e; + h$r1 = f; + return h$ap_1_0_fast(); +} \ No newline at end of file ===================================== libraries/base/GHCJS/Prim.hs → libraries/base/GHC/JS/Prim.hs ===================================== @@ -5,9 +5,9 @@ UnboxedTuples #-} -module GHCJS.Prim ( JSVal(..), JSVal# - , JSException(..) - , WouldBlockException(..) +module GHC.JS.Prim ( JSVal(..), JSVal# + , JSException(..) + , WouldBlockException(..) #ifdef js_HOST_ARCH , toIO , resolve @@ -112,9 +112,9 @@ toJSString :: String -> JSVal toJSString = js_toJSString . unsafeCoerce . seqList {-# INLINE [0] toJSString #-} {-# RULES -"GHCJSPRIM toJSString/literal" forall a. +"GHC.JS.PRIM toJSString/literal" forall a. toJSString (GHC.unpackCString# a) = JSVal (unsafeUnpackJSStringUtf8## a) -"GHCJSPRIM toJSString/literalUtf8" forall a. +"GHC.JS.PRIM toJSString/literalUtf8" forall a. toJSString (GHC.unpackCStringUtf8# a) = JSVal (unsafeUnpackJSStringUtf8## a) #-} @@ -152,9 +152,9 @@ getProp :: JSVal -> String -> IO JSVal getProp o p = js_getProp o (unsafeCoerce $ seqList p) {-# INLINE [0] getProp #-} {-# RULES -"GHCJSPRIM getProp/literal" forall o a. +"GHC.JS.PRIM getProp/literal" forall o a. getProp o (GHC.unpackCString# a) = getProp# o a -"GHCJSPRIM getProp/literalUtf8" forall o a. +"GHC.JS.PRIM getProp/literalUtf8" forall o a. getProp o (GHC.unpackCStringUtf8# a) = getPropUtf8# o a #-} @@ -163,9 +163,9 @@ unsafeGetProp :: JSVal -> String -> JSVal unsafeGetProp o p = js_unsafeGetProp o (unsafeCoerce $ seqList p) {-# INLINE [0] unsafeGetProp #-} {-# RULES -"GHCJSPRIM unsafeGetProp/literal" forall o a. +"GHC.JS.PRIM unsafeGetProp/literal" forall o a. unsafeGetProp o (GHC.unpackCString# a) = unsafeGetProp# o a -"GHCJSPRIM unsafeGetProp/literalUtf8" forall o a. +"GHC.JS.PRIM unsafeGetProp/literalUtf8" forall o a. unsafeGetProp o (GHC.unpackCStringUtf8# a) = unsafeGetPropUtf8# o a #-} @@ -173,9 +173,9 @@ getProp' :: JSVal -> JSVal -> IO JSVal getProp' o p = js_getProp' o p {-# INLINE [0] getProp' #-} {-# RULES -"GHCJSPRIM getProp'/literal" forall o a. +"GHC.JS.PRIM getProp'/literal" forall o a. getProp' o (unsafeUnpackJSString# a) = getProp# o a -"GHCJSPRIM getProp'/literalUtf8" forall o a. +"GHC.JS.PRIM getProp'/literalUtf8" forall o a. getProp' o (unsafeUnpackJSStringUtf8# a) = getPropUtf8# o a #-} @@ -184,9 +184,9 @@ unsafeGetProp' :: JSVal -> JSVal -> JSVal unsafeGetProp' o p = js_unsafeGetProp' o p {-# INLINE [0] unsafeGetProp' #-} {-# RULES -"GHCJSPRIM unsafeGetProp'/literal" forall o a. +"GHC.JS.PRIM unsafeGetProp'/literal" forall o a. unsafeGetProp' o (unsafeUnpackJSString# a) = unsafeGetPropUtf8# o a -"GHCJSPRIM unsafeGetProp'/literalUtf8" forall o a. +"GHC.JS.PRIM unsafeGetProp'/literalUtf8" forall o a. unsafeGetProp' o (unsafeUnpackJSStringUtf8# a) = unsafeGetPropUtf8# o a #-} ===================================== libraries/base/GHCJS/Prim/Internal.hs → libraries/base/GHC/JS/Prim/Internal.hs ===================================== @@ -2,17 +2,17 @@ -} -module GHCJS.Prim.Internal ( blockedIndefinitelyOnMVar - , blockedIndefinitelyOnSTM - , wouldBlock - , ignoreException - , setCurrentThreadResultException - , setCurrentThreadResultValue - ) where +module GHC.JS.Prim.Internal ( blockedIndefinitelyOnMVar + , blockedIndefinitelyOnSTM + , wouldBlock + , ignoreException + , setCurrentThreadResultException + , setCurrentThreadResultValue + ) where import Control.Exception -import GHCJS.Prim +import GHC.JS.Prim wouldBlock :: SomeException wouldBlock = toException WouldBlockException ===================================== libraries/base/GHCJS/Prim/Internal/Build.hs → libraries/base/GHC/JS/Prim/Internal/Build.hs ===================================== @@ -2,10 +2,10 @@ -- no Template Haskell available yet, generated by utils/genBuildObject.hs {-# LANGUAGE CPP #-} #ifndef js_HOST_ARCH -module GHCJS.Prim.Internal.Build () where +module GHC.JS.Prim.Internal.Build () where #else {-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, GHCForeignImportPrim #-} -module GHCJS.Prim.Internal.Build +module GHC.JS.Prim.Internal.Build ( buildArrayI , buildArrayM , buildObjectI @@ -140,7 +140,7 @@ module GHCJS.Prim.Internal.Build , buildObjectM32 ) where -import GHCJS.Prim +import GHC.JS.Prim import GHC.Exts import Unsafe.Coerce import System.IO.Unsafe ===================================== libraries/base/base.cabal ===================================== @@ -461,10 +461,9 @@ Library if arch(js) exposed-modules: - -- FIXME: Luite (2022,05): remove GHCJS name - GHCJS.Prim - GHCJS.Prim.Internal - GHCJS.Prim.Internal.Build + GHC.JS.Prim + GHC.JS.Prim.Internal + GHC.JS.Prim.Internal.Build -- We need to set the unit id to base (without a version number) -- as it's magic. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3c523b3af8f2a5a158455042fe00a279437495f9...9f2e853f01b16119339f4f9086bfdf802e576eda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3c523b3af8f2a5a158455042fe00a279437495f9...9f2e853f01b16119339f4f9086bfdf802e576eda You're receiving 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 Aug 15 19:03:52 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 15:03:52 -0400 Subject: [Git][ghc/ghc][wip/T21847] 2 commits: rts/linker: Consolidate initializer/finalizer handling Message-ID: <62fa98983a752_3d8149489901272286@gitlab.mail> Ben Gamari pushed to branch wip/T21847 at Glasgow Haskell Compiler / GHC Commits: e3f8fbb4 by Ben Gamari at 2022-08-15T14:59:29-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 8031c2ec by Ben Gamari at 2022-08-15T15:01:32-04:00 rts/linker: Add support for .fini sections - - - - - 7 changed files: - rts/linker/Elf.c - rts/linker/ElfTypes.h - + rts/linker/InitFini.c - + rts/linker/InitFini.h - rts/linker/PEi386.c - rts/linker/PEi386Types.h - rts/rts.cabal.in Changes: ===================================== rts/linker/Elf.c ===================================== @@ -25,7 +25,6 @@ #include "ForeignExports.h" #include "Profiling.h" #include "sm/OSMem.h" -#include "GetEnv.h" #include "linker/util.h" #include "linker/elf_util.h" @@ -710,6 +709,66 @@ ocGetNames_ELF ( ObjectCode* oc ) StgWord size = shdr[i].sh_size; StgWord offset = shdr[i].sh_offset; StgWord align = shdr[i].sh_addralign; + const char *sh_name = oc->info->sectionHeaderStrtab + shdr[i].sh_name; + + /* + * Identify initializer and finalizer lists + * + * See Note [Initializers and finalizers (ELF)]. + */ + if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".init", sh_name, 5)) { + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT, 0); + } else if (kind == SECTIONKIND_CODE_OR_RODATA + && 0 == memcmp(".fini", sh_name, 5)) { + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI, 0); + } else if (kind == SECTIONKIND_INIT_ARRAY + || 0 == memcmp(".init_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".init_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .init_arrays run after .ctors + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_INIT_ARRAY, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (kind == SECTIONKIND_FINI_ARRAY + || 0 == memcmp(".fini_array", sh_name, 11)) { + uint32_t prio; + if (sscanf(sh_name, ".fini_array.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + prio += 0x10000; // .fini_arrays run before .dtors + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_FINI_ARRAY, prio); + kind = SECTIONKIND_FINI_ARRAY; + + /* N.B. a compilation unit may have more than one .ctor section; we + * must run them all. See #21618 for a case where this happened */ + } else if (0 == memcmp(".ctors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); + kind = SECTIONKIND_INIT_ARRAY; + } else if (0 == memcmp(".dtors", sh_name, 6)) { + uint32_t prio; + if (sscanf(sh_name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; + } + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); + kind = SECTIONKIND_FINI_ARRAY; + } + if (is_bss && size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for @@ -848,13 +907,9 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->sections[i].info->stub_size = 0; oc->sections[i].info->stubs = NULL; } - oc->sections[i].info->name = oc->info->sectionHeaderStrtab - + shdr[i].sh_name; + oc->sections[i].info->name = sh_name; oc->sections[i].info->sectionHeader = &shdr[i]; - - - if (shdr[i].sh_type != SHT_SYMTAB) continue; /* copy stuff into this module's object symbol table */ @@ -1971,62 +2026,10 @@ ocResolve_ELF ( ObjectCode* oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunInit_ELF( ObjectCode *oc ) { - Elf_Word i; - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - // XXX Apparently in some archs .init may be something - // special! See DL_DT_INIT_ADDRESS macro in glibc - // as well as ELF_FUNCTION_PTR_IS_SPECIAL. We've not handled - // it here, please file a bug report if it affects you. - for (i = 0; i < elf_shnum(ehdr); i++) { - init_t *init_start, *init_end, *init; - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA - && 0 == memcmp(".init", sh_name, 5)) { - init_t init_f = (init_t)(oc->sections[i].start); - init_f(argc, argv, envv); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_INIT_ARRAY - || 0 == memcmp(".init_array", sh_name, 11)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - for (init = init_start; init < init_end; init++) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - - // XXX could be more strict and assert that it's - // SECTIONKIND_RWDATA; but allowing RODATA seems harmless enough. - if ((kind == SECTIONKIND_RWDATA || kind == SECTIONKIND_CODE_OR_RODATA) - && 0 == memcmp(".ctors", sh_strtab + shdr[i].sh_name, 6)) { - char *init_startC = oc->sections[i].start; - init_start = (init_t*)init_startC; - init_end = (init_t*)(init_startC + shdr[i].sh_size); - // ctors run in reverse - for (init = init_end - 1; init >= init_start; init--) { - CHECK(0x0 != *init); - (*init)(argc, argv, envv); - } - } - } - - freeProgEnvv(envc, envv); - return 1; + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); + } + return true; } // Run the finalizers of an ObjectCode. @@ -2034,46 +2037,10 @@ int ocRunInit_ELF( ObjectCode *oc ) // See Note [Initializers and finalizers (ELF)]. int ocRunFini_ELF( ObjectCode *oc ) { - char* ehdrC = (char*)(oc->image); - Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC; - Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[elf_shstrndx(ehdr)].sh_offset; - - for (Elf_Word i = 0; i < elf_shnum(ehdr); i++) { - char *sh_name = sh_strtab + shdr[i].sh_name; - int is_bss = false; - SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss); - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".fini", sh_strtab + shdr[i].sh_name, 5)) { - fini_t fini_f = (fini_t)(oc->sections[i].start); - fini_f(); - } - - // Note [GCC 6 init/fini section workaround] - if (kind == SECTIONKIND_FINI_ARRAY - || 0 == memcmp(".fini_array", sh_name, 11)) { - fini_t *fini_start, *fini_end, *fini; - char *fini_startC = oc->sections[i].start; - fini_start = (fini_t*)fini_startC; - fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - - if (kind == SECTIONKIND_CODE_OR_RODATA && 0 == memcmp(".dtors", sh_strtab + shdr[i].sh_name, 6)) { - char *fini_startC = oc->sections[i].start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + shdr[i].sh_size); - for (fini_t *fini = fini_start; fini < fini_end; fini++) { - CHECK(0x0 != *fini); - (*fini)(); - } - } - } - - return 1; + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); + } + return true; } /* ===================================== rts/linker/ElfTypes.h ===================================== @@ -6,6 +6,7 @@ #include "ghcplatform.h" #include +#include "linker/InitFini.h" /* * Define a set of types which can be used for both ELF32 and ELF64 @@ -137,6 +138,8 @@ struct ObjectCodeFormatInfo { ElfRelocationTable *relTable; ElfRelocationATable *relaTable; + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 /* pointer to the global offset table */ void * got_start; @@ -164,7 +167,7 @@ struct SectionFormatInfo { size_t nstubs; Stub * stubs; - char * name; + const char * name; Elf_Shdr *sectionHeader; }; ===================================== rts/linker/InitFini.c ===================================== @@ -0,0 +1,201 @@ +#include "Rts.h" +#include "RtsUtils.h" +#include "LinkerInternals.h" +#include "GetEnv.h" +#include "InitFini.h" + +/* + * Note [Initializers and finalizers (PEi386/ELF)] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Most ABIs allow an object to define initializers and finalizers to be run + * at load/unload time, respectively. These are represented in two ways: + * + * - a `.init`/`.fini` section which contains a function of type init_t which + * is to be executed during initialization/finalization. + * + * - `.ctors`/`.dtors` sections; these contain an array of pointers to + * `init_t`/`fini_t` functions, all of which should be executed at + * initialization/finalization time. The `.ctors` entries are run in reverse + * order. The list may end in a 0 or -1 sentinel value. + * + * - `.init_array`/`.fini_array` sections; these contain an array + * of pointers to `init_t`/`fini_t` functions. + * + * Objects may contain multiple `.ctors`/`.dtors` and + * `.init_array`/`.fini_array` sections, each optionally suffixed with an + * 16-bit integer priority (e.g. `.init_array.1234`). Confusingly, `.ctors` + * priorities and `.init_array` priorities have different orderings: `.ctors` + * sections are run from high to low priority whereas `.init_array` sections + * are run from low-to-high. + * + * Sections without a priority (e.g. `.ctors`) are assumed to run last (that + * is, are given a priority of 0xffff). + * + * In general, we run finalizers in the reverse order of the associated + * initializers. That is to say, e.g., .init_array entries are run from first + * to last entry and therefore .fini_array entries are run from last-to-first. + * + * To determine the ordering among the various section types, we follow glibc's + * model: + * + * - first run .ctors (last entry to first entry) + * - then run .init_arrays (first-to-last) + * + * and on unload we run in opposite order: + * + * - first run fini_arrays (first-to-last) + * - then run .dtors (last-to-first) + * + * For more about how the code generator emits initializers and finalizers see + * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. + */ + +// Priority follows the init_array definition: initializers are run +// lowest-to-highest, finalizers run highest-to-lowest. +void addInitFini(struct InitFiniList **head, Section *section, enum InitFiniKind kind, uint32_t priority) +{ + struct InitFiniList *slist = stgMallocBytes(sizeof(struct InitFiniList), "addInitFini"); + slist->section = section; + slist->kind = kind; + slist->priority = priority; + slist->next = *head; + *head = slist; +} + +enum SortOrder { INCREASING, DECREASING }; + +// Sort a InitFiniList by priority. +static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order) +{ + // Bubble sort + bool done = false; + while (!done) { + struct InitFiniList **last = slist; + done = true; + while (*last != NULL && (*last)->next != NULL) { + struct InitFiniList *s0 = *last; + struct InitFiniList *s1 = s0->next; + bool flip; + switch (order) { + case INCREASING: flip = s0->priority > s1->priority; break; + case DECREASING: flip = s0->priority < s1->priority; break; + } + if (flip) { + s0->next = s1->next; + s1->next = s0; + *last = s1; + done = false; + } else { + last = &s0->next; + } + } + } +} + +void freeInitFiniList(struct InitFiniList *slist) +{ + while (slist != NULL) { + struct InitFiniList *next = slist->next; + stgFree(slist); + slist = next; + } +} + +static bool runInitFini(struct InitFiniList **head) +{ + int argc, envc; + char **argv, **envv; + + getProgArgv(&argc, &argv); + getProgEnvv(&envc, &envv); + + for (struct InitFiniList *slist = *head; + slist != NULL; + slist = slist->next) + { + Section *section = slist->section; + switch (slist->kind) { + case INITFINI_INIT: { + init_t *init = (init_t*)section->start; + (*init)(argc, argv, envv); + break; + } + case INITFINI_FINI: { + fini_t *fini = (fini_t*)section->start; + (*fini)(); + break; + } + case INITFINI_CTORS: { + uint8_t *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + + // ctors are run *backwards*! + for (init_t *init = init_end - 1; init >= init_start; init--) { + if ((intptr_t) *init == 0x0 || (intptr_t)*init == -1) { + continue; + } + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_DTORS: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + for (fini_t *fini = fini_start; fini < fini_end; fini++) { + if ((intptr_t) *fini == 0x0 || (intptr_t) *fini == -1) { + continue; + } + (*fini)(); + } + break; + } + case INITFINI_INIT_ARRAY: { + char *init_startC = section->start; + init_t *init_start = (init_t*)init_startC; + init_t *init_end = (init_t*)(init_startC + section->size); + for (init_t *init = init_start; init < init_end; init++) { + CHECK(0x0 != *init); + (*init)(argc, argv, envv); + } + break; + } + case INITFINI_FINI_ARRAY: { + char *fini_startC = section->start; + fini_t *fini_start = (fini_t*)fini_startC; + fini_t *fini_end = (fini_t*)(fini_startC + section->size); + // .fini_array finalizers are run backwards + for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { + CHECK(0x0 != *fini); + (*fini)(); + } + break; + } + default: barf("unknown InitFiniKind"); + } + } + freeInitFiniList(*head); + *head = NULL; + + freeProgEnvv(envc, envv); + return true; +} + +// Run the constructors/initializers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runInit(struct InitFiniList **head) +{ + sortInitFiniList(head, INCREASING); + return runInitFini(head); +} + +// Run the finalizers of an ObjectCode. +// Returns 1 on success. +// See Note [Initializers and finalizers (PEi386/ELF)]. +bool runFini(struct InitFiniList **head) +{ + sortInitFiniList(head, DECREASING); + return runInitFini(head); +} ===================================== rts/linker/InitFini.h ===================================== @@ -0,0 +1,23 @@ +#pragma once + +enum InitFiniKind { + INITFINI_INIT, // .init section + INITFINI_FINI, // .fini section + INITFINI_CTORS, // .ctors section + INITFINI_DTORS, // .dtors section + INITFINI_INIT_ARRAY, // .init_array section + INITFINI_FINI_ARRAY, // .fini_array section +}; + +// A linked-list of initializer or finalizer sections. +struct InitFiniList { + Section *section; + uint32_t priority; + enum InitFiniKind kind; + struct InitFiniList *next; +}; + +void addInitFini(struct InitFiniList **slist, Section *section, enum InitFiniKind kind, uint32_t priority); +void freeInitFiniList(struct InitFiniList *slist); +bool runInit(struct InitFiniList **slist); +bool runFini(struct InitFiniList **slist); ===================================== rts/linker/PEi386.c ===================================== @@ -308,7 +308,6 @@ #include "RtsUtils.h" #include "RtsSymbolInfo.h" -#include "GetEnv.h" #include "CheckUnload.h" #include "LinkerInternals.h" #include "linker/PEi386.h" @@ -386,45 +385,6 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -enum SortOrder { INCREASING, DECREASING }; - -// Sort a SectionList by priority. -static void sortSectionList(struct SectionList **slist, enum SortOrder order) -{ - // Bubble sort - bool done = false; - while (!done) { - struct SectionList **last = slist; - done = true; - while (*last != NULL && (*last)->next != NULL) { - struct SectionList *s0 = *last; - struct SectionList *s1 = s0->next; - bool flip; - switch (order) { - case INCREASING: flip = s0->priority > s1->priority; break; - case DECREASING: flip = s0->priority < s1->priority; break; - } - if (flip) { - s0->next = s1->next; - s1->next = s0; - *last = s1; - done = false; - } else { - last = &s0->next; - } - } - } -} - -static void freeSectionList(struct SectionList *slist) -{ - while (slist != NULL) { - struct SectionList *next = slist->next; - stgFree(slist); - slist = next; - } -} - void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), @@ -553,8 +513,8 @@ static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { - freeSectionList(oc->info->init); - freeSectionList(oc->info->fini); + freeInitFiniList(oc->info->init); + freeInitFiniList(oc->info->fini); stgFree (oc->info->ch_info); stgFree (oc->info->symbols); stgFree (oc->info->str_tab); @@ -1513,26 +1473,28 @@ ocGetNames_PEi386 ( ObjectCode* oc ) if (0==strncmp(".ctors", section->info->name, 6)) { /* N.B. a compilation unit may have more than one .ctor section; we * must run them all. See #21618 for a case where this happened */ - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->init; - if (sscanf(section->info->name, ".ctors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = 0; + uint32_t prio; + if (sscanf(section->info->name, ".ctors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->init = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->init, &oc->sections[i], INITFINI_CTORS, prio); kind = SECTIONKIND_INIT_ARRAY; } if (0==strncmp(".dtors", section->info->name, 6)) { - struct SectionList *slist = stgMallocBytes(sizeof(struct SectionList), "ocGetNames_PEi386"); - slist->section = &oc->sections[i]; - slist->next = oc->info->fini; - if (sscanf(section->info->name, ".dtors.%d", &slist->priority) != 1) { - // Sections without an explicit priority must be run last - slist->priority = INT_MAX; + uint32_t prio; + if (sscanf(section->info->name, ".dtors.%d", &prio) != 1) { + // Sections without an explicit priority are run last + prio = 0; } - oc->info->fini = slist; + // .ctors/.dtors are executed in reverse order: higher numbers are + // executed first + prio = 0xffff - prio; + addInitFini(&oc->info->fini, &oc->sections[i], INITFINI_DTORS, prio); kind = SECTIONKIND_FINI_ARRAY; } @@ -1632,10 +1594,6 @@ ocGetNames_PEi386 ( ObjectCode* oc ) addProddableBlock(oc, oc->sections[i].start, sz); } - /* Sort the constructors and finalizers by priority */ - sortSectionList(&oc->info->init, DECREASING); - sortSectionList(&oc->info->fini, INCREASING); - /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; @@ -2170,95 +2128,23 @@ ocResolve_PEi386 ( ObjectCode* oc ) content of .pdata on to RtlAddFunctionTable and the OS will do the rest. When we're unloading the object we have to unregister them using RtlDeleteFunctionTable. - */ -/* - * Note [Initializers and finalizers (PEi386)] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * COFF/PE allows an object to define initializers and finalizers to be run - * at load/unload time, respectively. These are listed in the `.ctors` and - * `.dtors` sections. Moreover, these section names may be suffixed with an - * integer priority (e.g. `.ctors.1234`). Sections are run in order of - * high-to-low priority. Sections without a priority (e.g. `.ctors`) are run - * last. - * - * A `.ctors`/`.dtors` section contains an array of pointers to - * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in - * reverse order. - * - * For more about how the code generator emits initializers and finalizers see - * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini. - */ - - -// Run the constructors/initializers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunInit_PEi386 ( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->init) { - return true; - } - - int argc, envc; - char **argv, **envv; - - getProgArgv(&argc, &argv); - getProgEnvv(&envc, &envv); - - for (struct SectionList *slist = oc->info->init; - slist != NULL; - slist = slist->next) { - Section *section = slist->section; - CHECK(SECTIONKIND_INIT_ARRAY == section->kind); - uint8_t *init_startC = section->start; - init_t *init_start = (init_t*)init_startC; - init_t *init_end = (init_t*)(init_startC + section->size); - - // ctors are run *backwards*! - for (init_t *init = init_end - 1; init >= init_start; init--) { - (*init)(argc, argv, envv); + if (oc && oc->info && oc->info->init) { + return runInit(&oc->info->init); } - } - - freeSectionList(oc->info->init); - oc->info->init = NULL; - - freeProgEnvv(envc, envv); - return true; + return true; } -// Run the finalizers of an ObjectCode. -// Returns 1 on success. -// See Note [Initializers and finalizers (PEi386)]. bool ocRunFini_PEi386( ObjectCode *oc ) { - if (!oc || !oc->info || !oc->info->fini) { - return true; - } - - for (struct SectionList *slist = oc->info->fini; - slist != NULL; - slist = slist->next) { - Section section = *slist->section; - CHECK(SECTIONKIND_FINI_ARRAY == section.kind); - - uint8_t *fini_startC = section.start; - fini_t *fini_start = (fini_t*)fini_startC; - fini_t *fini_end = (fini_t*)(fini_startC + section.size); - - // dtors are run in forward order. - for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--) { - (*fini)(); + if (oc && oc->info && oc->info->fini) { + return runFini(&oc->info->fini); } - } - - freeSectionList(oc->info->fini); - oc->info->fini = NULL; - - return true; + return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type) ===================================== rts/linker/PEi386Types.h ===================================== @@ -4,6 +4,7 @@ #include "ghcplatform.h" #include "PEi386.h" +#include "linker/InitFini.h" #include #include @@ -17,17 +18,9 @@ struct SectionFormatInfo { uint64_t virtualAddr; }; -// A linked-list of Sections; used to represent the set of initializer/finalizer -// list sections. -struct SectionList { - Section *section; - int priority; - struct SectionList *next; -}; - struct ObjectCodeFormatInfo { - struct SectionList* init; // Freed by ocRunInit_PEi386 - struct SectionList* fini; // Freed by ocRunFini_PEi386 + struct InitFiniList* init; // Freed by ocRunInit_PEi386 + struct InitFiniList* fini; // Freed by ocRunFini_PEi386 Section* pdata; Section* xdata; COFF_HEADER_INFO* ch_info; // Freed by ocResolve_PEi386 ===================================== rts/rts.cabal.in ===================================== @@ -550,6 +550,7 @@ library hooks/StackOverflow.c linker/CacheFlush.c linker/Elf.c + linker/InitFini.c linker/LoadArchive.c linker/M32Alloc.c linker/MMap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ae873075c31d4ccd841f2e253ed6ee3d730164b...8031c2ec033c7af3ef1759a5f2b8ec39b198b1ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ae873075c31d4ccd841f2e253ed6ee3d730164b...8031c2ec033c7af3ef1759a5f2b8ec39b198b1ea You're receiving 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 Aug 15 19:13:15 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 15:13:15 -0400 Subject: [Git][ghc/ghc][wip/T22052] users-guide: Rephrase the rewrite rule documentation Message-ID: <62fa9acbac147_3d81494899012777b@gitlab.mail> Ben Gamari pushed to branch wip/T22052 at Glasgow Haskell Compiler / GHC Commits: e16fd88e by Ben Gamari at 2022-08-15T15:13:07-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 1 changed file: - docs/users_guide/exts/rewrite_rules.rst Changes: ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE ` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e16fd88e6939bfe988b80c9ef44efd93bd43b607 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e16fd88e6939bfe988b80c9ef44efd93bd43b607 You're receiving 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 Aug 15 19:16:09 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 15:16:09 -0400 Subject: [Git][ghc/ghc][wip/T22052] users-guide: Rephrase the rewrite rule documentation Message-ID: <62fa9b79ae80e_3d8149489901284443@gitlab.mail> Ben Gamari pushed to branch wip/T22052 at Glasgow Haskell Compiler / GHC Commits: 6d4612f9 by Ben Gamari at 2022-08-15T15:14:27-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 1 changed file: - docs/users_guide/exts/rewrite_rules.rst Changes: ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d4612f925dc6ef5d64b84f71addca97e5895108 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d4612f925dc6ef5d64b84f71addca97e5895108 You're receiving 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 Aug 15 20:28:35 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 15 Aug 2022 16:28:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/ghci-tag-nullary Message-ID: <62faac7389f47_3d81494882813015dd@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/ghci-tag-nullary You're receiving 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 Aug 15 20:39:02 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 15 Aug 2022 16:39:02 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 4 commits: Remove orphan instance for StaticArg Message-ID: <62faaee64c2b1_3d81494899013049fe@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 5ee51a84 by Sylvain Henry at 2022-08-15T22:26:52+02:00 Remove orphan instance for StaticArg - - - - - 7280af8a by Sylvain Henry at 2022-08-15T22:26:52+02:00 Minor doc/cleanup - - - - - 09b6fc33 by Sylvain Henry at 2022-08-15T22:26:52+02:00 Remove redundant jsIdIdent' function - - - - - 9716e7f2 by Sylvain Henry at 2022-08-15T22:26:52+02:00 Split StgToJS.Monad into StgToJS.{Monad,Ids,Stack} - - - - - 15 changed files: - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - + compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Linker/Compactor.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs - + compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/StaticPtr.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -43,6 +43,8 @@ import GHC.StgToJS.Regs import GHC.StgToJS.CoreUtils import GHC.StgToJS.Utils import GHC.StgToJS.Rts.Types +import GHC.StgToJS.Stack +import GHC.StgToJS.Ids import GHC.Types.Literal import GHC.Types.Id @@ -107,7 +109,7 @@ genApp ctx i args -- -- , Just (Lit (MachStr bs)) <- expandUnfolding_maybe (idUnfolding v) -- -- , Just t <- decodeModifiedUTF8 bs -- unpackFS fs -- Just t <- decodeModifiedUTF8 bs -- , matchVarName "ghcjs-prim" "GHCJS.Prim" "unsafeUnpackJSStringUtf8##" i = --- (,ExprInline Nothing) . (|=) top . app "h$decodeUtf8z" <$> genIds v +-- (,ExprInline Nothing) . (|=) top . app "h$decodeUtf8z" <$> varsForId v -- Case: unpackCStringAppend# "some string"# str -- @@ -131,7 +133,7 @@ genApp ctx i args | Just n <- ctxLneBindingStackSize ctx i = do as' <- concatMapM genArg args - ei <- jsEntryId i + ei <- varForEntryId i let ra = mconcat . reverse $ zipWith (\r a -> toJExpr r |= a) [R1 ..] as' p <- pushLneFrame n ctx @@ -171,7 +173,7 @@ genApp ctx i args , ctxIsEvaluated ctx i = do let c = head (concatMap typex_expr $ ctxTarget ctx) - is <- genIds i + is <- varsForId i case is of [i'] -> return ( c |= if_ (isObject i') (closureField1 i') i' @@ -220,7 +222,7 @@ genApp ctx i args , idFunRepArity i == 0 , not (might_be_a_function (idType i)) = do - enter_id <- genArg (StgVarArg i) >>= + enter_id <- genIdArg i >>= \case [x] -> return x xs -> pprPanic "genApp: unexpected multi-var argument" @@ -237,7 +239,7 @@ genApp ctx i args , isStrictId i = do as' <- concatMapM genArg args - is <- assignAll jsRegsFromR1 <$> genIds i + is <- assignAll jsRegsFromR1 <$> varsForId i jmp <- jumpToII i as' is return (jmp, ExprCont) @@ -252,7 +254,7 @@ genApp ctx i args let (reg,over) = splitAt (idFunRepArity i) args reg' <- concatMapM genArg reg pc <- pushCont over - is <- assignAll jsRegsFromR1 <$> genIds i + is <- assignAll jsRegsFromR1 <$> varsForId i jmp <- jumpToII i reg' is return (pc <> jmp, ExprCont) @@ -262,7 +264,7 @@ genApp ctx i args -- - otherwise use generic apply function h$ap_gen_fast | otherwise = do - is <- assignAll jsRegsFromR1 <$> genIds i + is <- assignAll jsRegsFromR1 <$> varsForId i jmp <- jumpToFast args is return (jmp, ExprCont) @@ -271,14 +273,14 @@ genApp ctx i args jumpToII :: Id -> [JExpr] -> JStat -> G JStat jumpToII i args afterLoad | isLocalId i = do - ii <- jsId i + ii <- varForId i return $ mconcat [ ra , afterLoad , returnS (closureEntry ii) ] | otherwise = do - ei <- jsEntryId i + ei <- varForEntryId i return $ mconcat [ ra , afterLoad @@ -1048,7 +1050,7 @@ initClosure cfg entry values ccs = -- | Return an expression for every field of the given Id getIdFields :: Id -> G [TypedExpr] -getIdFields i = assocIdExprs i <$> genIds i +getIdFields i = assocIdExprs i <$> varsForId i -- | Store fields of Id into the given target expressions storeIdFields :: Id -> [TypedExpr] -> G JStat ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -1,15 +1,16 @@ {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- For ToJExpr StaticArg, see FIXME +-- | Code generation of application arguments module GHC.StgToJS.Arg ( genArg - , genStaticArg , genIdArg , genIdArgI , genIdStackArgI , allocConStatic , allocUnboxedConStatic , allocateStaticList + , jsStaticArg + , jsStaticArgs ) where @@ -24,6 +25,7 @@ import GHC.StgToJS.Monad import GHC.StgToJS.Literal import GHC.StgToJS.CoreUtils import GHC.StgToJS.Profiling +import GHC.StgToJS.Ids import GHC.Builtin.Types import GHC.Stg.Syntax @@ -110,39 +112,40 @@ genStaticArg a = case a of | i == falseDataConId = return [StaticLitArg (BoolLit False)] | isMultiVar r = - map (\(TxtI t) -> StaticObjArg t) <$> mapM (jsIdIN i) [1..varSize r] -- this seems wrong, not an obj? - | otherwise = (\(TxtI it) -> [StaticObjArg it]) <$> jsIdI i + map (\(TxtI t) -> StaticObjArg t) <$> mapM (identForIdN i) [1..varSize r] -- this seems wrong, not an obj? + | otherwise = (\(TxtI it) -> [StaticObjArg it]) <$> identForId i unfloated :: CgStgExpr -> G [StaticArg] unfloated (StgLit l) = map StaticLitArg <$> genStaticLit l unfloated (StgConApp dc _n args _) | isBoolDataCon dc || isUnboxableCon dc = (:[]) . allocUnboxedConStatic dc . concat <$> mapM genStaticArg args -- fixme what is allocunboxedcon? - | null args = (\(TxtI t) -> [StaticObjArg t]) <$> jsIdI (dataConWorkId dc) + | null args = (\(TxtI t) -> [StaticObjArg t]) <$> identForId (dataConWorkId dc) | otherwise = do as <- concat <$> mapM genStaticArg args - (TxtI e) <- enterDataConI dc + (TxtI e) <- identForDataConWorker dc return [StaticConArg e as] unfloated x = pprPanic "genArg: unexpected unfloated expression" (pprStgExpr panicStgPprOpts x) +-- | Generate JS code for an StgArg genArg :: HasDebugCallStack => StgArg -> G [JExpr] genArg a = case a of StgLitArg l -> genLit l StgVarArg i -> do unFloat <- State.gets gsUnfloated case lookupUFM unFloat i of - Nothing -> reg Just expr -> unfloated expr + Nothing + | isVoid r -> return [] + | i == trueDataConId -> return [true_] + | i == falseDataConId -> return [false_] + | isMultiVar r -> mapM (varForIdN i) [1..varSize r] + | otherwise -> (:[]) <$> varForId i + where -- if our argument is a joinid, it can be an unboxed tuple r :: HasDebugCallStack => VarType r = uTypeVt . stgArgType $ a - reg - | isVoid r = return [] - | i == trueDataConId = return [true_] - | i == falseDataConId = return [false_] - | isMultiVar r = mapM (jsIdN i) [1..varSize r] - | otherwise = (:[]) <$> jsId i unfloated :: HasDebugCallStack => CgStgExpr -> G [JExpr] unfloated = \case @@ -150,10 +153,10 @@ genArg a = case a of StgConApp dc _n args _ | isBoolDataCon dc || isUnboxableCon dc -> (:[]) . allocUnboxedCon dc . concat <$> mapM genArg args - | null args -> (:[]) <$> jsId (dataConWorkId dc) + | null args -> (:[]) <$> varForId (dataConWorkId dc) | otherwise -> do as <- concat <$> mapM genArg args - e <- enterDataCon dc + e <- varForDataConWorker dc inl_alloc <- csInlineAlloc <$> getSettings return [allocDynamicE inl_alloc e as Nothing] -- FIXME: ccs x -> pprPanic "genArg: unexpected unfloated expression" (pprStgExpr panicStgPprOpts x) @@ -164,8 +167,8 @@ genIdArg i = genArg (StgVarArg i) genIdArgI :: HasDebugCallStack => Id -> G [Ident] genIdArgI i | isVoid r = return [] - | isMultiVar r = mapM (jsIdIN i) [1..varSize r] - | otherwise = (:[]) <$> jsIdI i + | isMultiVar r = mapM (identForIdN i) [1..varSize r] + | otherwise = (:[]) <$> identForId i where r = uTypeVt . idType $ i @@ -192,7 +195,7 @@ allocConStatic (TxtI to) cc con args = do | isBoolDataCon con && dataConTag con == 2 = emitStatic to (StaticUnboxed $ StaticUnboxedBool True) cc' | otherwise = do - (TxtI e) <- enterDataConI con + (TxtI e) <- identForDataConWorker con emitStatic to (StaticData e []) cc' allocConStatic' cc' [x] | isUnboxableCon con = @@ -211,7 +214,7 @@ allocConStatic (TxtI to) cc con args = do (a0:a1:_) -> flip (emitStatic to) cc' =<< allocateStaticList [a0] a1 _ -> panic "allocConStatic: invalid args for consDataCon" else do - (TxtI e) <- enterDataConI con + (TxtI e) <- identForDataConWorker con emitStatic to (StaticData e xs) cc' allocUnboxedConStatic :: DataCon -> [StaticArg] -> StaticArg @@ -249,16 +252,16 @@ allocateStaticList xs a@(StgVarArg i) pprPanic "allocateStaticList: invalid argument (tail)" (ppr (xs, r)) allocateStaticList _ _ = panic "allocateStaticList: unexpected literal in list" --- FIXME: Jeff (2022,03): Fix this orphan instance. It is consumed by --- Linker.Linker but requires allocDynamicE, hence its presence in this file. If --- we put it in StgToJS.Types (where StaticArg is defined) then we'll end up in --- an obvious module cycle. We could put it in DataCon but then we lose cohesion --- in that module (i.e., why should the DataCon module be exporting this --- instance?). It seems to be that this module should be the one that defines --- StaticArg, but I leave that for a refactor later. -instance ToJExpr StaticArg where - toJExpr (StaticLitArg l) = toJExpr l - toJExpr (StaticObjArg t) = ValExpr (JVar (TxtI t)) - toJExpr (StaticConArg c args) = +-- | Generate JS code corresponding to a static arg +jsStaticArg :: StaticArg -> JExpr +jsStaticArg = \case + StaticLitArg l -> toJExpr l + StaticObjArg t -> ValExpr (JVar (TxtI t)) + StaticConArg c args -> -- FIXME: cost-centre stack - allocDynamicE False (ValExpr . JVar . TxtI $ c) (map toJExpr args) Nothing + allocDynamicE False (ValExpr . JVar . TxtI $ c) (map jsStaticArg args) Nothing + +-- | Generate JS code corresponding to a list of static args +jsStaticArgs :: [StaticArg] -> JExpr +jsStaticArgs = ValExpr . JList . map jsStaticArg + ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -30,6 +30,8 @@ import GHC.StgToJS.Profiling import GHC.StgToJS.Regs import GHC.StgToJS.StaticPtr import GHC.StgToJS.UnitUtils +import GHC.StgToJS.Stack +import GHC.StgToJS.Ids import GHC.Stg.Syntax import GHC.Core.DataCon @@ -86,7 +88,7 @@ stgToJS logger config stg_binds0 this_mod spt_entries foreign_stubs cccs output_ -- (exported symbol names, javascript statements) for each linkable unit p <- forM lus \u -> do - ts <- mapM (fmap (\(TxtI i) -> i) . jsIdI) (luIdExports u) + ts <- mapM (fmap (\(TxtI i) -> i) . identForId) (luIdExports u) return (ts ++ luOtherExports u, luStat u) deps <- genDependencyData this_mod lus @@ -191,7 +193,7 @@ genUnits m ss spt_entries foreign_stubs -> Int -> G (Object.SymbolTable, Maybe LinkableUnit) generateBlock st (StgTopStringLit bnd str) n = do - bids <- genIdsI bnd + bids <- identsForId bnd case bids of [(TxtI b1t),(TxtI b2t)] -> do -- [e1,e2] <- genLit (MachStr str) @@ -242,7 +244,7 @@ serializeLinkableUnit _m st i ci si stat rawStat fe fi = do !(!st', !o) <- lift $ Object.serializeStat st ci si stat rawStat fe fi return (st', i', o) -- deepseq results? where - idStr i = itxt <$> jsIdI i + idStr i = itxt <$> identForId i -- | variable prefix for the nth block in module modulePrefix :: Module -> Int -> FastString @@ -274,7 +276,7 @@ genToplevelConEntry i rhs = case rhs of genSetConInfo :: HasDebugCallStack => Id -> DataCon -> LiveVars -> G JStat genSetConInfo i d l {- srt -} = do - ei@(TxtI eii) <- jsDcEntryIdI i + ei@(TxtI eii) <- identForDataConEntryId i sr <- genStaticRefs l emitClosureInfo $ ClosureInfo eii (CIRegs 0 [PtrV]) @@ -296,12 +298,19 @@ genToplevelRhs :: Id -> CgStgRhs -> G JStat -- general cases: genToplevelRhs i rhs = case rhs of StgRhsCon cc con _mu _tys args -> do - ii <- jsIdI i + ii <- identForId i allocConStatic ii cc con args return mempty StgRhsClosure _ext cc _upd_flag {- srt -} args body -> do - eid@(TxtI eidt) <- jsEnIdI i - (TxtI idt) <- jsIdI i + {- + algorithm: + - collect all Id refs that are in the global id cache + - count usage in body for each ref + - order by increasing use + - prepend loading lives var to body: body can stay the same + -} + eid@(TxtI eidt) <- identForEntryId i + (TxtI idt) <- identForId i body <- genBody (initExprCtx i) i R2 args body (lidents, lids) <- unzip <$> liftToGlobal (jsSaturate (Just "ghcjs_tmp_sat_") body) let lidents' = map (\(TxtI t) -> t) lidents ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -22,6 +22,7 @@ import GHC.StgToJS.Monad import GHC.StgToJS.CoreUtils import GHC.StgToJS.Profiling import GHC.StgToJS.Utils +import GHC.StgToJS.Ids import GHC.Core.DataCon @@ -53,10 +54,10 @@ allocCon to con cc xs | isBoolDataCon con || isUnboxableCon con = return (toJExpr to |= allocUnboxedCon con xs) {- | null xs = do - i <- jsId (dataConWorkId con) + i <- varForId (dataConWorkId con) return (assignj to i) -} | otherwise = do - e <- enterDataCon con + e <- varForDataConWorker con cs <- getSettings prof <- profiling ccsJ <- if prof then ccsVarJ cc else return Nothing ===================================== compiler/GHC/StgToJS/Deps.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.StgToJS.Object as Object import GHC.StgToJS.Types -import GHC.StgToJS.Monad +import GHC.StgToJS.Ids import GHC.JS.Syntax @@ -124,7 +124,7 @@ genDependencyData mod units = do let k = getKey . getUnique $ i addEntry :: StateT DependencyDataCache G Object.ExportedFun addEntry = do - (TxtI idTxt) <- lift (jsIdI i) + (TxtI idTxt) <- lift (identForId i) lookupExternalFun (Just k) (OtherSymb m idTxt) in if m == mod then pprPanic "local id not found" (ppr m) @@ -144,7 +144,7 @@ genDependencyData mod units = do lookupExportedId :: Id -> StateT DependencyDataCache G Object.ExportedFun lookupExportedId i = do - (TxtI idTxt) <- lift (jsIdI i) + (TxtI idTxt) <- lift (identForId i) lookupExternalFun (Just . getKey . getUnique $ i) (OtherSymb mod idTxt) lookupExportedOther :: FastString -> StateT DependencyDataCache G Object.ExportedFun ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -33,6 +33,8 @@ import GHC.StgToJS.Regs import GHC.StgToJS.StgUtils import GHC.StgToJS.CoreUtils import GHC.StgToJS.Utils +import GHC.StgToJS.Stack +import GHC.StgToJS.Ids import GHC.Types.Basic import GHC.Types.CostCentre @@ -143,16 +145,16 @@ genBind ctx bndr = let sel_tag | the_offset == 2 = if total_size == 2 then "2a" else "2b" | otherwise = show the_offset - tgts <- genIdsI b - the_fvjs <- genIds the_fv + tgts <- identsForId b + the_fvjs <- varsForId the_fv case (tgts, the_fvjs) of ([tgt], [the_fvj]) -> return $ Just (tgt ||= ApplExpr (var ("h$c_sel_" <> mkFastString sel_tag)) [the_fvj]) _ -> panic "genBind.assign: invalid size" assign b (StgRhsClosure _ext _ccs _upd [] expr) | snd (isInlineExpr (ctxEvaluatedIds ctx) expr) = do - d <- declIds b - tgt <- genIds b + d <- declVarsForId b + tgt <- varsForId b let ctx' = ctx { ctxTarget = assocIdExprs b tgt } (j, _) <- genExpr ctx' expr return (Just (d <> j)) @@ -175,7 +177,7 @@ genBindLne ctx bndr = do vis <- map (\(x,y,_) -> (x,y)) <$> optimizeFree oldFrameSize (newLvs++map fst updBinds) -- initialize updatable bindings to null_ - declUpds <- mconcat <$> mapM (fmap (||= null_) . jsIdI . fst) updBinds + declUpds <- mconcat <$> mapM (fmap (||= null_) . identForId . fst) updBinds -- update expression context to include the updated LNE frame let ctx' = ctxUpdateLneFrame vis bound ctx mapM_ (uncurry $ genEntryLne ctx') binds @@ -220,7 +222,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body) = | otherwise = mempty lvs <- popLneFrame True payloadSize ctx body <- genBody ctx i R1 args body - ei@(TxtI eii) <- jsEntryIdI i + ei@(TxtI eii) <- identForEntryId i sr <- genStaticRefsRhs rhs let f = JFunc [] (bh <> lvs <> body) emitClosureInfo $ @@ -234,9 +236,9 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body) = emitToplevel (ei ||= toJExpr f) genEntryLne ctx i (StgRhsCon cc con _mu _ticks args) = resetSlots $ do let payloadSize = ctxLneFrameSize ctx - ei@(TxtI _eii) <- jsEntryIdI i - -- di <- enterDataCon con - ii <- makeIdent + ei@(TxtI _eii) <- identForEntryId i + -- di <- varForDataConWorker con + ii <- freshIdent p <- popLneFrame True payloadSize ctx args' <- concatMapM genArg args ac <- allocCon ii con cc args' @@ -252,7 +254,7 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body) = res llv <- verifyRuntimeReps live upd <- genUpdFrame upd_flag i body <- genBody entryCtx i R2 args body - ei@(TxtI eii) <- jsEntryIdI i + ei@(TxtI eii) <- identForEntryId i et <- genEntryType args setcc <- ifProfiling $ if et == CIThunk @@ -358,7 +360,7 @@ verifyRuntimeReps xs = do else mconcat <$> mapM verifyRuntimeRep xs where verifyRuntimeRep i = do - i' <- genIds i + i' <- varsForId i pure $ go i' (idVt i) go js (VoidV:vs) = go js vs go (j1:j2:js) (LongV:vs) = v "h$verify_rep_long" [j1,j2] <> go js vs @@ -376,7 +378,7 @@ verifyRuntimeReps xs = do loadLiveFun :: [Id] -> G JStat loadLiveFun l = do - l' <- concat <$> mapM genIdsI l + l' <- concat <$> mapM identsForId l case l' of [] -> return mempty [v] -> return (v ||= r1 .^ closureField1_) @@ -385,7 +387,7 @@ loadLiveFun l = do , v2 ||= r1 .^ closureField2_ ] (v:vs) -> do - d <- makeIdent + d <- freshIdent let l'' = mconcat . zipWith (loadLiveVar $ toJExpr d) [(1::Int)..] $ vs return $ mconcat [ v ||= r1 .^ closureField1_ @@ -400,8 +402,15 @@ popLneFrame :: Bool -> Int -> ExprCtx -> G JStat popLneFrame inEntry size ctx = do let ctx' = ctxLneShrinkStack ctx size - is <- mapM (\(i,n) -> (,SlotId i n) <$> genIdsIN i n) - (ctxLneFrameVars ctx') + let gen_id_slot (i,n) = do + -- FIXME (Sylvain 2022-08): do we really need to generate all the Idents here + -- to only select one? Is it because we need the side effect that consists in + -- filling the GlobalId cache? + ids <- identsForId i + let !id_n = ids !! (n-1) + pure (id_n, SlotId i n) + + is <- mapM gen_id_slot (ctxLneFrameVars ctx') let skip = if inEntry then 1 else 0 -- pop the frame header popSkipI skip is @@ -449,6 +458,9 @@ genStaticRefs lv where sv = liveStatic lv + getStaticRef :: Id -> G (Maybe FastString) + getStaticRef = fmap (fmap itxt . listToMaybe) . identsForId + -- reorder the things we need to push to reuse existing stack values as much as possible -- True if already on the stack at that location optimizeFree :: HasDebugCallStack => Int -> [Id] -> G [(Id,Int,Bool)] @@ -486,25 +498,25 @@ allocCls dynMiddle xs = do proper candidates for this optimization should have been floated already toCl (i, StgRhsCon cc con []) = do - ii <- jsIdI i + ii <- identForId i Left <$> (return (decl ii) <> allocCon ii con cc []) -} toCl (i, StgRhsCon cc con _mui _ticjs [a]) | isUnboxableCon con = do - ii <- jsIdI i + ii <- identForId i ac <- allocCon ii con cc =<< genArg a pure (Left (DeclStat ii <> ac)) -- dynamics toCl (i, StgRhsCon cc con _mu _ticks ar) = -- fixme do we need to handle unboxed? - Right <$> ((,,,) <$> jsIdI i - <*> enterDataCon con + Right <$> ((,,,) <$> identForId i + <*> varForDataConWorker con <*> concatMapM genArg ar <*> pure cc) toCl (i, cl@(StgRhsClosure _ext cc _upd_flag _args _body)) = let live = stgLneLiveExpr cl - in Right <$> ((,,,) <$> jsIdI i - <*> jsEntryId i - <*> concatMapM genIds live + in Right <$> ((,,,) <$> identForId i + <*> varForEntryId i + <*> concatMapM varsForId live <*> pure cc) -- fixme CgCase has a reps_compatible check here @@ -517,8 +529,8 @@ genCase :: HasDebugCallStack -> LiveVars -> G (JStat, ExprResult) genCase ctx bnd e at alts l - | snd (isInlineExpr (ctxEvaluatedIds ctx) e) = withNewIdent $ \ccsVar -> do - bndi <- genIdsI bnd + | snd (isInlineExpr (ctxEvaluatedIds ctx) e) = freshIdent >>= \ccsVar -> do + bndi <- identsForId bnd let ctx' = ctxSetTop bnd $ ctxSetTarget (assocIdExprs bnd (map toJExpr bndi)) $ ctx @@ -558,7 +570,7 @@ genRet :: HasDebugCallStack -> [CgStgAlt] -> LiveVars -> G JStat -genRet ctx e at as l = withNewIdent f +genRet ctx e at as l = freshIdent >>= f where allRefs :: [Id] allRefs = S.toList . S.unions $ fmap (exprRefs emptyUFM . alt_rhs) as @@ -598,8 +610,8 @@ genRet ctx e at as l = withNewIdent f _ -> [PtrV] fun free = resetSlots $ do - decs <- declIds e - load <- flip assignAll (map toJExpr [R1 ..]) . map toJExpr <$> genIdsI e + decs <- declVarsForId e + load <- flip assignAll (map toJExpr [R1 ..]) . map toJExpr <$> identsForId e loadv <- verifyRuntimeReps [e] ras <- loadRetArgs free rasv <- verifyRuntimeReps (map (\(x,_,_)->x) free) @@ -627,15 +639,15 @@ genAlts ctx e at me alts = do PrimAlt _tc | [GenStgAlt _ bs expr] <- alts -> do - ie <- genIds e - dids <- mconcat <$> mapM declIds bs - bss <- concatMapM genIds bs + ie <- varsForId e + dids <- mconcat <$> mapM declVarsForId bs + bss <- concatMapM varsForId bs (ej, er) <- genExpr ctx expr return (dids <> assignAll bss ie <> ej, er) PrimAlt tc -> do - ie <- genIds e + ie <- varsForId e (r, bss) <- normalizeBranches ctx <$> mapM (isolateSlots . mkPrimIfBranch ctx [primRepVt tc]) alts setSlots [] @@ -644,7 +656,7 @@ genAlts ctx e at me alts = do MultiValAlt n | [GenStgAlt _ bs expr] <- alts -> do - eids <- genIds e + eids <- varsForId e l <- loadUbxTup eids bs n (ej, er) <- genExpr ctx expr return (l <> ej, er) @@ -659,7 +671,7 @@ genAlts ctx e at me alts = do , [GenStgAlt (DataAlt dc) bs expr] <- alts , not (isUnboxableCon dc) -> do - bsi <- mapM genIdsI bs + bsi <- mapM identsForId bs (ej, er) <- genExpr ctx expr return (declAssignAll (concat bsi) es <> ej, er) @@ -674,7 +686,7 @@ genAlts ctx e at me alts = do , DataAlt dc <- alt_con alt , isBoolDataCon dc -> do - i <- jsId e + i <- varForId e nbs <- normalizeBranches ctx <$> mapM (isolateSlots . mkAlgBranch ctx e) alts case nbs of @@ -689,7 +701,7 @@ genAlts ctx e at me alts = do -- FIXME: add all alts AlgAlt _tc -> do - ei <- jsId e + ei <- varForId e (r, brs) <- normalizeBranches ctx <$> mapM (isolateSlots . mkAlgBranch ctx e) alts setSlots [] @@ -707,7 +719,7 @@ verifyMatchRep x alt = do then pure mempty else case alt of AlgAlt tc -> do - ix <- genIds x + ix <- varsForId x pure $ ApplStat (var "h$verify_match_alg") (ValExpr(JStr(mkFastString (renderWithContext defaultSDocContext (ppr tc)))):ix) _ -> pure mempty @@ -740,7 +752,7 @@ normalizeBranches ctx brs loadUbxTup :: [JExpr] -> [Id] -> Int -> G JStat loadUbxTup es bs _n = do - bs' <- concatMapM genIdsI bs + bs' <- concatMapM identsForId bs return $ declAssignAll bs' es mkSw :: [JExpr] -> [Branch (Maybe [JExpr])] -> JStat @@ -796,8 +808,8 @@ mkAlgBranch top d alt , isUnboxableCon dc , [b] <- alt_bndrs alt = do - idd <- jsId d - fldx <- genIdsI b + idd <- varForId d + fldx <- identsForId b case fldx of [fld] -> do (ej, er) <- genExpr top (alt_rhs alt) @@ -807,7 +819,7 @@ mkAlgBranch top d alt | otherwise = do cc <- caseCond (alt_con alt) - idd <- jsId d + idd <- varForId d b <- loadParams idd (alt_bndrs alt) (ej, er) <- genExpr top (alt_rhs alt) return (Branch cc (b <> ej) er) @@ -838,7 +850,7 @@ caseCond = \case -- fixme use single tmp var for all branches loadParams :: JExpr -> [Id] -> G JStat loadParams from args = do - as <- concat <$> zipWithM (\a u -> map (,u) <$> genIdsI a) args use + as <- concat <$> zipWithM (\a u -> map (,u) <$> identsForId a) args use return $ case as of [] -> mempty [(x,u)] -> loadIfUsed (from .^ closureField1_) x u ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -23,6 +23,7 @@ import GHC.StgToJS.Types import GHC.StgToJS.Literal import GHC.StgToJS.Regs import GHC.StgToJS.CoreUtils +import GHC.StgToJS.Ids import GHC.Types.RepType import GHC.Types.ForeignCall @@ -101,9 +102,9 @@ parseFFIPatternA :: Bool -- ^ async -- async calls get an extra callback argument -- call it with the result parseFFIPatternA True True pat t es as = do - cb <- makeIdent - x <- makeIdent - d <- makeIdent + cb <- freshIdent + x <- freshIdent + d <- freshIdent stat <- parseFFIPattern' (Just (toJExpr cb)) True pat t es as return $ mconcat [ x ||= (toJExpr (jhFromList [("mv", null_)])) @@ -220,11 +221,11 @@ genFFIArg _isJavaScriptCc (StgLitArg l) = (mempty,) <$> genLit l genFFIArg isJavaScriptCc a@(StgVarArg i) | not isJavaScriptCc && (tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon) = - (\x -> (mempty,[x, zero_])) <$> jsId i + (\x -> (mempty,[x, zero_])) <$> varForId i | isVoid r = return (mempty, []) -- | Just x <- marshalFFIArg a = x - | isMultiVar r = (mempty,) <$> mapM (jsIdN i) [1..varSize r] - | otherwise = (\x -> (mempty,[x])) <$> jsId i + | isMultiVar r = (mempty,) <$> mapM (varForIdN i) [1..varSize r] + | otherwise = (\x -> (mempty,[x])) <$> varForId i where tycon = tyConAppTyCon (unwrapType arg_ty) arg_ty = stgArgType a ===================================== compiler/GHC/StgToJS/Ids.hs ===================================== @@ -0,0 +1,216 @@ +-- | Deals with JS identifiers +module GHC.StgToJS.Ids + ( freshUnique + , freshIdent + , makeIdentForId + , cachedIdentForId + -- * Helpers for Idents + , identForId + , identForIdN + , identsForId + , identForEntryId + , identForDataConEntryId + , identForDataConWorker + -- * Helpers for variables + , varForId + , varForIdN + , varsForId + , varForEntryId + , varForDataConEntryId + , varForDataConWorker + , declVarsForId + ) +where + +import GHC.Prelude + +import GHC.StgToJS.Types +import GHC.StgToJS.Monad +import GHC.StgToJS.CoreUtils +import GHC.StgToJS.UnitUtils + +import GHC.JS.Syntax +import GHC.JS.Make + +import GHC.Core.DataCon +import GHC.Types.Id +import GHC.Types.Unique +import GHC.Types.Name +import GHC.Unit.Module +import GHC.Utils.Encoding (zEncodeString) +import GHC.Data.FastString + +import Control.Monad +import qualified Control.Monad.Trans.State.Strict as State +import qualified Data.Map as M +import Data.Maybe + +-- | Get fresh unique number +freshUnique :: G Int +freshUnique = do + State.modify (\s -> s { gsId = gsId s + 1}) + State.gets gsId + +-- | Get fresh local Ident of the form: h$$unit:module_uniq +freshIdent :: G Ident +freshIdent = do + i <- freshUnique + mod <- State.gets gsModule + let !name = mkFastString $ mconcat + [ "h$$" + , zEncodeString (unitModuleString mod) + , "_" + , encodeUnique i + ] + return (TxtI name) + + + +-- | Encode a Unique number as a base-62 String +encodeUnique :: Int -> String +encodeUnique = reverse . iToBase62 -- reversed is more compressible + +-- | Generate unique Ident for the given ID (uncached!) +-- +-- The ident has the following forms: +-- +-- global Id: h$unit:module.name[_num][_type_suffix] +-- local Id: h$$unit:module.name[_num][_type_suffix]_uniq +-- +-- Note that the string is z-encoded except for "_" delimiters. +-- +-- Optional "_type_suffix" can be: +-- - "_e" for IdEntry +-- - "_con_e" for IdConEntry +-- +-- Optional "_num" is passed as an argument to this function. It is used for +-- Haskell Ids that require several JS variables: e.g. 64-bit numbers (Word64#, +-- Int64#), Addr#, StablePtr#, unboxed tuples, etc. +-- +makeIdentForId :: Id -> Maybe Int -> IdType -> Module -> Ident +makeIdentForId i num id_type current_module = TxtI ident + where + exported = isExportedId i + name = getName i + !ident = mkFastString $ mconcat + [ "h$" + , if exported then "" else "$" + , zEncodeString $ unitModuleString $ case exported of + True | Just m <- nameModule_maybe name -> m + _ -> current_module + , zEncodeString "." + , zString (zEncodeFS (occNameFS (nameOccName name))) + , case num of + Nothing -> "" + Just v -> "_" ++ show v + , case id_type of + IdPlain -> "" + IdEntry -> "_e" + IdConEntry -> "_con_e" + , if exported + then "" + else "_" ++ encodeUnique (getKey (getUnique i)) + ] + +-- | Retrieve the cached Ident for the given Id if there is one. Otherwise make +-- a new one with 'makeIdentForId' and cache it. +cachedIdentForId :: Id -> Maybe Int -> IdType -> G Ident +cachedIdentForId i mi id_type = do + + -- compute key + let !key = IdKey (getKey . getUnique $ i) (fromMaybe 0 mi) id_type + + -- lookup Ident in the Ident cache + IdCache cache <- State.gets gsIdents + ident <- case M.lookup key cache of + Just ident -> pure ident + Nothing -> do + mod <- State.gets gsModule + let !ident = makeIdentForId i mi id_type mod + let !cache' = IdCache (M.insert key ident cache) + State.modify (\s -> s { gsIdents = cache' }) + pure ident + + -- Now update the GlobalId cache, if required + + let update_global_cache = isGlobalId i && isNothing mi && id_type == IdPlain + -- fixme also allow caching entries for lifting? + + when (update_global_cache) $ do + GlobalIdCache gidc <- getGlobalIdCache + case M.lookup ident gidc of + Nothing -> setGlobalIdCache $ GlobalIdCache (M.insert ident (key, i) gidc) + Just _ -> pure () + + pure ident + +-- | Retrieve default Ident for the given Id +identForId :: Id -> G Ident +identForId i = cachedIdentForId i Nothing IdPlain + +-- | Retrieve default Ident for the given Id with sub index +-- +-- Some types, Word64, Addr#, unboxed tuple have more than one corresponding JS +-- var, hence we use the sub index to identify each subpart / JS variable. +identForIdN :: Id -> Int -> G Ident +identForIdN i n = cachedIdentForId i (Just n) IdPlain + +-- | Retrieve all the idents for the given Id. +identsForId :: Id -> G [Ident] +identsForId i = case typeSize (idType i) of + 0 -> pure mempty + 1 -> (:[]) <$> identForId i + s -> mapM (identForIdN i) [1..s] + + +-- | Retrieve entry Ident for the given Id +identForEntryId :: Id -> G Ident +identForEntryId i = cachedIdentForId i Nothing IdEntry + +-- | Retrieve datacon entry Ident for the given Id +-- +-- Different name than the datacon wrapper. +identForDataConEntryId :: Id -> G Ident +identForDataConEntryId i = cachedIdentForId i Nothing IdConEntry + + +-- | Retrieve default variable name for the given Id +varForId :: Id -> G JExpr +varForId i = toJExpr <$> identForId i + +-- | Retrieve default variable name for the given Id with sub index +varForIdN :: Id -> Int -> G JExpr +varForIdN i n = toJExpr <$> identForIdN i n + +-- | Retrieve all the JS vars for the given Id +varsForId :: Id -> G [JExpr] +varsForId i = case typeSize (idType i) of + 0 -> pure mempty + 1 -> (:[]) <$> varForId i + s -> mapM (varForIdN i) [1..s] + + +-- | Retrieve entry variable name for the given Id +varForEntryId :: Id -> G JExpr +varForEntryId i = toJExpr <$> identForEntryId i + +-- | Retrieve datacon entry variable name for the given Id +varForDataConEntryId :: Id -> G JExpr +varForDataConEntryId i = ValExpr . JVar <$> identForDataConEntryId i + + +-- | Retrieve datacon worker entry variable name for the given datacon +identForDataConWorker :: DataCon -> G Ident +identForDataConWorker d = identForDataConEntryId (dataConWorkId d) + +-- | Retrieve datacon worker entry variable name for the given datacon +varForDataConWorker :: DataCon -> G JExpr +varForDataConWorker d = varForDataConEntryId (dataConWorkId d) + +-- | Declare all js vars for the id +declVarsForId :: Id -> G JStat +declVarsForId i = case typeSize (idType i) of + 0 -> return mempty + 1 -> DeclStat <$> identForId i + s -> mconcat <$> mapM (\n -> DeclStat <$> identForIdN i n) [1..s] + ===================================== compiler/GHC/StgToJS/Linker/Compactor.hs ===================================== @@ -76,7 +76,7 @@ import GHC.StgToJS.Types import GHC.StgToJS.Linker.Types import GHC.StgToJS.CoreUtils import GHC.StgToJS.Closure -import GHC.StgToJS.Arg() +import GHC.StgToJS.Arg import Prelude import GHC.Utils.Encoding @@ -389,12 +389,12 @@ staticInitStat :: Bool -- ^ profiling enabled -> JStat staticInitStat _prof (StaticInfo i sv cc) = case sv of - StaticData con args -> appS "h$sti" ([var i, var con, toJExpr args] ++ ccArg) - StaticFun f args -> appS "h$sti" ([var i, var f, toJExpr args] ++ ccArg) + StaticData con args -> appS "h$sti" ([var i, var con, jsStaticArgs args] ++ ccArg) + StaticFun f args -> appS "h$sti" ([var i, var f, jsStaticArgs args] ++ ccArg) StaticList args mt -> - appS "h$stl" ([var i, toJExpr args, toJExpr $ maybe null_ (toJExpr . TxtI) mt] ++ ccArg) + appS "h$stl" ([var i, jsStaticArgs args, toJExpr $ maybe null_ (toJExpr . TxtI) mt] ++ ccArg) StaticThunk (Just (f,args)) -> - appS "h$stc" ([var i, var f, toJExpr args] ++ ccArg) + appS "h$stc" ([var i, var f, jsStaticArgs args] ++ ccArg) _ -> mempty where ccArg = maybeToList (fmap toJExpr cc) ===================================== compiler/GHC/StgToJS/Literal.hs ===================================== @@ -14,6 +14,7 @@ import GHC.JS.Make import GHC.StgToJS.Types import GHC.StgToJS.Monad +import GHC.StgToJS.Ids import GHC.Data.FastString import GHC.Types.Literal @@ -36,8 +37,8 @@ genLit :: HasDebugCallStack => Literal -> G [JExpr] genLit = \case LitChar c -> return [ toJExpr (ord c) ] LitString str -> - withNewIdent $ \strLit@(TxtI strLitT) -> - withNewIdent $ \strOff@(TxtI strOffT) -> do + freshIdent >>= \strLit@(TxtI strLitT) -> + freshIdent >>= \strOff@(TxtI strOffT) -> do emitStatic strLitT (StaticUnboxed (StaticUnboxedString str)) Nothing emitStatic strOffT (StaticUnboxed (StaticUnboxedStringOffset str)) Nothing return [ ValExpr (JVar strLit), ValExpr (JVar strOff) ] ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE BangPatterns #-} +-- | JS codegen state monad module GHC.StgToJS.Monad ( runG , emitGlobal @@ -11,111 +13,37 @@ module GHC.StgToJS.Monad , emitForeign , assertRtsStat , getSettings - , updateThunk - , updateThunk' , liftToGlobal - , bhStats - -- * IDs - , withNewIdent - , makeIdent - , freshUnique - , jsIdIdent - , jsId - , jsIdN - , jsIdI - , jsIdIN - , jsIdIdent' - , jsIdV - , jsEnId - , jsEnIdI - , jsEntryId - , jsEntryIdI - , jsDcEntryId - , jsDcEntryIdI - , genIds - , genIdsN - , genIdsI - , genIdsIN - , getStaticRef - , declIds - -- * Datacon - , enterDataCon - , enterDataConI + , setGlobalIdCache + , getGlobalIdCache -- * Group , modifyGroup , resetGroup - -- * Stack - , resetSlots - , isolateSlots - , setSlots - , getSlots - , addSlots - , dropSlots - , addUnknownSlots - , adjPushStack - , push - , push' - , adjSpN - , adjSpN' - , adjSp' - , adjSp - , pushNN - , pushNN' - , pushN' - , pushN - , pushOptimized' - , pushOptimized - , pushLneFrame - , pop - , popn - , popUnknown - , popSkipUnknown - , popSkip - , popSkip' - , popSkipI - , loadSkip ) where import GHC.Prelude import GHC.JS.Syntax -import GHC.JS.Make import GHC.JS.Transform -import GHC.StgToJS.ExprCtx -import GHC.StgToJS.Heap import GHC.StgToJS.Types -import GHC.StgToJS.Regs -import GHC.StgToJS.CoreUtils -import GHC.StgToJS.UnitUtils import GHC.Unit.Module -import GHC.Core.DataCon import GHC.Stg.Syntax import GHC.Types.SrcLoc import GHC.Types.Id -import GHC.Types.Name -import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.ForeignCall -import GHC.Utils.Encoding (zEncodeString) -import GHC.Utils.Outputable hiding ((<>)) -import GHC.Utils.Misc import qualified Control.Monad.Trans.State.Strict as State import GHC.Data.FastString import qualified Data.Map as M import qualified Data.Set as S -import qualified Data.Bits as Bits import qualified Data.List as L import Data.Function -import Data.Maybe -import Data.Array -import Data.Monoid -import Control.Monad runG :: StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> G a -> IO a runG config m unfloat action = State.evalStateT action (initState config m unfloat) @@ -188,186 +116,9 @@ emitForeign mbSpan pat safety cconv arg_tys res_ty = modifyGroup mod_group Nothing -> "" -withNewIdent :: (Ident -> G a) -> G a -withNewIdent m = makeIdent >>= m - -makeIdent :: G Ident -makeIdent = do - i <- freshUnique - mod <- State.gets gsModule - -- TODO: Is there a better way to concatenate FastStrings? - let !name = mkFastString $ mconcat - [ "h$$" - , zEncodeString (unitModuleString mod) - , "_" - , encodeUnique i - ] - return (TxtI name) - -encodeUnique :: Int -> String -encodeUnique = reverse . iToBase62 -- reversed is more compressible - -jsId :: Id -> G JExpr -jsId i --- | i == trueDataConId = return $ toJExpr True --- | i == falseDataConId = return $ toJExpr False - | otherwise = ValExpr . JVar <$> jsIdIdent i Nothing IdPlain - -jsIdI :: Id -> G Ident -jsIdI i = jsIdIdent i Nothing IdPlain - --- some types, Word64, Addr#, unboxed tuple have more than one javascript var -jsIdIN :: Id -> Int -> G Ident -jsIdIN i n = jsIdIdent i (Just n) IdPlain - -jsIdN :: Id -> Int -> G JExpr -jsIdN i n = ValExpr . JVar <$> jsIdIdent i (Just n) IdPlain - --- uncached -jsIdIdent' :: Id -> Maybe Int -> IdType -> G Ident -jsIdIdent' i mn suffix0 = do - (prefix, u) <- mkPrefixU - let i' = (\x -> mkFastString $ "h$"++prefix++x++mns++suffix++u) . zEncodeString $ name - i' `seq` return (TxtI i') - where - suffix = idTypeSuffix suffix0 - mns = maybe "" (('_':).show) mn - name = ('.':) . nameStableString . localiseName . getName $ i - - mkPrefixU :: G (String, String) - mkPrefixU - | isExportedId i, Just x <- (nameModule_maybe . getName) i = do - let xstr = unitModuleString x - return (zEncodeString xstr, "") - | otherwise = (,('_':) . encodeUnique . getKey . getUnique $ i) . ('$':) - . zEncodeString . unitModuleString <$> State.gets gsModule - --- entry id -jsEnId :: Id -> G JExpr -jsEnId i = ValExpr . JVar <$> jsEnIdI i - -jsEnIdI :: Id -> G Ident -jsEnIdI i = jsIdIdent i Nothing IdEntry - -jsEntryId :: Id -> G JExpr -jsEntryId i = ValExpr . JVar <$> jsEntryIdI i - -jsEntryIdI :: Id -> G Ident -jsEntryIdI i = jsIdIdent i Nothing IdEntry - --- datacon entry, different name than the wrapper -jsDcEntryId :: Id -> G JExpr -jsDcEntryId i = ValExpr . JVar <$> jsDcEntryIdI i - -jsDcEntryIdI :: Id -> G Ident -jsDcEntryIdI i = jsIdIdent i Nothing IdConEntry - --- entry function of the worker -enterDataCon :: DataCon -> G JExpr -enterDataCon d = jsDcEntryId (dataConWorkId d) - -enterDataConI :: DataCon -> G Ident -enterDataConI d = jsDcEntryIdI (dataConWorkId d) - - -jsIdV :: Id -> G JVal -jsIdV i = JVar <$> jsIdIdent i Nothing IdPlain - - --- | generate all js vars for the ids (can be multiple per var) -genIds :: Id -> G [JExpr] -genIds i - | s == 0 = return mempty - | s == 1 = (:[]) <$> jsId i - | otherwise = mapM (jsIdN i) [1..s] - where - s = typeSize (idType i) - -genIdsN :: Id -> Int -> G JExpr -genIdsN i n = do - xs <- genIds i - return $ xs !! (n-1) - --- | get all idents for an id -genIdsI :: Id -> G [Ident] -genIdsI i - | s == 1 = (:[]) <$> jsIdI i - | otherwise = mapM (jsIdIN i) [1..s] - where - s = typeSize (idType i) - -genIdsIN :: Id -> Int -> G Ident -genIdsIN i n = do - xs <- genIdsI i - return $ xs !! (n-1) - -jsIdIdent :: Id -> Maybe Int -> IdType -> G Ident -jsIdIdent i mi suffix = do - IdCache cache <- State.gets gsIdents - ident <- case M.lookup key cache of - Just ident -> pure ident - Nothing -> do - mod <- State.gets gsModule - let !ident = makeIdIdent i mi suffix mod - let !cache' = IdCache (M.insert key ident cache) - State.modify (\s -> s { gsIdents = cache' }) - pure ident - updateGlobalIdCache ident - where - !key = IdKey (getKey . getUnique $ i) (fromMaybe 0 mi) suffix - updateGlobalIdCache :: Ident -> G Ident - updateGlobalIdCache ji - -- fixme also allow caching entries for lifting? - | not (isGlobalId i) || isJust mi || suffix /= IdPlain = pure ji - | otherwise = do - GlobalIdCache gidc <- getGlobalIdCache - case M.lookup ji gidc of - Nothing -> do - let mod_group g = g { ggsGlobalIdCache = GlobalIdCache (M.insert ji (key, i) gidc) } - State.modify (\s -> s { gsGroup = mod_group (gsGroup s) }) - Just _ -> pure () - pure ji - -getStaticRef :: Id -> G (Maybe FastString) -getStaticRef = fmap (fmap itxt . listToMaybe) . genIdsI - --- uncached -makeIdIdent :: Id -> Maybe Int -> IdType -> Module -> Ident -makeIdIdent i mn suffix0 mod = TxtI txt - where - !txt = mkFastString full_name - - full_name = mconcat - ["h$" - , prefix - , zEncodeString ('.':name) - , mns - , suffix - , u - ] - - -- prefix and suffix (unique) - (prefix,u) - | isExportedId i - , Just x <- (nameModule_maybe . getName) i - = ( zEncodeString (unitModuleString x) - , "" - ) - | otherwise - = ( '$':zEncodeString (unitModuleString mod) - , '_': encodeUnique (getKey (getUnique i)) - ) - - suffix = idTypeSuffix suffix0 - mns = maybe "" (('_':).show) mn - name = renderWithContext defaultSDocContext . pprNameUnqualified . getName $ i - - - -idTypeSuffix :: IdType -> String -idTypeSuffix IdPlain = "" -idTypeSuffix IdEntry = "_e" -idTypeSuffix IdConEntry = "_con_e" + + + -- | start with a new binding group resetGroup :: G () @@ -382,225 +133,6 @@ emptyGlobalIdCache = GlobalIdCache M.empty emptyIdCache :: IdCache emptyIdCache = IdCache M.empty --- | run the action with no stack info -resetSlots :: G a -> G a -resetSlots m = do - s <- getSlots - d <- getStackDepth - setSlots [] - a <- m - setSlots s - setStackDepth d - return a - --- | run the action with current stack info, but don't let modifications propagate -isolateSlots :: G a -> G a -isolateSlots m = do - s <- getSlots - d <- getStackDepth - a <- m - setSlots s - setStackDepth d - pure a - --- | Set stack depth -setStackDepth :: Int -> G () -setStackDepth d = modifyGroup (\s -> s { ggsStackDepth = d}) - --- | Get stack depth -getStackDepth :: G Int -getStackDepth = State.gets (ggsStackDepth . gsGroup) - --- | Modify stack depth -modifyStackDepth :: (Int -> Int) -> G () -modifyStackDepth f = modifyGroup (\s -> s { ggsStackDepth = f (ggsStackDepth s) }) - --- | overwrite our stack knowledge -setSlots :: [StackSlot] -> G () -setSlots xs = modifyGroup (\g -> g { ggsStack = xs}) - --- | retrieve our current stack knowledge -getSlots :: G [StackSlot] -getSlots = State.gets (ggsStack . gsGroup) - --- | Modify stack slots -modifySlots :: ([StackSlot] -> [StackSlot]) -> G () -modifySlots f = modifyGroup (\g -> g { ggsStack = f (ggsStack g)}) - --- | add `n` unknown slots to our stack knowledge -addUnknownSlots :: Int -> G () -addUnknownSlots n = addSlots (replicate n SlotUnknown) - --- | add knowledge about the stack slots -addSlots :: [StackSlot] -> G () -addSlots xs = do - s <- getSlots - setSlots (xs ++ s) - -dropSlots :: Int -> G () -dropSlots n = modifySlots (drop n) - -adjPushStack :: Int -> G () -adjPushStack n = do - modifyStackDepth (+n) - dropSlots n - -push :: [JExpr] -> G JStat -push xs = do - dropSlots (length xs) - modifyStackDepth (+ (length xs)) - flip push' xs <$> getSettings - -push' :: StgToJSConfig -> [JExpr] -> JStat -push' _ [] = mempty -push' cs xs - | csInlinePush cs || l > 32 || l < 2 = adjSp' l <> mconcat items - | otherwise = ApplStat (toJExpr $ pushN ! l) xs - where - items = zipWith (\i e -> AssignStat ((IdxExpr stack) (toJExpr (offset i))) (toJExpr e)) - [(1::Int)..] xs - offset i | i == l = sp - | otherwise = InfixExpr SubOp sp (toJExpr (l - i)) - l = length xs - - -adjSp' :: Int -> JStat -adjSp' 0 = mempty -adjSp' n = sp |= InfixExpr AddOp sp (toJExpr n) - -adjSpN' :: Int -> JStat -adjSpN' 0 = mempty -adjSpN' n = sp |= InfixExpr SubOp sp (toJExpr n) - -adjSp :: Int -> G JStat -adjSp 0 = return mempty -adjSp n = do - modifyStackDepth (+n) - return (adjSp' n) - -adjSpN :: Int -> G JStat -adjSpN 0 = return mempty -adjSpN n = do - modifyStackDepth (\x -> x - n) - return (adjSpN' n) - -pushN :: Array Int Ident -pushN = listArray (1,32) $ map (TxtI . mkFastString . ("h$p"++) . show) [(1::Int)..32] - -pushN' :: Array Int JExpr -pushN' = fmap (ValExpr . JVar) pushN - -pushNN :: Array Integer Ident -pushNN = listArray (1,255) $ map (TxtI . mkFastString . ("h$pp"++) . show) [(1::Int)..255] - -pushNN' :: Array Integer JExpr -pushNN' = fmap (ValExpr . JVar) pushNN - -pushOptimized' :: [(Id,Int)] -> G JStat -pushOptimized' xs = do - slots <- getSlots - pushOptimized =<< (zipWithM f xs (slots++repeat SlotUnknown)) - where - f (i1,n1) (SlotId i2 n2) = (,i1==i2&&n1==n2) <$> genIdsN i1 n1 - f (i1,n1) _ = (,False) <$> genIdsN i1 n1 - --- | optimized push that reuses existing values on stack automatically chooses --- an optimized partial push (h$ppN) function when possible. -pushOptimized :: [(JExpr,Bool)] -- ^ contents of the slots, True if same value is already there - -> G JStat -pushOptimized [] = return mempty -pushOptimized xs = do - dropSlots l - modifyStackDepth (+ length xs) - go . csInlinePush <$> getSettings - where - go True = inlinePush - go _ - | all snd xs = adjSp' l - | all (not.snd) xs && l <= 32 = - ApplStat (pushN' ! l) (map fst xs) - | l <= 8 && not (snd $ last xs) = - ApplStat (pushNN' ! sig) [ e | (e,False) <- xs ] - | otherwise = inlinePush - l = length xs - sig :: Integer - sig = L.foldl1' (Bits..|.) $ zipWith (\(_e,b) i -> if not b then Bits.bit i else 0) xs [0..] - inlinePush = adjSp' l <> mconcat (zipWith pushSlot [1..] xs) - pushSlot i (ex, False) = IdxExpr stack (offset i) |= ex - pushSlot _ _ = mempty - offset i | i == l = sp - | otherwise = InfixExpr SubOp sp (toJExpr (l - i)) - -pushLneFrame :: HasDebugCallStack => Int -> ExprCtx -> G JStat -pushLneFrame size ctx = - let ctx' = ctxLneShrinkStack ctx size - in pushOptimized' (ctxLneFrameVars ctx') - -popUnknown :: [JExpr] -> G JStat -popUnknown xs = popSkipUnknown 0 xs - -popSkipUnknown :: Int -> [JExpr] -> G JStat -popSkipUnknown n xs = popSkip n (map (,SlotUnknown) xs) - -pop :: [(JExpr,StackSlot)] -> G JStat -pop = popSkip 0 - --- | pop the expressions, but ignore the top n elements of the stack -popSkip :: Int -> [(JExpr,StackSlot)] -> G JStat -popSkip 0 [] = pure mempty -popSkip n [] = addUnknownSlots n >> adjSpN n -popSkip n xs = do - addUnknownSlots n - addSlots (map snd xs) - a <- adjSpN (length xs + n) - return (loadSkip n (map fst xs) <> a) - --- | pop things, don't upstate stack knowledge -popSkip' :: Int -- ^ number of slots to skip - -> [JExpr] -- ^ assign stack slot values to these - -> JStat -popSkip' 0 [] = mempty -popSkip' n [] = adjSpN' n -popSkip' n tgt = loadSkip n tgt <> adjSpN' (length tgt + n) - --- | like popSkip, but without modifying the stack pointer -loadSkip :: Int -> [JExpr] -> JStat -loadSkip = loadSkipFrom sp - -loadSkipFrom :: JExpr -> Int -> [JExpr] -> JStat -loadSkipFrom fr n xs = mconcat items - where - items = reverse $ zipWith (\i ex -> ex |= IdxExpr stack (toJExpr (offset (i+n)))) - [(0::Int)..] - (reverse xs) - offset 0 = toJExpr fr - offset n = InfixExpr SubOp (toJExpr fr) (toJExpr n) - - --- declare and pop -popSkipI :: Int -> [(Ident,StackSlot)] -> G JStat -popSkipI 0 [] = pure mempty -popSkipI n [] = adjSpN n -popSkipI n xs = do - addUnknownSlots n - addSlots (map snd xs) - a <- adjSpN (length xs + n) - return (loadSkipI n (map fst xs) <> a) - --- like popSkip, but without modifying sp -loadSkipI :: Int -> [Ident] -> JStat -loadSkipI = loadSkipIFrom sp - -loadSkipIFrom :: JExpr -> Int -> [Ident] -> JStat -loadSkipIFrom fr n xs = mconcat items - where - items = reverse $ zipWith f [(0::Int)..] (reverse xs) - offset 0 = fr - offset n = InfixExpr SubOp fr (toJExpr n) - f i ex = ex ||= IdxExpr stack (toJExpr (offset (i+n))) - -popn :: Int -> G JStat -popn n = addUnknownSlots n >> adjSpN n assertRtsStat :: G JStat -> G JStat @@ -614,40 +146,9 @@ getSettings = State.gets gsSettings getGlobalIdCache :: G GlobalIdCache getGlobalIdCache = State.gets (ggsGlobalIdCache . gsGroup) -updateThunk' :: StgToJSConfig -> JStat -updateThunk' settings = - if csInlineBlackhole settings - then bhStats settings True - else ApplStat (var "h$bh") [] - --- | Generate statemeents to update the current node with a blackhole -bhStats :: StgToJSConfig -> Bool -> JStat -bhStats s pushUpd = mconcat - [ if pushUpd then push' s [r1, var "h$upd_frame"] else mempty - , toJExpr R1 .^ closureEntry_ |= var "h$blackhole" - , toJExpr R1 .^ closureField1_ |= var "h$currentThread" - , toJExpr R1 .^ closureField2_ |= null_ -- will be filled with waiters array - ] - -updateThunk :: G JStat -updateThunk = do - settings <- getSettings - adjPushStack 2 -- update frame size - return $ (updateThunk' settings) - --- | declare all js vars for the id -declIds :: Id -> G JStat -declIds i - | s == 0 = return mempty - | s == 1 = DeclStat <$> jsIdI i - | otherwise = mconcat <$> mapM (\n -> DeclStat <$> jsIdIN i n) [1..s] - where - s = typeSize (idType i) +setGlobalIdCache :: GlobalIdCache -> G () +setGlobalIdCache v = State.modify (\s -> s { gsGroup = (gsGroup s) { ggsGlobalIdCache = v}}) -freshUnique :: G Int -freshUnique = do - State.modify (\s -> s { gsId = gsId s + 1}) - State.gets gsId liftToGlobal :: JStat -> G [(Ident, Id)] liftToGlobal jst = do @@ -663,10 +164,3 @@ nub' xs = go S.empty xs go _ [] = [] go s (x:xs) | S.member x s = go s xs | otherwise = x : go (S.insert x s) xs --- ids = filter M.member gidc -{- - algorithm: - - collect all Id refs that are in the cache, count usage - - order by increasing use - - prepend loading lives var to body: body can stay the same --} ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -38,11 +38,11 @@ import GHC.JS.Transform import GHC.StgToJS.Apply import GHC.StgToJS.Closure import GHC.StgToJS.Heap -import GHC.StgToJS.Monad import GHC.StgToJS.Printer import GHC.StgToJS.Profiling import GHC.StgToJS.Regs import GHC.StgToJS.Types +import GHC.StgToJS.Stack import GHC.Data.FastString import GHC.Types.Unique.Map ===================================== compiler/GHC/StgToJS/Stack.hs ===================================== @@ -0,0 +1,312 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +-- | Stack manipulation +module GHC.StgToJS.Stack + ( resetSlots + , isolateSlots + , setSlots + , getSlots + , addSlots + , dropSlots + , addUnknownSlots + , adjPushStack + , push + , push' + , adjSpN + , adjSpN' + , adjSp' + , adjSp + , pushNN + , pushNN' + , pushN' + , pushN + , pushOptimized' + , pushOptimized + , pushLneFrame + , pop + , popn + , popUnknown + , popSkipUnknown + , popSkip + , popSkip' + , popSkipI + , loadSkip + -- * Thunk update + , updateThunk + , updateThunk' + , bhStats + ) +where + +import GHC.Prelude + +import GHC.JS.Syntax +import GHC.JS.Make + +import GHC.StgToJS.Types +import GHC.StgToJS.Monad +import GHC.StgToJS.Ids +import GHC.StgToJS.ExprCtx +import GHC.StgToJS.Heap +import GHC.StgToJS.Regs + +import GHC.Types.Id +import GHC.Utils.Misc +import GHC.Data.FastString + +import qualified Data.Bits as Bits +import qualified Data.List as L +import qualified Control.Monad.Trans.State.Strict as State +import Data.Array +import Data.Monoid +import Control.Monad + +-- | Run the action with no stack info +resetSlots :: G a -> G a +resetSlots m = do + s <- getSlots + d <- getStackDepth + setSlots [] + a <- m + setSlots s + setStackDepth d + return a + +-- | run the action with current stack info, but don't let modifications propagate +isolateSlots :: G a -> G a +isolateSlots m = do + s <- getSlots + d <- getStackDepth + a <- m + setSlots s + setStackDepth d + pure a + +-- | Set stack depth +setStackDepth :: Int -> G () +setStackDepth d = modifyGroup (\s -> s { ggsStackDepth = d}) + +-- | Get stack depth +getStackDepth :: G Int +getStackDepth = State.gets (ggsStackDepth . gsGroup) + +-- | Modify stack depth +modifyStackDepth :: (Int -> Int) -> G () +modifyStackDepth f = modifyGroup (\s -> s { ggsStackDepth = f (ggsStackDepth s) }) + +-- | overwrite our stack knowledge +setSlots :: [StackSlot] -> G () +setSlots xs = modifyGroup (\g -> g { ggsStack = xs}) + +-- | retrieve our current stack knowledge +getSlots :: G [StackSlot] +getSlots = State.gets (ggsStack . gsGroup) + +-- | Modify stack slots +modifySlots :: ([StackSlot] -> [StackSlot]) -> G () +modifySlots f = modifyGroup (\g -> g { ggsStack = f (ggsStack g)}) + +-- | add `n` unknown slots to our stack knowledge +addUnknownSlots :: Int -> G () +addUnknownSlots n = addSlots (replicate n SlotUnknown) + +-- | add knowledge about the stack slots +addSlots :: [StackSlot] -> G () +addSlots xs = do + s <- getSlots + setSlots (xs ++ s) + +dropSlots :: Int -> G () +dropSlots n = modifySlots (drop n) + +adjPushStack :: Int -> G () +adjPushStack n = do + modifyStackDepth (+n) + dropSlots n + +push :: [JExpr] -> G JStat +push xs = do + dropSlots (length xs) + modifyStackDepth (+ (length xs)) + flip push' xs <$> getSettings + +push' :: StgToJSConfig -> [JExpr] -> JStat +push' _ [] = mempty +push' cs xs + | csInlinePush cs || l > 32 || l < 2 = adjSp' l <> mconcat items + | otherwise = ApplStat (toJExpr $ pushN ! l) xs + where + items = zipWith (\i e -> AssignStat ((IdxExpr stack) (toJExpr (offset i))) (toJExpr e)) + [(1::Int)..] xs + offset i | i == l = sp + | otherwise = InfixExpr SubOp sp (toJExpr (l - i)) + l = length xs + + +adjSp' :: Int -> JStat +adjSp' 0 = mempty +adjSp' n = sp |= InfixExpr AddOp sp (toJExpr n) + +adjSpN' :: Int -> JStat +adjSpN' 0 = mempty +adjSpN' n = sp |= InfixExpr SubOp sp (toJExpr n) + +adjSp :: Int -> G JStat +adjSp 0 = return mempty +adjSp n = do + modifyStackDepth (+n) + return (adjSp' n) + +adjSpN :: Int -> G JStat +adjSpN 0 = return mempty +adjSpN n = do + modifyStackDepth (\x -> x - n) + return (adjSpN' n) + +pushN :: Array Int Ident +pushN = listArray (1,32) $ map (TxtI . mkFastString . ("h$p"++) . show) [(1::Int)..32] + +pushN' :: Array Int JExpr +pushN' = fmap (ValExpr . JVar) pushN + +pushNN :: Array Integer Ident +pushNN = listArray (1,255) $ map (TxtI . mkFastString . ("h$pp"++) . show) [(1::Int)..255] + +pushNN' :: Array Integer JExpr +pushNN' = fmap (ValExpr . JVar) pushNN + +pushOptimized' :: [(Id,Int)] -> G JStat +pushOptimized' xs = do + slots <- getSlots + pushOptimized =<< (zipWithM f xs (slots++repeat SlotUnknown)) + where + f (i1,n1) xs2 = do + -- FIXME (Sylvain 2022-08): do we really need to generate all the Idents here + -- to only select one? Is it because we need the side effect that consists in + -- filling the GlobalId cache? + xs <- varsForId i1 + let !id_n1 = xs !! (n1-1) + + case xs2 of + SlotId i2 n2 -> pure (id_n1,i1==i2&&n1==n2) + _ -> pure (id_n1,False) + +-- | optimized push that reuses existing values on stack automatically chooses +-- an optimized partial push (h$ppN) function when possible. +pushOptimized :: [(JExpr,Bool)] -- ^ contents of the slots, True if same value is already there + -> G JStat +pushOptimized [] = return mempty +pushOptimized xs = do + dropSlots l + modifyStackDepth (+ length xs) + go . csInlinePush <$> getSettings + where + go True = inlinePush + go _ + | all snd xs = adjSp' l + | all (not.snd) xs && l <= 32 = + ApplStat (pushN' ! l) (map fst xs) + | l <= 8 && not (snd $ last xs) = + ApplStat (pushNN' ! sig) [ e | (e,False) <- xs ] + | otherwise = inlinePush + l = length xs + sig :: Integer + sig = L.foldl1' (Bits..|.) $ zipWith (\(_e,b) i -> if not b then Bits.bit i else 0) xs [0..] + inlinePush = adjSp' l <> mconcat (zipWith pushSlot [1..] xs) + pushSlot i (ex, False) = IdxExpr stack (offset i) |= ex + pushSlot _ _ = mempty + offset i | i == l = sp + | otherwise = InfixExpr SubOp sp (toJExpr (l - i)) + +pushLneFrame :: HasDebugCallStack => Int -> ExprCtx -> G JStat +pushLneFrame size ctx = + let ctx' = ctxLneShrinkStack ctx size + in pushOptimized' (ctxLneFrameVars ctx') + +popUnknown :: [JExpr] -> G JStat +popUnknown xs = popSkipUnknown 0 xs + +popSkipUnknown :: Int -> [JExpr] -> G JStat +popSkipUnknown n xs = popSkip n (map (,SlotUnknown) xs) + +pop :: [(JExpr,StackSlot)] -> G JStat +pop = popSkip 0 + +-- | pop the expressions, but ignore the top n elements of the stack +popSkip :: Int -> [(JExpr,StackSlot)] -> G JStat +popSkip 0 [] = pure mempty +popSkip n [] = addUnknownSlots n >> adjSpN n +popSkip n xs = do + addUnknownSlots n + addSlots (map snd xs) + a <- adjSpN (length xs + n) + return (loadSkip n (map fst xs) <> a) + +-- | pop things, don't upstate stack knowledge +popSkip' :: Int -- ^ number of slots to skip + -> [JExpr] -- ^ assign stack slot values to these + -> JStat +popSkip' 0 [] = mempty +popSkip' n [] = adjSpN' n +popSkip' n tgt = loadSkip n tgt <> adjSpN' (length tgt + n) + +-- | like popSkip, but without modifying the stack pointer +loadSkip :: Int -> [JExpr] -> JStat +loadSkip = loadSkipFrom sp + +loadSkipFrom :: JExpr -> Int -> [JExpr] -> JStat +loadSkipFrom fr n xs = mconcat items + where + items = reverse $ zipWith (\i ex -> ex |= IdxExpr stack (toJExpr (offset (i+n)))) + [(0::Int)..] + (reverse xs) + offset 0 = toJExpr fr + offset n = InfixExpr SubOp (toJExpr fr) (toJExpr n) + + +-- declare and pop +popSkipI :: Int -> [(Ident,StackSlot)] -> G JStat +popSkipI 0 [] = pure mempty +popSkipI n [] = adjSpN n +popSkipI n xs = do + addUnknownSlots n + addSlots (map snd xs) + a <- adjSpN (length xs + n) + return (loadSkipI n (map fst xs) <> a) + +-- like popSkip, but without modifying sp +loadSkipI :: Int -> [Ident] -> JStat +loadSkipI = loadSkipIFrom sp + +loadSkipIFrom :: JExpr -> Int -> [Ident] -> JStat +loadSkipIFrom fr n xs = mconcat items + where + items = reverse $ zipWith f [(0::Int)..] (reverse xs) + offset 0 = fr + offset n = InfixExpr SubOp fr (toJExpr n) + f i ex = ex ||= IdxExpr stack (toJExpr (offset (i+n))) + +popn :: Int -> G JStat +popn n = addUnknownSlots n >> adjSpN n + +updateThunk' :: StgToJSConfig -> JStat +updateThunk' settings = + if csInlineBlackhole settings + then bhStats settings True + else ApplStat (var "h$bh") [] + +-- | Generate statements to update the current node with a blackhole +bhStats :: StgToJSConfig -> Bool -> JStat +bhStats s pushUpd = mconcat + [ if pushUpd then push' s [r1, var "h$upd_frame"] else mempty + , toJExpr R1 .^ closureEntry_ |= var "h$blackhole" + , toJExpr R1 .^ closureField1_ |= var "h$currentThread" + , toJExpr R1 .^ closureField2_ |= null_ -- will be filled with waiters array + ] + +updateThunk :: G JStat +updateThunk = do + settings <- getSettings + adjPushStack 2 -- update frame size + return $ (updateThunk' settings) ===================================== compiler/GHC/StgToJS/StaticPtr.hs ===================================== @@ -15,15 +15,14 @@ import GHC.JS.Make import GHC.StgToJS.Types import GHC.StgToJS.Literal -import GHC.StgToJS.Monad +import GHC.StgToJS.Ids initStaticPtrs :: [SptEntry] -> G JStat initStaticPtrs ptrs = mconcat <$> mapM initStatic ptrs where initStatic (SptEntry sp_id (Fingerprint w1 w2)) = do - i <- jsId sp_id + i <- varForId sp_id fpa <- concat <$> mapM (genLit . mkLitWord64 . fromIntegral) [w1,w2] let sptInsert = ApplExpr (var "h$hs_spt_insert") (fpa ++ [i]) - -- fixme can precedence be so that parens aren't needed? return $ (var "h$initStatic" .^ "push") `ApplStat` [jLam sptInsert] ===================================== compiler/ghc.cabal.in ===================================== @@ -643,6 +643,7 @@ Library GHC.StgToJS.ExprCtx GHC.StgToJS.FFI GHC.StgToJS.Heap + GHC.StgToJS.Ids GHC.StgToJS.Literal GHC.StgToJS.Monad GHC.StgToJS.Object @@ -653,6 +654,7 @@ Library GHC.StgToJS.Rts.Types GHC.StgToJS.Rts.Rts GHC.StgToJS.Sinker + GHC.StgToJS.Stack GHC.StgToJS.StaticPtr GHC.StgToJS.StgUtils GHC.StgToJS.Types View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f2e853f01b16119339f4f9086bfdf802e576eda...9716e7f23f01be535a8f211010dd2c5cedb8838d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f2e853f01b16119339f4f9086bfdf802e576eda...9716e7f23f01be535a8f211010dd2c5cedb8838d You're receiving 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 Aug 15 20:57:04 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 16:57:04 -0400 Subject: [Git][ghc/ghc][wip/T22052] 4 commits: Bump haddock submodule Message-ID: <62fab32077c72_3d8149489041306754@gitlab.mail> Ben Gamari pushed to branch wip/T22052 at Glasgow Haskell Compiler / GHC Commits: 468fd91e by Ben Gamari at 2022-08-15T16:56:59-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - d169ef76 by Ben Gamari at 2022-08-15T16:56:59-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - f2e24ce0 by Ben Gamari at 2022-08-15T16:56:59-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - c57075eb by Ben Gamari at 2022-08-15T16:56:59-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 4 changed files: - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/rewrite_rules.rst - libraries/base/changelog.md - utils/haddock Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -87,3 +87,50 @@ Compiler ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ + + +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/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. @@ -66,14 +66,55 @@ A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md) is available. - * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to - `Debug.Trace`, per - [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36). - * Re-export `augment` and `build` function from `GHC.List` * Re-export the `IsList` typeclass from the new `GHC.IsList` module. + * There's a new special function ``withDict`` in ``GHC.Exts``: :: + + withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r + + where ``cls`` must be a class containing exactly one method, whose type + must be ``meth``. + + This function converts ``meth`` to a type class dictionary. + It removes the need for ``unsafeCoerce`` in implementation of reflection + libraries. It should be used with care, because it can introduce + incoherent instances. + + For example, the ``withTypeable`` function from the + ``Type.Reflection`` module can now be defined as: :: + + withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () + => TypeRep a -> (Typeable a => r) -> r + withTypeable rep k = withDict @(Typeable a) rep k + + Note that the explicit type application is required, as the call to + ``withDict`` would be ambiguous otherwise. + + This replaces the old ``GHC.Exts.magicDict``, which required + an intermediate data type and was less reliable. + + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by + `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these + were rather represented by `Word#` and `Int#`. See GHC #11953. + +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes + ## 4.16.1.0 *Feb 2022* * Shipped with GHC 9.2.2 @@ -498,7 +539,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit a9a312991e55ab99a8dee36a6747f4fc5d5b7c67 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d4612f925dc6ef5d64b84f71addca97e5895108...c57075ebbed5dc8ae82902999b9f5ae5f3e83b0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d4612f925dc6ef5d64b84f71addca97e5895108...c57075ebbed5dc8ae82902999b9f5ae5f3e83b0e You're receiving 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 Aug 15 21:11:41 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 Aug 2022 17:11:41 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] 15 commits: make: Add another missing build dependency on template-haskell Message-ID: <62fab68d39922_3d8149488a013152fe@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: 05eef6e2 by Ben Gamari at 2022-08-15T17:03:18-04:00 make: Add another missing build dependency on template-haskell This time the culprit is Data.Sequence.Internal. Closes #22047. - - - - - c2043b0a by normalcoder at 2022-08-15T17:11:26-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms (cherry picked from commit 67575f2004340564d6e52af055ed6fb43d3f9711) - - - - - 44b60e03 by Ben Gamari at 2022-08-15T17:11:26-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. (cherry picked from commit c1c08bd829fb33a185f0a71f08babe5d7e6556fc) - - - - - 658d3fd5 by Ben Gamari at 2022-08-15T17:11:26-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. (cherry picked from commit 1c582f44e41f534a8506a76618f6cffe5d71ed42) - - - - - e2832cbd by Ben Gamari at 2022-08-15T17:11:26-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. (cherry picked from commit 681aa076259c05c626266cf516de7e7c5524eadb) - - - - - cdf69083 by Ben Gamari at 2022-08-15T17:11:26-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. (cherry picked from commit 844df61e8de5e2d9a058e6cbe388802755fc0305) (cherry picked from commit d8961a2dc974b7f8f8752781c4aec261ae8f8c0f) - - - - - 4f1e1a30 by Ben Gamari at 2022-08-15T17:11:26-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt (cherry picked from commit 5d66a0ce39f47b7b9f6c732a18ac6e102a21ee6b) - - - - - 573569d5 by Ben Gamari at 2022-08-15T17:11:26-04:00 gitlab-ci: Bump to use freebsd13 runners (cherry picked from commit ea90e61dc3c6ba0433e008284dc6c3970ead98a7) - - - - - 12244700 by Douglas Wilson at 2022-08-15T17:11:26-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. (cherry picked from commit 76b52cf0c52ee05c20f7d1b80f5600eecab3c42a) - - - - - feceab56 by Douglas Wilson at 2022-08-15T17:11:26-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. (cherry picked from commit 7589ee7241d46b393979d98d4ded17a15ee974fb) - - - - - 088071e5 by Jens Petersen at 2022-08-15T17:11:26-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally (cherry picked from commit 823fe5b56450a7eefbf41ce8ece34095bf2217ee) - - - - - f7322f2a by Ben Gamari at 2022-08-15T17:11:26-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. (cherry picked from commit 7cabea7c9b10d2d15a4798be9f3130994393dd9c) - - - - - a77c7462 by Ben Gamari at 2022-08-15T17:11:26-04:00 relnotes: Fix typo - - - - - d87e0545 by Matthew Pickering at 2022-08-15T17:11:27-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 (cherry picked from commit ef30e21594e44af309c627052f63aea6fd575c9e) - - - - - 0bea62ff by Ben Gamari at 2022-08-15T17:11:27-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - 27 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Driver/Make.hs - docs/users_guide/9.4.1-notes.rst - ghc.mk - hadrian/bindist/Makefile - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/changelog.md - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - + testsuite/tests/concurrent/should_run/T21651.hs - + testsuite/tests/concurrent/should_run/T21651.stdout - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/driver/T20316.stdout - + testsuite/tests/driver/T21866.hs - + testsuite/tests/driver/T21866.stderr - testsuite/tests/driver/all.T - testsuite/tests/driver/recomp007/recomp007.stdout - testsuite/tests/driver/retc001/retc001.stdout - testsuite/tests/indexed-types/should_compile/impexp.stderr - testsuite/tests/typecheck/should_fail/T6018fail.stderr Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +290,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +328,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,7 +299,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,7 +307,7 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) ===================================== .gitlab/jobs.yaml ===================================== @@ -541,7 +541,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +551,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +560,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -588,17 +588,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2050,7 +2050,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2060,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2069,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2097,18 +2097,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2970,7 +2970,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +2980,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +2989,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3017,17 +3017,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -299,7 +299,7 @@ linkNodes summaries uid hue = in if | ghcLink dflags == LinkBinary && isJust ofile && not do_linking -> Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags)) -- This should be an error, not a warning (#10895). - | do_linking -> Just (Right (LinkNode unit_nodes uid)) + | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid)) | otherwise -> Nothing -- Note [Missing home modules] ===================================== docs/users_guide/9.4.1-notes.rst ===================================== @@ -104,7 +104,7 @@ Language - GHC Proposal `#302 `_ has been implemented. This means under ``-XLambdaCase``, a new expression heralded by ``\cases`` is available, which works like ``\case`` but can match on multiple patterns. - This means constructor patterns with arguments have to parenthesized here, + This means constructor patterns with arguments have to be parenthesized here, just like in lambda expressions. - The parsing of implicit parameters is slightly more permissive, as GHC now allows :: ===================================== ghc.mk ===================================== @@ -509,11 +509,13 @@ libraries/containers/containers/dist-install/build/Data/IntMap/Internal.o: libra libraries/containers/containers/dist-install/build/Data/Graph.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi libraries/containers/containers/dist-install/build/Data/Set/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi libraries/containers/containers/dist-install/build/Data/IntSet/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/Sequence/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi libraries/containers/containers/dist-install/build/Data/IntMap/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi libraries/containers/containers/dist-install/build/Data/Graph.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi libraries/containers/containers/dist-install/build/Data/Set/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi libraries/containers/containers/dist-install/build/Data/IntSet/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Sequence/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi ifeq "$(BIGNUM_BACKEND)" "gmp" GMP_ENABLED = YES ===================================== hadrian/bindist/Makefile ===================================== @@ -22,43 +22,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -82,6 +45,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -216,10 +181,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ @@ -227,12 +194,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -349,6 +349,7 @@ bindistInstallFiles = , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in", "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -278,6 +278,7 @@ runTestBuilderArgs = builder Testsuite ? do where emitWhenSet Nothing _ = mempty emitWhenSet (Just v) f = f v + stageNumber :: Stage -> Int stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot" stageNumber (Stage0 InTreeLibs) = 1 stageNumber Stage1 = 2 ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Event.Thread -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) @@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, - threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) + threadStatus, writeTVar, newTVarIO, readTVar, retry, + throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, @@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM +import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) @@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () -closeFdWith close fd = do - eventManagerArray <- readIORef eventManager - let (low, high) = boundsIOArray eventManagerArray - mgrs <- flip mapM [low..high] $ \i -> do - Just (_,!mgr) <- readIOArray eventManagerArray i - return mgr - -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. - -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have - -- to use uninterruptible mask. - uninterruptibleMask_ $ do - tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd - cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables - close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) +closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys) + -- The array inside 'eventManager' can be swapped out at any time, see + -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by + -- checking the array bounds before and after. When such a swap has + -- happened we cleanup and try again + close_loop = do + eventManagerArray <- readIORef eventManager + let ema_bounds@(low, high) = boundsIOArray eventManagerArray + mgrs <- flip mapM [low..high] $ \i -> do + Just (_,!mgr) <- readIOArray eventManagerArray i + return mgr + + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. + -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have + -- to use uninterruptible mask. + join $ uninterruptibleMask_ $ do + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager + -- Here we exploit Note [The eventManager Array] + if new_ema_bounds /= ema_bounds + then do + -- the array has been modified. + -- mgrs still holds the right EventManagers, by the Note. + -- new_ema_bounds must be larger than ema_bounds, by the note. + -- return the MVars we took and try again + sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables + pure close_loop + else do + -- We surely have taken all the appropriate MVars. Even if the array + -- has been swapped, our mgrs is still correct. + -- Remove the Fd from all callback tables, close the Fd, and run all + -- callbacks. + cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables + close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) + pure (pure ()) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId - (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager - mmgr <- readIOArray eventManagerArray cap - return $ fmap snd mmgr + let r = boundsIOArray eventManagerArray + (cap, _) <- threadCapability t + -- It is possible that we've just increased the number of capabilities and the + -- new EventManager has not yet been constructed by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- Two options to proceed: + -- 1) return the EventManager for capability 0. This is guaranteed to exist, + -- and "shouldn't" cause any correctness issues. + -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, + -- because we must be on a brand capability and there must be a call to + -- 'ioManagerCapabilitiesChanged' pending. + -- + -- We take the second option, with the yield, judging it the most robust. + if not (inRange r cap) + then yield >> getSystemEventManager + else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do @@ -191,6 +229,22 @@ getSystemEventManager_ = do foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A mutable array holding the current EventManager for each capability +-- An entry is Nothing only while the eventmanagers are initialised, see +-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'. +-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality +-- 'cap'. +-- The array will be swapped with newer arrays when the number of capabilities +-- changes(via 'setNumCapabilities'). However: +-- * the size of the arrays will never decrease; and +-- * The 'EventManager's in the array are not replaced with other +-- 'EventManager' constructors. +-- +-- This is a similar strategy as the rts uses for it's +-- capabilities array (n_capabilities is the size of the array, +-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities @@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged = startIOManagerThread new_eventManagerArray -- update the event manager array reference: - writeIORef eventManager new_eventManagerArray + atomicWriteIORef eventManager new_eventManagerArray + -- We need an atomic write here because 'eventManager' is accessed + -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i ===================================== libraries/base/changelog.md ===================================== @@ -77,6 +77,21 @@ `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these were rather represented by `Word#` and `Int#`. See GHC #11953. +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes ## 4.16.1.0 *Feb 2022* ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== testsuite/tests/concurrent/should_run/T21651.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test is adapted from setnumcapabilities001. + +import GHC.Conc hiding (threadWaitRead, threadWaitWrite) +import GHC.Exts +import GHC.IO.Encoding +import System.Environment +import System.IO +import Control.Monad +import Text.Printf +import Data.Time.Clock +import Control.DeepSeq + +import System.Posix.IO +import System.Posix.Types +import Control.Concurrent +import Control.Exception + +passTheParcel :: Int -> IO (IO ()) +passTheParcel n = do + pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe + rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do + let + read = fdRead readfd $ fromIntegral 1 + write = fdWrite writefd + mv <- newEmptyMVar + tid <- forkIO $ let + loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do + threadWaitRead readfd + (s, _) <- read + threadWaitWrite writefd + write s + cleanup = do + closeFdWith closeFd readfd + closeFdWith closeFd writefd + putMVar mv () + in loop `finally` cleanup + pure (mv, tid) + + let + cleanup = do + killThread tid1 + forM_ rs $ \(mv, _) -> takeMVar mv + + fdWrite (snd p1) "a" + pure cleanup + + +main = do + setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale + [n,q,t,z] <- fmap (fmap read) getArgs + cleanup_ptp <- passTheParcel z + t <- forkIO $ do + forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do + setNumCapabilities m + threadDelay t + printf "%d\n" (nqueens q) + cleanup_ptp + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 + +nqueens :: Int -> Int +nqueens nq = length (pargen 0 []) + where + safe :: Int -> Int -> [Int] -> Bool + safe x d [] = True + safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l + + gen :: [[Int]] -> [[Int]] + gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] + + pargen :: Int -> [Int] -> [[Int]] + pargen n b + | n >= threshold = iterate gen [b] !! (nq - n) + | otherwise = concat bs + where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq + + threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x ===================================== testsuite/tests/concurrent/should_run/T21651.stdout ===================================== @@ -0,0 +1 @@ +14200 ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, ['']) test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2', 'nonmoving_thr']), + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), extra_run_opts('8 12 2000'), when(have_thread_sanitizer(), expect_broken(18808)), req_smp ], compile_and_run, ['']) +test('T21651', + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), + when(opsys('mingw32'),skip), # uses POSIX pipes + when(opsys('darwin'),extra_run_opts('8 12 2000 100')), + unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files + req_smp ], + compile_and_run, ['']) + test('hs_try_putmvar001', [ when(opsys('mingw32'),skip), # uses pthread APIs in the C code ===================================== testsuite/tests/driver/T20316.stdout ===================================== @@ -1,4 +1,4 @@ -[1 of 2] Compiling Main ( T20316.hs, nothing ) +[1 of 1] Compiling Main ( T20316.hs, nothing ) *** non-module.dump-timings *** initializing unit database: Chasing dependencies: ===================================== testsuite/tests/driver/T21866.hs ===================================== @@ -0,0 +1,3 @@ +module Main where + +main = print () ===================================== testsuite/tests/driver/T21866.stderr ===================================== @@ -0,0 +1 @@ +[1 of 1] Compiling Main ( T21866.hs, T21866.o ) ===================================== testsuite/tests/driver/all.T ===================================== @@ -306,4 +306,5 @@ test('T20316', normal, makefile_test, []) test('MultiRootsErr', normal, multimod_compile_fail, ['MultiRootsErr', 'MultiRootsErr']) test('patch-level2', normal, compile, ['-Wcpp-undef']) test('T20569', extra_files(["T20569/"]), makefile_test, []) +test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21869', normal, makefile_test, []) ===================================== testsuite/tests/driver/recomp007/recomp007.stdout ===================================== @@ -1,6 +1,6 @@ "1.0" Preprocessing executable 'test' for b-1.0.. Building executable 'test' for b-1.0.. -[1 of 3] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed] +[1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed] [3 of 3] Linking dist/build/test/test [Objects changed] "2.0" ===================================== testsuite/tests/driver/retc001/retc001.stdout ===================================== @@ -1,7 +1,7 @@ -[1 of 4] Compiling A ( A.hs, nothing ) -[2 of 4] Compiling B ( B.hs, nothing ) -[3 of 4] Compiling Main ( C.hs, nothing ) +[1 of 3] Compiling A ( A.hs, nothing ) +[2 of 3] Compiling B ( B.hs, nothing ) +[3 of 3] Compiling Main ( C.hs, nothing ) Middle End -[2 of 4] Compiling B ( B.hs, nothing ) [Source file changed] -[3 of 4] Compiling Main ( C.hs, nothing ) [B changed] +[2 of 3] Compiling B ( B.hs, nothing ) [Source file changed] +[3 of 3] Compiling Main ( C.hs, nothing ) [B changed] ===================================== testsuite/tests/indexed-types/should_compile/impexp.stderr ===================================== @@ -1,2 +1,2 @@ -[1 of 3] Compiling Exp ( Exp.hs, Exp.o ) -[2 of 3] Compiling Imp ( Imp.hs, Imp.o ) +[1 of 2] Compiling Exp ( Exp.hs, Exp.o ) +[2 of 2] Compiling Imp ( Imp.hs, Imp.o ) ===================================== testsuite/tests/typecheck/should_fail/T6018fail.stderr ===================================== @@ -1,8 +1,8 @@ -[1 of 6] Compiling T6018Afail ( T6018Afail.hs, T6018Afail.o ) -[2 of 6] Compiling T6018Bfail ( T6018Bfail.hs, T6018Bfail.o ) -[3 of 6] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o ) -[4 of 6] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o ) -[5 of 6] Compiling T6018fail ( T6018fail.hs, T6018fail.o ) +[1 of 5] Compiling T6018Afail ( T6018Afail.hs, T6018Afail.o ) +[2 of 5] Compiling T6018Bfail ( T6018Bfail.hs, T6018Bfail.o ) +[3 of 5] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o ) +[4 of 5] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o ) +[5 of 5] Compiling T6018fail ( T6018fail.hs, T6018fail.o ) T6018fail.hs:15:15: error: Type family equation right-hand sides overlap; this violates View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29319dafda95f95f2b2b9f2444b319d8026ab187...0bea62ff81bd05ed4c88b6c96a1d77f857936114 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29319dafda95f95f2b2b9f2444b319d8026ab187...0bea62ff81bd05ed4c88b6c96a1d77f857936114 You're receiving 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 Aug 15 21:26:42 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 15 Aug 2022 17:26:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t22001 Message-ID: <62faba1214546_3d81494899013226e@gitlab.mail> Matthew Pickering pushed new branch wip/t22001 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t22001 You're receiving 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 Aug 15 23:42:43 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 15 Aug 2022 19:42:43 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: Apply: remove commented case (wasn't optimized either in latest ghcjs) Message-ID: <62fad9f362508_3d81494890413379b7@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 84655973 by Sylvain Henry at 2022-08-15T23:17:13+02:00 Apply: remove commented case (wasn't optimized either in latest ghcjs) - - - - - 14d2ed4f by Sylvain Henry at 2022-08-16T01:45:30+02:00 Doc: Apply - - - - - 1 changed file: - compiler/GHC/StgToJS/Apply.hs Changes: ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -100,17 +100,6 @@ genApp -> G (JStat, ExprResult) genApp ctx i args --- FIXME (sylvain 2022/02): what's our new equivalent of this? --- -- special cases for JSString literals --- -- we could handle unpackNBytes# here, but that's probably not common --- -- enough to warrant a special case --- | [StgVarArg v] <- args --- , [top] <- concatMap snd (ctxTarget ctx) --- -- , Just (Lit (MachStr bs)) <- expandUnfolding_maybe (idUnfolding v) --- -- , Just t <- decodeModifiedUTF8 bs -- unpackFS fs -- Just t <- decodeModifiedUTF8 bs --- , matchVarName "ghcjs-prim" "GHCJS.Prim" "unsafeUnpackJSStringUtf8##" i = --- (,ExprInline Nothing) . (|=) top . app "h$decodeUtf8z" <$> varsForId v - -- Case: unpackCStringAppend# "some string"# str -- -- Generates h$appendToHsStringA(str, "some string"), which has a faster @@ -118,16 +107,15 @@ genApp ctx i args | [StgLitArg (LitString bs), x] <- args , [top] <- concatMap typex_expr (ctxTarget ctx) , getUnique i == unpackCStringAppendIdKey - -- , Just d <- decodeModifiedUTF8 bs , d <- utf8DecodeByteString bs -- FIXME (Sylvain, 2022/02): we assume that it decodes but it may not (e.g. embedded file) = do - -- fixme breaks assumption in codegen if bs doesn't decode prof <- csProf <$> getSettings let profArg = if prof then [jCafCCS] else [] a <- genArg x - return (top |= app "h$appendToHsStringA" ([toJExpr d, toJExpr a] ++ profArg) - ,ExprInline Nothing) + return ( top |= app "h$appendToHsStringA" ([toJExpr d, toJExpr a] ++ profArg) + , ExprInline Nothing + ) -- let-no-escape | Just n <- ctxLneBindingStackSize ctx i @@ -395,8 +383,11 @@ pushCont as = do -- efficiently than other more specialized functions. -- -- Stack layout: --- 0. tag: (regs << 8 | arity) --- 1. args +-- -x: ... +-- -y: args... +-- -3: ... +-- -2: register values to enter R1 +-- -1: tag (number of register values << 8 | number of args) -- -- Regs: -- R1 = closure to apply to @@ -440,51 +431,91 @@ genericStackApply cfg = , returnS (app "h$blockOnBlackhole" [r1]) ] - fun_case c arity = jVar \myArity ar myAr myRegs regs newTag newAp p dat -> - [ myArity |= stack .! (sp - 1) - , ar |= mask8 arity - , myAr |= mask8 myArity - , myRegs |= myArity .>>. 8 - , traceRts cfg (jString "h$ap_gen: args: " + myAr - + jString " regs: " + myRegs) - , ifBlockS (myAr .===. ar) - -- then + fun_case c arity = jVar \tag needed_args needed_regs given_args given_regs newTag newAp p dat -> + [ tag |= stack .! (sp - 1) -- tag on the stack + , given_args |= mask8 tag -- indicates the number of passed args + , given_regs |= tag .>>. 8 -- and the number of passed values for registers + , needed_args |= mask8 arity + , needed_regs |= arity .>>. 8 + , traceRts cfg (jString "h$ap_gen: args: " + given_args + + jString " regs: " + given_regs) + , ifBlockS (given_args .===. needed_args) + -------------------------------- + -- exactly saturated application + -------------------------------- [ traceRts cfg (jString "h$ap_gen: exact") - , loop 0 (.<. myRegs) - (\i -> appS "h$setReg" [i+2, stack .! (sp-2-i)] - <> postIncrS i) - , (sp |= sp - myRegs - 2) + -- Set registers to register values on the stack + , loop 0 (.<. given_regs) \i -> mconcat + [ appS "h$setReg" [i+2, stack .! (sp-2-i)] + , postIncrS i + ] + -- drop register values from the stack + , sp |= sp - given_regs - 2 + -- enter closure in R1 , returnS c ] - -- else - [ ifBlockS (myAr .>. ar) - --then - [ regs |= arity .>>. 8 - , traceRts cfg (jString "h$ap_gen: oversat: arity: " + ar - + jString " regs: " + regs) - , loop 0 (.<. regs) - (\i -> traceRts cfg (jString "h$ap_gen: loading register: " + i) - <> appS "h$setReg" [i+2, stack .! (sp-2-i)] - <> postIncrS i) - , newTag |= ((myRegs-regs).<<.8).|.myAr - ar + [ ifBlockS (given_args .>. needed_args) + ---------------------------- + -- oversaturated application + ---------------------------- + [ traceRts cfg (jString "h$ap_gen: oversat: arity: " + needed_args + + jString " regs: " + needed_regs) + -- load needed register values + , loop 0 (.<. needed_regs) \i -> mconcat + [ traceRts cfg (jString "h$ap_gen: loading register: " + i) + , appS "h$setReg" [i+2, stack .! (sp-2-i)] + , postIncrS i + ] + -- compute new tag with consumed register values and args removed + , newTag |= ((given_regs-needed_regs).<<.8) .|. (given_args - needed_args) + -- find application function for the remaining regs/args , newAp |= var "h$apply" .! newTag , traceRts cfg (jString "h$ap_gen: next: " + (newAp .^ "n")) + + -- Drop used registers from the stack. + -- Test if the application function needs a tag and push it. , ifS (newAp .===. var "h$ap_gen") - ((sp |= sp - regs) <> (stack .! (sp - 1) |= newTag)) - (sp |= sp - regs - 1) + ((sp |= sp - needed_regs) <> (stack .! (sp - 1) |= newTag)) + (sp |= sp - needed_regs - 1) + -- FIXME (Sylvain 2022-08): this is fragile and probably inefficient. + -- Instead of filling h$apply array with h$ap_gen, we should leave + -- it with empty items and match "undefined" here. + + -- Push generic application function as continuation , stack .! sp |= newAp + + -- Push "current thread CCS restore" function as continuation , profStat cfg pushRestoreCCS + + -- enter closure in R1 , returnS c ] - -- else + + ----------------------------- + -- undersaturated application + ----------------------------- [ traceRts cfg (jString "h$ap_gen: undersat") - , p |= var "h$paps" .! myRegs - , dat |= toJExpr [r1, ((arity .>>. 8)-myRegs)*256+ar-myAr] - , loop 0 (.<. myRegs) - (\i -> (dat .^ "push") `ApplStat` [stack .! (sp - i - 2)] - <> postIncrS i) - , sp |= sp - myRegs - 2 + -- find PAP entry function corresponding to given_regs count + , p |= var "h$paps" .! given_regs + + -- build PAP payload: R1 + tag + given register values + , newTag |= ((needed_regs-given_regs) .<<. 8) .|. (needed_args-given_args) + , dat |= toJExpr [r1, newTag] + , loop 0 (.<. given_regs) \i -> mconcat + [ (dat .^ "push") `ApplStat` [stack .! (sp - i - 2)] + , postIncrS i + ] + + -- remove register values from the stack. + , sp |= sp - given_regs - 2 + + -- alloc PAP closure, store reference to it in R1. , r1 |= initClosure cfg p dat jCurrentCCS + + -- FIXME (Sylvain 2022-08): why don't we pop/store the given args + -- too? + + -- return to the continuation on the stack , returnStack ] ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9716e7f23f01be535a8f211010dd2c5cedb8838d...14d2ed4f1c2f5f4f7c1a480ae40bef5e17879a99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9716e7f23f01be535a8f211010dd2c5cedb8838d...14d2ed4f1c2f5f4f7c1a480ae40bef5e17879a99 You're receiving 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 Aug 16 01:25:50 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 15 Aug 2022 21:25:50 -0400 Subject: [Git][ghc/ghc][wip/T21623] Move from NthCo to SelCo Message-ID: <62faf21eb7bc3_3d81494883c1341345@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: ac9c8ca6 by Simon Peyton Jones at 2022-08-16T02:25:54+01:00 Move from NthCo to SelCo - - - - - 29 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.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/Arity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.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/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Literal.hs - libraries/ghc-prim/GHC/Types.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -1478,7 +1478,7 @@ unrestrictedFunTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "-> ********************************************************************* -} -- For these synonyms, see --- Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim, and +-- Note [TYPE and CONSTRAINT] in GHC.Builtin.Types.Prim, and -- Note [Using synonyms to compress types] in GHC.Core.Type {- Note [Naked FunTy] ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -656,33 +656,28 @@ tcArrowTyCon = mkPrimTyCon tcArrowTyConName tc_bndrs constraintKind tc_roles * * ************************************************************************ -Note [SORT, TYPE, and CONSTRAINT] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -All types that classify values have a kind of the form (SORT t_or_c rr), where +Note [TYPE and CONSTRAINT] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC distinguishes Type from Constraint throughout the compiler. +See GHC Proposal #518, and tickets #21623 and #11715. - -- Primitive - type SORT :: TypeOrConstraint -> RuntimeRep -> Type +All types that classify values have a kind of the form + (TYPE rr) or (CONSTRAINT rr) +where the `RuntimeRep` parameter, rr, tells us how the value is represented +at runtime. TYPE and CONSTRAINT are primitive type constructors. -* The `TypeOrConstraint` tells whether this value is - a regular type or a constraint; see Note [Type vs Constraint] +There are a bunch of type synonyms and data types defined in in the +library ghc-prim:GHC.Types. All of them are also wired in to GHC, in +GHC.Builtin.Types -* The `RuntimeRep` parameter tells us how the value is represented at runtime. - -There are a bunch of type synonyms and data types defined in -in the library ghc-prim:GHC.Types. All of them are also wired in to GHC, -in GHC.Builtin.Types - - type CONSTRAINT = SORT ConstraintLike :: RuntimeRep -> Type type Constraint = CONSTRAINT LiftedRep :: Type - type TYPE = SORT TypeLike :: RuntimeRep -> Type type Type = TYPE LiftedRep :: Type type UnliftedType = TYPE UnliftedRep :: Type type LiftedRep = BoxedRep Lifted :: RuntimeRep type UnliftedRep = BoxedRep Unlifted :: RuntimeRep - data RuntimeRep -- Defined in ghc-prim:GHC.Types = BoxedRep Levity | IntRep @@ -691,7 +686,8 @@ in GHC.Builtin.Types data Levity = Lifted | Unlifted - data TypeOrConstraint = TypeLike | ConstraintLike +We abbreviate '*' specially: + type * = Type So for example: Int :: TYPE (BoxedRep Lifted) @@ -701,15 +697,12 @@ So for example: Maybe :: TYPE (BoxedRep Lifted) -> TYPE (BoxedRep Lifted) (# , #) :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2]) -We abbreviate '*' specially: - type * = Type - -Note [Type vs Constraint] -~~~~~~~~~~~~~~~~~~~~~~~~~ -GHC distinguishes Type from Constraint, via the TypeOrConstraint -parameter of SORT. See GHC Proposal #518, and tickets #21623 and #11715. + Eq Int :: CONSTRAINT (BoxedRep Lifted) + IP "foo" Int :: CONSTRAINT (BoxedRep Lifted) + a ~ b :: CONSTRAINT (BoxedRep Lifted) + a ~# b :: CONSTRAINT (TupleRep []) -There are a number of wrinkles +Note that: * Type and Constraint are considered distinct throughout GHC. But they are not /apart/: see Note [Type and Constraint are not apart] @@ -717,13 +710,6 @@ There are a number of wrinkles * Constraints are mostly lifted, but unlifted ones are useful too. Specifically (a ~# b) :: CONSTRAINT (TupleRep []) -Examples: - - Eq Int :: CONSTRAINT (BoxedRep Lifted) - IP "foo" Int :: CONSTRAINT (BoxedRep Lifted) - a ~ b :: CONSTRAINT (BoxedRep Lifted) - a ~# b :: CONSTRAINT (TupleRep []) - Note [Type and Constraint are not apart] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Type and Constraint are not equal (eqType) but they are not /apart/ @@ -733,17 +719,17 @@ either. Reason (c.f. #7451): class C a where { op :: a -> a } * The axiom for such a class will look like - axiom axC a :: C a ~# (a->a) + axiom axC a :: (C a :: Constraint) ~# (a->a :: Type) * This axion connects a type of kind Type with one of kind Constraint That is dangerous: kindCo (axC Int) :: Type ~ Constraint In general, having a "contradictory proof" like (Int ~ Bool) would be very - bad; but it's fine provide they are not Apart. + bad; but it's fine provided they are not Apart. So we ensure that Type and Constraint are not apart; or, more precisely, that TYPE and CONSTRAINT are not apart. This -non-apart-ness check is implemented in GHC.Core.Unify.unify_ty: look for -`maybeApart MARTypeVsConstraint`. +non-apart-ness check is implemented in GHC.Core.Unify.unify_ty: look +for `maybeApart MARTypeVsConstraint`. Note that, as before, nothing prevents writing instances like: @@ -799,7 +785,6 @@ tYPEKind :: Type tYPEKind = mkTyConTy tYPETyCon ---------------------- --- type CONSTRAINT = SORT ConstraintLike cONSTRAINTTyCon :: TyCon cONSTRAINTTyCon = mkPrimTyCon cONSTRAINTTyConName (mkTemplateAnonTyConBinders [runtimeRepTy]) ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -12,7 +12,9 @@ -- module GHC.Core.Coercion ( -- * Main data type - Coercion, CoercionN, CoercionR, CoercionP, MCoercion(..), MCoercionN, MCoercionR, + Coercion, CoercionN, CoercionR, CoercionP, + MCoercion(..), MCoercionN, MCoercionR, + CoSel(..), FunSel(..), UnivCoProvenance, CoercionHole(..), coHoleCoVar, setCoHoleCoVar, LeftOrRight(..), @@ -34,7 +36,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkNthCo, getNthFun, getNthFromType, nthCoRole, mkLRCo, + mkSelCo, getNthFun, getNthFromType, nthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunResCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkPhantomCo, @@ -62,8 +64,8 @@ module GHC.Core.Coercion ( splitForAllCo_maybe, splitForAllCo_ty_maybe, splitForAllCo_co_maybe, - nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe, - nthFunRole, funRolesX, + tyConRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe, + funRole, pickLR, isGReflCo, isReflCo, isReflCo_maybe, isGReflCo_maybe, isReflexiveCo, isReflexiveCo_maybe, @@ -418,7 +420,7 @@ decomposeCo :: Arity -> Coercion -- entries as the Arity provided -> [Coercion] decomposeCo arity co rs - = [mkNthCo r n co | (n,r) <- [0..(arity-1)] `zip` rs ] + = [mkSelCo r (SelTyCon n) co | (n,r) <- [0..(arity-1)] `zip` rs ] -- Remember, Nth is zero-indexed decomposeFunCo :: HasDebugCallStack @@ -430,11 +432,13 @@ decomposeFunCo :: HasDebugCallStack -- See Note [Function coercions] for the "3" and "4" decomposeFunCo _ (FunCo _ w co1 co2) = (w, co1, co2) - -- Short-circuits the calls to mkNthCo + -- Short-circuits the calls to mkSelCo decomposeFunCo r co = assertPpr all_ok (ppr co) $ - (mkNthCo Nominal 0 co, mkNthCo r 1 co, mkNthCo r 2 co) + ( mkSelCo Nominal (SelFun SelMult) co + , mkSelCo r (SelFun SelArg) co + , mkSelCo r (SelFun SelRes) co ) where Pair s1t1 s2t2 = coercionKind co all_ok = isFunTy s1t1 && isFunTy s2t2 @@ -495,7 +499,7 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args -- ty :: s2 -- need arg_co :: s2 ~ s1 -- res_co :: t1[ty |> arg_co / a] ~ t2[ty / b] - = let arg_co = mkNthCo Nominal 0 (mkSymCo co) + = let arg_co = mkSelCo Nominal SelForAll (mkSymCo co) res_co = mkInstCo co (mkGReflLeftCo Nominal ty arg_co) subst1' = extendTCvSubst subst1 a (ty `CastTy` arg_co) subst2' = extendTCvSubst subst2 b ty @@ -547,7 +551,7 @@ splitAppCo_maybe (TyConAppCo r tc args) | not (mustBeSaturated tc) -- Never create unsaturated type family apps! , Just (args', arg') <- snocView args - , Just arg'' <- setNominalRole_maybe (nthRole r tc (length args')) arg' + , Just arg'' <- setNominalRole_maybe (tyConRole r tc (length args')) arg' = Just ( mkTyConAppCo r tc args', arg'' ) -- Use mkTyConAppCo to preserve the invariant -- that identity coercions are always represented by Refl @@ -625,7 +629,7 @@ eqTyConRole tc -- produce a coercion @rep_co :: r1 ~ r2 at . mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion mkRuntimeRepCo co - = mkNthCo Nominal 0 kind_co + = mkSelCo Nominal (SelTyCon 0) kind_co where kind_co = mkKindCo co -- kind_co :: TYPE r1 ~ TYPE r2 @@ -1066,50 +1070,52 @@ mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2) mkTransCo co1 co2 = TransCo co1 co2 -mkNthCo :: HasDebugCallStack +mkSelCo :: HasDebugCallStack => Role -- The role of the coercion you're creating - -> Int -- Zero-indexed + -> CoSel -> Coercion -> Coercion -mkNthCo r n co = mkNthCo_maybe r n co `orElse` NthCo r n co +mkSelCo r n co = mkSelCo_maybe r n co `orElse` SelCo r n co -mkNthCo_maybe :: HasDebugCallStack +mkSelCo_maybe :: HasDebugCallStack => Role -- The role of the coercion you're creating - -> Int -- Zero-indexed + -> CoSel -> Coercion -> Maybe Coercion --- mkNthCo_maybe tries to optimise call to mkNthCo -mkNthCo_maybe r n co +-- mkSelCo_maybe tries to optimise call to mkSelCo +mkSelCo_maybe r cs co = assertPpr good_call bad_call_msg $ - go n co + go cs co where Pair ty1 ty2 = coercionKind co - go n co + go cs co | Just (ty, _) <- isReflCo_maybe co - = Just (mkReflCo r (getNthFromType n ty)) + = Just (mkReflCo r (getNthFromType cs ty)) - go 0 (ForAllCo _ kind_co _) + go SelForAll (ForAllCo _ kind_co _) = assert (r == Nominal) Just kind_co -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2) - -- then (nth 0 co :: k1 ~N k2) + -- then (nth SelForAll co :: k1 ~N k2) -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2) - -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4)) + -- then (nth SelForAll co :: (t1 ~ t2) ~N (t3 ~ t4)) - go n (FunCo _ w arg res) - = Just (getNthFun n w arg res) + go (SelFun fs) (FunCo r0 w arg res) + = assertPpr (r == funRole r0 fs) (ppr r <+> ppr fs $$ ppr co) $ + Just (getNthFun fs w arg res) - go n (TyConAppCo r0 tc arg_cos) = assertPpr (r == nthRole r0 tc n) - (vcat [ ppr tc - , ppr arg_cos - , ppr r0 - , ppr n - , ppr r ]) $ - Just (arg_cos `getNth` n) + go (SelTyCon i) (TyConAppCo r0 tc arg_cos) + = assertPpr (r == tyConRole r0 tc i) + (vcat [ ppr tc + , ppr arg_cos + , ppr r0 + , ppr i + , ppr r ]) $ + Just (arg_cos `getNth` i) - go n (SymCo co) -- Recurse, hoping to get to a TyConAppCo or FunCo - = do { co' <- go n co; return (mkSymCo co') } + go cs (SymCo co) -- Recurse, hoping to get to a TyConAppCo or FunCo + = do { co' <- go cs co; return (mkSymCo co') } go _ _ = Nothing @@ -1117,14 +1123,15 @@ mkNthCo_maybe r n co bad_call_msg = vcat [ text "Coercion =" <+> ppr co , text "LHS ty =" <+> ppr ty1 , text "RHS ty =" <+> ppr ty2 - , text "n =" <+> ppr n, text "r =" <+> ppr r + , text "cs =" <+> ppr cs, text "r =" <+> ppr r , text "coercion role =" <+> ppr (coercionRole co) ] good_call -- If the Coercion passed in is between forall-types, then the Int must -- be 0 and the role must be Nominal. | Just (_tv1, _) <- splitForAllTyCoVar_maybe ty1 , Just (_tv2, _) <- splitForAllTyCoVar_maybe ty2 - = n == 0 && r == Nominal + , SelForAll <- cs + = r == Nominal -- If the Coercion passed in is between T tys and T tys', then the Int -- must be less than the length of tys/tys' (which must be the same @@ -1135,59 +1142,58 @@ mkNthCo_maybe r n co -- role passed in must be tyConRolesRepresentational T !! n. If the role -- of the Coercion is Phantom, then the role passed in must be Phantom. -- - -- See also Note [NthCo Cached Roles] if you're wondering why it's + -- See also Note [SelCo Cached Roles] if you're wondering why it's -- glaringly obvious that we should be *computing* this role instead of -- npassing it in. | isFunTy ty1, isFunTy ty2 - = n < 3 && r == nthFunRole (coercionRole co) n + , SelFun fs <- cs + = r == funRole (coercionRole co) fs | Just (tc1, tys1) <- splitTyConApp_maybe ty1 , Just (tc2, tys2) <- splitTyConApp_maybe ty2 , tc1 == tc2 + , SelTyCon n <- cs = let len1 = length tys1 len2 = length tys2 in len1 == len2 && n < len1 - && r == nthRole (coercionRole co) tc1 n + && r == tyConRole (coercionRole co) tc1 n | otherwise - = True + = False -- | Extract the nth field of a FunCo -getNthFun :: Int -- ^ "n" +getNthFun :: FunSel -> a -- ^ multiplicity -> a -- ^ argument -> a -- ^ result - -> a -- ^ One of rhe above three + -> a -- ^ One of the above three -- See Note [Function coercions] -- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) -- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) -- Then we want to behave as if co was -- TyConAppCo mult argk_co resk_co arg_co res_co -- where --- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) --- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) +-- argk_co :: sk1 ~ tk1 = mkSelCo 0 (mkKindCo arg_co) +-- resk_co :: sk2 ~ tk2 = mkSelCo 0 (mkKindCo res_co) -- i.e. mkRuntimeRepCo -getNthFun n mult arg res - = case n of - 0 -> mult - 1 -> arg - 2 -> res - _ -> bad_n - where - bad_n = pprPanic "getNthFun" (ppr n) +getNthFun SelMult mult _ _ = mult +getNthFun SelArg _ arg _ = arg +getNthFun SelRes _ _ res = res --- | If you're about to call @mkNthCo r n co@, then @r@ should be +-- | If you're about to call @mkSelCo r n co@, then @r@ should be -- whatever @nthCoRole n co@ returns. -nthCoRole :: Int -> Coercion -> Role -nthCoRole n co - | isFunTy lty - = nthFunRole r n +nthCoRole :: CoSel -> Coercion -> Role +nthCoRole cs co + | SelFun fs <- cs, isFunTy lty + = funRole r fs - | Just (tc, _) <- splitTyConApp_maybe lty - = nthRole r tc n + | SelTyCon n <- cs + , Just (tc, _) <- splitTyConApp_maybe lty + = tyConRole r tc n - | Just _ <- splitForAllTyCoVar_maybe lty + | SelForAll <- cs + , Just _ <- splitForAllTyCoVar_maybe lty = Nominal | otherwise @@ -1359,10 +1365,10 @@ 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 (NthCo _r n co) + setNominalRole_maybe_helper (SelCo _r n co) -- NB, this case recurses via setNominalRole_maybe, not -- setNominalRole_maybe_helper! - = NthCo Nominal n <$> setNominalRole_maybe (coercionRole co) co + = SelCo Nominal n <$> setNominalRole_maybe (coercionRole co) co setNominalRole_maybe_helper (InstCo co arg) = InstCo <$> setNominalRole_maybe_helper co <*> pure arg setNominalRole_maybe_helper (UnivCo prov _ co1 co2) @@ -1399,27 +1405,25 @@ tyConRolesX :: Role -> TyCon -> [Role] tyConRolesX Representational tc = tyConRolesRepresentational tc tyConRolesX role _ = repeat role -funRolesX :: Role -> [Role] -funRolesX Representational = funRolesRepresentational -funRolesX role = repeat role - -- Returns the roles of the parameters of a tycon, with an infinite tail -- of Nominal tyConRolesRepresentational :: TyCon -> [Role] tyConRolesRepresentational tc = tyConRoles tc ++ repeat Nominal -funRolesRepresentational :: [Role] -funRolesRepresentational = [Nominal,Representational,Representational] +tyConRole :: Role -> TyCon -> Int -> Role +tyConRole Nominal _ _ = Nominal +tyConRole Phantom _ _ = Phantom +tyConRole Representational tc n = tyConRolesRepresentational tc `getNth` n -nthRole :: Role -> TyCon -> Int -> Role -nthRole Nominal _ _ = Nominal -nthRole Phantom _ _ = Phantom -nthRole Representational tc n = tyConRolesRepresentational tc `getNth` n +funRole :: Role -> FunSel -> Role +funRole Nominal _ = Nominal +funRole Phantom _ = Phantom +funRole Representational fs = funRoleRepresentational fs -nthFunRole :: Role -> Int -> Role -nthFunRole Nominal _ = Nominal -nthFunRole Phantom _ = Phantom -nthFunRole Representational n = funRolesRepresentational `getNth` n +funRoleRepresentational :: FunSel -> Role +funRoleRepresentational SelMult = Nominal +funRoleRepresentational SelArg = Representational +funRoleRepresentational SelRes = Representational ltRole :: Role -> Role -> Bool -- Is one role "less" than another? @@ -1498,8 +1502,8 @@ promoteCoercion co = case co of TransCo co1 co2 -> mkTransCo (promoteCoercion co1) (promoteCoercion co2) - NthCo r n co1 - | Just co' <- mkNthCo_maybe r n co1 + SelCo r n co1 + | Just co' <- mkSelCo_maybe r n co1 -> promoteCoercion co' | otherwise @@ -1552,10 +1556,12 @@ instCoercion (Pair lty rty) g w -- w :: s1 ~ s2 -- returns mkInstCo g w' :: t2 [t1 |-> s1 ] ~ t3 [t1 |-> s2] = Just $ mkInstCo g w' + | isFunTy lty && isFunTy rty -- g :: (t1 -> t2) ~ (t3 -> t4) -- returns t2 ~ t4 - = Just $ mkNthCo Nominal 4 g -- extract result type, which is the 5th argument to (->) + = Just $ mkSelCo Nominal (SelFun SelRes) g -- extract result type + | otherwise -- one forall, one funty... = Nothing @@ -2202,8 +2208,8 @@ liftCoSubstCoVarBndrUsing view_co fun lc@(LC subst cenv) old_var role = coVarRole old_var eta' = downgradeRole role Nominal eta - eta1 = mkNthCo role 2 eta' - eta2 = mkNthCo role 3 eta' + eta1 = mkSelCo role (SelTyCon 2) eta' + eta2 = mkSelCo role (SelTyCon 3) eta' co1 = mkCoVarCo new_var co2 = mkSymCo eta1 `mkTransCo` co1 `mkTransCo` eta2 @@ -2298,7 +2304,7 @@ seqCo (UnivCo p r t1 t2) = seqProv p `seq` r `seq` seqType t1 `seq` seqType t2 seqCo (SymCo co) = seqCo co seqCo (TransCo co1 co2) = seqCo co1 `seq` seqCo co2 -seqCo (NthCo r n co) = r `seq` n `seq` seqCo co +seqCo (SelCo r n co) = r `seq` n `seq` seqCo co seqCo (LRCo lr co) = lr `seq` seqCo co seqCo (InstCo co arg) = seqCo co `seq` seqCo arg seqCo (KindCo co) = seqCo co @@ -2364,7 +2370,7 @@ coercionLKind co go (InstCo aco arg) = go_app aco [go arg] go (KindCo co) = typeKind (go co) go (SubCo co) = go co - go (NthCo _ d co) = getNthFromType d (go co) + go (SelCo _ d co) = getNthFromType d (go co) go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos) go (AxiomRuleCo ax cos) = pFst $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos @@ -2387,25 +2393,22 @@ coercionLKind co go_app (InstCo co arg) args = go_app co (go arg:args) go_app co args = piResultTys (go co) args -getNthFromType :: HasDebugCallStack => Int -> Type -> Type -getNthFromType d ty +getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type +getNthFromType (SelFun fs) ty | Just (_af, mult, arg, res) <- splitFunTy_maybe ty - = getNthFun d mult arg res + = getNthFun fs mult arg res +getNthFromType (SelTyCon n) ty | Just args <- tyConAppArgs_maybe ty - = assertPpr (args `lengthExceeds` d) bad_doc $ - args `getNth` d + = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $ + args `getNth` n - | d == 0 - , Just (tv,_) <- splitForAllTyCoVar_maybe ty - -- Works for both tyvar and covar - -- nth:0 pulls out a kind coercion from a hetero forall +getNthFromType SelForAll ty -- Works for both tyvar and covar + | Just (tv,_) <- splitForAllTyCoVar_maybe ty = tyVarKind tv - | otherwise - = pprPanic "getNthFromType" bad_doc - where - bad_doc = ppr d $$ ppr ty +getNthFromType cs ty + = pprPanic "getNthFromType" (ppr cs $$ ppr ty) coercionRKind :: Coercion -> Type coercionRKind co @@ -2426,7 +2429,7 @@ coercionRKind co go (InstCo aco arg) = go_app aco [go arg] go (KindCo co) = typeKind (go co) go (SubCo co) = go co - go (NthCo _ d co) = getNthFromType d (go co) + go (SelCo _ d co) = getNthFromType d (go co) go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos) go (AxiomRuleCo ax cos) = pSnd $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos @@ -2471,10 +2474,11 @@ coercionRKind co | isCoVar cv1 = mkTyCoInvForAllTy cv2 (go_forall subst' co) where - k2 = coercionRKind k_co - r = coVarRole cv1 - eta1 = mkNthCo r 2 (downgradeRole r Nominal k_co) - eta2 = mkNthCo r 3 (downgradeRole r Nominal k_co) + k2 = coercionRKind k_co + r = coVarRole cv1 + k_co' = downgradeRole r Nominal k_co + eta1 = mkSelCo r (SelTyCon 2) k_co' + eta2 = mkSelCo r (SelTyCon 3) k_co' -- k_co :: (t1 ~r t2) ~N (s1 ~r s2) -- k1 = t1 ~r t2 @@ -2528,7 +2532,7 @@ coercionRole = go go (UnivCo _ r _ _) = r go (SymCo co) = go co go (TransCo co1 _co2) = go co1 - go (NthCo r _d _co) = r + go (SelCo r _d _co) = r go (LRCo {}) = Nominal go (InstCo co _) = go co go (KindCo {}) = Nominal @@ -2669,8 +2673,8 @@ buildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2 r = coVarRole cv1 kind_co' = downgradeRole r Nominal kind_co - eta1 = mkNthCo r 2 kind_co' - eta2 = mkNthCo r 3 kind_co' + eta1 = mkSelCo r (SelTyCon 2) kind_co' + eta2 = mkSelCo r (SelTyCon 3) kind_co' subst = mkEmptySubst $ mkInScopeSet $ tyCoVarsOfType ty2 `unionVarSet` tyCoVarsOfCo kind_co ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -24,7 +24,7 @@ mkPhantomCo :: Coercion -> Type -> Type -> Coercion mkUnivCo :: UnivCoProvenance -> Role -> Type -> Type -> Coercion mkSymCo :: Coercion -> Coercion mkTransCo :: Coercion -> Coercion -> Coercion -mkNthCo :: HasDebugCallStack => Role -> Int -> Coercion -> Coercion +mkSelCo :: HasDebugCallStack => Role -> CoSel -> Coercion -> Coercion mkLRCo :: LeftOrRight -> Coercion -> Coercion mkInstCo :: Coercion -> Coercion -> Coercion mkGReflCo :: Role -> Type -> MCoercionN -> Coercion ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -338,31 +338,30 @@ opt_co4 env sym rep r (TransCo co1 co2) co2' = opt_co4_wrap env sym rep r co2 in_scope = lcInScopeSet env -opt_co4 env _sym rep r (NthCo _r n co) +opt_co4 env _sym rep r (SelCo _r n co) | Just (ty, _) <- isReflCo_maybe co = assert (r == _r ) $ liftCoSubst (chooseRole rep r) env (getNthFromType n ty) -opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos)) +opt_co4 env sym rep r (SelCo r1 (SelTyCon n) (TyConAppCo _ _ cos)) = assert (r == r1 ) opt_co4_wrap env sym rep r (cos `getNth` n) -- see the definition of GHC.Builtin.Types.Prim.funTyCon -opt_co4 env sym rep r (NthCo r1 n (FunCo _r2 w co1 co2)) +opt_co4 env sym rep r (SelCo r1 (SelFun fs) (FunCo _r2 w co1 co2)) = assert (r == r1 ) - opt_co4_wrap env sym rep r (getNthFun n w co1 co2) + opt_co4_wrap env sym rep r (getNthFun fs w co1 co2) -opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) +opt_co4 env sym rep r (SelCo _r SelForAll (ForAllCo _ eta _)) -- works for both tyvar and covar = assert (r == _r ) - assert (n == 0 ) opt_co4_wrap env sym rep Nominal eta -opt_co4 env sym rep r (NthCo _r n co) - | Just nth_co <- case co' of - TyConAppCo _ _ cos -> Just (cos `getNth` n) - FunCo _ w co1 co2 -> Just (getNthFun n w co1 co2) - ForAllCo _ eta _ -> Just eta +opt_co4 env sym rep r (SelCo _r n co) + | Just nth_co <- case (co', n) of + (TyConAppCo _ _ cos, SelTyCon n) -> Just (cos `getNth` n) + (FunCo _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) + (ForAllCo _ eta _, SelForAll) -> Just eta _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo @@ -370,7 +369,7 @@ opt_co4 env sym rep r (NthCo _r n co) else nth_co | otherwise - = wrapRole rep r $ NthCo r n co' + = wrapRole rep r $ SelCo r n co' where co' = opt_co1 env sym co @@ -453,8 +452,8 @@ opt_co4 env sym rep r (InstCo co1 arg) -- new_co = (h1 :: t1 ~ t2) ~ ((n1;h2;sym n2) :: t1 ~ t2) r2 = coVarRole cv kind_co' = downgradeRole r2 Nominal kind_co - n1 = mkNthCo r2 2 kind_co' - n2 = mkNthCo r2 3 kind_co' + n1 = mkSelCo r2 (SelTyCon 2) kind_co' + n2 = mkSelCo r2 (SelTyCon 3) kind_co' in mkProofIrrelCo Nominal (Refl (coercionType h1)) h1 (n1 `mkTransCo` h2 `mkTransCo` (mkSymCo n2)) @@ -575,9 +574,9 @@ opt_univ env sym prov role oty1 oty2 eta = mkUnivCo prov' Nominal k1 k2 eta_d = downgradeRole r' Nominal eta -- eta gets opt'ed soon, but not yet. - n_co = (mkSymCo $ mkNthCo r' 2 eta_d) `mkTransCo` + n_co = (mkSymCo $ mkSelCo r' (SelTyCon 2) eta_d) `mkTransCo` (mkCoVarCo cv1) `mkTransCo` - (mkNthCo r' 3 eta_d) + (mkSelCo r' (SelTyCon 3) eta_d) ty2' = substTyWithCoVars [cv2] [n_co] ty2 (env', cv1', eta') = optForAllCoBndr env sym cv1 eta @@ -649,13 +648,13 @@ opt_trans_rule is in_co1@(GRefl r1 t1 (MCo co1)) in_co2@(GRefl r2 _ (MCo co2)) mkGReflRightCo r1 t1 (opt_trans is co1 co2) -- Push transitivity through matching destructors -opt_trans_rule is in_co1@(NthCo r1 d1 co1) in_co2@(NthCo r2 d2 co2) +opt_trans_rule is in_co1@(SelCo r1 d1 co1) in_co2@(SelCo r2 d2 co2) | d1 == d2 , coercionRole co1 == coercionRole co2 , co1 `compatible_co` co2 = assert (r1 == r2) $ fireTransRule "PushNth" in_co1 in_co2 $ - mkNthCo r1 d1 (opt_trans is co1 co2) + mkSelCo r1 d1 (opt_trans is co1 co2) opt_trans_rule is in_co1@(LRCo d1 co1) in_co2@(LRCo d2 co2) | d1 == d2 @@ -770,8 +769,8 @@ opt_trans_rule is co1 co2 is' = is `extendInScopeSet` cv1 role = coVarRole cv1 eta1' = downgradeRole role Nominal eta1 - n1 = mkNthCo role 2 eta1' - n2 = mkNthCo role 3 eta1' + n1 = mkSelCo role (SelTyCon 2) eta1' + n2 = mkSelCo role (SelTyCon 3) eta1' r2' = substCo (zipCvSubst [cv2] [(mkSymCo n1) `mkTransCo` (mkCoVarCo cv1) `mkTransCo` n2]) r2 @@ -1132,9 +1131,9 @@ Similarly, we do this Here, - h1 = mkNthCo Nominal 0 g :: (s1~s2)~(s3~s4) - eta1 = mkNthCo r 2 h1 :: (s1 ~ s3) - eta2 = mkNthCo r 3 h1 :: (s2 ~ s4) + h1 = mkSelCo Nominal 0 g :: (s1~s2)~(s3~s4) + eta1 = mkSelCo r (SelTyCon 2) h1 :: (s1 ~ s3) + eta2 = mkSelCo r (SelTyCon 3) h1 :: (s2 ~ s4) h2 = mkInstCo g (cv1 ~ (sym eta1;c1;eta2)) -} etaForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion) @@ -1146,7 +1145,7 @@ etaForAllCo_ty_maybe co | Pair ty1 ty2 <- coercionKind co , Just (tv1, _) <- splitForAllTyVar_maybe ty1 , isForAllTy_ty ty2 - , let kind_co = mkNthCo Nominal 0 co + , let kind_co = mkSelCo Nominal SelForAll co = Just ( tv1, kind_co , mkInstCo co (mkGReflRightCo Nominal (TyVarTy tv1) kind_co)) @@ -1162,13 +1161,13 @@ etaForAllCo_co_maybe co | Pair ty1 ty2 <- coercionKind co , Just (cv1, _) <- splitForAllCoVar_maybe ty1 , isForAllTy_co ty2 - = let kind_co = mkNthCo Nominal 0 co + = let kind_co = mkSelCo Nominal SelForAll co r = coVarRole cv1 l_co = mkCoVarCo cv1 kind_co' = downgradeRole r Nominal kind_co - r_co = (mkSymCo (mkNthCo r 2 kind_co')) `mkTransCo` - l_co `mkTransCo` - (mkNthCo r 3 kind_co') + r_co = mkSymCo (mkSelCo r (SelTyCon 2) kind_co') + `mkTransCo` l_co + `mkTransCo` mkSelCo r (SelTyCon 3) kind_co' in Just ( cv1, kind_co , mkInstCo co (mkProofIrrelCo Nominal kind_co l_co r_co)) @@ -1205,7 +1204,7 @@ etaTyConAppCo_maybe tc co , Just (tc1, tys1) <- splitTyConApp_maybe ty1 , Just (tc2, tys2) <- splitTyConApp_maybe ty2 , tc1 == tc2 - , isInjectiveTyCon tc r -- See Note [NthCo and newtypes] in GHC.Core.TyCo.Rep + , isInjectiveTyCon tc r -- See Note [SelCo and newtypes] in GHC.Core.TyCo.Rep , let n = length tys1 , tys2 `lengthIs` n -- This can fail in an erroneous program -- E.g. T a ~# T a b ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -398,7 +398,7 @@ orphNamesOfCo (UnivCo p _ t1 t2) = orphNamesOfProv p `unionNameSet` orphNames `unionNameSet` orphNamesOfType t2 orphNamesOfCo (SymCo co) = orphNamesOfCo co orphNamesOfCo (TransCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2 -orphNamesOfCo (NthCo _ _ co) = orphNamesOfCo co +orphNamesOfCo (SelCo _ _ co) = orphNamesOfCo co orphNamesOfCo (LRCo _ co) = orphNamesOfCo co orphNamesOfCo (InstCo co arg) = orphNamesOfCo co `unionNameSet` orphNamesOfCo arg orphNamesOfCo (KindCo co) = orphNamesOfCo co ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2041,7 +2041,7 @@ that returned coercion. If we get long chains, that can be asymptotically inefficient, notably in * TransCo * InstCo -* NthCo (cf #9233) +* SelCo (cf #9233) * LRCo But the code is simple. And this is only Lint. Let's wait to see if @@ -2299,33 +2299,34 @@ lintCoercion co@(TransCo co1 co2) ; lintRole co (coercionRole co1) (coercionRole co2) ; return (TransCo co1' co2') } -lintCoercion the_co@(NthCo r0 n co) +lintCoercion the_co@(SelCo r0 cs co) = do { co' <- lintCoercion co ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTyCoVar_maybe s, splitForAllTyCoVar_maybe t) of { (Just _, Just _) -- works for both tyvar and covar - | n == 0 + | SelForAll <- cs , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (NthCo r0 n co') } + ; return (SelCo r0 cs co') } ; _ -> case (isFunTy s, isFunTy t) of { (True, True) - | n < 3 - -> do { lintRole the_co (nthFunRole r n) r0 - ; return (NthCo r0 n co') } + | SelFun fs <- cs + -> do { lintRole the_co (funRole r fs) r0 + ; return (SelCo r0 cs co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) | tc_s == tc_t + , SelTyCon n <- cs , isInjectiveTyCon tc_s r - -- see Note [NthCo and newtypes] in GHC.Core.TyCo.Rep + -- see Note [SelCo and newtypes] in GHC.Core.TyCo.Rep , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n - -> do { lintRole the_co (nthRole r tc_s n) r0 - ; return (NthCo r0 n co') } + -> do { lintRole the_co (tyConRole r tc_s n) r0 + ; return (SelCo r0 cs co') } ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}}} ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -2564,11 +2564,11 @@ pushCoTyArg co ty -- tyL = forall (a1 :: k1). ty1 -- tyR = forall (a2 :: k2). ty2 - co1 = mkSymCo (mkNthCo Nominal 0 co) + co1 = mkSymCo (mkSelCo Nominal SelForAll co) -- co1 :: k2 ~N k1 - -- Note that NthCo can extract a Nominal equality between the + -- Note that SelCo can extract a Nominal equality between the -- kinds of the types related by a coercion between forall-types. - -- See the NthCo case in GHC.Core.Lint. + -- See the SelCo case in GHC.Core.Lint. co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] @@ -2759,14 +2759,14 @@ collectBindersPushingCo e , let Pair tyL tyR = coercionKind co , assert (isForAllTy_ty tyL) $ isForAllTy_ty tyR - , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] + , isReflCo (mkSelCo Nominal SelForAll co) -- See Note [collectBindersPushingCo] = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b))) | isCoVar b , let Pair tyL tyR = coercionKind co , assert (isForAllTy_co tyL) $ isForAllTy_co tyR - , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] + , isReflCo (mkSelCo Nominal SelForAll co) -- See Note [collectBindersPushingCo] , let cov = mkCoVarCo b = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov))) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1543,7 +1543,7 @@ In particular, we want to behave well on * (f |> co) @t1 @t2 ... @tn x1 .. xm Here we will use pushCoTyArg and pushCoValArg successively, which - build up NthCo stacks. Silly to do that if co is reflexive. + build up SelCo stacks. Silly to do that if co is reflexive. However, we don't want to call isReflexiveCo too much, because it uses type equality which is expensive on big types (#14737 comment:7). ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -630,7 +630,7 @@ tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc tyCoFVsOfCo (SymCo co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfCo (TransCo co1 co2) fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc -tyCoFVsOfCo (NthCo _ _ co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfCo (SelCo _ _ co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfCo (LRCo _ co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfCo (InstCo co arg) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc tyCoFVsOfCo (KindCo co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc @@ -690,7 +690,7 @@ almost_devoid_co_var_of_co (SymCo co) cv almost_devoid_co_var_of_co (TransCo co1 co2) cv = almost_devoid_co_var_of_co co1 cv && almost_devoid_co_var_of_co co2 cv -almost_devoid_co_var_of_co (NthCo _ _ co) cv +almost_devoid_co_var_of_co (SelCo _ _ co) cv = almost_devoid_co_var_of_co co cv almost_devoid_co_var_of_co (LRCo _ co) cv = almost_devoid_co_var_of_co co cv ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -36,7 +36,7 @@ module GHC.Core.TyCo.Rep ( ArgFlag(..), AnonArgFlag(..), -- * Coercions - Coercion(..), + Coercion(..), CoSel(..), FunSel(..), UnivCoProvenance(..), CoercionHole(..), coHoleCoVar, setCoHoleCoVar, CoercionN, CoercionR, CoercionP, KindCoercion, @@ -97,10 +97,12 @@ import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Utils.Binary -- libraries import qualified Data.Data as Data hiding ( TyCon ) import Data.IORef ( IORef ) -- for CoercionHole +import Control.DeepSeq {- ********************************************************************** * * @@ -1208,7 +1210,7 @@ data Coercion | ForAllCo TyCoVar KindCoercion Coercion -- ForAllCo :: _ -> N -> e -> e - | FunCo Role CoercionN Coercion Coercion -- lift FunTy + | FunCo Role CoercionN Coercion Coercion -- See Note [FunCo] -- FunCo :: "e" -> N -> e -> e -> e -- These are special @@ -1236,14 +1238,7 @@ data Coercion | SymCo Coercion -- :: e -> e | TransCo Coercion Coercion -- :: e -> e -> e - | NthCo Role Int Coercion -- Zero-indexed; decomposes (T t0 ... tn) - -- :: "e" -> _ -> e0 -> e (inverse of TyConAppCo, see Note [TyConAppCo roles]) - -- Using NthCo on a ForAllCo gives an N coercion always - -- See Note [NthCo and newtypes] - -- - -- Invariant: (NthCo r i co), it is always the case that r = role of (Nth i co) - -- That is: the role of the entire coercion is redundantly cached here. - -- See Note [NthCo Cached Roles] + | SelCo Role CoSel Coercion -- See Note [SelCo] | LRCo LeftOrRight CoercionN -- Decomposes (t_left t_right) -- :: _ -> N -> N @@ -1263,6 +1258,18 @@ data Coercion -- Only present during typechecking deriving Data.Data +data CoSel -- See Note [SelCo] + = SelTyCon Int -- Decomposes (T co1 ... con); zero-indexed + | SelFun FunSel -- Decomposes (co1 -> co2) + | SelForAll -- Decomposes (forall a. co) + deriving( Eq, Data.Data ) + +data FunSel -- See Note [SelCo] + = SelMult -- Multiplicity + | SelArg -- Argument of function + | SelRes -- Result of function + deriving( Eq, Data.Data ) + type CoercionN = Coercion -- always nominal type CoercionR = Coercion -- always representational type CoercionP = Coercion -- always phantom @@ -1271,6 +1278,36 @@ type KindCoercion = CoercionN -- always nominal instance Outputable Coercion where ppr = pprCo +instance Outputable CoSel where + ppr (SelTyCon n) = text "Tc" <> parens (int n) + ppr SelForAll = text "All" + ppr (SelFun fs) = text "Fun" <> parens (ppr fs) + +instance Outputable FunSel where + ppr SelMult = text "mult" + ppr SelArg = text "arg" + ppr SelRes = text "res" + +instance Binary CoSel where + put_ bh (SelTyCon n) = do { putByte bh 0; put_ bh n } + put_ bh SelForAll = putByte bh 1 + put_ bh (SelFun SelMult) = putByte bh 2 + put_ bh (SelFun SelArg) = putByte bh 3 + put_ bh (SelFun SelRes) = putByte bh 4 + + get bh = do { h <- getByte bh + ; case h of + 0 -> do { n <- get bh; return (SelTyCon n) } + 1 -> return SelForAll + 2 -> return (SelFun SelMult) + 3 -> return (SelFun SelArg) + _ -> return (SelFun SelRes) } + +instance NFData CoSel where + rnf (SelTyCon n) = n `seq` () + rnf SelForAll = () + rnf (SelFun fs) = fs `seq` () + -- | A semantically more meaningful type to represent what may or may not be a -- useful 'Coercion'. data MCoercion @@ -1343,6 +1380,71 @@ It is easy to see that A nominal reflexive coercion is quite common, so we keep the special form Refl to save allocation. +Note [Coercion selection] +~~~~~~~~~~~~~~~~~~~~~~~~~ +The Coercion form SelCo allows us to decompose a structural coercion, one +between ForallTys, or TyConApps, or FunTys. + +Invariant: (SelCo r cs co), it is always the case that + r = role of (Nth cs co) + That is: the role of the entire coercion is redundantly cached here. + See Note [SelCo Cached Roles] + +There are three forms, split by the CoSel field inside the SelCo: +SelTyCon, SelForAll, and SelFun. + +* SelTyCon: + + co : (T s1..sn) ~r0 (T t1..tn) + T is a data type not a newtype + r = tyConRole tc r0 i + i < n (i is zero-indexed) + ---------------------------------- + SelCo r (SelTyCon i) : si ~r ti + + See Note [SelCo and newtypes] + + +* SelForAll: + co : forall (a:k1).t1 ~r0 forall (a:k2).t2 + ---------------------------------- + SelCo N SelForAll : k1 ~N k2 + + NB: SelForAll always gives a Nominal coercion. + +* The SelFun form, for functions, has three sub-forms for the three + components of the function type (multiplicity, argument, result). + + co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2) + r = funRole r0 SelMult + ---------------------------------- + SelCo r (SelFun SelMult) : m1 ~r m2 + + co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2) + r = funRole r0 SelArg + ---------------------------------- + SelCo r (SelFun SelArg) : s1 ~r s2 + + co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2) + r = funRole r0 SelRes + ---------------------------------- + SelCo r (SelFun SelRes) : t1 ~r t2 + +Note [FunCo] +~~~~~~~~~~~~ +You might think that a FunCo (which connects two function types should +contain the AnonArgFlag from the function types. But we are allowed to +have an axiom (and hence a coercion) connecting Type and Constraint, thus + co :: (t::Type) ~ (c::Constraint) +c.f. GHC.Builtin.Types.Prim Note [Type and Constraint are not apart] +Given such a coercion we can use FunCo to make + FunCo co :: (t -> Int) ~ (c => Int) +Note that the two arrows are different: those FunTys have different +AnonArgFlags! That's why: + +* FunCo does not store an AnonArgFlag +* We use mkFuntionType in the FunCo case of coercionLKind/coercoinRKind, + Note [Coercion axioms applied to coercions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The reason coercion axioms can be applied to coercions and not just @@ -1575,7 +1677,7 @@ TyConAppCo Phantom Foo (UnivCo Phantom Int Bool) : Foo Int ~P Foo Bool The rules here dictate the roles of the parameters to mkTyConAppCo (should be checked by Lint). -Note [NthCo and newtypes] +Note [SelCo and newtypes] ~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have @@ -1592,20 +1694,20 @@ We can then build co = NTCo:N a ; sym (NTCo:N b) for any `a` and `b`. Because of the role annotation on N, if we use -NthCo, we'll get out a representational coercion. That is: +SelCo, we'll get out a representational coercion. That is: - NthCo r 0 co :: forall a b. a ~R b + SelCo r 0 co :: forall a b. a ~R b Yikes! Clearly, this is terrible. The solution is simple: forbid -NthCo to be used on newtypes if the internal coercion is representational. +SelCo to be used on newtypes if the internal coercion is representational. This is not just some corner case discovered by a segfault somewhere; it was discovered in the proof of soundness of roles and described in the "Safe Coercions" paper (ICFP '14). -Note [NthCo Cached Roles] +Note [SelCo Cached Roles] ~~~~~~~~~~~~~~~~~~~~~~~~~ -Why do we cache the role of NthCo in the NthCo constructor? +Why do we cache the role of SelCo in the SelCo constructor? Because computing role(Nth i co) involves figuring out that co :: T tys1 ~ T tys2 @@ -1615,7 +1717,7 @@ at the tyConRoles of T. Avoiding bad asymptotic behaviour here means we have to compute the kind and role of a coercion simultaneously, which makes the code complicated and inefficient. -This only happens for NthCo. Caching the role solves the problem, and +This only happens for SelCo. Caching the role solves the problem, and allows coercionKind and coercionRole to be simple. See #11735 @@ -1982,7 +2084,7 @@ foldTyCo (TyCoFolder { tcf_view = view go_co env (SymCo co) = go_co env co go_co env (TransCo c1 c2) = go_co env c1 `mappend` go_co env c2 go_co env (AxiomRuleCo _ cos) = go_cos env cos - go_co env (NthCo _ _ co) = go_co env co + go_co env (SelCo _ _ co) = go_co env co go_co env (LRCo _ co) = go_co env co go_co env (InstCo co arg) = go_co env co `mappend` go_co env arg go_co env (KindCo co) = go_co env co @@ -2046,7 +2148,7 @@ coercionSize (AxiomInstCo _ _ args) = 1 + sum (map coercionSize args) coercionSize (UnivCo p _ t1 t2) = 1 + provSize p + typeSize t1 + typeSize t2 coercionSize (SymCo co) = 1 + coercionSize co coercionSize (TransCo co1 co2) = 1 + coercionSize co1 + coercionSize co2 -coercionSize (NthCo _ _ co) = 1 + coercionSize co +coercionSize (SelCo _ _ co) = 1 + coercionSize co coercionSize (LRCo _ co) = 1 + coercionSize co coercionSize (InstCo co arg) = 1 + coercionSize co + coercionSize arg coercionSize (KindCo co) = 1 + coercionSize co ===================================== compiler/GHC/Core/TyCo/Rep.hs-boot ===================================== @@ -8,6 +8,7 @@ import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) data Type data Coercion +data CoSel data UnivCoProvenance data TyLit data TyCoBinder ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Core.Type ( mkCastTy, mkAppTy, isCoercionTy, mkTyConApp ) import {-# SOURCE #-} GHC.Core.Coercion - ( mkCoVarCo, mkKindCo, mkNthCo, mkTransCo + ( mkCoVarCo, mkKindCo, mkSelCo, mkTransCo , mkNomReflCo, mkSubCo, mkSymCo , mkFunCo, mkForAllCo, mkUnivCo , mkAxiomInstCo, mkAppCo, mkGReflCo @@ -886,7 +886,7 @@ subst_co subst co (go_ty t1)) $! (go_ty t2) go (SymCo co) = mkSymCo $! (go co) go (TransCo co1 co2) = (mkTransCo $! (go co1)) $! (go co2) - go (NthCo r d co) = mkNthCo r d $! (go co) + go (SelCo r d co) = mkSelCo r d $! (go co) go (LRCo lr co) = mkLRCo lr $! (go co) go (InstCo co arg) = (mkInstCo $! (go co)) $! go arg go (KindCo co) = mkKindCo $! (go co) ===================================== compiler/GHC/Core/TyCo/Tidy.hs ===================================== @@ -242,7 +242,7 @@ tidyCo env@(_, subst) co tidyType env t1) $! tidyType env t2 go (SymCo co) = SymCo $! go co go (TransCo co1 co2) = (TransCo $! go co1) $! go co2 - go (NthCo r d co) = NthCo r d $! go co + go (SelCo r d co) = SelCo r d $! go co go (LRCo lr co) = LRCo lr $! go co go (InstCo co ty) = (InstCo $! go co) $! go ty go (KindCo co) = KindCo $! go co ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -281,7 +281,7 @@ import {-# SOURCE #-} GHC.Core.Coercion ( mkNomReflCo, mkGReflCo, mkReflCo , mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo , mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo - , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo + , mkSymCo, mkTransCo, mkSelCo, mkLRCo, mkInstCo , mkKindCo, mkSubCo , decomposePiCos, coercionKind, coercionLKind , coercionRKind, coercionType @@ -605,8 +605,8 @@ expandTypeSynonyms ty = mkSymCo (go_co subst co) go_co subst (TransCo co1 co2) = mkTransCo (go_co subst co1) (go_co subst co2) - go_co subst (NthCo r n co) - = mkNthCo r n (go_co subst co) + go_co subst (SelCo r n co) + = mkSelCo r n (go_co subst co) go_co subst (LRCo lr co) = mkLRCo lr (go_co subst co) go_co subst (InstCo co arg) @@ -667,16 +667,15 @@ kindRep k = case kindRep_maybe k of Just r -> r Nothing -> pprPanic "kindRep" (ppr k) --- | Given a kind (SORT _ rr), extract its RuntimeRep classifier rr. +-- | Given a kind (TYPE rr) or (CONSTRAINT rr), extract its RuntimeRep classifier rr. -- For example, @kindRep_maybe * = Just LiftedRep@ -- Returns 'Nothing' if the kind is not of form (TYPE rr) --- Treats * and Constraint as the same kindRep_maybe :: HasDebugCallStack => Kind -> Maybe RuntimeRepType kindRep_maybe kind | Just (_, rep) <- sORTKind_maybe kind = Just rep | otherwise = Nothing --- | Returns True if the argument is a lifted SORT +-- | Returns True if the argument is a lifted type or constraint -- See Note [Kind Constraint and kind Type] isLiftedTypeKind :: Kind -> Bool isLiftedTypeKind kind @@ -969,7 +968,7 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar go_co env (SymCo co) = mkSymCo <$> go_co env co go_co env (TransCo c1 c2) = mkTransCo <$> go_co env c1 <*> go_co env c2 go_co env (AxiomRuleCo r cos) = AxiomRuleCo r <$> go_cos env cos - go_co env (NthCo r i co) = mkNthCo r i <$> go_co env co + go_co env (SelCo r i co) = mkSelCo r i <$> go_co env co go_co env (LRCo lr co) = mkLRCo lr <$> go_co env co go_co env (InstCo co arg) = mkInstCo <$> go_co env co <*> go_co env arg go_co env (KindCo co) = mkKindCo <$> go_co env co @@ -3083,22 +3082,22 @@ isPredTy ty = case typeTypeOrConstraint ty of -- | Does this classify a type allowed to have values? Responds True to things -- like *, TYPE Lifted, TYPE IntRep, TYPE v, Constraint. classifiesTypeWithValues :: Kind -> Bool --- ^ True of a kind `SORT _ _` +-- ^ True of a kind `TYPE _` or `CONSTRAINT _` classifiesTypeWithValues k = isJust (sORTKind_maybe k) isConstraintKind :: Kind -> Bool --- True of (SORT ConstraintLike _) +-- True of (CONSTRAINT _) isConstraintKind kind | Just (ConstraintLike, _) <- sORTKind_maybe kind = True | otherwise = False --- | Is this kind equivalent to 'Type' i.e. SORT TypeLike LiftedRep? +tcIsLiftedTypeKind :: Kind -> Bool +-- ^ Is this kind equivalent to 'Type' i.e. TYPE LiftedRep? -- -- This considers 'Constraint' to be distinct from 'Type'. For a version that -- treats them as the same type, see 'isLiftedTypeKind'. -tcIsLiftedTypeKind :: Kind -> Bool tcIsLiftedTypeKind kind | Just (TypeLike, rep) <- sORTKind_maybe kind = isLiftedRuntimeRep rep @@ -3355,8 +3354,8 @@ occCheckExpand vs_to_avoid ty go_co cxt (TransCo co1 co2) = do { co1' <- go_co cxt co1 ; co2' <- go_co cxt co2 ; return (mkTransCo co1' co2') } - go_co cxt (NthCo r n co) = do { co' <- go_co cxt co - ; return (mkNthCo r n co') } + go_co cxt (SelCo r n co) = do { co' <- go_co cxt co + ; return (mkSelCo r n co') } go_co cxt (LRCo lr co) = do { co' <- go_co cxt co ; return (mkLRCo lr co') } go_co cxt (InstCo co arg) = do { co' <- go_co cxt co @@ -3416,7 +3415,7 @@ tyConsOfType ty go_co (HoleCo {}) = emptyUniqSet go_co (SymCo co) = go_co co go_co (TransCo co1 co2) = go_co co1 `unionUniqSets` go_co co2 - go_co (NthCo _ _ co) = go_co co + go_co (SelCo _ _ co) = go_co co go_co (LRCo _ co) = go_co co go_co (InstCo co arg) = go_co co `unionUniqSets` go_co arg go_co (KindCo co) = go_co co @@ -3514,7 +3513,7 @@ during type inference. -- | Checks that a kind of the form 'Type', 'Constraint' -- or @'TYPE r@ is concrete. See 'isConcrete'. -- --- __Precondition:__ The type has kind `SORT blah` +-- __Precondition:__ The type has kind `TYPE blah` or `CONSTRAINT blah` isFixedRuntimeRepKind :: HasDebugCallStack => Kind -> Bool isFixedRuntimeRepKind k = assertPpr (classifiesTypeWithValues k) (ppr k) $ @@ -3976,7 +3975,7 @@ mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type -- because those inner types should already have been rewritten -- to LiftedRep and UnliftedRep respectively, by mkTyConApp -- --- see Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. +-- see Note [TYPE and CONSTRAINT] in GHC.Builtin.Types.Prim. -- See Note [Using synonyms to compress types] in GHC.Core.Type {-# NOINLINE mkTYPEapp_maybe #-} mkTYPEapp_maybe (TyConApp tc args) @@ -4010,7 +4009,7 @@ mkBoxedRepApp_maybe :: Type -> Maybe Type -- On the fly, rewrite -- BoxedRep Lifted --> liftedRepTy (a synonym) -- BoxedRep Unlifted --> unliftedRepTy (ditto) --- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. +-- See Note [TYPE and CONSTRAINT] in GHC.Builtin.Types.Prim. -- See Note [Using synonyms to compress types] in GHC.Core.Type {-# NOINLINE mkBoxedRepApp_maybe #-} mkBoxedRepApp_maybe (TyConApp tc args) @@ -4024,7 +4023,7 @@ mkTupleRepApp_maybe :: Type -> Maybe Type -- ^ Given a `[RuntimeRep]`, apply `TupleRep` to it -- On the fly, rewrite -- TupleRep [] -> zeroBitRepTy (a synonym) --- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim. +-- See Note [TYPE and CONSTRAINT] in GHC.Builtin.Types.Prim. -- See Note [Using synonyms to compress types] in GHC.Core.Type {-# NOINLINE mkTupleRepApp_maybe #-} mkTupleRepApp_maybe (TyConApp tc args) ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1117,7 +1117,7 @@ unify_ty env ty1 ty2 _kco = maybeApart MARTypeFamily -- TYPE and CONSTRAINT are not Apart - -- See Note [Type vs Constraint] in GHC.Builtin.Types.Prim + -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim -- NB: at this point we know that the two TyCons do not match | Just {} <- sORTKind_maybe ty1 , Just {} <- sORTKind_maybe ty2 @@ -1637,9 +1637,9 @@ ty_co_match menv subst (ForAllTy (Bndr tv1 _) ty1) -- 1. Given: -- cv1 :: (s1 :: k1) ~r (s2 :: k2) -- kind_co2 :: (s1' ~ s2') ~N (t1 ~ t2) --- eta1 = mkNthCo role 2 (downgradeRole r Nominal kind_co2) +-- eta1 = mkSelCo role (SelTyCon 2) (downgradeRole r Nominal kind_co2) -- :: s1' ~ t1 --- eta2 = mkNthCo role 3 (downgradeRole r Nominal kind_co2) +-- eta2 = mkSelCo role (SelTyCon 3) (downgradeRole r Nominal kind_co2) -- :: s2' ~ t2 -- Wanted: -- subst1 <- ty_co_match menv subst s1 eta1 kco1 kco2 ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -289,7 +289,7 @@ toIfaceCoercionX fr co go (AppCo co1 co2) = IfaceAppCo (go co1) (go co2) go (SymCo co) = IfaceSymCo (go co) go (TransCo co1 co2) = IfaceTransCo (go co1) (go co2) - go (NthCo _r d co) = IfaceNthCo d (go co) + go (SelCo _r d co) = IfaceSelCo d (go co) go (LRCo lr co) = IfaceLRCo lr (go co) go (InstCo co arg) = IfaceInstCo (go co) (go arg) go (KindCo c) = IfaceKindCo (go c) ===================================== compiler/GHC/Iface/Rename.hs ===================================== @@ -697,7 +697,7 @@ rnIfaceCo (IfaceTransCo c1 c2) = IfaceTransCo <$> rnIfaceCo c1 <*> rnIfaceCo c2 rnIfaceCo (IfaceInstCo c1 c2) = IfaceInstCo <$> rnIfaceCo c1 <*> rnIfaceCo c2 -rnIfaceCo (IfaceNthCo d c) = IfaceNthCo d <$> rnIfaceCo c +rnIfaceCo (IfaceSelCo d c) = IfaceSelCo d <$> rnIfaceCo c rnIfaceCo (IfaceLRCo lr c) = IfaceLRCo lr <$> rnIfaceCo c rnIfaceCo (IfaceSubCo c) = IfaceSubCo <$> rnIfaceCo c rnIfaceCo (IfaceAxiomRuleCo ax cos) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -1693,7 +1693,7 @@ freeNamesIfCoercion (IfaceSymCo c) = freeNamesIfCoercion c freeNamesIfCoercion (IfaceTransCo c1 c2) = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2 -freeNamesIfCoercion (IfaceNthCo _ co) +freeNamesIfCoercion (IfaceSelCo _ co) = freeNamesIfCoercion co freeNamesIfCoercion (IfaceLRCo _ co) = freeNamesIfCoercion co ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -74,7 +74,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , manyDataConTyCon , liftedRepTyCon, liftedDataConTyCon ) import GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy, isLevityTy, anonArgTyCon ) - +import GHC.Core.TyCo.Rep( CoSel ) import GHC.Core.TyCon hiding ( pprPromotionQuote ) import GHC.Core.Coercion.Axiom import GHC.Types.Var @@ -383,7 +383,7 @@ data IfaceCoercion | IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType | IfaceSymCo IfaceCoercion | IfaceTransCo IfaceCoercion IfaceCoercion - | IfaceNthCo Int IfaceCoercion + | IfaceSelCo CoSel IfaceCoercion | IfaceLRCo LeftOrRight IfaceCoercion | IfaceInstCo IfaceCoercion IfaceCoercion | IfaceKindCo IfaceCoercion @@ -585,7 +585,7 @@ substIfaceType env ty go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2) go_co (IfaceSymCo co) = IfaceSymCo (go_co co) go_co (IfaceTransCo co1 co2) = IfaceTransCo (go_co co1) (go_co co2) - go_co (IfaceNthCo n co) = IfaceNthCo n (go_co co) + go_co (IfaceSelCo n co) = IfaceSelCo n (go_co co) go_co (IfaceLRCo lr co) = IfaceLRCo lr (go_co co) go_co (IfaceInstCo c1 c2) = IfaceInstCo (go_co c1) (go_co c2) go_co (IfaceKindCo co) = IfaceKindCo (go_co co) @@ -1786,8 +1786,8 @@ ppr_co ctxt_prec (IfaceTransCo co1 co2) ppr_trans c = [semi <+> ppr_co opPrec c] in maybeParen ctxt_prec opPrec $ vcat (ppr_co topPrec co1 : ppr_trans co2) -ppr_co ctxt_prec (IfaceNthCo d co) - = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co] +ppr_co ctxt_prec (IfaceSelCo d co) + = ppr_special_co ctxt_prec (text "Nth:" <> ppr d) [co] ppr_co ctxt_prec (IfaceLRCo lr co) = ppr_special_co ctxt_prec (ppr lr) [co] ppr_co ctxt_prec (IfaceSubCo co) @@ -2077,7 +2077,7 @@ instance Binary IfaceCoercion where putByte bh 11 put_ bh a put_ bh b - put_ bh (IfaceNthCo a b) = do + put_ bh (IfaceSelCo a b) = do putByte bh 12 put_ bh a put_ bh b @@ -2148,7 +2148,7 @@ instance Binary IfaceCoercion where return $ IfaceTransCo a b 12-> do a <- get bh b <- get bh - return $ IfaceNthCo a b + return $ IfaceSelCo a b 13-> do a <- get bh b <- get bh return $ IfaceLRCo a b @@ -2234,7 +2234,7 @@ instance NFData IfaceCoercion where IfaceUnivCo f1 f2 f3 f4 -> rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 IfaceSymCo f1 -> rnf f1 IfaceTransCo f1 f2 -> rnf f1 `seq` rnf f2 - IfaceNthCo f1 f2 -> rnf f1 `seq` rnf f2 + IfaceSelCo f1 f2 -> rnf f1 `seq` rnf f2 IfaceLRCo f1 f2 -> f1 `seq` rnf f2 IfaceInstCo f1 f2 -> rnf f1 `seq` rnf f2 IfaceKindCo f1 -> rnf f1 ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1420,8 +1420,8 @@ tcIfaceCo = go <*> go c2 go (IfaceInstCo c1 t2) = InstCo <$> go c1 <*> go t2 - go (IfaceNthCo d c) = do { c' <- go c - ; return $ mkNthCo (nthCoRole d c') d c' } + go (IfaceSelCo d c) = do { c' <- go c + ; return $ mkSelCo (nthCoRole d c') d c' } go (IfaceLRCo lr c) = LRCo lr <$> go c go (IfaceKindCo c) = KindCo <$> go c go (IfaceSubCo c) = SubCo <$> go c ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -1249,7 +1249,7 @@ checkBootTyCon is_boot tc1 tc2 -- data T a = MkT -- -- If you write this, we'll treat T as injective, and make inferences - -- like T a ~R T b ==> a ~N b (mkNthCo). But if we can + -- like T a ~R T b ==> a ~N b (mkSelCo). But if we can -- subsequently replace T with one at phantom role, we would then be able to -- infer things like T Int ~R T Bool which is bad news. -- ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -1038,7 +1038,7 @@ 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] - = canDecomposableFunTy ev eq_rel [am1,ty1a,ty1b] [am2,ty2a,ty2b] + = canDecomposableFunTy ev eq_rel (am1,ty1a,ty1b) (am2,ty2a,ty2b) -- Decompose type constructor applications -- NB: we have expanded type synonyms already @@ -1779,8 +1779,8 @@ Conclusion: It all comes from the fact that newtypes aren't necessarily injective w.r.t. representational equality. -Furthermore, as explained in Note [NthCo and newtypes] in GHC.Core.TyCo.Rep, we can't use -NthCo on representational coercions over newtypes. NthCo comes into play +Furthermore, as explained in Note [SelCo and newtypes] in GHC.Core.TyCo.Rep, we can't use +SelCo on representational coercions over newtypes. SelCo comes into play only when decomposing givens. Conclusion: @@ -1892,7 +1892,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 -> do { let ev_co = mkCoVarCo evar ; given_evs <- newGivenEvVars loc $ [ ( mkPrimEqPredRole r ty1 ty2 - , evCoercion $ mkNthCo r i ev_co ) + , evCoercion $ mkSelCo r (SelTyCon i) ev_co ) | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..] , r /= Phantom , not (isCoercionTy ty1) && not (isCoercionTy ty2) ] @@ -1927,22 +1927,29 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2 = new_loc0 ] ++ repeat loc -canDecomposableFunTy :: CtEvidence -> EqRel -> [Type] -> [Type] +canDecomposableFunTy :: CtEvidence -> EqRel + -> (Type,Type,Type) -- (multiplicity,arg,res) + -> (Type,Type,Type) -- (multiplicity,arg,res) -> TcS (StopOrContinue Ct) -canDecomposableFunTy ev eq_rel tys1 tys2 +canDecomposableFunTy ev eq_rel f1@(m1,a1,r1) f2@(m2,a2,r2) = do { traceTcS "canDecomposableFunTy" - (ppr ev $$ ppr eq_rel $$ ppr tys1 $$ ppr tys2) + (ppr ev $$ ppr eq_rel $$ ppr f1 $$ ppr f2) ; case ev of CtWanted { ctev_dest = dest, ctev_rewriters = rewriters } - -> do { [mult,arg,res] <- zipWith4M (unifyWanted rewriters) new_locs tc_roles tys1 tys2 + -> do { mult <- unifyWanted rewriters mult_loc (funRole role SelMult) m1 m2 + ; arg <- unifyWanted rewriters loc (funRole role SelArg) a1 a2 + ; res <- unifyWanted rewriters loc (funRole role SelRes) r1 r2 ; setWantedEq dest (mkFunCo role mult arg res) } CtGiven { ctev_evar = evar } -> do { let ev_co = mkCoVarCo evar ; given_evs <- newGivenEvVars loc $ - [ ( mkPrimEqPredRole r ty1 ty2 - , evCoercion $ mkNthCo r i ev_co ) - | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..] ] + [ ( mkPrimEqPredRole role' ty1 ty2 + , evCoercion $ mkSelCo role' (SelFun fs) ev_co ) + | (fs, ty1, ty2) <- [(SelMult, m1, m2) + ,(SelArg, a1, a2) + ,(SelRes, r2, r2)] + , let role' = funRole role fs ] ; emitWorkNC given_evs } ; stopWith ev "Decomposed TyConApp" } @@ -1950,8 +1957,7 @@ canDecomposableFunTy ev eq_rel tys1 tys2 where loc = ctEvLoc ev role = eqRelRole eq_rel - tc_roles = funRolesX role - new_locs = [updateCtLocOrigin loc toInvisibleOrigin, loc, loc] + mult_loc = updateCtLocOrigin loc toInvisibleOrigin -- | Call when canonicalizing an equality fails, but if the equality is -- representational, there is some hope for the future. ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -146,7 +146,7 @@ synonymTyConsOfType ty go_co (UnivCo p _ ty ty') = go_prov p `plusNameEnv` go ty `plusNameEnv` go ty' go_co (SymCo co) = go_co co go_co (TransCo co co') = go_co co `plusNameEnv` go_co co' - go_co (NthCo _ _ co) = go_co co + go_co (SelCo _ _ co) = go_co co go_co (LRCo _ co) = go_co co go_co (InstCo co co') = go_co co `plusNameEnv` go_co co' go_co (KindCo co) = go_co co ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -46,7 +46,7 @@ module GHC.Tc.Types.Evidence ( mkTcAxInstCo, mkTcUnbranchedAxInstCo, mkTcForAllCo, mkTcForAllCos, mkTcSymCo, mkTcSymMCo, mkTcTransCo, - mkTcNthCo, mkTcLRCo, mkTcSubCo, maybeTcSymCo, + mkTcSelCo, mkTcLRCo, mkTcSubCo, maybeTcSymCo, maybeTcSubCo, tcDowngradeRole, mkTcAxiomRuleCo, mkTcGReflRightCo, mkTcGReflRightMCo, mkTcGReflLeftCo, mkTcGReflLeftMCo, mkTcPhantomCo, @@ -139,7 +139,7 @@ mkTcUnbranchedAxInstCo :: CoAxiom Unbranched -> [TcType] -> [TcCoercion] -> TcCoercionR mkTcForAllCo :: TyVar -> TcCoercionN -> TcCoercion -> TcCoercion mkTcForAllCos :: [(TyVar, TcCoercionN)] -> TcCoercion -> TcCoercion -mkTcNthCo :: Role -> Int -> TcCoercion -> TcCoercion +mkTcSelCo :: Role -> CoSel -> TcCoercion -> TcCoercion mkTcLRCo :: LeftOrRight -> TcCoercion -> TcCoercion mkTcSubCo :: HasDebugCallStack => TcCoercionN -> TcCoercionR tcDowngradeRole :: Role -> Role -> TcCoercion -> TcCoercion @@ -177,7 +177,7 @@ mkTcAxInstCo = mkAxInstCo mkTcUnbranchedAxInstCo = mkUnbranchedAxInstCo Representational mkTcForAllCo = mkForAllCo mkTcForAllCos = mkForAllCos -mkTcNthCo = mkNthCo +mkTcSelCo = mkSelCo mkTcLRCo = mkLRCo mkTcSubCo = mkSubCo tcDowngradeRole = downgradeRole ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1515,7 +1515,7 @@ collect_cand_qtvs_co orig_ty bound = go_co collect_cand_qtvs orig_ty True bound dv2 t2 go_co dv (SymCo co) = go_co dv co go_co dv (TransCo co1 co2) = foldlM go_co dv [co1, co2] - go_co dv (NthCo _ _ co) = go_co dv co + go_co dv (SelCo _ _ co) = go_co dv co go_co dv (LRCo _ co) = go_co dv co go_co dv (InstCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (KindCo co) = go_co dv co ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -127,13 +127,11 @@ import qualified Data.Semigroup as Semi import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted) import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag) -{- -************************************************************************ +{- ********************************************************************* * * Binary choice * * -************************************************************************ --} +********************************************************************* -} data LeftOrRight = CLeft | CRight deriving( Eq, Data ) ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -134,7 +134,8 @@ data Literal | LitRubbish -- ^ A nonsense value; See Note [Rubbish literals]. TypeOrConstraint -- t_or_c: whether this is a type or a constraint Type -- rr: a type of kind RuntimeRep - -- The type of the literal is forall (a:SORT t_or_c rr). a + -- The type of the literal is forall (a:TYPE rr). a + -- or forall (a:CONSTRAINT rr). a -- -- INVARIANT: the Type has no free variables -- and so substitution etc can ignore it ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -475,7 +475,7 @@ data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type -- RuntimeRep is intimately tied to TyCon.RuntimeRep (in GHC proper). See -- Note [RuntimeRep and PrimRep] in RepType. -- See also Note [Wiring in RuntimeRep] in GHC.Builtin.Types --- See also Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Type.Prim +-- See also Note [TYPE and CONSTRAINT] in GHC.Builtin.Type.Prim -- | Length of a SIMD vector type data VecCount = Vec2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac9c8ca6e81b88872d89e0781d6db0d7d735c302 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac9c8ca6e81b88872d89e0781d6db0d7d735c302 You're receiving 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 Aug 16 07:11:07 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 03:11:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: EPA: DotFieldOcc does not have exact print annotations Message-ID: <62fb430b16cac_3d814948990139021b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ad87b327 by Eric Lindblad at 2022-08-16T03:10:49-04:00 typo - - - - - e3ee1d00 by Ben Gamari at 2022-08-16T03:10:50-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - d670b498 by Bryan Richter at 2022-08-16T03:10:50-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 6a6a3ff7 by Cheng Shao at 2022-08-16T03:10:52-04:00 CmmToAsm/AArch64: correct a typo - - - - - 7800e2c9 by Ben Gamari at 2022-08-16T03:10:53-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - f4c9f072 by Ben Gamari at 2022-08-16T03:10:53-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 683d1ec1 by Ben Gamari at 2022-08-16T03:10:53-04:00 users-guide: Add :ghc-flag: reference - - - - - b824db03 by Ben Gamari at 2022-08-16T03:10:53-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - c0b5d8d5 by Ben Gamari at 2022-08-16T03:10:53-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - cbfbf8b6 by Ben Gamari at 2022-08-16T03:10:53-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - 392ad3f5 by Ben Gamari at 2022-08-16T03:10:53-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - e66c9859 by Ben Gamari at 2022-08-16T03:10:53-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/FieldLabel.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5a02854fe872f5709292ca48dbd4b0f9ce9ee9ca...e66c9859f0b189fa270e687dd3c4302c1909b9bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5a02854fe872f5709292ca48dbd4b0f9ce9ee9ca...e66c9859f0b189fa270e687dd3c4302c1909b9bb You're receiving 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 Aug 16 08:16:23 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 Aug 2022 04:16:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/9.4-foward-fixed-make Message-ID: <62fb525726ef2_3d81494886414279e9@gitlab.mail> Matthew Pickering pushed new branch wip/9.4-foward-fixed-make at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/9.4-foward-fixed-make You're receiving 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 Aug 16 08:19:10 2022 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 16 Aug 2022 04:19:10 -0400 Subject: [Git][ghc/ghc][wip/T21583] 406 commits: Don't store LlvmConfig into DynFlags Message-ID: <62fb52feb8b45_3d81494890414319eb@gitlab.mail> Bryan R pushed to branch wip/T21583 at Glasgow Haskell Compiler / GHC Commits: ef3c8d9e by Sylvain Henry at 2022-05-17T20:22:02-04:00 Don't store LlvmConfig into DynFlags LlvmConfig contains information read from llvm-passes and llvm-targets files in GHC's top directory. Reading these files is done only when needed (i.e. when the LLVM backend is used) and cached for the whole compiler session. This patch changes the way this is done: - Split LlvmConfig into LlvmConfig and LlvmConfigCache - Store LlvmConfigCache in HscEnv instead of DynFlags: there is no good reason to store it in DynFlags. As it is fixed per session, we store it in the session state instead (HscEnv). - Initializing LlvmConfigCache required some changes to driver functions such as newHscEnv. I've used the opportunity to untangle initHscEnv from initGhcMonad (in top-level GHC module) and to move it to GHC.Driver.Main, close to newHscEnv. - I've also made `cmmPipeline` independent of HscEnv in order to remove the call to newHscEnv in regalloc_unit_tests. - - - - - 828fbd8a by Andreas Klebinger at 2022-05-17T20:22:38-04:00 Give all EXTERN_INLINE closure macros prototypes - - - - - cfc8e2e2 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Introduce [sg]etFinalizerExceptionHandler This introduces a global hook which is called when an exception is thrown during finalization. - - - - - 372cf730 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Throw exceptions raised while closing finalized Handles Fixes #21336. - - - - - 3dd2f944 by Ben Gamari at 2022-05-19T04:57:51-04:00 testsuite: Add tests for #21336 - - - - - 297156e0 by Matthew Pickering at 2022-05-19T04:58:27-04:00 Add release flavour and use it for the release jobs The release flavour is essentially the same as the perf flavour currently but also enables `-haddock`. I have hopefully updated all the relevant places where the `-perf` flavour was hardcoded. Fixes #21486 - - - - - a05b6293 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Don't build sphinx documentation on centos The centos docker image lacks the sphinx builder so we disable building sphinx docs for these jobs. Fixes #21580 - - - - - 209d7c69 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Use correct syntax when args list is empty This seems to fail on the ancient version of bash present on CentOS - - - - - 02d16334 by Matthew Pickering at 2022-05-19T04:59:03-04:00 hadrian: Don't attempt to build dynamic profiling libraries We only support building static profiling libraries, the transformer was requesting things like a dynamic, threaded, debug, profiling RTS, which we have never produced nor distributed. Fixes #21567 - - - - - 35bdab1c by Ben Gamari at 2022-05-19T04:59:39-04:00 configure: Check CC_STAGE0 for --target support We previously only checked the stage 1/2 compiler for --target support. We got away with this for quite a while but it eventually caught up with us in #21579, where `bytestring`'s new NEON implementation was unbuildable on Darwin due to Rosetta's seemingly random logic for determining which executable image to execute. This lead to a confusing failure to build `bytestring`'s cbits, when `clang` tried to compile NEON builtins while targetting x86-64. Fix this by checking CC_STAGE0 for --target support. Fixes #21579. - - - - - 0ccca94b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator analysis of `CmmGraph` This commit adds module `GHC.Cmm.Dominators`, which provides a wrapper around two existing algorithms in GHC: the Lengauer-Tarjan dominator analysis from the X86 back end and the reverse postorder ordering from the Cmm Dataflow framework. Issue #20726 proposes that we evaluate some alternatives for dominator analysis, but for the time being, the best path forward is simply to use the existing analysis on `CmmGraph`s. This commit addresses a bullet in #21200. - - - - - 54f0b578 by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator-tree function - - - - - 05ed917b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add HasDebugCallStack; remove unneeded extensions - - - - - 0b848136 by Andreas Klebinger at 2022-05-20T05:32:32-04:00 document fields of `DominatorSet` - - - - - 8a26e8d6 by Ben Gamari at 2022-05-20T05:33:08-04:00 nonmoving: Fix documentation of GC statistics fields These were previously incorrect. Fixes #21553. - - - - - c1e24e61 by Matthew Pickering at 2022-05-20T05:33:44-04:00 Remove pprTrace from pushCoercionIntoLambda (#21555) This firstly caused spurious output to be emitted (as evidenced by #21555) but even worse caused a massive coercion to be attempted to be printed (> 200k terms) which would invariably eats up all the memory of your computer. The good news is that removing this trace allows the program to compile to completion, the bad news is that the program exhibits a core lint error (on 9.0.2) but not any other releases it seems. Fixes #21577 and #21555 - - - - - a36d12ee by Zubin Duggal at 2022-05-20T10:44:35-04:00 docs: Fix LlvmVersion in manpage (#21280) - - - - - 36b8a57c by Matthew Pickering at 2022-05-20T10:45:10-04:00 validate: Use $make rather than make In the validate script we are careful to use the $make variable as this stores whether we are using gmake, make, quiet mode etc. There was just this one place where we failed to use it. Fixes #21598 - - - - - 4aa3c5bd by Norman Ramsey at 2022-05-21T03:11:04+00:00 Change `Backend` type and remove direct dependencies With this change, `Backend` becomes an abstract type (there are no more exposed value constructors). Decisions that were formerly made by asking "is the current back end equal to (or different from) this named value constructor?" are now made by interrogating the back end about its properties, which are functions exported by `GHC.Driver.Backend`. There is a description of how to migrate code using `Backend` in the user guide. Clients using the GHC API can find a backdoor to access the Backend datatype in GHC.Driver.Backend.Internal. Bumps haddock submodule. Fixes #20927 - - - - - ecf5f363 by Julian Ospald at 2022-05-21T12:51:16-04:00 Respect DESTDIR in hadrian bindist Makefile, fixes #19646 - - - - - 7edd991e by Julian Ospald at 2022-05-21T12:51:16-04:00 Test DESTDIR in test_hadrian() - - - - - ea895b94 by Matthew Pickering at 2022-05-22T21:57:47-04:00 Consider the stage of typeable evidence when checking stage restriction We were considering all Typeable evidence to be "BuiltinInstance"s which meant the stage restriction was going unchecked. In-fact, typeable has evidence and so we need to apply the stage restriction. This is complicated by the fact we don't generate typeable evidence and the corresponding DFunIds until after typechecking is concluded so we introcue a new `InstanceWhat` constructor, BuiltinTypeableInstance which records whether the evidence is going to be local or not. Fixes #21547 - - - - - ffbe28e5 by Dominik Peteler at 2022-05-22T21:58:23-04:00 Modularize GHC.Core.Opt.LiberateCase Progress towards #17957 - - - - - bc723ac2 by Simon Peyton Jones at 2022-05-23T17:09:34+01:00 Improve FloatOut and SpecConstr This patch addresses a relatively obscure situation that arose when chasing perf regressions in !7847, which itself is fixing It does two things: * SpecConstr can specialise on ($df d1 d2) dictionary arguments * FloatOut no longer checks argument strictness See Note [Specialising on dictionaries] in GHC.Core.Opt.SpecConstr. A test case is difficult to construct, but it makes a big difference in nofib/real/eff/VSM, at least when we have the patch for #21286 installed. (The latter stops worker/wrapper for dictionary arguments). There is a spectacular, but slightly illusory, improvement in runtime perf on T15426. I have documented the specifics in T15426 itself. Metric Decrease: T15426 - - - - - 1a4195b0 by John Ericson at 2022-05-23T17:33:59-04:00 Make debug a `Bool` not an `Int` in `StgToCmmConfig` We don't need any more resolution than this. Rename the field to `stgToCmmEmitDebugInfo` to indicate it is no longer conveying any "level" information. - - - - - e9fff12b by Alan Zimmerman at 2022-05-23T21:04:49-04:00 EPA : Remove duplicate comments in DataFamInstD The code data instance Method PGMigration = MigrationQuery Query -- ^ Run a query against the database | MigrationCode (Connection -> IO (Either String ())) -- ^ Run any arbitrary IO code Resulted in two instances of the "-- ^ Run a query against the database" comment appearing in the Exact Print Annotations when it was parsed. Ensure only one is kept. Closes #20239 - - - - - e2520df3 by Alan Zimmerman at 2022-05-23T21:05:27-04:00 EPA: Comment Order Reversed Make sure comments captured in the exact print annotations are in order of increasing location Closes #20718 - - - - - 4b45fd72 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Add test for T21455 - - - - - e2cd1d43 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Allow passing -po outside profiling way Resolves #21455 - - - - - 3b8c413a by Greg Steuck at 2022-05-24T10:49:52-04:00 Fix haddock_*_perf tests on non-GNU-grep systems Using regexp pattern requires `egrep` and straight up `+`. The haddock_parser_perf and haddock_renamer_perf tests now pass on OpenBSD. They previously incorrectly parsed the files and awk complained about invalid syntax. - - - - - 1db877a3 by Ben Gamari at 2022-05-24T10:50:28-04:00 hadrian/bindist: Drop redundant include of install.mk `install.mk` is already included by `config.mk`. Moreover, `install.mk` depends upon `config.mk` to set `RelocatableBuild`, making this first include incorrect. - - - - - f485d267 by Greg Steuck at 2022-05-24T10:51:08-04:00 Remove -z wxneeded for OpenBSD With all the recent W^X fixes in the loader this workaround is not necessary any longer. I verified that the only tests failing for me on OpenBSD 7.1-current are the same (libc++ related) before and after this commit (with --fast). - - - - - 7c51177d by Andreas Klebinger at 2022-05-24T22:13:19-04:00 Use UnionListsOrd instead of UnionLists in most places. This should get rid of most, if not all "Overlong lists" errors and fix #20016 - - - - - 81b3741f by Andreas Klebinger at 2022-05-24T22:13:55-04:00 Fix #21563 by using Word64 for 64bit shift code. We use the 64bit shifts only on 64bit platforms. But we compile the code always so compiling it on 32bit caused a lint error. So use Word64 instead. - - - - - 2c25fff6 by Zubin Duggal at 2022-05-24T22:14:30-04:00 Fix compilation with -haddock on GHC <= 8.10 -haddock on GHC < 9.0 is quite fragile and can result in obtuse parse errors when it encounters invalid haddock syntax. This has started to affect users since 297156e0b8053a28a860e7a18e1816207a59547b enabled -haddock by default on many flavours. Furthermore, since we don't test bootstrapping with 8.10 on CI, this problem managed to slip throught the cracks. - - - - - cfb9faff by sheaf at 2022-05-24T22:15:12-04:00 Hadrian: don't add "lib" for relocatable builds The conditional in hadrian/bindist/Makefile depended on the target OS, but it makes more sense to use whether we are using a relocatable build. (Currently this only gets set to true on Windows, but this ensures that the logic stays correctly coupled.) - - - - - 9973c016 by Andre Marianiello at 2022-05-25T01:36:09-04:00 Remove HscEnv from GHC.HsToCore.Usage (related to #17957) Metric Decrease: T16875 - - - - - 2ff18e39 by sheaf at 2022-05-25T01:36:48-04:00 SimpleOpt: beta-reduce through casts The simple optimiser would sometimes fail to beta-reduce a lambda when there were casts in between the lambda and its arguments. This can cause problems because we rely on representation-polymorphic lambdas getting beta-reduced away (for example, those that arise from newtype constructors with representation-polymorphic arguments, with UnliftedNewtypes). - - - - - e74fc066 by CarrieMY at 2022-05-25T16:43:03+02:00 Desugar RecordUpd in `tcExpr` This patch typechecks record updates by desugaring them inside the typechecker using the HsExpansion mechanism, and then typechecking this desugared result. Example: data T p q = T1 { x :: Int, y :: Bool, z :: Char } | T2 { v :: Char } | T3 { x :: Int } | T4 { p :: Float, y :: Bool, x :: Int } | T5 The record update `e { x=e1, y=e2 }` desugars as follows e { x=e1, y=e2 } ===> let { x' = e1; y' = e2 } in case e of T1 _ _ z -> T1 x' y' z T4 p _ _ -> T4 p y' x' The desugared expression is put into an HsExpansion, and we typecheck that. The full details are given in Note [Record Updates] in GHC.Tc.Gen.Expr. Fixes #2595 #3632 #10808 #10856 #16501 #18311 #18802 #21158 #21289 Updates haddock submodule - - - - - 2b8bdab8 by Eric Lindblad at 2022-05-26T03:21:58-04:00 update README - - - - - 3d7e7e84 by BinderDavid at 2022-05-26T03:22:38-04:00 Replace dead link in Haddock documentation of Control.Monad.Fail (fixes #21602) - - - - - ee61c7f9 by John Ericson at 2022-05-26T03:23:13-04:00 Add Haddocks for `WwOpts` - - - - - da5ccf0e by Dominik Peteler at 2022-05-26T03:23:13-04:00 Avoid global compiler state for `GHC.Core.Opt.WorkWrap` Progress towards #17957 - - - - - 3bd975b4 by sheaf at 2022-05-26T03:23:52-04:00 Optimiser: avoid introducing bad rep-poly The functions `pushCoValArg` and `pushCoercionIntoLambda` could introduce bad representation-polymorphism. Example: type RR :: RuntimeRep type family RR where { RR = IntRep } type F :: TYPE RR type family F where { F = Int# } co = GRefl F (TYPE RR[0]) :: (F :: TYPE RR) ~# (F |> TYPE RR[0] :: TYPE IntRep) f :: F -> () `pushCoValArg` would transform the unproblematic application (f |> (co -> <()>)) (arg :: F |> TYPE RR[0]) into an application in which the argument does not have a fixed `RuntimeRep`: f ((arg |> sym co) :: (F :: TYPE RR)) - - - - - b22979fb by Fraser Tweedale at 2022-05-26T06:14:51-04:00 executablePath test: fix file extension treatment The executablePath test strips the file extension (if any) when comparing the query result with the expected value. This is to handle platforms where GHC adds a file extension to the output program file (e.g. .exe on Windows). After the initial check, the file gets deleted (if supported). However, it tries to delete the *stripped* filename, which is incorrect. The test currently passes only because Windows does not allow deleting the program while any process created from it is alive. Make the test program correct in general by deleting the *non-stripped* executable filename. - - - - - afde4276 by Fraser Tweedale at 2022-05-26T06:14:51-04:00 fix executablePath test for NetBSD executablePath support for NetBSD was added in a172be07e3dce758a2325104a3a37fc8b1d20c9c, but the test was not updated. Update the test so that it works for NetBSD. This requires handling some quirks: - The result of getExecutablePath could include "./" segments. Therefore use System.FilePath.equalFilePath to compare paths. - The sysctl(2) call returns the original executable name even after it was deleted. Add `canQueryAfterDelete :: [FilePath]` and adjust expectations for the post-delete query accordingly. Also add a note to the `executablePath` haddock to advise that NetBSD behaves differently from other OSes when the file has been deleted. Also accept a decrease in memory usage for T16875. On Windows, the metric is -2.2% of baseline, just outside the allowed ±2%. I don't see how this commit could have influenced this metric, so I suppose it's something in the CI environment. Metric Decrease: T16875 - - - - - d0e4355a by John Ericson at 2022-05-26T06:15:30-04:00 Factor out `initArityOps` to `GHC.Driver.Config.*` module We want `DynFlags` only mentioned in `GHC.Driver`. - - - - - 44bb7111 by romes at 2022-05-26T16:27:57+00:00 TTG: Move MatchGroup Origin field and MatchGroupTc to GHC.Hs - - - - - 88e58600 by sheaf at 2022-05-26T17:38:43-04:00 Add tests for eta-expansion of data constructors This patch adds several tests relating to the eta-expansion of data constructors, including UnliftedNewtypes and DataTypeContexts. - - - - - d87530bb by Richard Eisenberg at 2022-05-26T23:20:14-04:00 Generalize breakTyVarCycle to work with TyFamLHS The function breakTyVarCycle_maybe has been installed in a dark corner of GHC to catch some gremlins (a.k.a. occurs-check failures) who lurk there. But it previously only caught gremlins of the form (a ~ ... F a ...), where some of our intrepid users have spawned gremlins of the form (G a ~ ... F (G a) ...). This commit improves breakTyVarCycle_maybe (and renames it to breakTyEqCycle_maybe) to catch the new gremlins. Happily, the change is remarkably small. The gory details are in Note [Type equality cycles]. Test cases: typecheck/should_compile/{T21515,T21473}. - - - - - ed37027f by Hécate Moonlight at 2022-05-26T23:20:52-04:00 [base] Fix the links in the Data.Data module fix #21658 fix #21657 fix #21657 - - - - - 3bd7d5d6 by Krzysztof Gogolewski at 2022-05-27T16:44:48+02:00 Use a class to check validity of withDict This moves handling of the magic 'withDict' function from the desugarer to the typechecker. Details in Note [withDict]. I've extracted a part of T16646Fail to a separate file T16646Fail2, because the new error in 'reify' hides the errors from 'f' and 'g'. WithDict now works with casts, this fixes #21328. Part of #19915 - - - - - b54f6c4f by sheaf at 2022-05-28T21:00:09-04:00 Fix FreeVars computation for mdo Commit acb188e0 introduced a regression in the computation of free variables in mdo statements, as the logic in GHC.Rename.Expr.segmentRecStmts was slightly different depending on whether the recursive do block corresponded to an mdo statement or a rec statment. This patch restores the previous computation for mdo blocks. Fixes #21654 - - - - - 0704295c by Matthew Pickering at 2022-05-28T21:00:45-04:00 T16875: Stabilise (temporarily) by increasing acceptance threshold The theory is that on windows there is some difference in the environment between pipelines on master and merge requests which affects all tests equally but because T16875 barely allocates anything it is the test which is affected the most. See #21557 - - - - - 6341c8ed by Matthew Pickering at 2022-05-28T21:01:20-04:00 make: Fix make maintainer-clean deleting a file tracked by source control Fixes #21659 - - - - - fbf2f254 by Bodigrim at 2022-05-28T21:01:58-04:00 Expand documentation of hIsTerminalDevice - - - - - 0092c67c by Teo Camarasu at 2022-05-29T12:25:39+00:00 export IsList from GHC.IsList it is still re-exported from GHC.Exts - - - - - 91396327 by Sylvain Henry at 2022-05-30T09:40:55-04:00 MachO linker: fix handling of ARM64_RELOC_SUBTRACTOR ARM64_RELOC_SUBTRACTOR relocations are paired with an AMR64_RELOC_UNSIGNED relocation to implement: addend + sym1 - sym2 The linker was doing it in two steps, basically: *addend <- *addend - sym2 *addend <- *addend + sym1 The first operation was likely to overflow. For example when the relocation target was 32-bit and both sym1/sym2 were 64-bit addresses. With the small memory model, (sym1-sym2) would fit in 32 bits but (*addend-sym2) may not. Now the linker does it in one step: *addend <- *addend + sym1 - sym2 - - - - - acc26806 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Some fixes to SRT documentation - reordered the 3 SRT implementation cases from the most general to the most specific one: USE_SRT_POINTER -> USE_SRT_OFFSET -> USE_INLINE_SRT_FIELD - added requirements for each - found and documented a confusion about "SRT inlining" not supported with MachO. (It is fixed in the following commit) - - - - - 5878f439 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Enable USE_INLINE_SRT_FIELD on ARM64 It was previously disabled because of: - a confusion about "SRT inlining" (see removed comment in this commit) - a linker bug (overflow) in the handling of ARM64_RELOC_SUBTRACTOR relocation: fixed by a previous commit. - - - - - 59bd6159 by Matthew Pickering at 2022-05-30T09:41:39-04:00 ci: Make sure to exit promptly if `make install` fails. Due to the vageries of bash, you have to explicitly handle the failure and exit when in a function. This failed to exit promptly when !8247 was failing. See #21358 for the general issue - - - - - 5a5a28da by Sylvain Henry at 2022-05-30T09:42:23-04:00 Split GHC.HsToCore.Foreign.Decl This is preliminary work for JavaScript support. It's better to put the code handling the desugaring of Prim, C and JavaScript declarations into separate modules. - - - - - 6f5ff4fa by Sylvain Henry at 2022-05-30T09:43:05-04:00 Bump hadrian to LTS-19.8 (GHC 9.0.2) - - - - - f2e70707 by Sylvain Henry at 2022-05-30T09:43:05-04:00 Hadrian: remove unused code - - - - - 2f215b9f by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Eta reduction with casted function We want to be able to eta-reduce \x y. ((f x) |> co) y by pushing 'co' inwards. A very small change accommodates this See Note [Eta reduction with casted function] - - - - - f4f6a87a by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Do arity trimming at bindings, rather than in exprArity Sometimes there are very large casts, and coercionRKind can be slow. - - - - - 610a2b83 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make findRhsArity take RecFlag This avoids a fixpoint iteration for the common case of non-recursive bindings. - - - - - 80ba50c7 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Comments and white space - - - - - 0079171b by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make PrimOpId record levity This patch concerns #20155, part (1) The general idea is that since primops have curried bindings (currently in PrimOpWrappers.hs) we don't need to eta-expand them. But we /do/ need to eta-expand the levity-polymorphic ones, because they /don't/ have bindings. This patch makes a start in that direction, by identifying the levity-polymophic primops in the PrimOpId IdDetails constructor. For the moment, I'm still eta-expanding all primops (by saying that hasNoBinding returns True for all primops), because of the bug reported in #20155. But I hope that before long we can tidy that up too, and remove the TEMPORARILY stuff in hasNoBinding. - - - - - 6656f016 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 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: * Move state-hack stuff from GHC.Types.Id (where it never belonged) to GHC.Core.Opt.Arity (which seems much more appropriate). * Add a crucial mkCast in the Cast case of GHC.Core.Opt.Arity.eta_expand; helps with T18223 * Add clarifying notes about eta-reducing to PAPs. See Note [Do not eta reduce PAPs] * I moved tryEtaReduce from GHC.Core.Utils to GHC.Core.Opt.Arity, where it properly belongs. See Note [Eta reduce PAPs] * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, pull out the code for when eta-expansion is wanted, to make wantEtaExpansion, and all that same function in GHC.Core.Opt.Simplify.simplStableUnfolding. It was previously inconsistent, but it's doing the same thing. * I did a substantial refactor of ArityType; see Note [ArityType]. This allowed me to do away with the somewhat mysterious takeOneShots; more generally it allows arityType to describe the function, leaving its clients to decide how to use that information. I made ArityType abstract, so that clients have to use functions to access it. * Make GHC.Core.Opt.Simplify.Utils.rebuildLam (was stupidly called mkLam before) aware of the floats that the simplifier builds up, so that it can still do eta-reduction even if there are some floats. (Previously that would not happen.) That means passing the floats to rebuildLam, and an extra check when eta-reducting (etaFloatOk). * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, make use of call-info in the idDemandInfo of the binder, as well as the CallArity info. The occurrence analyser did this but we were failing to take advantage here. In the end I moved the heavy lifting to GHC.Core.Opt.Arity.findRhsArity; see Note [Combining arityType with demand info], and functions idDemandOneShots and combineWithDemandOneShots. (These changes partly drove my refactoring of ArityType.) * In GHC.Core.Opt.Arity.findRhsArity * I'm now taking account of the demand on the binder to give extra one-shot info. E.g. if the fn is always called with two args, we can give better one-shot info on the binders than if we just look at the RHS. * Don't do any fixpointing in the non-recursive case -- simple short cut. * Trim arity inside the loop. See Note [Trim arity inside the loop] * Make SimpleOpt respect the eta-reduction flag (Some associated refactoring here.) * I made the CallCtxt which the Simplifier uses distinguish between recursive and non-recursive right-hand sides. data CallCtxt = ... | RhsCtxt RecFlag | ... It affects only one thing: - We call an RHS context interesting only if it is non-recursive see Note [RHS of lets] in GHC.Core.Unfold * Remove eta-reduction in GHC.CoreToStg.Prep, a welcome simplification. See Note [No eta reduction needed in rhsToBody] in GHC.CoreToStg.Prep. 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. * Delete dead function GHC.Core.Opt.Simplify.Utils.contIsRhsOrArg Metrics: compile_time/bytes allocated Test Metric Baseline New value Change --------------------------------------------------------------------------------------- MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,743,297,692 2,619,762,992 -4.5% GOOD T18223(normal) ghc/alloc 1,103,161,360 972,415,992 -11.9% GOOD T3064(normal) ghc/alloc 201,222,500 184,085,360 -8.5% GOOD T8095(normal) ghc/alloc 3,216,292,528 3,254,416,960 +1.2% T9630(normal) ghc/alloc 1,514,131,032 1,557,719,312 +2.9% BAD parsing001(normal) ghc/alloc 530,409,812 525,077,696 -1.0% geo. mean -0.1% Nofib: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- banner +0.0% +0.4% -8.9% -8.7% 0.0% exact-reals +0.0% -7.4% -36.3% -37.4% 0.0% fannkuch-redux +0.0% -0.1% -1.0% -1.0% 0.0% fft2 -0.1% -0.2% -17.8% -19.2% 0.0% fluid +0.0% -1.3% -2.1% -2.1% 0.0% gg -0.0% +2.2% -0.2% -0.1% 0.0% spectral-norm +0.1% -0.2% 0.0% 0.0% 0.0% tak +0.0% -0.3% -9.8% -9.8% 0.0% x2n1 +0.0% -0.2% -3.2% -3.2% 0.0% -------------------------------------------------------------------------------- Min -3.5% -7.4% -58.7% -59.9% 0.0% Max +0.1% +2.2% +32.9% +32.9% 0.0% Geometric Mean -0.0% -0.1% -14.2% -14.8% -0.0% Metric Decrease: MultiLayerModulesTH_OneShot T18223 T3064 T15185 T14766 Metric Increase: T9630 - - - - - cac8c7bb by Matthew Pickering at 2022-05-30T13:44:50-04:00 hadrian: Fix building from source-dist without alex/happy This fixes two bugs which were adding dependencies on alex/happy when building from a source dist. * When we try to pass `--with-alex` and `--with-happy` to cabal when configuring but the builders are not set. This is fixed by making them optional. * When we configure, cabal requires alex/happy because of the build-tool-depends fields. These are now made optional with a cabal flag (build-tool-depends) for compiler/hpc-bin/genprimopcode. Fixes #21627 - - - - - a96dccfe by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test the bootstrap without ALEX/HAPPY on path - - - - - 0e5bb3a8 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test bootstrapping in release jobs - - - - - d8901469 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Allow testing bootstrapping on MRs using the "test-bootstrap" label - - - - - 18326ad2 by Matthew Pickering at 2022-05-30T13:45:25-04:00 rts: Remove explicit timescale for deprecating -h flag We originally planned to remove the flag in 9.4 but there's actually no great rush to do so and it's probably less confusing (forever) to keep the message around suggesting an explicit profiling option. Fixes #21545 - - - - - eaaa1389 by Matthew Pickering at 2022-05-30T13:46:01-04:00 Enable -dlint in hadrian lint transformer Now #21563 is fixed we can properly enable `-dlint` in CI rather than a subset of the flags. - - - - - 0544f114 by Ben Gamari at 2022-05-30T19:16:55-04:00 upload-ghc-libs: Allow candidate-only upload - - - - - 83467435 by Sylvain Henry at 2022-05-30T19:17:35-04:00 Avoid using DynFlags in GHC.Linker.Unit (#17957) - - - - - 5c4421b1 by Matthew Pickering at 2022-05-31T08:35:17-04:00 hadrian: Introduce new package database for executables needed to build stage0 These executables (such as hsc2hs) are built using the boot compiler and crucially, most libraries from the global package database. We also move other build-time executables to be built in this stage such as linters which also cleans up which libraries end up in the global package database. This allows us to remove hacks where linters-common is removed from the package database when a bindist is created. This fixes issues caused by infinite recursion due to bytestring adding a dependency on template-haskell. Fixes #21634 - - - - - 0dafd3e7 by Matthew Pickering at 2022-05-31T08:35:17-04:00 Build stage1 with -V as well This helps tracing errors which happen when building stage1 - - - - - 15d42a7a by Matthew Pickering at 2022-05-31T08:35:52-04:00 Revert "packaging: Build perf builds with -split-sections" This reverts commit 699f593532a3cd5ca1c2fab6e6e4ce9d53be2c1f. Split sections causes segfaults in profiling way with old toolchains (deb9) and on windows (#21670) Fixes #21670 - - - - - d4c71f09 by John Ericson at 2022-05-31T16:26:28+00:00 Purge `DynFlags` and `HscEnv` from some `GHC.Core` modules where it's not too hard Progress towards #17957 Because of `CoreM`, I did not move the `DynFlags` and `HscEnv` to other modules as thoroughly as I usually do. This does mean that risk of `DynFlags` "creeping back in" is higher than it usually is. After we do the same process to the other Core passes, and then figure out what we want to do about `CoreM`, we can finish the job started here. That is a good deal more work, however, so it certainly makes sense to land this now. - - - - - a720322f by romes at 2022-06-01T07:44:44-04:00 Restore Note [Quasi-quote overview] - - - - - 392ce3fc by romes at 2022-06-01T07:44:44-04:00 Move UntypedSpliceFlavour from L.H.S to GHC.Hs UntypedSpliceFlavour was only used in the client-specific `GHC.Hs.Expr` but was defined in the client-independent L.H.S.Expr. - - - - - 7975202b by romes at 2022-06-01T07:44:44-04:00 TTG: Rework and improve splices This commit redefines the structure of Splices in the AST. We get rid of `HsSplice` which used to represent typed and untyped splices, quasi quotes, and the result of splicing either an expression, a type or a pattern. Instead we have `HsUntypedSplice` which models an untyped splice or a quasi quoter, which works in practice just like untyped splices. The `HsExpr` constructor `HsSpliceE` which used to be constructed with an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The former is directly constructed with an `HsExpr` and the latter now takes an `HsUntypedSplice`. Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now take an `HsUntypedSplice` instead of a `HsSplice` (remember only /untyped splices/ can be spliced as types or patterns). The result of splicing an expression, type, or pattern is now comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`, `XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult (HsExpr GhcRn)` Overall the TTG extension points are now better used to make invalid states unrepresentable and model the progression between stages better. See Note [Lifecycle of an untyped splice, and PendingRnSplice] and Note [Lifecycle of an typed splice, and PendingTcSplice] for more details. Updates haddock submodule Fixes #21263 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - 320270c2 by Matthew Pickering at 2022-06-01T07:44:44-04:00 Add test for #21619 Fixes #21619 - - - - - ef7ddd73 by Pierre Le Marre at 2022-06-01T07:44:47-04:00 Pure Haskell implementation of GHC.Unicode Switch to a pure Haskell implementation of base:GHC.Unicode, based on the implementation of the package unicode-data (https://github.com/composewell/unicode-data/). Approved by CLC as per https://github.com/haskell/core-libraries-committee/issues/59#issuecomment-1132106691. - Remove current Unicode cbits. - Add generator for Unicode property files from Unicode Character Database. - Generate internal modules. - Update GHC.Unicode. - Add unicode003 test for general categories and case mappings. - Add Python scripts to check 'base' Unicode tests outputs and characters properties. Fixes #21375 ------------------------- Metric Decrease: T16875 Metric Increase: T4029 T18304 haddock.base ------------------------- - - - - - 514a6a28 by Eric Lindblad at 2022-06-01T07:44:51-04:00 typos - - - - - 9004be3c by Matthew Pickering at 2022-06-01T07:44:52-04:00 source-dist: Copy in files created by ./boot Since we started producing source dists with hadrian we stopped copying in the files created by ./boot which adds a dependency on python3 and autoreconf. This adds back in the files which were created by running configure. Fixes #21673 #21672 and #21626 - - - - - a12a3cab by Matthew Pickering at 2022-06-01T07:44:52-04:00 ci: Don't try to run ./boot when testing bootstrap of source dist - - - - - e07f9059 by Shlomo Shuck at 2022-06-01T07:44:55-04:00 Language.Haskell.Syntax: Fix docs for PromotedConsT etc. Fixes ghc/ghc#21675. - - - - - 87295e6d by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump bytestring, process, and text submodules Metric Decrease: T5631 Metric Increase: T18223 (cherry picked from commit 55fcee30cb3281a66f792e8673967d64619643af) - - - - - 24b5bb61 by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump Cabal submodule To current `master`. (cherry picked from commit fbb59c212415188486aafd970eafef170516356a) - - - - - 5433a35e by Matthew Pickering at 2022-06-01T22:26:30-04:00 hadrian/tool-args: Write output to intermediate file rather than via stdout This allows us to see the output of hadrian while it is doing the setup. - - - - - 468f919b by Matthew Pickering at 2022-06-01T22:27:10-04:00 Make -fcompact-unwind the default This is a follow-up to !7247 (closed) making the inclusion of compact unwinding sections the default. Also a slight refactoring/simplification of the flag handling to add -fno-compact-unwind. - - - - - 819fdc61 by Zubin Duggal at 2022-06-01T22:27:47-04:00 hadrian bootstrap: add plans for 9.0.2 and 9.2.3 - - - - - 9fa790b4 by Zubin Duggal at 2022-06-01T22:27:47-04:00 ci: Add matrix for bootstrap sources - - - - - ce9f986b by John Ericson at 2022-06-02T15:42:59+00:00 HsToCore.Coverage: Improve haddocks - - - - - f065804e by John Ericson at 2022-06-02T15:42:59+00:00 Hoist auto `mkModBreaks` and `writeMixEntries` conditions to caller No need to inline traversing a maybe for `mkModBreaks`. And better to make each function do one thing and let the caller deside when than scatter the decision making and make the caller seem more imperative. - - - - - d550d907 by John Ericson at 2022-06-02T15:42:59+00:00 Rename `HsToCore.{Coverage -> Ticks}` The old name made it confusing why disabling HPC didn't disable the entire pass. The name makes it clear --- there are other reasons to add ticks in addition. - - - - - 6520da95 by John Ericson at 2022-06-02T15:42:59+00:00 Split out `GHC.HsToCore.{Breakpoints,Coverage}` and use `SizedSeq` As proposed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_432877 and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_434676, `GHC.HsToCore.Ticks` is about ticks, breakpoints are separate and backend-specific (only for the bytecode interpreter), and mix entry writing is just for HPC. With this split we separate out those interpreter- and HPC-specific its, and keep the main `GHC.HsToCore.Ticks` agnostic. Also, instead of passing the reversed list and count around, we use `SizedSeq` which abstracts over the algorithm. This is much nicer to avoid noise and prevents bugs. (The bugs are not just hypothetical! I missed up the reverses on an earlier draft of this commit.) - - - - - 1838c3d8 by Sylvain Henry at 2022-06-02T15:43:14+00:00 GHC.HsToCore.Breakpoints: Slightly improve perf We have the length already, so we might as well use that rather than O(n) recomputing it. - - - - - 5a3fdcfd by John Ericson at 2022-06-02T15:43:59+00:00 HsToCore.Coverage: Purge DynFlags Finishes what !7467 (closed) started. Progress towards #17957 - - - - - 9ce9ea50 by HaskellMouse at 2022-06-06T09:50:00-04:00 Deprecate TypeInType extension This commit fixes #20312 It deprecates "TypeInType" extension according to the following proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0083-no-type-in-type.rst It has been already implemented. The migration strategy: 1. Disable TypeInType 2. Enable both DataKinds and PolyKinds extensions Metric Decrease: T16875 - - - - - f2e037fd by Aaron Allen at 2022-06-06T09:50:39-04:00 Diagnostics conversions, part 6 (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and `GHC.Tc.Gen.Sig`. - - - - - 04209f2a by Simon Peyton Jones at 2022-06-06T09:51:15-04:00 Ensure floated dictionaries are in scope (again) In the Specialiser, we missed one more call to bringFloatedDictsIntoScope (see #21391). This omission led to #21689. The problem is that the call to `rewriteClassOps` needs to have in scope any dictionaries floated out of the arguments we have just specialised. Easy fix. - - - - - a7fece19 by John Ericson at 2022-06-07T05:04:22+00:00 Don't print the number of deps in count-deps tests It is redundant information and a source of needless version control conflicts when multiple MRs are changing the deps list. Just printing the list and not also its length is fine. - - - - - a1651a3a by John Ericson at 2022-06-07T05:06:38+00:00 Core.Lint: Reduce `DynFlags` and `HscEnv` Co-Authored-By: Andre Marianiello <andremarianiello at users.noreply.github.com> - - - - - 56ebf9a5 by Andreas Klebinger at 2022-06-09T09:11:43-04:00 Fix a CSE shadowing bug. We used to process the rhs of non-recursive bindings and their body using the same env. If we had something like let x = ... x ... this caused trouble because the two xs refer to different binders but we would substitute both for a new binder x2 causing out of scope errors. We now simply use two different envs for the rhs and body in cse_bind. It's all explained in the Note [Separate envs for let rhs and body] Fixes #21685 - - - - - 28880828 by sheaf at 2022-06-09T09:12:19-04:00 Typecheck remaining ValArgs in rebuildHsApps This patch refactors hasFixedRuntimeRep_remainingValArgs, renaming it to tcRemainingValArgs. The logic is moved to rebuildHsApps, which ensures consistent behaviour across tcApp and quickLookArg1/tcEValArg. This patch also refactors the treatment of stupid theta for data constructors, changing the place we drop stupid theta arguments from dsConLike to mkDataConRep (now the datacon wrapper drops these arguments). We decided not to implement PHASE 2 of the FixedRuntimeRep plan for these remaining ValArgs. Future directions are outlined on the wiki: https://gitlab.haskell.org/ghc/ghc/-/wikis/Remaining-ValArgs Fixes #21544 and #21650 - - - - - 1fbba97b by Matthew Pickering at 2022-06-09T09:12:54-04:00 Add test for T21682 Fixes #21682 - - - - - 8727be73 by Andreas Klebinger at 2022-06-09T09:13:29-04:00 Document dataToTag# primop - - - - - 7eab75bb by uhbif19 at 2022-06-09T20:22:47+03:00 Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115 - - - - - 46d2fc65 by uhbif19 at 2022-06-09T20:24:40+03:00 Fix TcRnPragmaWarning meaning - - - - - 69e72ecd by Matthew Pickering at 2022-06-09T19:07:01-04:00 getProcessCPUTime: Fix the getrusage fallback to account for system CPU time clock_gettime reports the combined total or user AND system time so in order to replicate it with getrusage we need to add both system and user time together. See https://stackoverflow.com/questions/7622371/getrusage-vs-clock-gettime Some sample measurements when building Cabal with this patch t1: rusage t2: clock_gettime t1: 62347518000; t2: 62347520873 t1: 62395687000; t2: 62395690171 t1: 62432435000; t2: 62432437313 t1: 62478489000; t2: 62478492465 t1: 62514990000; t2: 62514992534 t1: 62515479000; t2: 62515480327 t1: 62515485000; t2: 62515486344 Fixes #21656 - - - - - 722814ba by Yiyun Liu at 2022-06-10T21:23:03-04:00 Use <br> instead of newline character - - - - - dc202080 by Matthew Craven at 2022-06-13T14:07:12-04:00 Use (fixed_lev = True) in mkDataTyConRhs - - - - - ad70c621 by Matthew Pickering at 2022-06-14T08:40:53-04:00 hadrian: Fix testing stage1 compiler There were various issues with testing the stage1 compiler.. 1. The wrapper was not being built 2. The wrapper was picking up the stage0 package database and trying to load prelude from that. 3. The wrappers never worked on windows so just don't support that for now. Fixes #21072 - - - - - ac83899d by Ben Gamari at 2022-06-14T08:41:30-04:00 validate: Ensure that $make variable is set Currently the `$make` variable is used without being set in `validate`'s Hadrian path, which uses make to install the binary distribution. Fix this. Fixes #21687. - - - - - 59bc6008 by John Ericson at 2022-06-15T18:05:35+00:00 CoreToStg.Prep: Get rid of `DynFlags` and `HscEnv` The call sites in `Driver.Main` are duplicative, but this is good, because the next step is to remove `InteractiveContext` from `Core.Lint` into `Core.Lint.Interactive`. Also further clean up `Core.Lint` to use a better configuration record than the one we initially added. - - - - - aa9d9381 by Ben Gamari at 2022-06-15T20:33:04-04:00 hadrian: Run xattr -rc . on bindist tarball Fixes #21506. - - - - - cdc75a1f by Ben Gamari at 2022-06-15T20:33:04-04:00 configure: Hide spurious warning from ld Previously the check_for_gold_t22266 configure check could result in spurious warnings coming from the linker being blurted to stderr. Suppress these by piping stderr to /dev/null. - - - - - e128b7b8 by Ben Gamari at 2022-06-15T20:33:40-04:00 cmm: Add surface syntax for MO_MulMayOflo - - - - - bde65ea9 by Ben Gamari at 2022-06-15T20:34:16-04:00 configure: Don't attempt to override linker on Darwin Configure's --enable-ld-override functionality is intended to ensure that we don't rely on ld.bfd, which tends to be slow and buggy, on Linux and Windows. However, on Darwin the lack of sensible package management makes it extremely easy for users to have awkward mixtures of toolchain components from, e.g., XCode, the Apple Command-Line Tools package, and homebrew. This leads to extremely confusing problems like #21712. Here we avoid this by simply giving up on linker selection on Darwin altogether. This isn't so bad since the Apple ld64 linker has decent performance and AFAICT fairly reliable. Closes #21712. - - - - - 25b510c3 by Torsten Schmits at 2022-06-16T12:37:45-04:00 replace quadratic nub to fight byte code gen perf explosion Despite this code having been present in the core-to-bytecode implementation, I have observed it in the wild starting with 9.2, causing enormous slowdown in certain situations. My test case produces the following profiles: Before: ``` total time = 559.77 secs (559766 ticks @ 1000 us, 1 processor) total alloc = 513,985,665,640 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes elem_by Data.OldList libraries/base/Data/OldList.hs:429:1-7 67.6 92.9 378282 477447404296 eqInt GHC.Classes libraries/ghc-prim/GHC/Classes.hs:275:8-14 12.4 0.0 69333 32 $c>>= GHC.Data.IOEnv <no location info> 6.9 0.6 38475 3020371232 ``` After: ``` total time = 89.83 secs (89833 ticks @ 1000 us, 1 processor) total alloc = 39,365,306,360 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes $c>>= GHC.Data.IOEnv <no location info> 43.6 7.7 39156 3020403424 doCase GHC.StgToByteCode compiler/GHC/StgToByteCode.hs:(805,1)-(1054,53) 2.5 7.4 2246 2920777088 ``` - - - - - aa7e1f20 by Matthew Pickering at 2022-06-16T12:38:21-04:00 hadrian: Don't install `include/` directory in bindist. The install_includes for the RTS package used to be put in the top-level ./include folder but this would lead to confusing things happening if you installed multiple GHC versions side-by-side. We don't need this folder anymore because install-includes is honoured properly by cabal and the relevant header files already copied in by the cabal installation process. If you want to depend on the header files for the RTS in a Haskell project then you just have to depend on the `rts` package and the correct include directories will be provided for you. If you want to depend on the header files in a standard C project then you should query ghc-pkg to get the right paths. ``` ghc-pkg field rts include-dirs --simple-output ``` Fixes #21609 - - - - - 03172116 by Bryan Richter at 2022-06-16T12:38:57-04:00 Enable eventlogs on nightly perf job - - - - - ecbf8685 by Hécate Moonlight at 2022-06-16T16:30:00-04:00 Repair dead link in TH haddocks Closes #21724 - - - - - 99ff3818 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian: allow configuring Hsc2Hs This patch adds the ability to pass options to Hsc2Hs as Hadrian key/value settings, in the same way as cabal configure options, using the syntax: *.*.hsc2hs.run.opts += ... - - - - - 9c575f24 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian bootstrap: look up hsc2hs Hadrian bootstrapping looks up where to find ghc_pkg, but the same logic was not in place for hsc2hs which meant we could fail to find the appropriate hsc2hs executabe when bootstrapping Hadrian. This patch adds that missing logic. - - - - - 229d741f by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Add (broken) test for #21622 - - - - - cadd7753 by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Don't Box NULL pointers Previously we could construct a `Box` of a NULL pointer from the `link` field of `StgWeak`. Now we take care to avoid ever introducing such pointers in `collect_pointers` and ensure that the `link` field is represented as a `Maybe` in the `Closure` type. Fixes #21622 - - - - - 31c214cc by Tamar Christina at 2022-06-18T10:43:34-04:00 winio: Add support to console handles to handleToHANDLE - - - - - 711cb417 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Add SMUL[LH] instructions These will be needed to fix #21624. - - - - - d05d90d2 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Fix syntax of OpRegShift operands Previously this produced invalid assembly containing a redundant comma. - - - - - a1e1d8ee by Ben Gamari at 2022-06-18T10:44:11-04:00 ncg/aarch64: Fix implementation of IntMulMayOflo The code generated for IntMulMayOflo was previously wrong as it depended upon the overflow flag, which the AArch64 MUL instruction does not set. Fix this. Fixes #21624. - - - - - 26745006 by Ben Gamari at 2022-06-18T10:44:11-04:00 testsuite: Add test for #21624 Ensuring that mulIntMayOflo# behaves as expected. - - - - - 94f2e92a by Sebastian Graf at 2022-06-20T09:40:58+02:00 CprAnal: Set signatures of DFuns to top The recursive DFun in the reproducer for #20836 also triggered a bug in CprAnal that is observable in a debug build. The CPR signature of a recursive DFunId was never updated and hence the optimistic arity 0 bottom signature triggered a mismatch with the arity 1 of the binding in WorkWrap. We never miscompiled any code because WW doesn't exploit bottom CPR signatures. - - - - - b570da84 by Sebastian Graf at 2022-06-20T09:43:29+02:00 CorePrep: Don't speculatively evaluate recursive calls (#20836) In #20836 we have optimised a terminating program into an endless loop, because we speculated the self-recursive call of a recursive DFun. Now we track the set of enclosing recursive binders in CorePrep to prevent speculation of such self-recursive calls. See the updates to Note [Speculative evaluation] for details. Fixes #20836. - - - - - 49fb2f9b by Sebastian Graf at 2022-06-20T09:43:32+02:00 Simplify: Take care with eta reduction in recursive RHSs (#21652) Similar to the fix to #20836 in CorePrep, we now track the set of enclosing recursive binders in the SimplEnv and SimpleOptEnv. See Note [Eta reduction in recursive RHSs] for details. I also updated Note [Arity robustness] with the insights Simon and I had in a call discussing the issue. Fixes #21652. Unfortunately, we get a 5% ghc/alloc regression in T16577. That is due to additional eta reduction in GHC.Read.choose1 and the resulting ANF-isation of a large list literal at the top-level that didn't happen before (presumably because it was too interesting to float to the top-level). There's not much we can do about that. Metric Increase: T16577 - - - - - 2563b95c by Sebastian Graf at 2022-06-20T09:45:09+02:00 Ignore .hie-bios - - - - - e4e44d8d by Simon Peyton Jones at 2022-06-20T12:31:45-04:00 Instantiate top level foralls in partial type signatures The main fix for #21667 is the new call to tcInstTypeBnders in tcHsPartialSigType. It was really a simple omission before. I also moved the decision about whether we need to apply the Monomorphism Restriction, from `decideGeneralisationPlan` to `tcPolyInfer`. That removes a flag from the InferGen constructor, which is good. But more importantly, it allows the new function, checkMonomorphismRestriction called from `tcPolyInfer`, to "see" the `Types` involved rather than the `HsTypes`. And that in turn matters because we invoke the MR for partial signatures if none of the partial signatures in the group have any overloading context; and we can't answer that question for HsTypes. See Note [Partial type signatures and the monomorphism restriction] in GHC.Tc.Gen.Bind. This latter is really a pre-existing bug. - - - - - 262a9f93 by Winston Hartnett at 2022-06-20T12:32:23-04:00 Make Outputable instance for InlineSig print the InlineSpec Fix ghc/ghc#21739 Squash fix ghc/ghc#21739 - - - - - b5590fff by Matthew Pickering at 2022-06-20T12:32:59-04:00 Add NO_BOOT to hackage_doc_tarball job We were attempting to boot a src-tarball which doesn't work as ./boot is not included in the source tarball. This slipped through as the job is only run on nightly. - - - - - d24afd9d by Vladislav Zavialov at 2022-06-20T17:34:44-04:00 HsToken for @-patterns and TypeApplications (#19623) One more step towards the new design of EPA. - - - - - 159b7628 by Tamar Christina at 2022-06-20T17:35:23-04:00 linker: only keep rtl exception tables if they have been relocated - - - - - da5ff105 by Andreas Klebinger at 2022-06-21T17:04:12+02:00 Ticky:Make json info a separate field. - - - - - 1a4ce4b2 by Matthew Pickering at 2022-06-22T09:49:22+01:00 Revert "Ticky:Make json info a separate field." This reverts commit da5ff10503e683e2148c62e36f8fe2f819328862. This was pushed directly without review. - - - - - f89bf85f by Vanessa McHale at 2022-06-22T08:21:32-04:00 Flags to disable local let-floating; -flocal-float-out, -flocal-float-out-top-level CLI flags These flags affect the behaviour of local let floating. If `-flocal-float-out` is disabled (the default) then we disable all local floating. ``` …(let x = let y = e in (a,b) in body)... ===> …(let y = e; x = (a,b) in body)... ``` Further to this, top-level local floating can be disabled on it's own by passing -fno-local-float-out-top-level. ``` x = let y = e in (a,b) ===> y = e; x = (a,b) ``` Note that this is only about local floating, ie, floating two adjacent lets past each other and doesn't say anything about the global floating pass which is controlled by `-fno-float`. Fixes #13663 - - - - - 4ccefc6e by Matthew Craven at 2022-06-22T08:22:12-04:00 Check for Int overflows in Data.Array.Byte - - - - - 2004e3c8 by Matthew Craven at 2022-06-22T08:22:12-04:00 Add a basic test for ByteArray's Monoid instance - - - - - fb36770c by Matthew Craven at 2022-06-22T08:22:12-04:00 Rename `copyByteArray` to `unsafeCopyByteArray` - - - - - ecc9aedc by Ben Gamari at 2022-06-22T08:22:48-04:00 testsuite: Add test for #21719 Happily, this has been fixed since 9.2. - - - - - 19606c42 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Use lookupNameCache instead of lookupOrigIO - - - - - 4c9dfd69 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Break out thNameToGhcNameIO (ref. #21730) - - - - - eb4fb849 by Michael Peyton Jones at 2022-06-22T08:24:07-04:00 Add laws for 'toInteger' and 'toRational' CLC discussion here: https://github.com/haskell/core-libraries-committee/issues/58 - - - - - c1a950c1 by Alexander Esgen at 2022-06-22T12:36:13+00:00 Correct documentation of defaults of the `-V` RTS option - - - - - b7b7d90d by Matthew Pickering at 2022-06-22T21:58:12-04:00 Transcribe discussion from #21483 into a Note In #21483 I had a discussion with Simon Marlow about the memory retention behaviour of -Fd. I have just transcribed that conversation here as it elucidates the potentially subtle assumptions which led to the design of the memory retention behaviours of -Fd. Fixes #21483 - - - - - 980d1954 by Ben Gamari at 2022-06-22T21:58:48-04:00 eventlog: Don't leave dangling pointers hanging around Previously we failed to reset pointers to various eventlog buffers to NULL after freeing them. In principle we shouldn't look at them after they are freed but nevertheless it is good practice to set them to a well-defined value. - - - - - 575ec846 by Eric Lindblad at 2022-06-22T21:59:28-04:00 runhaskell - - - - - e6a69337 by Artem Pelenitsyn at 2022-06-22T22:00:07-04:00 re-export GHC.Natural.minusNaturalMaybe from Numeric.Natural CLC proposal: https://github.com/haskell/core-libraries-committee/issues/45 - - - - - 5d45aa97 by Gergo ERDI at 2022-06-22T22:00:46-04:00 When specialising, look through floatable ticks. Fixes #21697. - - - - - 531205ac by Andreas Klebinger at 2022-06-22T22:01:22-04:00 TagCheck.hs: Properly check if arguments are boxed types. For one by mistake I had been checking against the kind of runtime rep instead of the boxity. This uncovered another bug, namely that we tried to generate the checking code before we had associated the function arguments with a register, so this could never have worked to begin with. This fixes #21729 and both of the above issues. - - - - - c7f9f6b5 by Gleb Popov at 2022-06-22T22:02:00-04:00 Use correct arch for the FreeBSD triple in gen-data-layout.sh Downstream bug for reference: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=261798 Relevant upstream issue: #15718 - - - - - 75f0091b by Andreas Klebinger at 2022-06-22T22:02:35-04:00 Bump nofib submodule. Allows the shake runner to build with 9.2.3 among other things. Fixes #21772 - - - - - 0aa0ce69 by Ben Gamari at 2022-06-27T08:01:03-04:00 Bump ghc-prim and base versions To 0.9.0 and 4.17.0 respectively. Bumps array, deepseq, directory, filepath, haskeline, hpc, parsec, stm, terminfo, text, unix, haddock, and hsc2hs submodules. (cherry picked from commit ba47b95122b7b336ce1cc00896a47b584ad24095) - - - - - 4713abc2 by Ben Gamari at 2022-06-27T08:01:03-04:00 testsuite: Use normalise_version more consistently Previously several tests' output were unnecessarily dependent on version numbers, particularly of `base`. Fix this. - - - - - d7b0642b by Matthew Pickering at 2022-06-27T08:01:03-04:00 linters: Fix lint-submodule-refs when crashing trying to find plausible branches - - - - - 38378be3 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 hadrian: Improve haddocks for ghcDebugAssertions - - - - - ac7a7fc8 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 Don't mark lambda binders as OtherCon We used to put OtherCon unfoldings on lambda binders of workers and sometimes also join points/specializations with with the assumption that since the wrapper would force these arguments once we execute the RHS they would indeed be in WHNF. This was wrong for reasons detailed in #21472. So now we purge evaluated unfoldings from *all* lambda binders. This fixes #21472, but at the cost of sometimes not using as efficient a calling convention. It can also change inlining behaviour as some occurances will no longer look like value arguments when they did before. As consequence we also change how we compute CBV information for arguments slightly. We now *always* determine the CBV convention for arguments during tidy. Earlier in the pipeline we merely mark functions as candidates for having their arguments treated as CBV. As before the process is described in the relevant notes: Note [CBV Function Ids] Note [Attaching CBV Marks to ids] Note [Never put `OtherCon` unfoldigns on lambda binders] ------------------------- Metric Decrease: T12425 T13035 T18223 T18223 T18923 MultiLayerModulesTH_OneShot Metric Increase: WWRec ------------------------- - - - - - 06cf6f4a by Tony Zorman at 2022-06-27T08:02:18-04:00 Add suggestions for unrecognised pragmas (#21589) In case of a misspelled pragma, offer possible corrections as to what the user could have meant. Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/21589 - - - - - 3fbab757 by Greg Steuck at 2022-06-27T08:02:56-04:00 Remove the traces of i386-*-openbsd, long live amd64 OpenBSD will not ship any ghc packages on i386 starting with 7.2 release. This means there will not be a bootstrap compiler easily available. The last available binaries are ghc-8.10.6 which is already not supported as bootstrap for HEAD. See here for more information: https://marc.info/?l=openbsd-ports&m=165060700222580&w=2 - - - - - 58530271 by Bodigrim at 2022-06-27T08:03:34-04:00 Add Foldable1 and Bifoldable1 type classes Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/9 Instances roughly follow https://hackage.haskell.org/package/semigroupoids-5.3.7/docs/Data-Semigroup-Foldable-Class.html#t:Foldable1 but the API of `Foldable1` was expanded in comparison to `semigroupoids`. Compatibility shim is available from https://github.com/phadej/foldable1 (to be released). Closes #13573. - - - - - a51f4ecc by Naomi Liu at 2022-06-27T08:04:13-04:00 add levity polymorphism to addrToAny# - - - - - f4edcdc4 by Naomi Liu at 2022-06-27T08:04:13-04:00 add tests for addrToAny# levity - - - - - 07016fc9 by Matthew Pickering at 2022-06-27T08:04:49-04:00 hadrian: Update main README page This README had some quite out-of-date content about the build system so I did a complete pass deleting old material. I also made the section about flavours more prominent and mentioned flavour transformers. - - - - - 79ae2d89 by Ben Gamari at 2022-06-27T08:05:24-04:00 testsuite: Hide output from test compilations with verbosity==2 Previously the output from test compilations used to determine whether, e.g., profiling libraries are available was shown with verbosity levels >= 2. However, the default level is 2, meaning that most users were often spammed with confusing errors. Fix this by bumping the verbosity threshold for this output to >=3. Fixes #21760. - - - - - 995ea44d by Ben Gamari at 2022-06-27T08:06:00-04:00 configure: Only probe for LD in FIND_LD Since 6be2c5a7e9187fc14d51e1ec32ca235143bb0d8b we would probe for LD rather early in `configure`. However, it turns out that this breaks `configure`'s `ld`-override logic, which assumes that `LD` was set by the user and aborts. Fixes #21778. - - - - - b43d140b by Sergei Trofimovich at 2022-06-27T08:06:39-04:00 `.hs-boot` make rules: add missing order-only dependency on target directory Noticed missing target directory dependency as a build failure in `make --shuffle` mode (added in https://savannah.gnu.org/bugs/index.php?62100): "cp" libraries/base/./GHC/Stack/CCS.hs-boot libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot cp: cannot create regular file 'libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot': No such file or directory libraries/haskeline/ghc.mk:4: libraries/haskeline/dist-install/build/.depend-v-p-dyn.haskell: No such file or directory make[1]: *** [libraries/base/ghc.mk:4: libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot] Error 1 shuffle=1656129254 make: *** [Makefile:128: all] Error 2 shuffle=1656129254 Note that `cp` complains about inability to create target file. The change adds order-only dependency on a target directory (similar to the rest of rules in that file). The bug is lurking there since 2009 commit 34cc75e1a (`GHC new build system megapatch`.) where upfront directory creation was never added to `.hs-boot` files. - - - - - 57a5f88c by Ben Gamari at 2022-06-28T03:24:24-04:00 Mark AArch64/Darwin as requiring sign-extension Apple's AArch64 ABI requires that the caller sign-extend small integer arguments. Set platformCConvNeedsExtension to reflect this fact. Fixes #21773. - - - - - df762ae9 by Ben Gamari at 2022-06-28T03:24:24-04:00 -ddump-llvm shouldn't imply -fllvm Previously -ddump-llvm would change the backend used, which contrasts with all other dump flags. This is quite surprising and cost me quite a bit of time. Dump flags should not change compiler behavior. Fixes #21776. - - - - - 70f0c1f8 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Re-format argument handling logic Previously there were very long, hard to parse lines. Fix this. - - - - - 696d64c3 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Sign-extend narrow C arguments The AArch64/Darwin ABI requires that function arguments narrower than 32-bits must be sign-extended by the caller. We neglected to do this, resulting in #20735. Fixes #20735. - - - - - c006ac0d by Ben Gamari at 2022-06-28T03:24:24-04:00 testsuite: Add test for #20735 - - - - - 16b9100c by Ben Gamari at 2022-06-28T03:24:59-04:00 integer-gmp: Fix cabal file Evidently fields may not come after sections in a cabal file. - - - - - 03cc5d02 by Sergei Trofimovich at 2022-06-28T15:20:45-04:00 ghc.mk: fix 'make install' (`mk/system-cxx-std-lib-1.0.conf.install` does not exist) before the change `make install` was failing as: ``` "mv" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc-stage2" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc" make[1]: *** No rule to make target 'mk/system-cxx-std-lib-1.0.conf.install', needed by 'install_packages'. Stop. ``` I think it's a recent regression caused by 0ef249aa where `system-cxx-std-lib-1.0.conf` is created (somewhat manually), but not the .install varianlt of it. The fix is to consistently use `mk/system-cxx-std-lib-1.0.conf` everywhere. Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/21784 - - - - - eecab8f9 by Simon Peyton Jones at 2022-06-28T15:21:21-04:00 Comments only, about join points This MR just adds some documentation about why casts destroy join points, following #21716. - - - - - 251471e7 by Matthew Pickering at 2022-06-28T19:02:41-04:00 Cleanup BuiltInSyntax vs UserSyntax There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302 - - - - - 0e22f16c by Ben Gamari at 2022-06-28T19:03:16-04:00 template-haskell: Bump version to 2.19.0.0 Bumps text and exceptions submodules due to bounds. - - - - - bbe6f10e by Emily Bourke at 2022-06-29T08:23:13+00:00 Tiny tweak to `IOPort#` documentation The exclamation mark and bracket don’t seem to make sense here. I’ve looked through the history, and I don’t think they’re deliberate – possibly a copy-and-paste error. - - - - - 70e47489 by Dominik Peteler at 2022-06-29T19:26:31-04:00 Remove `CoreOccurAnal` constructor of the `CoreToDo` type It was dead code since the last occurence in an expression context got removed in 71916e1c018dded2e68d6769a2dbb8777da12664. - - - - - d0722170 by nineonine at 2022-07-01T08:15:56-04:00 Fix panic with UnliftedFFITypes+CApiFFI (#14624) When declaring foreign import using CAPI calling convention, using unlifted unboxed types would result in compiler panic. There was an attempt to fix the situation in #9274, however it only addressed some of the ByteArray cases. This patch fixes other missed cases for all prims that may be used as basic foreign types. - - - - - eb043148 by Douglas Wilson at 2022-07-01T08:16:32-04:00 rts: gc stats: account properly for copied bytes in sequential collections We were not updating the [copied,any_work,scav_find_work, max_n_todo_overflow] counters during sequential collections. As well, we were double counting for parallel collections. To fix this we add an `else` clause to the `if (is_par_gc())`. The par_* counters do not need to be updated in the sequential case because they must be 0. - - - - - f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow Enabling `-fhpc` or `-finfo-table-map` would case a tick to end up between the appliation of `neg` to its argument. This defeated the special logic which looks for `NegApp ... (HsOverLit` to warn about possible overflow if a user writes a negative literal (without out NegativeLiterals) in their code. Fixes #21701 - - - - - f25c8d03 by Matthew Pickering at 2022-07-01T19:22:31-04:00 ci: Fix definition of slow-validate flavour (so that -dlint) is passed In this embarassing sequence of events we were running slow-validate without -dlint. - - - - - bf7991b0 by Mike Pilgrem at 2022-07-02T10:12:04-04:00 Identify the extistence of the `runhaskell` command and that it is equivalent to the `runghc` command. Add an entry to the index for `runhaskell`. See https://gitlab.haskell.org/ghc/ghc/-/issues/21411 - - - - - 9e79f6d0 by Simon Jakobi at 2022-07-02T10:12:39-04:00 Data.Foldable1: Remove references to Foldable-specific note ...as discussed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8495#note_439455. - - - - - 3a8970ac by romes at 2022-07-03T14:11:31-04:00 TTG: Move HsModule to L.H.S Move the definition of HsModule defined in GHC.Hs to Language.Haskell.Syntax with an added TTG parameter and corresponding extension fields. This is progress towards having the haskell-syntax package, as described in #21592 - - - - - f9f80995 by romes at 2022-07-03T14:11:31-04:00 TTG: Move ImpExp client-independent bits to L.H.S.ImpExp Move the GHC-independent definitions from GHC.Hs.ImpExp to Language.Haskell.Syntax.ImpExp with the required TTG extension fields such as to keep the AST independent from GHC. This is progress towards having the haskell-syntax package, as described in #21592 Bumps haddock submodule - - - - - c43dbac0 by romes at 2022-07-03T14:11:31-04:00 Refactor ModuleName to L.H.S.Module.Name ModuleName used to live in GHC.Unit.Module.Name. In this commit, the definition of ModuleName and its associated functions are moved to Language.Haskell.Syntax.Module.Name according to the current plan towards making the AST GHC-independent. The instances for ModuleName for Outputable, Uniquable and Binary were moved to the module in which the class is defined because these instances depend on GHC. The instance of Eq for ModuleName is slightly changed to no longer depend on unique explicitly and instead uses FastString's instance of Eq. - - - - - 2635c6f2 by konsumlamm at 2022-07-03T14:12:11-04:00 Expand `Ord` instance for `Down` Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/23#issuecomment-1172932610 - - - - - 36fba0df by Anselm Schüler at 2022-07-04T05:06:42+00:00 Add applyWhen to Data.Function per CLC prop Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/71#issuecomment-1165830233 - - - - - 3b13aab1 by Matthew Pickering at 2022-07-04T15:15:00-04:00 hadrian: Don't read package environments in ghc-stage1 wrapper The stage1 compiler may be on the brink of existence and not have even a working base library. You may have installed packages globally with a similar stage2 compiler which will then lead to arguments such as --show-iface not even working because you are passing too many package flags. The solution is simple, don't read these implicit files. Fixes #21803 - - - - - aba482ea by Andreas Klebinger at 2022-07-04T17:55:55-04:00 Ticky:Make json info a separate field. Fixes #21233 - - - - - 74f3867d by Matthew Pickering at 2022-07-04T17:56:30-04:00 Add docs:<pkg> command to hadrian to build docs for just one package - - - - - 418afaf1 by Matthew Pickering at 2022-07-04T17:56:30-04:00 upload-docs: propagate publish correctly in upload_sdist - - - - - ed793d7a by Matthew Pickering at 2022-07-04T17:56:30-04:00 docs-upload: Fix upload script when no packages are listed - - - - - d002c6e0 by Matthew Pickering at 2022-07-04T17:56:30-04:00 hadrian: Add --haddock-base-url option for specifying base-url when generating docs The motiviation for this flag is to be able to produce documentation which is suitable for uploading for hackage, ie, the cross-package links work correctly. There are basically three values you want to set this to: * off - default, base_url = ../%pkg% which works for local browsing * on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload * on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation. The `%pkg%` string is a template variable which is replaced with the package identifier for the relevant package. This is one step towards fixing #21749 - - - - - 41eb749a by Matthew Pickering at 2022-07-04T17:56:31-04:00 Add nightly job for generating docs suitable for hackage upload - - - - - 620ee7ed by Matthew Pickering at 2022-07-04T17:57:05-04:00 ghci: Support :set prompt in multi repl This adds supports for various :set commands apart from `:set <FLAG>` in multi repl, this includes `:set prompt` and so-on. Fixes #21796 - - - - - b151b65e by Matthew Pickering at 2022-07-05T16:32:31-04:00 Vendor filepath inside template-haskell Adding filepath as a dependency of template-haskell means that it can't be reinstalled if any build-plan depends on template-haskell. This is a temporary solution for the 9.4 release. A longer term solution is to split-up the template-haskell package into the wired-in part and a non-wired-in part which can be reinstalled. This was deemed quite risky on the 9.4 release timescale. Fixes #21738 - - - - - c9347ecf by John Ericson at 2022-07-05T16:33:07-04:00 Factor fields of `CoreDoSimplify` into separate data type This avoids some partiality. The work @mmhat is doing cleaning up and modularizing `Core.Opt` will build on this nicely. - - - - - d0e74992 by Eric Lindblad at 2022-07-06T01:35:48-04:00 https urls - - - - - 803e965c by Eric Lindblad at 2022-07-06T01:35:48-04:00 options and typos - - - - - 5519baa5 by Eric Lindblad at 2022-07-06T01:35:48-04:00 grammar - - - - - 4ddc1d3e by Eric Lindblad at 2022-07-06T01:35:48-04:00 sources - - - - - c95c2026 by Matthew Pickering at 2022-07-06T01:35:48-04:00 Fix lint warnings in bootstrap.py - - - - - 86ced2ad by romes at 2022-07-06T01:36:23-04:00 Restore Eq instance of ImportDeclQualifiedStyle Fixes #21819 - - - - - 3547e264 by romes at 2022-07-06T13:50:27-04:00 Prune L.H.S modules of GHC dependencies Move around datatypes, functions and instances that are GHC-specific out of the `Language.Haskell.Syntax.*` modules to reduce the GHC dependencies in them -- progressing towards #21592 Creates a module `Language.Haskell.Syntax.Basic` to hold basic definitions required by the other L.H.S modules (and don't belong in any of them) - - - - - e4eea07b by romes at 2022-07-06T13:50:27-04:00 TTG: Move CoreTickish out of LHS.Binds Remove the `[CoreTickish]` fields from datatype `HsBindLR idL idR` and move them to the extension point instance, according to the plan outlined in #21592 to separate the base AST from the GHC specific bits. - - - - - acc1816b by romes at 2022-07-06T13:50:27-04:00 TTG for ForeignImport/Export Add a TTG parameter to both `ForeignImport` and `ForeignExport` and, according to #21592, move the GHC-specific bits in them and in the other AST data types related to foreign imports and exports to the TTG extension point. - - - - - 371c5ecf by romes at 2022-07-06T13:50:27-04:00 TTG for HsTyLit Add TTG parameter to `HsTyLit` to move the GHC-specific `SourceText` fields to the extension point and out of the base AST. Progress towards #21592 - - - - - fd379d1b by romes at 2022-07-06T13:50:27-04:00 Remove many GHC dependencies from L.H.S Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC imports according to the plan in the linked issue. Moves more GHC-specific declarations to `GHC.*` and brings more required GHC-independent declarations to `Language.Haskell.Syntax.*` (extending e.g. `Language.Haskell.Syntax.Basic`). Progress towards #21592 Bump haddock submodule for !8308 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - c5415bc5 by Alan Zimmerman at 2022-07-06T13:50:27-04:00 Fix exact printing of the HsRule name Prior to this branch, the HsRule name was XRec pass (SourceText,RuleName) and there is an ExactPrint instance for (SourceText, RuleName). The SourceText has moved to a different location, so synthesise the original to trigger the correct instance when printing. We need both the SourceText and RuleName when exact printing, as it is possible to have a NoSourceText variant, in which case we fall back to the FastString. - - - - - 665fa5a7 by Matthew Pickering at 2022-07-06T13:51:03-04:00 driver: Fix issue with module loops and multiple home units We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 - - - - - bbcaba6a by Andreas Klebinger at 2022-07-06T13:51:39-04:00 Remove a bogus #define from ClosureMacros.h - - - - - fa59223b by Tamar Christina at 2022-07-07T23:23:57-04:00 winio: make consoleReadNonBlocking not wait for any events at all. - - - - - 42c917df by Adam Sandberg Ericsson at 2022-07-07T23:24:34-04:00 rts: allow NULL to be used as an invalid StgStablePtr - - - - - 3739e565 by Andreas Schwab at 2022-07-07T23:25:10-04:00 RTS: Add stack marker to StgCRunAsm.S Every object file must be properly marked for non-executable stack, even if it contains no code. - - - - - a889bc05 by Ben Gamari at 2022-07-07T23:25:45-04:00 Bump unix submodule Adds `config.sub` to unix's `.gitignore`, fixing #19574. - - - - - 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode The most egrarious thing this fixes is the report about the total number of loaded modules after starting a session. Ticket #20889 - - - - - fc183c90 by Matthew Pickering at 2022-07-09T11:11:58-04:00 Enable :edit command in ghci multi-mode. This works after the last change to isLoaded. Ticket #20888 - - - - - 46050534 by Simon Peyton Jones at 2022-07-09T11:12:34-04:00 Fix a scoping bug in the Specialiser In the call to `specLookupRule` in `already_covered`, in `specCalls`, we need an in-scope set that includes the free vars of the arguments. But we simply were not guaranteeing that: did not include the `rule_bndrs`. Easily fixed. I'm not sure how how this bug has lain for quite so long without biting us. Fixes #21828. - - - - - 6e8d9056 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Edit Note [idArity varies independently of dmdTypeDepth] ...and refer to it in GHC.Core.Lint.lintLetBind. Fixes #21452 - - - - - 89ba4655 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Tiny documentation wibbles (comments only) - - - - - 61a46c6d by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix readme - - - - - 61babb5e by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix bootstrap - - - - - 8b417ad5 by Eric Lindblad at 2022-07-13T08:28:29-04:00 tarball - - - - - e9d9f078 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Fix scopes for deriving clauses and instance signatures (#18425) - - - - - c4989131 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Record location of filled in default method bindings This is useful for hie files to reconstruct the evidence that default methods depend on. - - - - - 9c52e7fc by Zubin Duggal at 2022-07-13T14:00:18-04:00 testsuite: Factor out common parts from hiefile tests - - - - - 6a9e4493 by sheaf at 2022-07-13T14:00:56-04:00 Hadrian: update documentation of settings The documentation for key-value settings was a bit out of date. This patch updates it to account for `cabal.configure.opts` and `hsc2hs.run.opts`. The user-settings document was also re-arranged, to make the key-value settings more prominent (as it doesn't involve changing the Hadrian source code, and thus doesn't require any recompilation of Hadrian). - - - - - a2f142f8 by Zubin Duggal at 2022-07-13T20:43:32-04:00 Fix potential space leak that arise from ModuleGraphs retaining references to previous ModuleGraphs, in particular the lazy `mg_non_boot` field. This manifests in `extendMG`. Solution: Delete `mg_non_boot` as it is only used for `mgLookupModule`, which is only called in two places in the compiler, and should only be called at most once for every home unit: GHC.Driver.Make: mainModuleSrcPath :: Maybe String mainModuleSrcPath = do ms <- mgLookupModule mod_graph (mainModIs hue) ml_hs_file (ms_location ms) GHCI.UI: listModuleLine modl line = do graph <- GHC.getModuleGraph let this = GHC.mgLookupModule graph modl Instead `mgLookupModule` can be a linear function that looks through the entire list of `ModuleGraphNodes` Fixes #21816 - - - - - dcf8b30a by Ben Gamari at 2022-07-13T20:44:08-04:00 rts: Fix AdjustorPool bitmap manipulation Previously the implementation of bitmap_first_unset assumed that `__builtin_clz` would accept `uint8_t` however it apparently rather extends its argument to `unsigned int`. To fix this we simply revert to a naive implementation since handling the various corner cases with `clz` is quite tricky. This should be fine given that AdjustorPool isn't particularly hot. Ideally we would have a single, optimised bitmap implementation in the RTS but I'll leave this for future work. Fixes #21838. - - - - - ad8f3e15 by Luite Stegeman at 2022-07-16T07:20:36-04:00 Change GHCi bytecode return convention for unlifted datatypes. This changes the bytecode return convention for unlifted algebraic datatypes to be the same as for lifted types, i.e. ENTER/PUSH_ALTS instead of RETURN_UNLIFTED/PUSH_ALTS_UNLIFTED Fixes #20849 - - - - - 5434d1a3 by Colten Webb at 2022-07-16T07:21:15-04:00 Compute record-dot-syntax types Ensures type information for record-dot-syntax is included in HieASTs. See #21797 - - - - - 89d169ec by Colten Webb at 2022-07-16T07:21:15-04:00 Add record-dot-syntax test - - - - - 4beb9f3c by Ben Gamari at 2022-07-16T07:21:51-04:00 Document RuntimeRep polymorphism limitations of catch#, et al As noted in #21868, several primops accepting continuations producing RuntimeRep-polymorphic results aren't nearly as polymorphic as their types suggest. Document this limitation and adapt the `UnliftedWeakPtr` test to avoid breaking this limitation in `keepAlive#`. - - - - - 4ef1c65d by Ben Gamari at 2022-07-16T07:21:51-04:00 Make keepAlive# out-of-line This is a naive approach to fixing the unsoundness noticed in #21708. Specifically, we remove the lowering of `keepAlive#` via CorePrep and instead turn it into an out-of-line primop. This is simple, inefficient (since the continuation must now be heap allocated), but good enough for 9.4.1. We will revisit this (particiularly via #16098) in a future release. Metric Increase: T4978 T7257 T9203 - - - - - 1bbff35d by Greg Steuck at 2022-07-16T07:22:29-04:00 Suppress extra output from configure check for c++ libraries - - - - - 3acbd7ad by Ben Gamari at 2022-07-16T07:23:04-04:00 rel-notes: Drop mention of #21745 fix Since we have backported the fix to 9.4.1. - - - - - b27c2774 by Dominik Peteler at 2022-07-16T07:23:43-04:00 Align the behaviour of `dopt` and `log_dopt` Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861 - - - - - 28347d71 by Douglas Wilson at 2022-07-16T13:25:06-04:00 rts: forkOn context switches the target capability Fixes #21824 - - - - - f1c44991 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Eliminate orphan Outputable instances Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and `OutputableP` instances for the Cmm AST. This makes it significantly easier to use the Cmm pretty-printers in tracing output without incurring module import cycles. - - - - - f2e5e763 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Move toBlockList to GHC.Cmm - - - - - fa092745 by Ben Gamari at 2022-07-16T13:25:41-04:00 compiler: Add haddock sections to GHC.Utils.Panic - - - - - 097759f9 by Ben Gamari at 2022-07-16T13:26:17-04:00 configure: Don't override Windows CXXFLAGS At some point we used the clang distribution from msys2's `MINGW64` environment for our Windows toolchain. This defaulted to using libgcc and libstdc++ for its runtime library. However, we found for a variety of reasons that compiler-rt, libunwind, and libc++ were more reliable, consequently we explicitly overrode the CXXFLAGS to use these. However, since then we have switched to use the `CLANG64` packaging, which default to these already. Consequently we can drop these arguments, silencing some redundant argument warnings from clang. Fixes #21669. - - - - - e38a2684 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Check that there are no NULL ctors - - - - - 616365b0 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Introduce support for invoking finalizers on unload Addresses #20494. - - - - - cdd3be20 by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add T20494 - - - - - 03c69d8d by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Rename finit field to fini fini is short for "finalizer", which does not contain a "t". - - - - - 033580bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Refactor handling of oc->info Previously we would free oc->info after running initializers. However, we can't do this is we want to also run finalizers. Moreover, freeing oc->info so early was wrong for another reason: we will need it in order to unregister the exception tables (see the call to `RtlDeleteFunctionTable`). In service of #20494. - - - - - f17912e4 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Add finalization support This implements #20494 for the PEi386 linker. Happily, this also appears to fix `T9405`, resolving #21361. - - - - - 2cd75550 by Ben Gamari at 2022-07-16T23:50:36-04:00 Loader: Implement gnu-style -l:$path syntax Gnu ld allows `-l` to be passed an absolute file path, signalled by a `:` prefix. Implement this in the GHC's loader search logic. - - - - - 5781a360 by Ben Gamari at 2022-07-16T23:50:36-04:00 Statically-link against libc++ on Windows Unfortunately on Windows we have no RPATH-like facility, making dynamic linking extremely fragile. Since we cannot assume that the user will add their GHC installation to `$PATH` (and therefore their DLL search path) we cannot assume that the loader will be able to locate our `libc++.dll`. To avoid this, we instead statically link against `libc++.a` on Windows. Fixes #21435. - - - - - 8e2e883b by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Ensure that all .ctors/.dtors sections are run It turns out that PE objects may have multiple `.ctors`/`.dtors` sections but the RTS linker had assumed that there was only one. Fix this. Fixes #21618. - - - - - fba04387 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Respect dtor/ctor priority Previously we would run constructors and destructors in arbitrary order despite explicit priorities. Fixes #21847. - - - - - 1001952f by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add test for #21618 and #21847 - - - - - 6f3816af by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Fix exception unwind unregistration RtlDeleteFunctionTable expects a pointer to the .pdata section yet we passed it the .xdata section. Happily, this fixes #21354. - - - - - d9bff44c by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Drop dead code - - - - - d161e6bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Use section flags to identify initializers - - - - - fbb17110 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Introduce finalizer support - - - - - 5b0ed8a8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Use system-cxx-std-lib instead of config.stdcxx_impl - - - - - 6c476e1a by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker/Elf: Work around GCC 6 init/fini behavior It appears that GCC 6t (at least on i386) fails to give init_array/fini_array sections the correct SHT_INIT_ARRAY/SHT_FINI_ARRAY section types, instead marking them as SHT_PROGBITS. This caused T20494 to fail on Debian. - - - - - 5f8203b8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Mark T13366Cxx as unbroken on Darwin - - - - - 1fd2f851 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Fix resolution of __dso_handle on Darwin Darwin expects a leading underscore. - - - - - a2dc00f3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Clean up section kinds - - - - - aeb1a7c3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Ensure that __cxa_finalize is called on code unload - - - - - 028f081e by Ben Gamari at 2022-07-16T23:51:12-04:00 testsuite: Fix T11829 on Centos 7 It appears that Centos 7 has a more strict C++ compiler than most distributions since std::runtime_error is defined in <stdexcept> rather than <exception>. In T11829 we mistakenly imported the latter. - - - - - a10584e8 by Ben Gamari at 2022-07-17T22:30:32-04:00 hadrian: Rename documentation directories for consistency with make * Rename `docs` to `doc` * Place pdf documentation in `doc/` instead of `doc/pdfs/` Fixes #21164. - - - - - b27c5947 by Anselm Schüler at 2022-07-17T22:31:11-04:00 Fix incorrect proof of applyWhen’s properties - - - - - eb031a5b by Matthew Pickering at 2022-07-18T08:04:47-04:00 hadrian: Add multi:<pkg> and multi targets for starting a multi-repl This patch adds support to hadrian for starting a multi-repl containing all the packages which stage0 can build. In particular, there is the new user-facing command: ``` ./hadrian/ghci-multi ``` which when executed will start a multi-repl containing the `ghc` package and all it's dependencies. This is implemented by two new hadrian targets: ``` ./hadrian/build multi:<pkg> ``` Construct the arguments for a multi-repl session where the top-level package is <pkg>. For example, `./hadrian/ghci-multi` is implemented using `multi:ghc` target. There is also the `multi` command which constructs a repl for everything in stage0 which we can build. - - - - - 19e7cac9 by Eric Lindblad at 2022-07-18T08:05:27-04:00 changelog typo - - - - - af6731a4 by Eric Lindblad at 2022-07-18T08:05:27-04:00 typos - - - - - 415468fe by Simon Peyton Jones at 2022-07-18T16:36:54-04:00 Refactor SpecConstr to use treat bindings uniformly This patch, provoked by #21457, simplifies SpecConstr by treating top-level and nested bindings uniformly (see the new scBind). * Eliminates the mysterious scTopBindEnv * Refactors scBind to handle top-level and nested definitions uniformly. * But, for now at least, continues the status quo of not doing SpecConstr for top-level non-recursive bindings. (In contrast we do specialise nested non-recursive bindings, although the original paper did not; see Note [Local let bindings].) I tried the effect of specialising top-level non-recursive bindings (which is now dead easy to switch on, unlike before) but found some regressions, so I backed off. See !8135. It's a pure refactoring. I think it'll do a better job in a few cases, but there is no regression test. - - - - - d4d3fe6e by Andreas Klebinger at 2022-07-18T16:37:29-04:00 Rule matching: Don't compute the FVs if we don't look at them. - - - - - 5f907371 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 White space only in FamInstEnv - - - - - ae3b3b62 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make transferPolyIdInfo work for CPR I don't know why this hasn't bitten us before, but it was plain wrong. - - - - - 9bdfdd98 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Inline mapAccumLM This function is called in inner loops in the compiler, and it's overloaded and higher order. Best just to inline it. This popped up when I was looking at something else. I think perhaps GHC is delicately balanced on the cusp of inlining this automatically. - - - - - d0b806ff by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make SetLevels honour floatConsts This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though. - - - - - d1c25a48 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Refactor wantToUnboxArg a bit * Rename GHC.Core.Opt.WorkWrap.Utils.wantToUnboxArg to canUnboxArg and similarly wantToUnboxResult to canUnboxResult. * Add GHC.Core.Opt.DmdAnal.wantToUnboxArg as a wrapper for the (new) GHC.Core.Opt.WorkWrap.Utils.canUnboxArg, avoiding some yukky duplication. I decided it was clearer to give it a new data type for its return type, because I nedeed the FD_RecBox case which was not otherwise readiliy expressible. * Add dcpc_args to WorkWrap.Utils.DataConPatContext for the payload * Get rid of the Unlift constructor of UnboxingDecision, eliminate two panics, and two arguments to canUnboxArg (new name). Much nicer now. - - - - - 6d8a715e by Teo Camarasu at 2022-07-18T16:38:44-04:00 Allow running memInventory when the concurrent nonmoving gc is enabled If the nonmoving gc is enabled and we are using a threaded RTS, we now try to grab the collector mutex to avoid memInventory and the collection racing. Before memInventory was disabled. - - - - - aa75bbde by Ben Gamari at 2022-07-18T16:39:20-04:00 gitignore: don't ignore all aclocal.m4 files While GHC's own aclocal.m4 is generated by the aclocal tool, other packages' aclocal.m4 are committed in the repository. Previously `.gitignore` included an entry which covered *any* file named `aclocal.m4`, which lead to quite some confusion (e.g. see #21740). Fix this by modifying GHC's `.gitignore` to only cover GHC's own `aclocal.m4`. - - - - - 4b98c5ce by Boris Lykah at 2022-07-19T02:34:12-04:00 Add mapAccumM, forAccumM to Data.Traversable Approved by Core Libraries Committee in https://github.com/haskell/core-libraries-committee/issues/65#issuecomment-1186275433 - - - - - bd92182c by Ben Gamari at 2022-07-19T02:34:47-04:00 configure: Use AC_PATH_TOOL to detect tools Previously we used AC_PATH_PROG which, as noted by #21601, does not look for tools with a target prefix, breaking cross-compilation. Fixes #21601. - - - - - e8c07aa9 by Matthew Pickering at 2022-07-19T10:07:53-04:00 driver: Fix implementation of -S We were failing to stop before running the assembler so the object file was also created. Fixes #21869 - - - - - e2f0094c by Ben Gamari at 2022-07-19T10:08:28-04:00 rts/ProfHeap: Ensure new Censuses are zeroed When growing the Census array ProfHeap previously neglected to zero the new part of the array. Consequently `freeEra` would attempt to free random words that often looked suspiciously like pointers. Fixes #21880. - - - - - 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - f68d033b by Bryan Richter at 2022-08-16T11:05:54+03:00 testsuite: Add test for #21583 - - - - - 24 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/upload_ghc_libs.py - compiler/.hlint.yaml - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps/Ids.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/Linker.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/Dataflow/Graph.hs - compiler/GHC/Cmm/DebugBlock.hs - + compiler/GHC/Cmm/Dominators.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/899dc1c5c38be7f0f2a9aed8e0bd7b2b5ceed713...f68d033b38c508b0c78da8cb9bb926f882ec156d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/899dc1c5c38be7f0f2a9aed8e0bd7b2b5ceed713...f68d033b38c508b0c78da8cb9bb926f882ec156d You're receiving 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 Aug 16 08:36:23 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 Aug 2022 04:36:23 -0400 Subject: [Git][ghc/ghc][wip/9.4-foward-fixed-make] 8 commits: Add dates to base, ghc-prim changelogs Message-ID: <62fb57077aeff_3d8149488a014413d0@gitlab.mail> Matthew Pickering pushed to branch wip/9.4-foward-fixed-make at Glasgow Haskell Compiler / GHC Commits: 26c378a1 by Ben Gamari at 2022-08-16T09:35:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 63d1d2ac by Ben Gamari at 2022-08-16T09:35:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - 15fba2a4 by Ben Gamari at 2022-08-16T09:35:52+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - ba65818d by Douglas Wilson at 2022-08-16T09:35:52+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - f7e680de by Matthew Pickering at 2022-08-16T09:35:52+01:00 ghc-9.4: make buildsystem: build stage0 cabal with older process Cabal has grown a bound process >= 1.6.14.0 to work around a bug in process. Making process a stage0 package proved difficult, so instead we carefully build stage0 cabal --exact-configuration including boot package-db's process. This is very ugly, but is only necessary on the 9.4 branch as the make build system will not be supported in the future. - - - - - ff605823 by Douglas Wilson at 2022-08-16T09:35:52+01:00 ghc-9.4: make build system: add container module dependencies on template-haskell - - - - - c0f3acae by Ben Gamari at 2022-08-16T09:35:52+01:00 make: Fix bootstrapping with profiling enabled 12ae2a9cf89af3ae9e4df051818b631cf213a1b8 attempted to work around a make build system deficiency by adding some dependencies from modules of `containers` which contain TH splices to the `template-haskell` package. However, it only did this for the vanilla way. Here we add similar edges for profiled objects. Fixes #21987. - - - - - 55930757 by Ben Gamari at 2022-08-16T09:35:52+01:00 make: Add another missing build dependency on template-haskell This time the culprit is Data.Sequence.Internal. Closes #22047. - - - - - 11 changed files: - compiler/ghc.cabal.in - config.guess - config.sub - ghc.mk - libraries/Cabal - libraries/base/changelog.md - libraries/bytestring - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-prim/changelog.md - libraries/ghc-prim/ghc-prim.cabal - testsuite/tests/driver/T4437.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -39,7 +39,7 @@ extra-source-files: custom-setup - setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.8, directory, process, filepath + setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.9, directory, process, filepath Flag internal-interpreter Description: Build with internal interpreter support. ===================================== config.guess ===================================== @@ -1,12 +1,14 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2019 Free Software Foundation, Inc. +# Copyright 1992-2022 Free Software Foundation, Inc. -timestamp='2019-03-04' +# shellcheck disable=SC2006,SC2268 # see below for rationale + +timestamp='2022-05-25' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or +# the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -27,11 +29,19 @@ timestamp='2019-03-04' # Originally written by Per Bothner; maintained since 2000 by Ben Elliston. # # You can get the latest version of this script from: -# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess +# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess # # Please send patches to . +# The "shellcheck disable" line above the timestamp inhibits complaints +# about features and limitations of the classic Bourne shell that were +# superseded or lifted in POSIX. However, this script identifies a wide +# variety of pre-POSIX systems that do not have POSIX shells at all, and +# even some reasonably current systems (Solaris 10 as case-in-point) still +# have a pre-POSIX /bin/sh. + + me=`echo "$0" | sed -e 's,.*/,,'` usage="\ @@ -50,7 +60,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2019 Free Software Foundation, Inc. +Copyright 1992-2022 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -84,6 +94,9 @@ if test $# != 0; then exit 1 fi +# Just in case it came from the environment. +GUESS= + # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a @@ -99,8 +112,10 @@ tmp= trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 set_cc_for_build() { + # prevent multiple calls if $tmp is already set + test "$tmp" && return 0 : "${TMPDIR=/tmp}" - # shellcheck disable=SC2039 + # shellcheck disable=SC2039,SC3028 { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || @@ -110,7 +125,7 @@ set_cc_for_build() { ,,) echo "int x;" > "$dummy.c" for driver in cc gcc c89 c99 ; do if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then - CC_FOR_BUILD="$driver" + CC_FOR_BUILD=$driver break fi done @@ -131,14 +146,12 @@ fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown -case "$UNAME_SYSTEM" in +case $UNAME_SYSTEM in Linux|GNU|GNU/*) - # If the system lacks a compiler, then just pick glibc. - # We could probably try harder. - LIBC=gnu + LIBC=unknown set_cc_for_build cat <<-EOF > "$dummy.c" @@ -147,24 +160,37 @@ Linux|GNU|GNU/*) LIBC=uclibc #elif defined(__dietlibc__) LIBC=dietlibc - #else + #elif defined(__GLIBC__) LIBC=gnu + #else + #include + /* First heuristic to detect musl libc. */ + #ifdef __DEFINED_va_list + LIBC=musl + #endif #endif EOF - eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`" + cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` + eval "$cc_set_libc" - # If ldd exists, use it to detect musl libc. - if command -v ldd >/dev/null && \ - ldd --version 2>&1 | grep -q ^musl - then - LIBC=musl + # Second heuristic to detect musl libc. + if [ "$LIBC" = unknown ] && + command -v ldd >/dev/null && + ldd --version 2>&1 | grep -q ^musl; then + LIBC=musl + fi + + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + if [ "$LIBC" = unknown ]; then + LIBC=gnu fi ;; esac # Note: order is significant - the case branches are not exclusive. -case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in +case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, @@ -176,12 +202,12 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in # # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ - "/sbin/$sysctl" 2>/dev/null || \ - "/usr/sbin/$sysctl" 2>/dev/null || \ + /sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \ echo unknown)` - case "$UNAME_MACHINE_ARCH" in + case $UNAME_MACHINE_ARCH in + aarch64eb) machine=aarch64_be-unknown ;; armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; @@ -190,13 +216,13 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in earmv*) arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'` endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'` - machine="${arch}${endian}"-unknown + machine=${arch}${endian}-unknown ;; - *) machine="$UNAME_MACHINE_ARCH"-unknown ;; + *) machine=$UNAME_MACHINE_ARCH-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently (or will in the future) and ABI. - case "$UNAME_MACHINE_ARCH" in + case $UNAME_MACHINE_ARCH in earm*) os=netbsdelf ;; @@ -217,7 +243,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in ;; esac # Determine ABI tags. - case "$UNAME_MACHINE_ARCH" in + case $UNAME_MACHINE_ARCH in earm*) expr='s/^earmv[0-9]/-eabi/;s/eb$//' abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"` @@ -228,7 +254,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in # thus, need a distinct triplet. However, they do not need # kernel version information, so it can be replaced with a # suitable tag, in the style of linux-gnu. - case "$UNAME_VERSION" in + case $UNAME_VERSION in Debian*) release='-gnu' ;; @@ -239,45 +265,57 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "$machine-${os}${release}${abi-}" - exit ;; + GUESS=$machine-${os}${release}${abi-} + ;; *:Bitrig:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE + ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE + ;; + *:SecBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/SecBSD.//'` + GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE + ;; *:LibertyBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE + ;; *:MidnightBSD:*:*) - echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE + ;; *:ekkoBSD:*:*) - echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE + ;; *:SolidBSD:*:*) - echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE + ;; + *:OS108:*:*) + GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE + ;; macppc:MirBSD:*:*) - echo powerpc-unknown-mirbsd"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE + ;; *:MirBSD:*:*) - echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE + ;; *:Sortix:*:*) - echo "$UNAME_MACHINE"-unknown-sortix - exit ;; + GUESS=$UNAME_MACHINE-unknown-sortix + ;; + *:Twizzler:*:*) + GUESS=$UNAME_MACHINE-unknown-twizzler + ;; *:Redox:*:*) - echo "$UNAME_MACHINE"-unknown-redox - exit ;; + GUESS=$UNAME_MACHINE-unknown-redox + ;; mips:OSF1:*.*) - echo mips-dec-osf1 - exit ;; + GUESS=mips-dec-osf1 + ;; alpha:OSF1:*:*) + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + trap '' 0 case $UNAME_RELEASE in *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` @@ -291,7 +329,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in # covers most systems running today. This code pipes the CPU # types through head -n 1, so we only detect the type of CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in + case $ALPHA_CPU_TYPE in "EV4 (21064)") UNAME_MACHINE=alpha ;; "EV4.5 (21064)") @@ -328,117 +366,121 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. - echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`" - # Reset EXIT trap before exiting to avoid spurious non-zero exit code. - exitcode=$? - trap '' 0 - exit $exitcode ;; + OSF_REL=`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` + GUESS=$UNAME_MACHINE-dec-osf$OSF_REL + ;; Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; + GUESS=m68k-unknown-sysv4 + ;; *:[Aa]miga[Oo][Ss]:*:*) - echo "$UNAME_MACHINE"-unknown-amigaos - exit ;; + GUESS=$UNAME_MACHINE-unknown-amigaos + ;; *:[Mm]orph[Oo][Ss]:*:*) - echo "$UNAME_MACHINE"-unknown-morphos - exit ;; + GUESS=$UNAME_MACHINE-unknown-morphos + ;; *:OS/390:*:*) - echo i370-ibm-openedition - exit ;; + GUESS=i370-ibm-openedition + ;; *:z/VM:*:*) - echo s390-ibm-zvmoe - exit ;; + GUESS=s390-ibm-zvmoe + ;; *:OS400:*:*) - echo powerpc-ibm-os400 - exit ;; + GUESS=powerpc-ibm-os400 + ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix"$UNAME_RELEASE" - exit ;; + GUESS=arm-acorn-riscix$UNAME_RELEASE + ;; arm*:riscos:*:*|arm*:RISCOS:*:*) - echo arm-unknown-riscos - exit ;; + GUESS=arm-unknown-riscos + ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit ;; + GUESS=hppa1.1-hitachi-hiuxmpp + ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee at wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit ;; + case `(/bin/universe) 2>/dev/null` in + att) GUESS=pyramid-pyramid-sysv3 ;; + *) GUESS=pyramid-pyramid-bsd ;; + esac + ;; NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit ;; + GUESS=pyramid-pyramid-svr4 + ;; DRS?6000:unix:4.0:6*) - echo sparc-icl-nx6 - exit ;; + GUESS=sparc-icl-nx6 + ;; DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; + sparc) GUESS=sparc-icl-nx7 ;; + esac + ;; s390x:SunOS:*:*) - echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL + ;; sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-hal-solaris2$SUN_REL + ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-sun-solaris2$SUN_REL + ;; i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) - echo i386-pc-auroraux"$UNAME_RELEASE" - exit ;; + GUESS=i386-pc-auroraux$UNAME_RELEASE + ;; i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) set_cc_for_build SUN_ARCH=i386 # If there is a compiler, see if it is configured for 64-bit objects. # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. # This test works for both compilers. - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then + if test "$CC_FOR_BUILD" != no_compiler_found; then if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + (CCOPTS="" $CC_FOR_BUILD -m64 -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null then SUN_ARCH=x86_64 fi fi - echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=$SUN_ARCH-pc-solaris2$SUN_REL + ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-sun-solaris3$SUN_REL + ;; sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in + case `/usr/bin/arch -k` in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'` + GUESS=sparc-sun-sunos$SUN_REL + ;; sun3*:SunOS:*:*) - echo m68k-sun-sunos"$UNAME_RELEASE" - exit ;; + GUESS=m68k-sun-sunos$UNAME_RELEASE + ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 - case "`/bin/arch`" in + case `/bin/arch` in sun3) - echo m68k-sun-sunos"$UNAME_RELEASE" + GUESS=m68k-sun-sunos$UNAME_RELEASE ;; sun4) - echo sparc-sun-sunos"$UNAME_RELEASE" + GUESS=sparc-sun-sunos$UNAME_RELEASE ;; esac - exit ;; + ;; aushp:SunOS:*:*) - echo sparc-auspex-sunos"$UNAME_RELEASE" - exit ;; + GUESS=sparc-auspex-sunos$UNAME_RELEASE + ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor @@ -448,41 +490,41 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-milan-mint$UNAME_RELEASE + ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-hades-mint$UNAME_RELEASE + ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-unknown-mint$UNAME_RELEASE + ;; m68k:machten:*:*) - echo m68k-apple-machten"$UNAME_RELEASE" - exit ;; + GUESS=m68k-apple-machten$UNAME_RELEASE + ;; powerpc:machten:*:*) - echo powerpc-apple-machten"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-apple-machten$UNAME_RELEASE + ;; RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; + GUESS=mips-dec-mach_bsd4.3 + ;; RISC*:ULTRIX:*:*) - echo mips-dec-ultrix"$UNAME_RELEASE" - exit ;; + GUESS=mips-dec-ultrix$UNAME_RELEASE + ;; VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix"$UNAME_RELEASE" - exit ;; + GUESS=vax-dec-ultrix$UNAME_RELEASE + ;; 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix"$UNAME_RELEASE" - exit ;; + GUESS=clipper-intergraph-clix$UNAME_RELEASE + ;; mips:*:*:UMIPS | mips:*:*:RISCos) set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" @@ -510,75 +552,76 @@ EOF dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`"$dummy" "$dummyarg"` && { echo "$SYSTEM_NAME"; exit; } - echo mips-mips-riscos"$UNAME_RELEASE" - exit ;; + GUESS=mips-mips-riscos$UNAME_RELEASE + ;; Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax - exit ;; + GUESS=powerpc-motorola-powermax + ;; Motorola:*:4.3:PL8-*) - echo powerpc-harris-powermax - exit ;; + GUESS=powerpc-harris-powermax + ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - echo powerpc-harris-powermax - exit ;; + GUESS=powerpc-harris-powermax + ;; Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit ;; + GUESS=powerpc-harris-powerunix + ;; m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit ;; + GUESS=m88k-harris-cxux7 + ;; m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit ;; + GUESS=m88k-motorola-sysv4 + ;; m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit ;; + GUESS=m88k-motorola-sysv3 + ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ] + if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110 then - if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \ - [ "$TARGET_BINARY_INTERFACE"x = x ] + if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \ + test "$TARGET_BINARY_INTERFACE"x = x then - echo m88k-dg-dgux"$UNAME_RELEASE" + GUESS=m88k-dg-dgux$UNAME_RELEASE else - echo m88k-dg-dguxbcs"$UNAME_RELEASE" + GUESS=m88k-dg-dguxbcs$UNAME_RELEASE fi else - echo i586-dg-dgux"$UNAME_RELEASE" + GUESS=i586-dg-dgux$UNAME_RELEASE fi - exit ;; + ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit ;; + GUESS=m88k-dolphin-sysv3 + ;; M88*:*:R3*:*) # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit ;; + GUESS=m88k-motorola-sysv3 + ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit ;; + GUESS=m88k-tektronix-sysv3 + ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit ;; + GUESS=m68k-tektronix-bsd + ;; *:IRIX*:*:*) - echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`" - exit ;; + IRIX_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/g'` + GUESS=mips-sgi-irix$IRIX_REL + ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id + ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) - echo i386-ibm-aix - exit ;; + GUESS=i386-ibm-aix + ;; ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then + if test -x /usr/bin/oslevel ; then IBM_REV=`/usr/bin/oslevel` else - IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + IBM_REV=$UNAME_VERSION.$UNAME_RELEASE fi - echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" - exit ;; + GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV + ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then set_cc_for_build @@ -595,16 +638,16 @@ EOF EOF if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` then - echo "$SYSTEM_NAME" + GUESS=$SYSTEM_NAME else - echo rs6000-ibm-aix3.2.5 + GUESS=rs6000-ibm-aix3.2.5 fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 + GUESS=rs6000-ibm-aix3.2.4 else - echo rs6000-ibm-aix3.2 + GUESS=rs6000-ibm-aix3.2 fi - exit ;; + ;; *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then @@ -612,56 +655,56 @@ EOF else IBM_ARCH=powerpc fi - if [ -x /usr/bin/lslpp ] ; then - IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | + if test -x /usr/bin/lslpp ; then + IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | \ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` else - IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + IBM_REV=$UNAME_VERSION.$UNAME_RELEASE fi - echo "$IBM_ARCH"-ibm-aix"$IBM_REV" - exit ;; + GUESS=$IBM_ARCH-ibm-aix$IBM_REV + ;; *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; + GUESS=rs6000-ibm-aix + ;; ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) - echo romp-ibm-bsd4.4 - exit ;; + GUESS=romp-ibm-bsd4.4 + ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 + GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to + ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) - echo rs6000-bull-bosx - exit ;; + GUESS=rs6000-bull-bosx + ;; DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit ;; + GUESS=m68k-bull-sysv3 + ;; 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit ;; + GUESS=m68k-hp-bsd + ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit ;; + GUESS=m68k-hp-bsd4.4 + ;; 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` - case "$UNAME_MACHINE" in + HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` + case $UNAME_MACHINE in 9000/31?) HP_ARCH=m68000 ;; 9000/[34]??) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then + if test -x /usr/bin/getconf; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "$sc_cpu_version" in + case $sc_cpu_version in 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 532) # CPU_PA_RISC2_0 - case "$sc_kernel_bits" in + case $sc_kernel_bits in 32) HP_ARCH=hppa2.0n ;; 64) HP_ARCH=hppa2.0w ;; '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 esac ;; esac fi - if [ "$HP_ARCH" = "" ]; then + if test "$HP_ARCH" = ""; then set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" @@ -700,7 +743,7 @@ EOF test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac - if [ "$HP_ARCH" = hppa2.0w ] + if test "$HP_ARCH" = hppa2.0w then set_cc_for_build @@ -721,12 +764,12 @@ EOF HP_ARCH=hppa64 fi fi - echo "$HP_ARCH"-hp-hpux"$HPUX_REV" - exit ;; + GUESS=$HP_ARCH-hp-hpux$HPUX_REV + ;; ia64:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux"$HPUX_REV" - exit ;; + HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` + GUESS=ia64-hp-hpux$HPUX_REV + ;; 3050*:HI-UX:*:*) set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" @@ -756,36 +799,36 @@ EOF EOF $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; + GUESS=unknown-hitachi-hiuxwe2 + ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) - echo hppa1.1-hp-bsd - exit ;; + GUESS=hppa1.1-hp-bsd + ;; 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit ;; + GUESS=hppa1.0-hp-bsd + ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; + GUESS=hppa1.0-hp-mpeix + ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) - echo hppa1.1-hp-osf - exit ;; + GUESS=hppa1.1-hp-osf + ;; hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit ;; + GUESS=hppa1.0-hp-osf + ;; i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo "$UNAME_MACHINE"-unknown-osf1mk + if test -x /usr/sbin/sysversion ; then + GUESS=$UNAME_MACHINE-unknown-osf1mk else - echo "$UNAME_MACHINE"-unknown-osf1 + GUESS=$UNAME_MACHINE-unknown-osf1 fi - exit ;; + ;; parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit ;; + GUESS=hppa1.1-hp-lites + ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit ;; + GUESS=c1-convex-bsd + ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd @@ -793,17 +836,18 @@ EOF fi exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit ;; + GUESS=c34-convex-bsd + ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit ;; + GUESS=c38-convex-bsd + ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit ;; + GUESS=c4-convex-bsd + ;; CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=ymp-cray-unicos$CRAY_REL + ;; CRAY*[A-Z]90:*:*:*) echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ @@ -811,114 +855,129 @@ EOF -e 's/\.[^.]*$/.X/' exit ;; CRAY*TS:*:*:*) - echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=t90-cray-unicos$CRAY_REL + ;; CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=alphaev5-cray-unicosmk$CRAY_REL + ;; CRAY*SV1:*:*:*) - echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=sv1-cray-unicos$CRAY_REL + ;; *:UNICOS/mp:*:*) - echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=craynv-cray-unicosmp$CRAY_REL + ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} + ;; 5000:UNIX_System_V:4.*:*) FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} + ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE + ;; sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi"$UNAME_RELEASE" - exit ;; + GUESS=sparc-unknown-bsdi$UNAME_RELEASE + ;; *:BSD/OS:*:*) - echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE + ;; arm:FreeBSD:*:*) UNAME_PROCESSOR=`uname -p` set_cc_for_build if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_PCS_VFP then - echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi else - echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf fi - exit ;; + ;; *:FreeBSD:*:*) UNAME_PROCESSOR=`/usr/bin/uname -p` - case "$UNAME_PROCESSOR" in + case $UNAME_PROCESSOR in amd64) UNAME_PROCESSOR=x86_64 ;; i386) UNAME_PROCESSOR=i586 ;; esac - echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL + ;; i*:CYGWIN*:*) - echo "$UNAME_MACHINE"-pc-cygwin - exit ;; + GUESS=$UNAME_MACHINE-pc-cygwin + ;; *:MINGW64*:*) - echo "$UNAME_MACHINE"-pc-mingw64 - exit ;; + GUESS=$UNAME_MACHINE-pc-mingw64 + ;; *:MINGW*:*) - echo "$UNAME_MACHINE"-pc-mingw32 - exit ;; + GUESS=$UNAME_MACHINE-pc-mingw32 + ;; *:MSYS*:*) - echo "$UNAME_MACHINE"-pc-msys - exit ;; + GUESS=$UNAME_MACHINE-pc-msys + ;; i*:PW*:*) - echo "$UNAME_MACHINE"-pc-pw32 - exit ;; + GUESS=$UNAME_MACHINE-pc-pw32 + ;; + *:SerenityOS:*:*) + GUESS=$UNAME_MACHINE-pc-serenity + ;; *:Interix*:*) - case "$UNAME_MACHINE" in + case $UNAME_MACHINE in x86) - echo i586-pc-interix"$UNAME_RELEASE" - exit ;; + GUESS=i586-pc-interix$UNAME_RELEASE + ;; authenticamd | genuineintel | EM64T) - echo x86_64-unknown-interix"$UNAME_RELEASE" - exit ;; + GUESS=x86_64-unknown-interix$UNAME_RELEASE + ;; IA64) - echo ia64-unknown-interix"$UNAME_RELEASE" - exit ;; + GUESS=ia64-unknown-interix$UNAME_RELEASE + ;; esac ;; i*:UWIN*:*) - echo "$UNAME_MACHINE"-pc-uwin - exit ;; + GUESS=$UNAME_MACHINE-pc-uwin + ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-pc-cygwin - exit ;; + GUESS=x86_64-pc-cygwin + ;; prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=powerpcle-unknown-solaris2$SUN_REL + ;; *:GNU:*:*) # the GNU system - echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`" - exit ;; + GNU_ARCH=`echo "$UNAME_MACHINE" | sed -e 's,[-/].*$,,'` + GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's,/.*$,,'` + GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL + ;; *:GNU/*:*:*) # other systems with GNU libc and userland - echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC" - exit ;; + GNU_SYS=`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"` + GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC + ;; *:Minix:*:*) - echo "$UNAME_MACHINE"-unknown-minix - exit ;; + GUESS=$UNAME_MACHINE-unknown-minix + ;; aarch64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; aarch64_be:Linux:*:*) UNAME_MACHINE=aarch64_be - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; @@ -929,60 +988,63 @@ EOF esac objdump --private-headers /bin/sh | grep -q ld.so.1 if test "$?" = 0 ; then LIBC=gnulibc1 ; fi - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - arc:Linux:*:* | arceb:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + arc:Linux:*:* | arceb:Linux:*:* | arc32:Linux:*:* | arc64:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; arm*:Linux:*:*) set_cc_for_build if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_EABI__ then - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC else if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_PCS_VFP then - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi + GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi else - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf + GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf fi fi - exit ;; + ;; avr32*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; cris:Linux:*:*) - echo "$UNAME_MACHINE"-axis-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-axis-linux-$LIBC + ;; crisv32:Linux:*:*) - echo "$UNAME_MACHINE"-axis-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-axis-linux-$LIBC + ;; e2k:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; frv:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; hexagon:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; i*86:Linux:*:*) - echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-pc-linux-$LIBC + ;; ia64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; k1om:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; m32r*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; m68*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; mips:Linux:*:* | mips64:Linux:*:*) set_cc_for_build IS_GLIBC=0 @@ -1027,113 +1089,135 @@ EOF #endif #endif EOF - eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`" + cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'` + eval "$cc_set_vars" test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } ;; mips64el:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; openrisc*:Linux:*:*) - echo or1k-unknown-linux-"$LIBC" - exit ;; + GUESS=or1k-unknown-linux-$LIBC + ;; or32:Linux:*:* | or1k*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; padre:Linux:*:*) - echo sparc-unknown-linux-"$LIBC" - exit ;; + GUESS=sparc-unknown-linux-$LIBC + ;; parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-"$LIBC" - exit ;; + GUESS=hppa64-unknown-linux-$LIBC + ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;; - PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;; - *) echo hppa-unknown-linux-"$LIBC" ;; + PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;; + PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;; + *) GUESS=hppa-unknown-linux-$LIBC ;; esac - exit ;; + ;; ppc64:Linux:*:*) - echo powerpc64-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpc64-unknown-linux-$LIBC + ;; ppc:Linux:*:*) - echo powerpc-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpc-unknown-linux-$LIBC + ;; ppc64le:Linux:*:*) - echo powerpc64le-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpc64le-unknown-linux-$LIBC + ;; ppcle:Linux:*:*) - echo powerpcle-unknown-linux-"$LIBC" - exit ;; - riscv32:Linux:*:* | riscv64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpcle-unknown-linux-$LIBC + ;; + riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; s390:Linux:*:* | s390x:Linux:*:*) - echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-ibm-linux-$LIBC + ;; sh64*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; sh*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; sparc:Linux:*:* | sparc64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; tile*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; vax:Linux:*:*) - echo "$UNAME_MACHINE"-dec-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-dec-linux-$LIBC + ;; x86_64:Linux:*:*) - echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; + set_cc_for_build + CPU=$UNAME_MACHINE + LIBCABI=$LIBC + if test "$CC_FOR_BUILD" != no_compiler_found; then + ABI=64 + sed 's/^ //' << EOF > "$dummy.c" + #ifdef __i386__ + ABI=x86 + #else + #ifdef __ILP32__ + ABI=x32 + #endif + #endif +EOF + cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'` + eval "$cc_set_abi" + case $ABI in + x86) CPU=i686 ;; + x32) LIBCABI=${LIBC}x32 ;; + esac + fi + GUESS=$CPU-pc-linux-$LIBCABI + ;; xtensa*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. - echo i386-sequent-sysv4 - exit ;; + GUESS=i386-sequent-sysv4 + ;; i*86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. - echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" - exit ;; + GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION + ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. - echo "$UNAME_MACHINE"-pc-os2-emx - exit ;; + GUESS=$UNAME_MACHINE-pc-os2-emx + ;; i*86:XTS-300:*:STOP) - echo "$UNAME_MACHINE"-unknown-stop - exit ;; + GUESS=$UNAME_MACHINE-unknown-stop + ;; i*86:atheos:*:*) - echo "$UNAME_MACHINE"-unknown-atheos - exit ;; + GUESS=$UNAME_MACHINE-unknown-atheos + ;; i*86:syllable:*:*) - echo "$UNAME_MACHINE"-pc-syllable - exit ;; + GUESS=$UNAME_MACHINE-pc-syllable + ;; i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) - echo i386-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=i386-unknown-lynxos$UNAME_RELEASE + ;; i*86:*DOS:*:*) - echo "$UNAME_MACHINE"-pc-msdosdjgpp - exit ;; + GUESS=$UNAME_MACHINE-pc-msdosdjgpp + ;; i*86:*:4.*:*) UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" + GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL else - echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" + GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL fi - exit ;; + ;; i*86:*:5:[678]*) # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in @@ -1141,12 +1225,12 @@ EOF *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac - echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}" - exit ;; + GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 @@ -1156,11 +1240,11 @@ EOF && UNAME_MACHINE=i686 (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ && UNAME_MACHINE=i686 - echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" + GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL else - echo "$UNAME_MACHINE"-pc-sysv32 + GUESS=$UNAME_MACHINE-pc-sysv32 fi - exit ;; + ;; pc:*:*:*) # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about @@ -1168,31 +1252,31 @@ EOF # Note: whatever this is, it MUST be the same as what config.sub # prints for the "djgpp" host, or else GDB configure will decide that # this is a cross-build. - echo i586-pc-msdosdjgpp - exit ;; + GUESS=i586-pc-msdosdjgpp + ;; Intel:Mach:3*:*) - echo i386-pc-mach3 - exit ;; + GUESS=i386-pc-mach3 + ;; paragon:*:*:*) - echo i860-intel-osf1 - exit ;; + GUESS=i860-intel-osf1 + ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 + GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4 + GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4 fi - exit ;; + ;; mini*:CTIX:SYS*5:*) # "miniframe" - echo m68010-convergent-sysv - exit ;; + GUESS=m68010-convergent-sysv + ;; mc68k:UNIX:SYSTEM5:3.51m) - echo m68k-convergent-sysv - exit ;; + GUESS=m68k-convergent-sysv + ;; M680?0:D-NIX:5.3:*) - echo m68k-diab-dnix - exit ;; + GUESS=m68k-diab-dnix + ;; M68*:*:R3V[5678]*:*) test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) @@ -1217,250 +1301,267 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - echo m68k-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=m68k-unknown-lynxos$UNAME_RELEASE + ;; mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; + GUESS=m68k-atari-sysv4 + ;; TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=sparc-unknown-lynxos$UNAME_RELEASE + ;; rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=rs6000-unknown-lynxos$UNAME_RELEASE + ;; PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) - echo powerpc-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-unknown-lynxos$UNAME_RELEASE + ;; SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv"$UNAME_RELEASE" - exit ;; + GUESS=mips-dde-sysv$UNAME_RELEASE + ;; RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit ;; + GUESS=mips-sni-sysv4 + ;; RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit ;; + GUESS=mips-sni-sysv4 + ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo "$UNAME_MACHINE"-sni-sysv4 + GUESS=$UNAME_MACHINE-sni-sysv4 else - echo ns32k-sni-sysv + GUESS=ns32k-sni-sysv fi - exit ;; + ;; PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says - echo i586-unisys-sysv4 - exit ;; + GUESS=i586-unisys-sysv4 + ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit ;; + GUESS=hppa1.1-stratus-sysv4 + ;; *:*:*:FTX*) # From seanf at swdc.stratus.com. - echo i860-stratus-sysv4 - exit ;; + GUESS=i860-stratus-sysv4 + ;; i*86:VOS:*:*) # From Paul.Green at stratus.com. - echo "$UNAME_MACHINE"-stratus-vos - exit ;; + GUESS=$UNAME_MACHINE-stratus-vos + ;; *:VOS:*:*) # From Paul.Green at stratus.com. - echo hppa1.1-stratus-vos - exit ;; + GUESS=hppa1.1-stratus-vos + ;; mc68*:A/UX:*:*) - echo m68k-apple-aux"$UNAME_RELEASE" - exit ;; + GUESS=m68k-apple-aux$UNAME_RELEASE + ;; news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; + GUESS=mips-sony-newsos6 + ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv"$UNAME_RELEASE" + if test -d /usr/nec; then + GUESS=mips-nec-sysv$UNAME_RELEASE else - echo mips-unknown-sysv"$UNAME_RELEASE" + GUESS=mips-unknown-sysv$UNAME_RELEASE fi - exit ;; + ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit ;; + GUESS=powerpc-be-beos + ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit ;; + GUESS=powerpc-apple-beos + ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit ;; + GUESS=i586-pc-beos + ;; BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - echo i586-pc-haiku - exit ;; - x86_64:Haiku:*:*) - echo x86_64-unknown-haiku - exit ;; + GUESS=i586-pc-haiku + ;; + ppc:Haiku:*:*) # Haiku running on Apple PowerPC + GUESS=powerpc-apple-haiku + ;; + *:Haiku:*:*) # Haiku modern gcc (not bound by BeOS compat) + GUESS=$UNAME_MACHINE-unknown-haiku + ;; SX-4:SUPER-UX:*:*) - echo sx4-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx4-nec-superux$UNAME_RELEASE + ;; SX-5:SUPER-UX:*:*) - echo sx5-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx5-nec-superux$UNAME_RELEASE + ;; SX-6:SUPER-UX:*:*) - echo sx6-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx6-nec-superux$UNAME_RELEASE + ;; SX-7:SUPER-UX:*:*) - echo sx7-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx7-nec-superux$UNAME_RELEASE + ;; SX-8:SUPER-UX:*:*) - echo sx8-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx8-nec-superux$UNAME_RELEASE + ;; SX-8R:SUPER-UX:*:*) - echo sx8r-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx8r-nec-superux$UNAME_RELEASE + ;; SX-ACE:SUPER-UX:*:*) - echo sxace-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sxace-nec-superux$UNAME_RELEASE + ;; Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-apple-rhapsody$UNAME_RELEASE + ;; *:Rhapsody:*:*) - echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE + ;; + arm64:Darwin:*:*) + GUESS=aarch64-apple-darwin$UNAME_RELEASE + ;; *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - set_cc_for_build - if test "$UNAME_PROCESSOR" = unknown ; then - UNAME_PROCESSOR=powerpc + UNAME_PROCESSOR=`uname -p` + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + if command -v xcode-select > /dev/null 2> /dev/null && \ + ! xcode-select --print-path > /dev/null 2> /dev/null ; then + # Avoid executing cc if there is no toolchain installed as + # cc will be a stub that puts up a graphical alert + # prompting the user to install developer tools. + CC_FOR_BUILD=no_compiler_found + else + set_cc_for_build fi - if test "`echo "$UNAME_RELEASE" | sed -e 's/\..*//'`" -le 10 ; then - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then - if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - case $UNAME_PROCESSOR in - i386) UNAME_PROCESSOR=x86_64 ;; - powerpc) UNAME_PROCESSOR=powerpc64 ;; - esac - fi - # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc - if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_PPC >/dev/null - then - UNAME_PROCESSOR=powerpc - fi + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc + if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_PPC >/dev/null + then + UNAME_PROCESSOR=powerpc fi elif test "$UNAME_PROCESSOR" = i386 ; then - # Avoid executing cc on OS X 10.9, as it ships with a stub - # that puts up a graphical alert prompting to install - # developer tools. Any system running Mac OS X 10.7 or - # later (Darwin 11 and later) is required to have a 64-bit - # processor. This is not true of the ARM version of Darwin - # that Apple uses in portable devices. - UNAME_PROCESSOR=x86_64 + # uname -m returns i386 or x86_64 + UNAME_PROCESSOR=$UNAME_MACHINE fi - echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE + ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = x86; then UNAME_PROCESSOR=i386 UNAME_MACHINE=pc fi - echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE + ;; *:QNX:*:4*) - echo i386-pc-qnx - exit ;; + GUESS=i386-pc-qnx + ;; NEO-*:NONSTOP_KERNEL:*:*) - echo neo-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=neo-tandem-nsk$UNAME_RELEASE + ;; NSE-*:NONSTOP_KERNEL:*:*) - echo nse-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nse-tandem-nsk$UNAME_RELEASE + ;; NSR-*:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nsr-tandem-nsk$UNAME_RELEASE + ;; NSV-*:NONSTOP_KERNEL:*:*) - echo nsv-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nsv-tandem-nsk$UNAME_RELEASE + ;; NSX-*:NONSTOP_KERNEL:*:*) - echo nsx-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nsx-tandem-nsk$UNAME_RELEASE + ;; *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit ;; + GUESS=mips-compaq-nonstopux + ;; BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit ;; + GUESS=bs2000-siemens-sysv + ;; DS/*:UNIX_System_V:*:*) - echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE + ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. - # shellcheck disable=SC2154 - if test "$cputype" = 386; then + if test "${cputype-}" = 386; then UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" + elif test "x${cputype-}" != x; then + UNAME_MACHINE=$cputype fi - echo "$UNAME_MACHINE"-unknown-plan9 - exit ;; + GUESS=$UNAME_MACHINE-unknown-plan9 + ;; *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit ;; + GUESS=pdp10-unknown-tops10 + ;; *:TENEX:*:*) - echo pdp10-unknown-tenex - exit ;; + GUESS=pdp10-unknown-tenex + ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit ;; + GUESS=pdp10-dec-tops20 + ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit ;; + GUESS=pdp10-xkl-tops20 + ;; *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit ;; + GUESS=pdp10-unknown-tops20 + ;; *:ITS:*:*) - echo pdp10-unknown-its - exit ;; + GUESS=pdp10-unknown-its + ;; SEI:*:*:SEIUX) - echo mips-sei-seiux"$UNAME_RELEASE" - exit ;; + GUESS=mips-sei-seiux$UNAME_RELEASE + ;; *:DragonFly:*:*) - echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; + DRAGONFLY_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL + ;; *:*VMS:*:*) UNAME_MACHINE=`(uname -p) 2>/dev/null` - case "$UNAME_MACHINE" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; + case $UNAME_MACHINE in + A*) GUESS=alpha-dec-vms ;; + I*) GUESS=ia64-dec-vms ;; + V*) GUESS=vax-dec-vms ;; esac ;; *:XENIX:*:SysV) - echo i386-pc-xenix - exit ;; + GUESS=i386-pc-xenix + ;; i*86:skyos:*:*) - echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`" - exit ;; + SKYOS_REL=`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'` + GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL + ;; i*86:rdos:*:*) - echo "$UNAME_MACHINE"-pc-rdos - exit ;; - i*86:AROS:*:*) - echo "$UNAME_MACHINE"-pc-aros - exit ;; + GUESS=$UNAME_MACHINE-pc-rdos + ;; + i*86:Fiwix:*:*) + GUESS=$UNAME_MACHINE-pc-fiwix + ;; + *:AROS:*:*) + GUESS=$UNAME_MACHINE-unknown-aros + ;; x86_64:VMkernel:*:*) - echo "$UNAME_MACHINE"-unknown-esx - exit ;; + GUESS=$UNAME_MACHINE-unknown-esx + ;; amd64:Isilon\ OneFS:*:*) - echo x86_64-unknown-onefs - exit ;; + GUESS=x86_64-unknown-onefs + ;; *:Unleashed:*:*) - echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE + ;; esac +# Do we have a guess based on uname results? +if test "x$GUESS" != x; then + echo "$GUESS" + exit +fi + # No uname command or uname output not recognized. set_cc_for_build cat > "$dummy.c" < "$dummy.c" < #include #endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#include +#if defined(_SIZE_T_) || defined(SIGLOST) +#include +#endif +#endif +#endif main () { #if defined (sony) @@ -1554,19 +1663,24 @@ main () #else printf ("vax-dec-bsd\n"); exit (0); #endif +#else +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname un; + uname (&un); + printf ("vax-dec-ultrix%s\n", un.release); exit (0); #else printf ("vax-dec-ultrix\n"); exit (0); #endif #endif +#endif #if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) #if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) -#include -#if defined(_SIZE_T_) /* >= ULTRIX4 */ - printf ("mips-dec-ultrix4\n"); exit (0); +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname *un; + uname (&un); + printf ("mips-dec-ultrix%s\n", un.release); exit (0); #else -#if defined(ULTRIX3) || defined(ultrix3) || defined(SIGLOST) - printf ("mips-dec-ultrix3\n"); exit (0); -#endif + printf ("mips-dec-ultrix\n"); exit (0); #endif #endif #endif @@ -1579,7 +1693,7 @@ main () } EOF -$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`$dummy` && +$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` && { echo "$SYSTEM_NAME"; exit; } # Apollos put the system type in the environment. @@ -1587,7 +1701,7 @@ test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } echo "$0: unable to guess system type" >&2 -case "$UNAME_MACHINE:$UNAME_SYSTEM" in +case $UNAME_MACHINE:$UNAME_SYSTEM in mips:Linux | mips64:Linux) # If we got here on MIPS GNU/Linux, output extra information. cat >&2 <&2 <&2 @@ -1743,8 +1784,12 @@ case $kernel-$os in ;; kfreebsd*-gnu* | kopensolaris*-gnu*) ;; + vxworks-simlinux | vxworks-simwindows | vxworks-spe) + ;; nto-qnx*) ;; + os2-emx) + ;; *-eabi* | *-gnueabi*) ;; -*) ===================================== ghc.mk ===================================== @@ -484,6 +484,33 @@ libraries/template-haskell_CONFIGURE_OPTS += --flags=+vendor-filepath libraries/ghc-bignum_CONFIGURE_OPTS += -f $(BIGNUM_BACKEND) +CABAL_DEPS = text transformers mtl parsec Cabal/Cabal-syntax +CABAL_BOOT_DEPS = process array filepath base bytestring containers deepseq time unix pretty directory + +BOOT_PKG_DEPS := \ + $(foreach p,$(CABAL_BOOT_DEPS),\ + --dependency="$p=$p-$(shell $(GHC_PKG) --simple-output field $p version)") + +STAGE0_PKG_DEPS := \ + $(foreach d,$(CABAL_DEPS),\ + $(foreach p,$(basename $(notdir $(wildcard libraries/$d/*.cabal))),\ + --dependency="$p=$p-$(shell grep -i "^Version:" libraries/$d/$p.cabal | sed "s/[^0-9.]//g")")) + +libraries/Cabal/Cabal_dist-boot_CONFIGURE_OPTS += --exact-configuration $(BOOT_PKG_DEPS) $(STAGE0_PKG_DEPS) + +# See Note [Support for building ghc 9.4 with the make build system] +libraries/containers/containers/dist-install/build/Data/IntMap/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/Graph.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/Set/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/IntSet/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/Sequence/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi + +libraries/containers/containers/dist-install/build/Data/IntMap/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Graph.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Set/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/IntSet/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Sequence/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi + ifeq "$(BIGNUM_BACKEND)" "gmp" GMP_ENABLED = YES libraries/ghc-bignum_CONFIGURE_OPTS += --configure-option="--with-gmp" @@ -1592,3 +1619,21 @@ phase_0_builds: $(utils/deriveConstants_dist_depfile_c_asm) .PHONY: phase_1_builds phase_1_builds: $(PACKAGE_DATA_MKS) + +################################################## +# {- Note [Support for building ghc 9.4 with the make build system] -} +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# For ghc-9.6 and forward we will be removing the make build system in favour of +# the in-tree hadrian build system. However for ghc-9.4 we do still support +# make. This support is fragile, and we do recommend that you build with +# hadrian if you are able to do so. The blog post +# https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html gives advice to +# packagers adapting to hadrian. +# +# There are several hacks in place to allow ghc-9.4 to build with make: +# * We require a boot compiler < ghc-9.2. See issue #21914 +# * We carefully build stage0 Cabal with the boot compiler's process library, +# which does not satisfy Cabal's bounds. See issue #21953 +# * We add an explicit dependencies from container modules containing splices to +# libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.o +# becasue those splices induce an implicit dependency on the template-haskell module. ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 18d801832a3ad5f346eeaaf3f8f3df1abd5a6b9d +Subproject commit 5d18b763356dca719f5286a52328cb41b9fa4192 ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit acfe93480a15ecd373a5de5e423b1460749e52e1 +Subproject commit 1543e054a314865d89a259065921d5acba03d966 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -28,7 +28,7 @@ build-type: Custom extra-source-files: changelog.md custom-setup - setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.8, directory, filepath + setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.9, directory, filepath source-repository head type: git ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -21,7 +21,7 @@ - The `threadLabel#` primop was added, allowing the user to query the label of a given `ThreadId#`. -## 0.9.0 +## 0.9.0 *August 2022* - Shipped with GHC 9.4.1 ===================================== libraries/ghc-prim/ghc-prim.cabal ===================================== @@ -20,7 +20,7 @@ source-repository head subdir: libraries/ghc-prim custom-setup - setup-depends: base >= 4 && < 5, process, filepath, directory, Cabal >= 1.23 && < 3.8 + setup-depends: base >= 4 && < 5, process, filepath, directory, Cabal >= 1.23 && < 3.9 Library default-language: Haskell2010 ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -37,11 +37,7 @@ check title expected got -- See Note [Adding a language extension] in compiler/GHC/Driver/Session.hs. expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = - [ "RelaxedLayout" - , "AlternativeLayoutRule" - , "AlternativeLayoutRuleTransitional" - , "OverloadedRecordUpdate" - , "DeepSubsumption" + [ "DeepSubsumption" ] expectedCabalOnlyExtensions :: [String] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a3043d940e6f2d4c90eb2a7752eb44d5fccc72a...55930757f2071c1315c8a1d7e9ae1a4804416110 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a3043d940e6f2d4c90eb2a7752eb44d5fccc72a...55930757f2071c1315c8a1d7e9ae1a4804416110 You're receiving 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 Aug 16 09:41:32 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 05:41:32 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: typo Message-ID: <62fb664ca268d_3d8149489a414690f7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 42321170 by Eric Lindblad at 2022-08-16T05:41:12-04:00 typo - - - - - 6cfb6b69 by Ben Gamari at 2022-08-16T05:41:13-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - a94e470b by Bryan Richter at 2022-08-16T05:41:14-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - dc62f24e by Cheng Shao at 2022-08-16T05:41:16-04:00 CmmToAsm/AArch64: correct a typo - - - - - 4 changed files: - .gitlab/gen_ci.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - rts/Interpreter.c Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -2,13 +2,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- cabal: -build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring +build-depends: base, aeson >= 1.8.1, containers, bytestring -} +import Data.Coerce import Data.String (String) import Data.Aeson as A -import qualified Data.Map.Monoidal as M +import qualified Data.Map as Map +import Data.Map (Map) import qualified Data.ByteString.Lazy as B hiding (putStrLn) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) @@ -307,10 +310,22 @@ dockerImage _ _ = Nothing -- The "proper" solution would be to use a dependent monoidal map where each key specifies -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error -- or they should be combined. -type Variables = M.MonoidalMap String [String] +newtype MonoidalMap k v = MonoidalMap (Map k v) + deriving (Eq, Show, Functor, ToJSON) + +instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where + (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b) + +instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where + mempty = MonoidalMap (Map.empty) + +mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a +mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m) + +type Variables = MonoidalMap String [String] (=:) :: String -> String -> Variables -a =: b = M.singleton a [b] +a =: b = MonoidalMap (Map.singleton a [b]) opsysVariables :: Arch -> Opsys -> Variables opsysVariables _ FreeBSD13 = mconcat @@ -566,7 +581,7 @@ instance ToJSON Job where , "allow_failure" A..= jobAllowFailure -- Joining up variables like this may well be the wrong thing to do but -- at least it doesn't lose information silently by overriding. - , "variables" A..= (M.map (intercalate " ") jobVariables) + , "variables" A..= fmap (intercalate " ") jobVariables , "artifacts" A..= jobArtifacts , "cache" A..= jobCache , "after_script" A..= jobAfterScript @@ -621,9 +636,9 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) - , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty + , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) + , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty ] jobArtifacts = Artifacts @@ -669,7 +684,7 @@ addJobRule :: Rule -> Job -> Job addJobRule r j = j { jobRules = enableRule r (jobRules j) } addVariable :: String -> String -> Job -> Job -addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) } +addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } -- Building the standard jobs -- @@ -765,8 +780,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b] -- | Specification for all the jobs we want to build. -jobs :: M.MonoidalMap String Job -jobs = M.fromList $ concatMap flattenJobGroup $ +jobs :: Map String Job +jobs = Map.fromList $ concatMap flattenJobGroup $ [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , (validateBuilds Amd64 (Linux Debian10) nativeInt) ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Native code generator for x86 and x86-64 architectures +-- | Native code generator for AArch64 architectures module GHC.CmmToAsm.AArch64 ( ncgAArch64 ) where ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Logger import Data.Maybe (fromJust) import Control.Monad (ap) -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, isPrefixOf) import Data.Ord (comparing) -- ---------------------------------------------------------------------------- @@ -504,6 +504,12 @@ generateExternDecls = do modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | Is a variable one of the special @$llvm@ globals? +isBuiltinLlvmVar :: LlvmVar -> Bool +isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) = + "$llvm" `isPrefixOf` unpackFS lbl +isBuiltinLlvmVar _ = False + -- | Here we take a global variable definition, rename it with a -- @$def@ suffix, and generate the appropriate alias. aliasify :: LMGlobal -> LlvmM [LMGlobal] @@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal] -- Here we obtain the indirectee's precise type and introduce -- fresh aliases to both the precise typed label (lbl$def) and the i8* -- typed (regular) label of it with the matching new names. -aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) - (Just orig)) = do +aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias) + (Just orig)) + | not $ isBuiltinLlvmVar var = do let defLbl = llvmDefLabel lbl LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig defOrigLbl = llvmDefLabel origLbl @@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') ] -aliasify (LMGlobal var val) = do +aliasify (LMGlobal var val) + | not $ isBuiltinLlvmVar var = do let LMGlobalVar lbl ty link sect align const = var defLbl = llvmDefLabel lbl @@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do return [ LMGlobal defVar val , LMGlobal aliasVar (Just aliasVal) ] +aliasify global = pure [global] -- Note [Llvm Forward References] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do -- away with casting the alias to the desired type in @getSymbolPtr@ -- and instead just emit a reference to the definition symbol directly. -- This is the @Just@ case in @getSymbolPtr at . +-- +-- Note that we must take care not to turn LLVM's builtin variables into +-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM. ===================================== rts/Interpreter.c ===================================== @@ -1875,7 +1875,7 @@ run_BCO: int flags = BCO_NEXT; bool interruptible = flags & 0x1; bool unsafe_call = flags & 0x2; - void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); + void(*marshal_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); /* the stack looks like this: @@ -1902,7 +1902,7 @@ run_BCO: #define ROUND_UP_WDS(p) ((((StgWord)(p)) + sizeof(W_)-1)/sizeof(W_)) - ffi_cif *cif = (ffi_cif *)marshall_fn; + ffi_cif *cif = (ffi_cif *)marshal_fn; uint32_t nargs = cif->nargs; uint32_t ret_size; uint32_t i; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e66c9859f0b189fa270e687dd3c4302c1909b9bb...dc62f24ecd1c2b8f3a127845ffdfb8159257fc8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e66c9859f0b189fa270e687dd3c4302c1909b9bb...dc62f24ecd1c2b8f3a127845ffdfb8159257fc8c You're receiving 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 Aug 16 09:59:24 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 16 Aug 2022 05:59:24 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Primop: fix 64-bit shifting primops + add some traces Message-ID: <62fb6a7c43d44_3d81494883c14794ec@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 12d3c118 by Sylvain Henry at 2022-08-16T12:02:06+02:00 Primop: fix 64-bit shifting primops + add some traces - - - - - 2 changed files: - compiler/GHC/StgToJS/Prim.hs - js/arith.js.pp Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -282,10 +282,9 @@ genPrim prof ty op = case op of Int64QuotOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_quotInt64" [h0,l0,h1,l1] Int64RemOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_remInt64" [h0,l0,h1,l1] - Int64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedIShiftL64" [h,l,n] - Int64SraOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedIShiftRA64" [h,l,n] - Int64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRL64" [h,l,n] - -- FIXME: Jeff 06-20222: Is this one right? No h$hs_uncheckedIShiftRL64? + Int64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftLLInt64" [h,l,n] + Int64SraOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRAInt64" [h,l,n] + Int64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRLInt64" [h,l,n] Int64ToWord64Op -> \[r1,r2] [x1,x2] -> PrimInline $ mconcat @@ -328,9 +327,8 @@ genPrim prof ty op = case op of Word64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .!==. h1) (l0 .<=. l1))) Word64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .!==. h1) (l0 .<. l1))) - Word64SllOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedIShiftL64" [h, l, n] - Word64SrlOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftRL64" [h, l, n] - -- FIXME: Jeff 06-20222: Is this one right? No h$hs_uncheckedIShiftRL64? + Word64SllOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftLWord64" [h, l, n] + Word64SrlOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftRWord64" [h, l, n] Word64OrOp -> \[hr,hl] [h0, l0, h1, l1] -> PrimInline $ mconcat ===================================== js/arith.js.pp ===================================== @@ -50,6 +50,7 @@ function h$hs_gtInt64(h1,l1,h2,l2) { } function h$hs_quotWord64(h1,l1,h2,l2) { + TRACE_ARITH("quotWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); // algorithm adapted from Hacker's Delight p198 // if divisor > numerator, just return 0 @@ -96,6 +97,7 @@ function h$hs_quotWord64(h1,l1,h2,l2) { } function h$hs_remWord64(h1,l1,h2,l2) { + TRACE_ARITH("remWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); var qh = h$hs_quotWord64(h1,l1,h2,l2); var ql = h$ret1; var qvh = h$hs_timesWord64(h2,l2,qh,ql); @@ -104,12 +106,14 @@ function h$hs_remWord64(h1,l1,h2,l2) { } function h$hs_timesWord64(h1,l1,h2,l2) { + TRACE_ARITH("timesWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); var rl = UN(l1 * l2); var rh = UN(UN(l2 * h1) + UN(l1 * h2)); RETURN_UBX_TUP2(rh,rl); } function h$hs_minusWord64(h1,l1,h2,l2) { + TRACE_ARITH("minusWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); var b = l2 > l1 ? 1 : 0 var rl = UN(l1 - l2); var rh = UN(UN(h2 - h1) - b); @@ -117,6 +121,7 @@ function h$hs_minusWord64(h1,l1,h2,l2) { } function h$hs_plusWord64(h1,l1,h2,l2) { + TRACE_ARITH("plusWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); var c1 = (l1 & 0x80000000) >>> 31; var c2 = (l2 & 0x80000000) >>> 31; var rl = UN(l1 & 0x7FFFFFFF) + UN(l1 & 0x7FFFFFFF); @@ -129,6 +134,8 @@ function h$hs_plusWord64(h1,l1,h2,l2) { } function h$hs_timesInt64(h1,l1,h2,l2) { + TRACE_ARITH("timesInt64: " + h1 + " " + l1 + " " + h2 + " " + l2); + // check for 0 and 1 operands if (h1 === 0) { if (l1 === 0) { @@ -182,18 +189,24 @@ function h$hs_timesInt64(h1,l1,h2,l2) { } function h$hs_quotInt64(h1,l1,h2,l2) { + TRACE_ARITH("quotInt64: " + h1 + " " + l1 + " " + h2 + " " + l2); + throw "hs_quotInt64 not implemented yet"; //var c = goog.math.Long.fromBits(l1,h1).div(goog.math.Long.fromBits(l2,h2)); //RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); } function h$hs_remInt64(h1,l1,h2,l2) { + TRACE_ARITH("remInt64: " + h1 + " " + l1 + " " + h2 + " " + l2); + throw "hs_remInt64 not implemented yet"; var c = goog.math.Long.fromBits(l1,h1).modulo(goog.math.Long.fromBits(l2,h2)); RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); } function h$hs_plusInt64(h1,l1,h2,l2) { + TRACE_ARITH("plusInt64: " + h1 + " " + l1 + " " + h2 + " " + l2); + const a48 = h1 >>> 16; const a32 = h1 & 0xFFFF; const a16 = l1 >>> 16; @@ -220,6 +233,8 @@ function h$hs_plusInt64(h1,l1,h2,l2) { } function h$hs_minusInt64(h1,l1,h2,l2) { + TRACE_ARITH("minusInt64: " + h1 + " " + l1 + " " + h2 + " " + l2); + // negate arg2 and adds it const nl2 = (~l2 + 1) | 0; const nh2 = (~h2 + !nl2) | 0; @@ -227,6 +242,8 @@ function h$hs_minusInt64(h1,l1,h2,l2) { } function h$hs_leWord64(h1,l1,h2,l2) { + TRACE_ARITH("leWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); + if(h1 === h2) { var l1s = l1 >>> 1; var l2s = l2 >>> 1; @@ -239,6 +256,8 @@ function h$hs_leWord64(h1,l1,h2,l2) { } function h$hs_ltWord64(h1,l1,h2,l2) { + TRACE_ARITH("ltWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); + if(h1 === h2) { var l1s = l1 >>> 1; var l2s = l2 >>> 1; @@ -251,6 +270,8 @@ function h$hs_ltWord64(h1,l1,h2,l2) { } function h$hs_geWord64(h1,l1,h2,l2) { + TRACE_ARITH("geWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); + if(h1 === h2) { var l1s = l1 >>> 1; var l2s = l2 >>> 1; @@ -263,6 +284,8 @@ function h$hs_geWord64(h1,l1,h2,l2) { } function h$hs_gtWord64(h1,l1,h2,l2) { + TRACE_ARITH("gtWord64: " + h1 + " " + l1 + " " + h2 + " " + l2); + if(h1 === h2) { var l1s = l1 >>> 1; var l2s = l2 >>> 1; @@ -274,69 +297,76 @@ function h$hs_gtWord64(h1,l1,h2,l2) { } } -function h$hs_remWord64(h1,l1,h2,l2) { - throw "hs_remWord64 not implemented yet"; - /* var a = h$bigFromWord64(h1,l1); - var b = h$bigFromWord64(h2,l2); - var c = a.mod(b); */ - var r = h$ghcjsbn_rem_bb(h$ghcjsbn_mkBigNat_ww(h1,l1) - ,h$ghcjsbn_mkBigNat_ww(h2,l2)); - return h$ghcjsbn_toWord64_b(r); - // RETURN_UBX_TUP2(c.shiftRight(32).intValue(), c.intValue()); -} +function h$hs_uncheckedShiftLWord64(h,l,n) { + TRACE_ARITH("uncheckedShiftLWord64: " + h + " " + l + " " + n); -function h$hs_uncheckedIShiftL64(h,l,n) { n &= 63; if (n == 0) { RETURN_UBX_TUP2(h,l); + } else if (n === 32) { + RETURN_UBX_TUP2(l,0); + } else if (n < 32) { + RETURN_UBX_TUP2(UN((h << n) | (l >>> (32 - n))), UN(l << n)); } else { - if (n < 32) { - RETURN_UBX_TUP2((h << n) | (l >>> (32 - n)), l << n); - } else { - RETURN_UBX_TUP2(l << (n - 32), 0); - } + RETURN_UBX_TUP2(UN(l << (n - 32)), 0); + } +} + +function h$hs_uncheckedShiftRWord64(h,l,n) { + TRACE_ARITH("uncheckedShiftRWord64 " + h + " " + l + " " + n); + + n &= 63; + if(n == 0) { + RETURN_UBX_TUP2(h, l); + } else if(n === 32) { + RETURN_UBX_TUP2(0, h); + } else if(n < 32) { + RETURN_UBX_TUP2(h >>> n, UN((l >>> n ) | (h << (32-n)))); + } else { + RETURN_UBX_TUP2(0, (h >>> (n-32))); } } -function h$hs_uncheckedIShiftRA64(h,l,n) { +function h$hs_uncheckedShiftLLInt64(h,l,n) { + TRACE_ARITH("uncheckedShiftLLInt64: " + h + " " + l + " " + n); + n &= 63; if (n == 0) { RETURN_UBX_TUP2(h,l); + } else if (n === 32) { + RETURN_UBX_TUP2(l|0,0); + } else if (n < 32) { + RETURN_UBX_TUP2((h << n) | (l >>> (32 - n)), UN(l << n)); } else { - if (n < 32) { - RETURN_UBX_TUP2(h >> n, (l >>> n) | (h << (32 - n))); - } else { - RETURN_UBX_TUP2(h >= 0 ? 0 : -1, h >> (n - 32)); - } + RETURN_UBX_TUP2(l << (n - 32), 0); } } -// always nonnegative n? -function h$hs_uncheckedShiftL64(h1,l1,n) { - TRACE_ARITH("hs_uncheckedShiftL64 " + h1 + " " + l1 + " " + n); +function h$hs_uncheckedShiftRAInt64(h,l,n) { + TRACE_ARITH("uncheckedShiftRAInt64: " + h + " " + l + " " + n); + n &= 63; - TRACE_ARITH("hs_uncheckedShiftL64 n " + n); - if(n == 0) { - TRACE_ARITH("hs_uncheckedShiftL64 zero"); - RETURN_UBX_TUP2(h1, l1); - } else if(n < 32) { - TRACE_ARITH("hs_uncheckedShiftL64 sm32"); - RETURN_UBX_TUP2((h1 << n) | (l1 >>> (32-n)), l1 << n); + if (n == 0) { + RETURN_UBX_TUP2(h,l); + } else if (n < 32) { + RETURN_UBX_TUP2(h >> n, UN((l >>> n) | (h << (32 - n)))); } else { - TRACE_ARITH("hs_uncheckedShiftL64 result " + ((l1 << (n-32))|0) + " " + 0); - RETURN_UBX_TUP2(((l1 << (n-32))|0), 0); + RETURN_UBX_TUP2(h >= 0 ? 0 : -1, UN(h >> (n - 32))); } } -function h$hs_uncheckedShiftRL64(h1,l1,n) { - TRACE_ARITH("hs_uncheckedShiftRL64 " + h1 + " " + l1 + " " + n); +function h$hs_uncheckedShiftRLInt64(h,l,n) { + TRACE_ARITH("uncheckedShiftRLInt64 " + h + " " + l + " " + n); + n &= 63; if(n == 0) { - RETURN_UBX_TUP2(h1, l1); + RETURN_UBX_TUP2(h, l); + } else if(n == 32) { + RETURN_UBX_TUP2(0, h); } else if(n < 32) { - RETURN_UBX_TUP2(h1 >>> n, (l1 >>> n ) | (h1 << (32-n))); + RETURN_UBX_TUP2(h >>> n, UN((l >>> n) | (h << (32-n)))); } else { - RETURN_UBX_TUP2(0, (h1 >>> (n-32))|0); + RETURN_UBX_TUP2(0, (h >>> (n-32))); } } @@ -353,16 +383,12 @@ function h$imul_shim(a, b) { var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim; -// function h$mulInt32(a,b) { -// return goog.math.Long.fromInt(a).multiply(goog.math.Long.fromInt(b)).getLowBits(); -// } -// var hs_mulInt32 = h$mulInt32; - - // Compute product of two Ints. Returns (nh,ch,cl) // where (ch,cl) are the two parts of the 64-bit result // and nh is 0 if ch can be safely dropped (i.e. it's a sign-extension of cl). function h$hs_timesInt2(l1,l2) { + TRACE_ARITH("timesInt2 " + l1 + " " + l2); + // check for 0 and 1 operands if (l1 === 0) { RETURN_UBX_TUP3(0,0,0); @@ -371,10 +397,10 @@ function h$hs_timesInt2(l1,l2) { RETURN_UBX_TUP3(0,0,0); } if (l1 === 1) { - RETURN_UBX_TUP3(0,0,l2); + RETURN_UBX_TUP3(0,l2<0?(-1):0,l2); } if (l2 === 1) { - RETURN_UBX_TUP3(0,0,l1); + RETURN_UBX_TUP3(0,l1<0?(-1):0,l1); } var a16 = l1 >>> 16; @@ -401,11 +427,14 @@ function h$hs_timesInt2(l1,l2) { var ch = (c48 << 16) | c32 var cl = (c16 << 16) | c00 var nh = ((ch === 0 && cl >= 0) || (ch === -1 && cl < 0)) ? 0 : 1 + TRACE_ARITH("timesInt2 results:" + nh + " " + ch + " " + cl); RETURN_UBX_TUP3(nh, ch, cl); } function h$mulWord32(l1,l2) { + TRACE_ARITH("mulWord32 " + l1 + " " + l2); + // check for 0 and 1 operands if (l1 === 0) { return 0; @@ -438,6 +467,8 @@ function h$mulWord32(l1,l2) { } function h$mul2Word32(l1,l2) { + TRACE_ARITH("mul2Word32 " + l1 + " " + l2); + // check for 0 and 1 operands if (l1 === 0) { RETURN_UBX_TUP2(0,0); @@ -476,6 +507,8 @@ function h$mul2Word32(l1,l2) { } function h$quotWord32(n,d) { + TRACE_ARITH("quotWord32 " + n + " " + d); + // from Hacker's Delight book (p 192) // adapted for JavaScript var t = d >> 31; @@ -487,6 +520,8 @@ function h$quotWord32(n,d) { } function h$remWord32(n,d) { + TRACE_ARITH("remWord32 " + n + " " + d); + var t = d >> 31; var n2 = n & ~t; var q = ((n2 >>> 1) / d) << 1; @@ -496,6 +531,8 @@ function h$remWord32(n,d) { } function h$quotRemWord32(n,d) { + TRACE_ARITH("quotRemWord32 " + n + " " + d); + var t = d >> 31; var n2 = n & ~t; var q = ((n2 >>> 1) / d) << 1; @@ -505,6 +542,8 @@ function h$quotRemWord32(n,d) { } function h$quotRem2Word32(nh,nl,d) { + TRACE_ARITH("quotRem2Word32 " + nh + " " + nl + " " + d); + // from Hacker's Delight book (p196) nh = UN(nh); @@ -560,6 +599,8 @@ function h$quotRem2Word32(nh,nl,d) { } function h$wordAdd2(a,b) { + TRACE_ARITH("wordAdd2 " + a + " " + b); + const a16 = a >>> 16; const a00 = a & 0xFFFF; @@ -576,19 +617,6 @@ function h$wordAdd2(a,b) { RETURN_UBX_TUP2(c32, (c16 << 16) | c00); } -// this does an unsigned shift, is that ok? -function h$uncheckedShiftRL64(h1,l1,n) { - if(n < 0) throw "unexpected right shift"; - n &= 63; - if(n == 0) { - RETURN_UBX_TUP2(h1, l1); - } else if(n < 32) { - RETURN_UBX_TUP2((h1 >>> n), (l1 >>> n) | (h1 << (32 - n))); - } else { - RETURN_UBX_TUP2(0, (l1 >>> (n - 32))|0); - } -} - function h$isDoubleNegativeZero(d) { TRACE_ARITH("isDoubleNegativeZero: " + d); return (d===0 && (1/d) === -Infinity) ? 1 : 0; @@ -863,6 +891,7 @@ if(typeof Math.fround === 'function') { } function h$decodeDoubleInt64(d) { + TRACE_ARITH("decodeDoubleInt64: " + d); if(isNaN(d)) { RETURN_UBX_TUP3(972, -1572864, 0); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12d3c118933a9c05eb122d8fa51532e02d17d518 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12d3c118933a9c05eb122d8fa51532e02d17d518 You're receiving 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 Aug 16 10:12:36 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 Aug 2022 06:12:36 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles Message-ID: <62fb6d945b666_3d814948904148478c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 8646dbaa by Simon Peyton Jones at 2022-08-16T11:13:55+01:00 Wibbles - - - - - 3 changed files: - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1380,8 +1380,8 @@ It is easy to see that A nominal reflexive coercion is quite common, so we keep the special form Refl to save allocation. -Note [Coercion selection] -~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [SelCo] +~~~~~~~~~~~~ The Coercion form SelCo allows us to decompose a structural coercion, one between ForallTys, or TyConApps, or FunTys. ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -52,6 +52,7 @@ import GHC.Data.Pair import GHC.Utils.Misc import GHC.Data.Bag import GHC.Utils.Monad +import GHC.Utils.Constants( debugIsOn ) import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) @@ -957,8 +958,14 @@ canEqNC :: CtEvidence -> EqRel -> Type -> Type -> TcS (StopOrContinue Ct) canEqNC ev eq_rel ty1 ty2 = do { result <- zonk_eq_types ty1 ty2 ; case result of - Left (Pair ty1' ty2') -> can_eq_nc False ev eq_rel ty1' ty1 ty2' ty2 - Right ty -> canEqReflexive ev eq_rel ty } + Right ty -> canEqReflexive ev eq_rel ty + Left (Pair ty1' ty2') -> can_eq_nc False ev' eq_rel ty1' ty1' ty2' ty2' + where + ev' | debugIsOn = setCtEvPredType ev $ + mkPrimEqPredRole (eqRelRole eq_rel) ty1' ty2' + | otherwise = ev + -- ev': satisfy the precondition of can_eq_nc + } can_eq_nc :: Bool -- True => both types are rewritten @@ -967,6 +974,11 @@ can_eq_nc -> Type -> Type -- LHS, after and before type-synonym expansion, resp -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- Precondition: in DEBUG mode, the `ctev_pred` of `ev` is (ps_ty1 ~# ps_ty2), +-- without zonking +-- This precondition is needed (only in DEBUG) to satisfy the assertions +-- in mkSelCo, called in canDecomposableTyConAppOK and canDecomposableFunTy + can_eq_nc rewritten ev eq_rel ty1 ps_ty1 ty2 ps_ty2 = do { traceTcS "can_eq_nc" $ vcat [ ppr rewritten, ppr ev, ppr eq_rel, ppr ty1, ppr ps_ty1, ppr ty2, ppr ps_ty2 ] @@ -1948,7 +1960,7 @@ canDecomposableFunTy ev eq_rel f1@(m1,a1,r1) f2@(m2,a2,r2) , evCoercion $ mkSelCo role' (SelFun fs) ev_co ) | (fs, ty1, ty2) <- [(SelMult, m1, m2) ,(SelArg, a1, a2) - ,(SelRes, r2, r2)] + ,(SelRes, r1, r2)] , let role' = funRole role fs ] ; emitWorkNC given_evs } ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1926,23 +1926,17 @@ arisesFromGivens ct = isGivenCt ct || isGivenLoc (ctLoc ct) -- the evidence and the ctev_pred in sync with each other. -- See Note [CtEvidence invariants]. setCtEvPredType :: HasDebugCallStack => CtEvidence -> Type -> CtEvidence -setCtEvPredType old_ctev new_pred - = case old_ctev of - CtGiven { ctev_evar = ev, ctev_loc = loc } -> - CtGiven { ctev_pred = new_pred - , ctev_evar = setVarType ev new_pred - , ctev_loc = loc - } - CtWanted { ctev_dest = dest, ctev_loc = loc, ctev_rewriters = rewriters } -> - CtWanted { ctev_pred = new_pred - , ctev_dest = new_dest - , ctev_loc = loc - , ctev_rewriters = rewriters - } - where - new_dest = case dest of - EvVarDest ev -> EvVarDest (setVarType ev new_pred) - HoleDest h -> HoleDest (setCoHoleType h new_pred) +setCtEvPredType old_ctev@(CtGiven { ctev_evar = ev }) new_pred + = old_ctev { ctev_pred = new_pred + , ctev_evar = setVarType ev new_pred } + +setCtEvPredType old_ctev@(CtWanted { ctev_dest = dest }) new_pred + = old_ctev { ctev_pred = new_pred + , ctev_dest = new_dest } + where + new_dest = case dest of + EvVarDest ev -> EvVarDest (setVarType ev new_pred) + HoleDest h -> HoleDest (setCoHoleType h new_pred) instance Outputable TcEvDest where ppr (HoleDest h) = text "hole" <> ppr h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8646dbaaace379583741ca5bed180981ac78e45d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8646dbaaace379583741ca5bed180981ac78e45d You're receiving 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 Aug 16 10:19:57 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 Aug 2022 06:19:57 -0400 Subject: [Git][ghc/ghc][wip/andreask/rules-omit-fix] Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Message-ID: <62fb6f4d76285_3d8149489a414869c4@gitlab.mail> Matthew Pickering pushed to branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC Commits: 28ba4f3d by Andreas Klebinger at 2022-08-16T11:19:38+01:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 3 changed files: - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1048,7 +1048,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28ba4f3d488ff70f46dab0272bc597995bb387f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28ba4f3d488ff70f46dab0272bc597995bb387f1 You're receiving 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 Aug 16 10:55:11 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 Aug 2022 06:55:11 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.4 Message-ID: <62fb778fbbb5e_3d8149488dc150679b@gitlab.mail> Matthew Pickering deleted branch wip/backports-9.4 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 Aug 16 10:55:18 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 Aug 2022 06:55:18 -0400 Subject: [Git][ghc/ghc][ghc-9.4] 19 commits: users-guide: Fix typo in release notes Message-ID: <62fb77967273e_3d8149489a415069fc@gitlab.mail> Matthew Pickering pushed to branch ghc-9.4 at Glasgow Haskell Compiler / GHC Commits: 2441c2f4 by Ben Gamari at 2022-08-12T09:44:50-04:00 users-guide: Fix typo in release notes - - - - - dae00493 by Ben Gamari at 2022-08-12T09:44:50-04:00 users-guide: Fix incorrect directives - - - - - ddd0a67f by Ben Gamari at 2022-08-12T09:44:50-04:00 relnotes: Reintroduce "included libraries" section As requested in #21988. - - - - - 05a86964 by Ben Gamari at 2022-08-12T09:44:50-04:00 make: Fix bootstrapping with profiling enabled 12ae2a9cf89af3ae9e4df051818b631cf213a1b8 attempted to work around a make build system deficiency by adding some dependencies from modules of `containers` which contain TH splices to the `template-haskell` package. However, it only did this for the vanilla way. Here we add similar edges for profiled objects. Fixes #21987. - - - - - 05eef6e2 by Ben Gamari at 2022-08-15T17:03:18-04:00 make: Add another missing build dependency on template-haskell This time the culprit is Data.Sequence.Internal. Closes #22047. - - - - - c2043b0a by normalcoder at 2022-08-15T17:11:26-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms (cherry picked from commit 67575f2004340564d6e52af055ed6fb43d3f9711) - - - - - 44b60e03 by Ben Gamari at 2022-08-15T17:11:26-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. (cherry picked from commit c1c08bd829fb33a185f0a71f08babe5d7e6556fc) - - - - - 658d3fd5 by Ben Gamari at 2022-08-15T17:11:26-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. (cherry picked from commit 1c582f44e41f534a8506a76618f6cffe5d71ed42) - - - - - e2832cbd by Ben Gamari at 2022-08-15T17:11:26-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. (cherry picked from commit 681aa076259c05c626266cf516de7e7c5524eadb) - - - - - cdf69083 by Ben Gamari at 2022-08-15T17:11:26-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. (cherry picked from commit 844df61e8de5e2d9a058e6cbe388802755fc0305) (cherry picked from commit d8961a2dc974b7f8f8752781c4aec261ae8f8c0f) - - - - - 4f1e1a30 by Ben Gamari at 2022-08-15T17:11:26-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt (cherry picked from commit 5d66a0ce39f47b7b9f6c732a18ac6e102a21ee6b) - - - - - 573569d5 by Ben Gamari at 2022-08-15T17:11:26-04:00 gitlab-ci: Bump to use freebsd13 runners (cherry picked from commit ea90e61dc3c6ba0433e008284dc6c3970ead98a7) - - - - - 12244700 by Douglas Wilson at 2022-08-15T17:11:26-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. (cherry picked from commit 76b52cf0c52ee05c20f7d1b80f5600eecab3c42a) - - - - - feceab56 by Douglas Wilson at 2022-08-15T17:11:26-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. (cherry picked from commit 7589ee7241d46b393979d98d4ded17a15ee974fb) - - - - - 088071e5 by Jens Petersen at 2022-08-15T17:11:26-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally (cherry picked from commit 823fe5b56450a7eefbf41ce8ece34095bf2217ee) - - - - - f7322f2a by Ben Gamari at 2022-08-15T17:11:26-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. (cherry picked from commit 7cabea7c9b10d2d15a4798be9f3130994393dd9c) - - - - - a77c7462 by Ben Gamari at 2022-08-15T17:11:26-04:00 relnotes: Fix typo - - - - - d87e0545 by Matthew Pickering at 2022-08-15T17:11:27-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 (cherry picked from commit ef30e21594e44af309c627052f63aea6fd575c9e) - - - - - 0bea62ff by Ben Gamari at 2022-08-15T17:11:27-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - 27 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Driver/Make.hs - docs/users_guide/9.4.1-notes.rst - ghc.mk - hadrian/bindist/Makefile - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/changelog.md - m4/fp_find_cxx_std_lib.m4 - + mk/install_script.sh - rts/Linker.c - + testsuite/tests/concurrent/should_run/T21651.hs - + testsuite/tests/concurrent/should_run/T21651.stdout - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/driver/T20316.stdout - + testsuite/tests/driver/T21866.hs - + testsuite/tests/driver/T21866.stderr - testsuite/tests/driver/all.T - testsuite/tests/driver/recomp007/recomp007.stdout - testsuite/tests/driver/retc001/retc001.stdout - testsuite/tests/indexed-types/should_compile/impexp.stderr - testsuite/tests/typecheck/should_fail/T6018fail.stderr Changes: ===================================== .gitlab/ci.sh ===================================== @@ -206,6 +206,9 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" + if [ "$(uname)" = "FreeBSD" ]; then + GHC=/usr/local/bin/ghc + fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -287,7 +290,7 @@ function fetch_ghc() { cp -r ghc-${GHC_VERSION}*/* "$toolchain" ;; *) - pushd "ghc-${GHC_VERSION}*" + pushd ghc-${GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd @@ -325,9 +328,7 @@ function fetch_cabal() { local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" case "$(uname)" in Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; - FreeBSD) - #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; - cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + FreeBSD) cabal_url="$base_url/cabal-install-$v-x86_64-freebsd13.tar.xz" ;; *) fail "don't know where to fetch cabal-install for $(uname)" esac echo "Fetching cabal-install from $cabal_url" ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -85,7 +85,6 @@ pkgs.writeTextFile { export PATH PATH="${pkgs.autoconf}/bin:$PATH" PATH="${pkgs.automake}/bin:$PATH" - PATH="${pkgs.coreutils}/bin:$PATH" export FONTCONFIG_FILE=${fonts} export XELATEX="${ourtexlive}/bin/xelatex" export MAKEINDEX="${ourtexlive}/bin/makeindex" ===================================== .gitlab/gen_ci.hs ===================================== @@ -92,7 +92,7 @@ names of jobs to update these other places. data Opsys = Linux LinuxDistro | Darwin - | FreeBSD + | FreeBSD13 | Windows deriving (Eq) data LinuxDistro @@ -210,7 +210,7 @@ runnerTag arch (Linux distro) = runnerTag AArch64 Darwin = "aarch64-darwin" runnerTag Amd64 Darwin = "x86_64-darwin-m1" runnerTag Amd64 Windows = "new-x86_64-windows" -runnerTag Amd64 FreeBSD = "x86_64-freebsd" +runnerTag Amd64 FreeBSD13 = "x86_64-freebsd13" tags :: Arch -> Opsys -> BuildConfig -> [String] tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use @@ -229,7 +229,7 @@ distroName Alpine = "alpine3_12" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro opsysName Darwin = "darwin" -opsysName FreeBSD = "freebsd" +opsysName FreeBSD13 = "freebsd13" opsysName Windows = "windows" archName :: Arch -> String @@ -299,7 +299,7 @@ type Variables = M.MonoidalMap String [String] a =: b = M.singleton a [b] opsysVariables :: Arch -> Opsys -> Variables -opsysVariables _ FreeBSD = mconcat +opsysVariables _ FreeBSD13 = mconcat [ -- N.B. we use iconv from ports as I see linker errors when we attempt -- to use the "native" iconv embedded in libc as suggested by the -- porting guide [1]. @@ -307,7 +307,7 @@ opsysVariables _ FreeBSD = mconcat "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" , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "GHC_VERSION" =: "9.2.2" - , "CABAL_INSTALL_VERSION" =: "3.2.0.0" + , "CABAL_INSTALL_VERSION" =: "3.6.2.0" ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> @@ -475,12 +475,12 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set - | ReleaseOnly -- ^ Only run this job in a release pipeline - | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDTag -- ^ Only run this job when the "FreeBSD" label is set. - | Disable -- ^ Don't run this job. +data Rule = FastCI -- ^ Run this job when the fast-ci label is set + | ReleaseOnly -- ^ Only run this job in a release pipeline + | Nightly -- ^ Only run this job in the nightly pipeline + | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the @@ -498,8 +498,8 @@ ruleString On FastCI = true ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true -ruleString On FreeBSDTag = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDTag = true +ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +ruleString Off FreeBSDLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -766,7 +766,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , fastCI (standardBuilds Amd64 Windows) , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDTag (standardBuilds Amd64 FreeBSD)) + , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) ===================================== .gitlab/jobs.yaml ===================================== @@ -541,7 +541,7 @@ "ac_cv_func_utimensat": "no" } }, - "nightly-x86_64-freebsd-validate": { + "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -551,7 +551,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -560,7 +560,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -588,17 +588,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate", + "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } }, @@ -2050,7 +2050,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd-release": { + "release-x86_64-freebsd13-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2060,7 +2060,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd-release.tar.xz", + "ghc-x86_64-freebsd13-release.tar.xz", "junit.xml" ], "reports": { @@ -2069,7 +2069,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -2097,18 +2097,18 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release", "BUILD_FLAVOUR": "release", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "x86_64-freebsd-release", + "TEST_ENV": "x86_64-freebsd13-release", "XZ_OPT": "-9" } }, @@ -2970,7 +2970,7 @@ "ac_cv_func_utimensat": "no" } }, - "x86_64-freebsd-validate": { + "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2980,7 +2980,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-freebsd-validate.tar.xz", + "ghc-x86_64-freebsd13-validate.tar.xz", "junit.xml" ], "reports": { @@ -2989,7 +2989,7 @@ "when": "always" }, "cache": { - "key": "x86_64-freebsd-$CACHE_REV", + "key": "x86_64-freebsd13-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" @@ -3017,17 +3017,17 @@ ], "stage": "full-build", "tags": [ - "x86_64-freebsd" + "x86_64-freebsd13" ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd-validate", + "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", - "CABAL_INSTALL_VERSION": "3.2.0.0", + "CABAL_INSTALL_VERSION": "3.6.2.0", "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.2.2", "HADRIAN_ARGS": "--docs=no-sphinx", - "TEST_ENV": "x86_64-freebsd-validate" + "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-int_native-validate+fully_static": { ===================================== compiler/CodeGen.Platform.h ===================================== @@ -926,6 +926,14 @@ freeReg 29 = False -- ip0 -- used for spill offset computations freeReg 16 = False +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- x18 is reserved by the platform on Darwin/iOS, and can not be used +-- More about ARM64 ABI that Apple platforms support: +-- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms +-- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +freeReg 18 = False +#endif + # if defined(REG_Base) freeReg REG_Base = False # endif ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -299,7 +299,7 @@ linkNodes summaries uid hue = in if | ghcLink dflags == LinkBinary && isJust ofile && not do_linking -> Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags)) -- This should be an error, not a warning (#10895). - | do_linking -> Just (Right (LinkNode unit_nodes uid)) + | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid)) | otherwise -> Nothing -- Note [Missing home modules] ===================================== docs/users_guide/9.4.1-notes.rst ===================================== @@ -31,7 +31,7 @@ upgrading to GHC 9.4: and are deprecated, having been superceded by the now levity-polymorphic ``Array#`` type. -- The type equality operator, ``(~)``, is not considered to be a type operator +- The type equality operator, ``(~)``, is now considered to be a type operator (exported from ``Prelude``) and therefore requires the enabling of the :extension:`TypeOperators` extension rather than :extension:`GADTs` or :extension:`TypeFamilies` as was sufficient previously. @@ -62,7 +62,7 @@ Language - GHC Proposal `#511 `_ has been implemented, introducing a new language extension, - :lang-ext:`DeepSubsumption`. This extension allows the user + :extension:`DeepSubsumption`. This extension allows the user to opt-in to the deep type subsumption-checking behavior implemented by GHC 8.10 and earlier. @@ -104,7 +104,7 @@ Language - GHC Proposal `#302 `_ has been implemented. This means under ``-XLambdaCase``, a new expression heralded by ``\cases`` is available, which works like ``\case`` but can match on multiple patterns. - This means constructor patterns with arguments have to parenthesized here, + This means constructor patterns with arguments have to be parenthesized here, just like in lambda expressions. - The parsing of implicit parameters is slightly more permissive, as GHC now allows :: @@ -283,7 +283,7 @@ Runtime system ~~~~~~~~~~~~~~~~ - ``GHC.Generics`` now provides a set of newtypes, ``Generically`` and - ``Generically1``, for deriving generic instances via :lang-ext:`DerivingVia`. + ``Generically1``, for deriving generic instances via :extension:`DerivingVia`. ``Generically`` instances include ``Semigroup`` and ``Monoid``. - There's a new special function ``withDict`` in ``GHC.Exts``: :: @@ -513,3 +513,50 @@ Runtime system - The ``link`` field of ``GHC.Exts.Heap.WeakClosure`` has been replaced with a ``weakLink`` field which is ``Nothing`` if and only if ``link`` would have been NULL. + + +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 + ===================================== ghc.mk ===================================== @@ -509,6 +509,13 @@ libraries/containers/containers/dist-install/build/Data/IntMap/Internal.o: libra libraries/containers/containers/dist-install/build/Data/Graph.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi libraries/containers/containers/dist-install/build/Data/Set/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi libraries/containers/containers/dist-install/build/Data/IntSet/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi +libraries/containers/containers/dist-install/build/Data/Sequence/Internal.o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.hi + +libraries/containers/containers/dist-install/build/Data/IntMap/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Graph.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Set/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/IntSet/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi +libraries/containers/containers/dist-install/build/Data/Sequence/Internal.p_o: libraries/template-haskell/dist-install/build/Language/Haskell/TH/Lib/Internal.p_hi ifeq "$(BIGNUM_BACKEND)" "gmp" GMP_ENABLED = YES ===================================== hadrian/bindist/Makefile ===================================== @@ -22,43 +22,6 @@ ifeq "$(Darwin_Host)" "YES" XATTR ?= /usr/bin/xattr endif -# installscript -# -# $1 = package name -# $2 = wrapper path -# $3 = bindir -# $4 = ghcbindir -# $5 = Executable binary path -# $6 = Library Directory -# $7 = Docs Directory -# $8 = Includes Directory -# We are installing wrappers to programs by searching corresponding -# wrappers. If wrapper is not found, we are attaching the common wrapper -# to it. This implementation is a bit hacky and depends on consistency -# of program names. For hadrian build this will work as programs have a -# consistent naming procedure. -define installscript - echo "installscript $1 -> $2" - @if [ -L 'wrappers/$1' ]; then \ - $(CP) -P 'wrappers/$1' '$2' ; \ - else \ - rm -f '$2' && \ - $(CREATE_SCRIPT) '$2' && \ - echo "#!$(SHELL)" >> '$2' && \ - echo "exedir=\"$4\"" >> '$2' && \ - echo "exeprog=\"$1\"" >> '$2' && \ - echo "executablename=\"$5\"" >> '$2' && \ - echo "bindir=\"$3\"" >> '$2' && \ - echo "libdir=\"$6\"" >> '$2' && \ - echo "docdir=\"$7\"" >> '$2' && \ - echo "includedir=\"$8\"" >> '$2' && \ - echo "" >> '$2' && \ - cat 'wrappers/$1' >> '$2' && \ - $(EXECUTABLE_FILE) '$2' ; \ - fi - @echo "$1 installed to $2" -endef - # patchpackageconf # # Hacky function to patch up the 'haddock-interfaces' and 'haddock-html' @@ -82,6 +45,8 @@ define patchpackageconf \ ((echo "$1" | grep rts) && (cat '$2.copy' | sed 's|haddock-.*||' > '$2.copy.copy')) || (cat '$2.copy' > '$2.copy.copy') # We finally replace the original file. mv '$2.copy.copy' '$2' + # Fix the mode, in case umask is set + chmod 644 '$2' endef # QUESTION : should we use shell commands? @@ -216,10 +181,12 @@ install_lib: lib/settings install_docs: @echo "Copying docs to $(DESTDIR)$(docdir)" $(INSTALL_DIR) "$(DESTDIR)$(docdir)" - cd doc; $(FIND) . -type f -exec sh -c \ - '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && \ - $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`" \ - ' sh '{}' \; + + if [ -d doc ]; then \ + cd doc; $(FIND) . -type f -exec sh -c \ + '$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \ + sh '{}' ';'; \ + fi if [ -d docs-utils ]; then \ $(INSTALL_DIR) "$(DESTDIR)$(docdir)/html/libraries/"; \ @@ -227,12 +194,13 @@ install_docs: $(INSTALL_SCRIPT) docs-utils/gen_contents_index "$(DESTDIR)$(docdir)/html/libraries/"; \ fi -BINARY_NAMES=$(shell ls ./wrappers/) +export SHELL install_wrappers: install_bin_libdir @echo "Installing wrapper scripts" $(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)" - $(foreach p, $(BINARY_NAMES),\ - $(call installscript,$p,$(DESTDIR)$(WrapperBinsDir)/$p,$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,$(ActualLibsDir),$(docdir),$(includedir))) + for p in `cd wrappers; $(FIND) . ! -type d`; do \ + mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \ + done PKG_CONFS = $(shell find "$(DESTDIR)$(ActualLibsDir)/package.conf.d" -name '*.conf' | sed "s: :\0xxx\0:g") update_package_db: install_bin install_lib ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -349,6 +349,7 @@ bindistInstallFiles = , "mk" -/- "config.mk.in", "mk" -/- "install.mk.in", "mk" -/- "project.mk" , "mk" -/- "relpath.sh" , "mk" -/- "system-cxx-std-lib-1.0.conf.in" + , "mk" -/- "install_script.sh" , "README", "INSTALL" ] -- | This auxiliary function gives us a top-level 'Filepath' that we can 'need' ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -278,6 +278,7 @@ runTestBuilderArgs = builder Testsuite ? do where emitWhenSet Nothing _ = mempty emitWhenSet (Just v) f = f v + stageNumber :: Stage -> Int stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot" stageNumber (Stage0 InTreeLibs) = 1 stageNumber Stage1 = 2 ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Event.Thread -- TODO: Use new Windows I/O manager import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicWriteIORef) import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) @@ -29,7 +29,8 @@ import GHC.List (zipWith, zipWith3) import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO, labelThread, modifyMVar_, withMVar, newTVar, sharedCAF, getNumCapabilities, threadCapability, myThreadId, forkOn, - threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM) + threadStatus, writeTVar, newTVarIO, readTVar, retry, + throwSTM, STM, yield) import GHC.IO (mask_, uninterruptibleMask_, onException) import GHC.IO.Exception (ioError) import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray, @@ -41,6 +42,7 @@ import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop, new, registerFd, unregisterFd_) import qualified GHC.Event.Manager as M import qualified GHC.Event.TimerManager as TM +import GHC.Ix (inRange) import GHC.Num ((-), (+)) import GHC.Real (fromIntegral) import GHC.Show (showSignedInt) @@ -98,22 +100,44 @@ threadWaitWrite = threadWait evtWrite closeFdWith :: (Fd -> IO ()) -- ^ Action that performs the close. -> Fd -- ^ File descriptor to close. -> IO () -closeFdWith close fd = do - eventManagerArray <- readIORef eventManager - let (low, high) = boundsIOArray eventManagerArray - mgrs <- flip mapM [low..high] $ \i -> do - Just (_,!mgr) <- readIOArray eventManagerArray i - return mgr - -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. - -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have - -- to use uninterruptible mask. - uninterruptibleMask_ $ do - tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd - cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables - close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) +closeFdWith close fd = close_loop where finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp zipWithM f xs ys = sequence (zipWith f xs ys) + -- The array inside 'eventManager' can be swapped out at any time, see + -- 'ioManagerCapabilitiesChanged'. See #21651. We detect this case by + -- checking the array bounds before and after. When such a swap has + -- happened we cleanup and try again + close_loop = do + eventManagerArray <- readIORef eventManager + let ema_bounds@(low, high) = boundsIOArray eventManagerArray + mgrs <- flip mapM [low..high] $ \i -> do + Just (_,!mgr) <- readIOArray eventManagerArray i + return mgr + + -- 'takeMVar', and 'M.closeFd_' might block, although for a very short time. + -- To make 'closeFdWith' safe in presence of asynchronous exceptions we have + -- to use uninterruptible mask. + join $ uninterruptibleMask_ $ do + tables <- flip mapM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd + new_ema_bounds <- boundsIOArray `fmap` readIORef eventManager + -- Here we exploit Note [The eventManager Array] + if new_ema_bounds /= ema_bounds + then do + -- the array has been modified. + -- mgrs still holds the right EventManagers, by the Note. + -- new_ema_bounds must be larger than ema_bounds, by the note. + -- return the MVars we took and try again + sequence_ $ zipWith (\mgr table -> finish mgr table (pure ())) mgrs tables + pure close_loop + else do + -- We surely have taken all the appropriate MVars. Even if the array + -- has been swapped, our mgrs is still correct. + -- Remove the Fd from all callback tables, close the Fd, and run all + -- callbacks. + cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables + close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps) + pure (pure ()) threadWait :: Event -> Fd -> IO () threadWait evt fd = mask_ $ do @@ -177,10 +201,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite getSystemEventManager :: IO (Maybe EventManager) getSystemEventManager = do t <- myThreadId - (cap, _) <- threadCapability t eventManagerArray <- readIORef eventManager - mmgr <- readIOArray eventManagerArray cap - return $ fmap snd mmgr + let r = boundsIOArray eventManagerArray + (cap, _) <- threadCapability t + -- It is possible that we've just increased the number of capabilities and the + -- new EventManager has not yet been constructed by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- Two options to proceed: + -- 1) return the EventManager for capability 0. This is guaranteed to exist, + -- and "shouldn't" cause any correctness issues. + -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, + -- because we must be on a brand capability and there must be a call to + -- 'ioManagerCapabilitiesChanged' pending. + -- + -- We take the second option, with the yield, judging it the most robust. + if not (inRange r cap) + then yield >> getSystemEventManager + else fmap snd `fmap` readIOArray eventManagerArray cap getSystemEventManager_ :: IO EventManager getSystemEventManager_ = do @@ -191,6 +229,22 @@ getSystemEventManager_ = do foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) +-- Note [The eventManager Array] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A mutable array holding the current EventManager for each capability +-- An entry is Nothing only while the eventmanagers are initialised, see +-- 'startIOManagerThread' and 'ioManagerCapabilitiesChanged'. +-- The 'ThreadId' at array position 'cap' will have been 'forkOn'ed capabality +-- 'cap'. +-- The array will be swapped with newer arrays when the number of capabilities +-- changes(via 'setNumCapabilities'). However: +-- * the size of the arrays will never decrease; and +-- * The 'EventManager's in the array are not replaced with other +-- 'EventManager' constructors. +-- +-- This is a similar strategy as the rts uses for it's +-- capabilities array (n_capabilities is the size of the array, +-- enabled_capabilities' is the number of active capabilities). eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager))) eventManager = unsafePerformIO $ do numCaps <- getNumCapabilities @@ -351,7 +405,9 @@ ioManagerCapabilitiesChanged = startIOManagerThread new_eventManagerArray -- update the event manager array reference: - writeIORef eventManager new_eventManagerArray + atomicWriteIORef eventManager new_eventManagerArray + -- We need an atomic write here because 'eventManager' is accessed + -- unsynchronized in 'getSystemEventManager' and 'closeFdWith' else when (new_n_caps > numEnabled) $ forM_ [numEnabled..new_n_caps-1] $ \i -> do Just (_,mgr) <- readIOArray eventManagerArray i ===================================== libraries/base/changelog.md ===================================== @@ -77,6 +77,21 @@ `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these were rather represented by `Word#` and `Int#`. See GHC #11953. +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes ## 4.16.1.0 *Feb 2022* ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -18,10 +18,44 @@ unknown #endif EOF AC_MSG_CHECKING([C++ standard library flavour]) - if "$CXX" -E actest.cpp -o actest.out; then - if grep "libc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="c++ c++abi" - p="`"$CXX" --print-file-name libc++.so`" + if ! "$CXX" -E actest.cpp -o actest.out; then + rm -f actest.cpp actest.out + AC_MSG_ERROR([Failed to compile test program]) + fi + + dnl Identify standard library type + if grep "libc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="c++" + AC_MSG_RESULT([libc++]) + elif grep "libstdc++" actest.out >/dev/null; then + CXX_STD_LIB_FLAVOUR="stdc++" + AC_MSG_RESULT([libstdc++]) + else + rm -f actest.cpp actest.out + AC_MSG_ERROR([Unknown C++ standard library implementation.]) + fi + rm -f actest.cpp actest.out + + dnl ----------------------------------------- + dnl Figure out how to link... + dnl ----------------------------------------- + cat >actest.cpp <<-EOF +#include +int main(int argc, char** argv) { + std::cout << "hello world\n"; + return 0; +} +EOF + if ! "$CXX" -c actest.cpp; then + AC_MSG_ERROR([Failed to compile test object]) + fi + + try_libs() { + dnl Try to link a plain object with CC manually + AC_MSG_CHECKING([for linkage against '${3}']) + if "$CC" -o actest actest.o ${1} 2>/dev/null; then + CXX_STD_LIB_LIBS="${3}" + p="`"$CXX" --print-file-name ${2}`" d="`dirname "$p"`" dnl On some platforms (e.g. Windows) the C++ standard library dnl can be found in the system search path. In this case $CXX @@ -31,24 +65,25 @@ EOF if test "$d" = "."; then d=""; fi CXX_STD_LIB_LIB_DIRS="$d" CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libc++]) - elif grep "libstdc++" actest.out >/dev/null; then - CXX_STD_LIB_LIBS="stdc++" - p="`"$CXX" --print-file-name libstdc++.so`" - d="`dirname "$p"`" - if test "$d" = "."; then d=""; fi - CXX_STD_LIB_LIB_DIRS="$d" - CXX_STD_LIB_DYN_LIB_DIRS="$d" - AC_MSG_RESULT([libstdc++]) + AC_MSG_RESULT([success]) + true else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Unknown C++ standard library implementation.]) + AC_MSG_RESULT([failed]) + false fi - rm -f actest.cpp actest.out - else - rm -f actest.cpp actest.out - AC_MSG_ERROR([Failed to compile test program]) - fi + } + case $CXX_STD_LIB_FLAVOUR in + c++) + try_libs "-lc++ -lc++abi" "libc++.so" "c++ c++abi" || \ + try_libs "-lc++ -lcxxrt" "libc++.so" "c++ cxxrt" || + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + stdc++) + try_libs "-lstdc++" "libstdc++.so" "stdc++" || \ + try_libs "-lstdc++ -lsupc++" "libstdc++.so" "stdc++ supc++" || \ + AC_MSG_ERROR([Failed to find C++ standard library]) ;; + esac + + rm -f actest.cpp actest.o actest fi AC_SUBST([CXX_STD_LIB_LIBS]) ===================================== mk/install_script.sh ===================================== @@ -0,0 +1,34 @@ +#!/bin/sh + +# $1 = executable name +# $2 = wrapper path +# $3 = bindir +# $4 = ghcbindir +# $5 = Executable binary path +# $6 = Library Directory +# $7 = Docs Directory +# $8 = Includes Directory +# We are installing wrappers to programs by searching corresponding +# wrappers. If wrapper is not found, we are attaching the common wrapper +# to it. This implementation is a bit hacky and depends on consistency +# of program names. For hadrian build this will work as programs have a +# consistent naming procedure. + +echo "Installing $1 -> $2" +if [ -L "wrappers/$1" ]; then + cp -RP "wrappers/$1" "$2" +else + rm -f "$2" && + touch "$2" && + echo "#!$SHELL" >> "$2" && + echo "exedir=\"$4\"" >> "$2" && + echo "exeprog=\"$1\"" >> "$2" && + echo "executablename=\"$5\"" >> "$2" && + echo "bindir=\"$3\"" >> "$2" && + echo "libdir=\"$6\"" >> "$2" && + echo "docdir=\"$7\"" >> "$2" && + echo "includedir=\"$8\"" >> "$2" && + echo "" >> "$2" && + cat "wrappers/$1" >> "$2" && + chmod 755 "$2" +fi ===================================== rts/Linker.c ===================================== @@ -80,6 +80,33 @@ #if defined(dragonfly_HOST_OS) #include #endif + +/* + * Note [iconv and FreeBSD] + * ~~~~~~~~~~~~~~~~~~~~~~~~ + * + * On FreeBSD libc.so provides an implementation of the iconv_* family of + * functions. However, due to their implementation, these symbols cannot be + * resolved via dlsym(); rather, they can only be resolved using the + * explicitly-versioned dlvsym(). + * + * This is problematic for the RTS linker since we may be asked to load + * an object that depends upon iconv. To handle this we include a set of + * fallback cases for these functions, allowing us to resolve them to the + * symbols provided by the libc against which the RTS is linked. + * + * See #20354. + */ + +#if defined(freebsd_HOST_OS) +extern void iconvctl(); +extern void iconv_open_into(); +extern void iconv_open(); +extern void iconv_close(); +extern void iconv_canonicalize(); +extern void iconv(); +#endif + /* Note [runtime-linker-support] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -637,6 +664,10 @@ internal_dlsym(const char *symbol) { } RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in special cases\n", symbol)); +# define SPECIAL_SYMBOL(sym) \ + if (strcmp(symbol, #sym) == 0) return (void*)&sym; + # if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) // HACK: GLIBC implements these functions with a great deal of trickery where // they are either inlined at compile time to their corresponding @@ -646,18 +677,28 @@ internal_dlsym(const char *symbol) { // We borrow the approach that the LLVM JIT uses to resolve these // symbols. See http://llvm.org/PR274 and #7072 for more info. - IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + SPECIAL_SYMBOL(stat); + SPECIAL_SYMBOL(fstat); + SPECIAL_SYMBOL(lstat); + SPECIAL_SYMBOL(stat64); + SPECIAL_SYMBOL(fstat64); + SPECIAL_SYMBOL(lstat64); + SPECIAL_SYMBOL(atexit); + SPECIAL_SYMBOL(mknod); +# endif - if (strcmp(symbol, "stat") == 0) return (void*)&stat; - if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; - if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; - if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; - if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; - if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; - if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; - if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; + // See Note [iconv and FreeBSD] +# if defined(freebsd_HOST_OS) + SPECIAL_SYMBOL(iconvctl); + SPECIAL_SYMBOL(iconv_open_into); + SPECIAL_SYMBOL(iconv_open); + SPECIAL_SYMBOL(iconv_close); + SPECIAL_SYMBOL(iconv_canonicalize); + SPECIAL_SYMBOL(iconv); # endif +#undef SPECIAL_SYMBOL + // we failed to find the symbol return NULL; } ===================================== testsuite/tests/concurrent/should_run/T21651.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test is adapted from setnumcapabilities001. + +import GHC.Conc hiding (threadWaitRead, threadWaitWrite) +import GHC.Exts +import GHC.IO.Encoding +import System.Environment +import System.IO +import Control.Monad +import Text.Printf +import Data.Time.Clock +import Control.DeepSeq + +import System.Posix.IO +import System.Posix.Types +import Control.Concurrent +import Control.Exception + +passTheParcel :: Int -> IO (IO ()) +passTheParcel n = do + pipes@(p1 : rest) <- forM [0..n-1] $ \_ -> createPipe + rs@((_,tid1) : _) <- forM (pipes `zip` (rest ++ [p1])) $ \((readfd, _), (_, writefd)) -> do + let + read = fdRead readfd $ fromIntegral 1 + write = fdWrite writefd + mv <- newEmptyMVar + tid <- forkIO $ let + loop = flip catch (\(x :: IOException) -> pure ()) $ forever $ do + threadWaitRead readfd + (s, _) <- read + threadWaitWrite writefd + write s + cleanup = do + closeFdWith closeFd readfd + closeFdWith closeFd writefd + putMVar mv () + in loop `finally` cleanup + pure (mv, tid) + + let + cleanup = do + killThread tid1 + forM_ rs $ \(mv, _) -> takeMVar mv + + fdWrite (snd p1) "a" + pure cleanup + + +main = do + setLocaleEncoding latin1 -- fdRead and fdWrite depend on the current locale + [n,q,t,z] <- fmap (fmap read) getArgs + cleanup_ptp <- passTheParcel z + t <- forkIO $ do + forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do + setNumCapabilities m + threadDelay t + printf "%d\n" (nqueens q) + cleanup_ptp + killThread t + -- If we don't kill the child thread, it might be about to + -- call setNumCapabilities() in C when the main thread exits, + -- and chaos can ensue. See #12038 + +nqueens :: Int -> Int +nqueens nq = length (pargen 0 []) + where + safe :: Int -> Int -> [Int] -> Bool + safe x d [] = True + safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l + + gen :: [[Int]] -> [[Int]] + gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] + + pargen :: Int -> [Int] -> [[Int]] + pargen n b + | n >= threshold = iterate gen [b] !! (nq - n) + | otherwise = concat bs + where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq + + threshold = 3 + +using :: a -> Strategy a -> a +x `using` strat = runEval (strat x) + +type Strategy a = a -> Eval a + +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) + +runEval :: Eval a -> a +runEval (Eval x) = case x realWorld# of (# _, a #) -> a + +instance Functor Eval where + fmap = liftM + +instance Applicative Eval where + pure x = Eval $ \s -> (# s, x #) + (<*>) = ap + +instance Monad Eval where + return = pure + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case k a of + Eval f -> f s' + +parList :: Strategy a -> Strategy [a] +parList strat = traverse (rparWith strat) + +rpar :: Strategy a +rpar x = Eval $ \s -> spark# x s + +rseq :: Strategy a +rseq x = Eval $ \s -> seq# x s + +rparWith :: Strategy a -> Strategy a +rparWith s a = do l <- rpar r; return (case l of Lift x -> x) + where r = case s a of + Eval f -> case f realWorld# of + (# _, a' #) -> Lift a' + +data Lift a = Lift a + +rdeepseq :: NFData a => Strategy a +rdeepseq x = do rseq (rnf x); return x ===================================== testsuite/tests/concurrent/should_run/T21651.stdout ===================================== @@ -0,0 +1 @@ +14200 ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -218,12 +218,20 @@ test('conc067', ignore_stdout, compile_and_run, ['']) test('conc068', [ omit_ways(concurrent_ways), exit_code(1) ], compile_and_run, ['']) test('setnumcapabilities001', - [ only_ways(['threaded1','threaded2', 'nonmoving_thr']), + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), extra_run_opts('8 12 2000'), when(have_thread_sanitizer(), expect_broken(18808)), req_smp ], compile_and_run, ['']) +test('T21651', + [ only_ways(['threaded1','threaded2', 'nonmoving_thr', 'profthreaded']), + when(opsys('mingw32'),skip), # uses POSIX pipes + when(opsys('darwin'),extra_run_opts('8 12 2000 100')), + unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files + req_smp ], + compile_and_run, ['']) + test('hs_try_putmvar001', [ when(opsys('mingw32'),skip), # uses pthread APIs in the C code ===================================== testsuite/tests/driver/T20316.stdout ===================================== @@ -1,4 +1,4 @@ -[1 of 2] Compiling Main ( T20316.hs, nothing ) +[1 of 1] Compiling Main ( T20316.hs, nothing ) *** non-module.dump-timings *** initializing unit database: Chasing dependencies: ===================================== testsuite/tests/driver/T21866.hs ===================================== @@ -0,0 +1,3 @@ +module Main where + +main = print () ===================================== testsuite/tests/driver/T21866.stderr ===================================== @@ -0,0 +1 @@ +[1 of 1] Compiling Main ( T21866.hs, T21866.o ) ===================================== testsuite/tests/driver/all.T ===================================== @@ -306,4 +306,5 @@ test('T20316', normal, makefile_test, []) test('MultiRootsErr', normal, multimod_compile_fail, ['MultiRootsErr', 'MultiRootsErr']) test('patch-level2', normal, compile, ['-Wcpp-undef']) test('T20569', extra_files(["T20569/"]), makefile_test, []) +test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21869', normal, makefile_test, []) ===================================== testsuite/tests/driver/recomp007/recomp007.stdout ===================================== @@ -1,6 +1,6 @@ "1.0" Preprocessing executable 'test' for b-1.0.. Building executable 'test' for b-1.0.. -[1 of 3] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed] +[1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed] [3 of 3] Linking dist/build/test/test [Objects changed] "2.0" ===================================== testsuite/tests/driver/retc001/retc001.stdout ===================================== @@ -1,7 +1,7 @@ -[1 of 4] Compiling A ( A.hs, nothing ) -[2 of 4] Compiling B ( B.hs, nothing ) -[3 of 4] Compiling Main ( C.hs, nothing ) +[1 of 3] Compiling A ( A.hs, nothing ) +[2 of 3] Compiling B ( B.hs, nothing ) +[3 of 3] Compiling Main ( C.hs, nothing ) Middle End -[2 of 4] Compiling B ( B.hs, nothing ) [Source file changed] -[3 of 4] Compiling Main ( C.hs, nothing ) [B changed] +[2 of 3] Compiling B ( B.hs, nothing ) [Source file changed] +[3 of 3] Compiling Main ( C.hs, nothing ) [B changed] ===================================== testsuite/tests/indexed-types/should_compile/impexp.stderr ===================================== @@ -1,2 +1,2 @@ -[1 of 3] Compiling Exp ( Exp.hs, Exp.o ) -[2 of 3] Compiling Imp ( Imp.hs, Imp.o ) +[1 of 2] Compiling Exp ( Exp.hs, Exp.o ) +[2 of 2] Compiling Imp ( Imp.hs, Imp.o ) ===================================== testsuite/tests/typecheck/should_fail/T6018fail.stderr ===================================== @@ -1,8 +1,8 @@ -[1 of 6] Compiling T6018Afail ( T6018Afail.hs, T6018Afail.o ) -[2 of 6] Compiling T6018Bfail ( T6018Bfail.hs, T6018Bfail.o ) -[3 of 6] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o ) -[4 of 6] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o ) -[5 of 6] Compiling T6018fail ( T6018fail.hs, T6018fail.o ) +[1 of 5] Compiling T6018Afail ( T6018Afail.hs, T6018Afail.o ) +[2 of 5] Compiling T6018Bfail ( T6018Bfail.hs, T6018Bfail.o ) +[3 of 5] Compiling T6018Cfail ( T6018Cfail.hs, T6018Cfail.o ) +[4 of 5] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o ) +[5 of 5] Compiling T6018fail ( T6018fail.hs, T6018fail.o ) T6018fail.hs:15:15: error: Type family equation right-hand sides overlap; this violates View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/616c77fac9bc022e76eb9a00b0d2841e85679e37...0bea62ff81bd05ed4c88b6c96a1d77f857936114 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/616c77fac9bc022e76eb9a00b0d2841e85679e37...0bea62ff81bd05ed4c88b6c96a1d77f857936114 You're receiving 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 Aug 16 11:05:45 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 Aug 2022 07:05:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/21984 Message-ID: <62fb7a0931a1d_3d81494887815146ac@gitlab.mail> Matthew Pickering pushed new branch wip/21984 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/21984 You're receiving 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 Aug 16 11:18:10 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 16 Aug 2022 07:18:10 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] 2 commits: Add test Message-ID: <62fb7cf27555e_3d814948990152169a@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 9007eb90 by Andreas Klebinger at 2022-08-16T11:58:02+02:00 Add test - - - - - 08648849 by Andreas Klebinger at 2022-08-16T13:17:51+02:00 Always run tag inference, including for byteCodeGen - - - - - 11 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,7 +186,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Stg.InferTags import GHC.Builtin.Utils @@ -268,6 +268,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1719,11 +1721,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1766,7 +1773,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return (output_filename, stub_c_exists, foreign_fps, Just cg_infos{ cgTagSigs = stg_cg_infos}) hscInteractive :: HscEnv @@ -1801,7 +1808,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1906,13 +1915,13 @@ doCodeGen hsc_env this_mod denv data_tycons hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - + stg_ppr_opts = (initStgPprOpts dflags) -- Do tag inference on optimized STG (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + {-# SCC "StgTagFields" #-} inferTags stg_ppr_opts logger this_mod stg_binds_w_fvs putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_post_infer) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1960,7 +1969,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1978,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1986,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2008,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2159,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2396,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -221,13 +220,13 @@ the output of itself. -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} @@ -16,6 +17,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +66,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg pass. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,7 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1670,17 +1670,20 @@ pushAtom d p (StgVarArg var) Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. | Just con <- isDataConWorkId_maybe var -> do - let sz = idSizeCon platform var massert (sz == wordSize platform) massert (isNullaryRepDataCon con) return (unitOL (PACK con 0), sz) | otherwise -> do - let sz = idSizeCon platform var + let massert (sz == wordSize platform) return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -94,6 +94,7 @@ data CgInfos = CgInfos , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information , cgTagSigs :: !(NameEnv TagSig) + -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos. } -------------------------------------------------------------------------------- ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -dtag-inference-checks -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) \ No newline at end of file ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c \ No newline at end of file ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal')], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd6c05478b0eb1d1a974e5bc00bbcd233ee6f58e...08648849359218f1d6943b920b1f27fa690d4de9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd6c05478b0eb1d1a974e5bc00bbcd233ee6f58e...08648849359218f1d6943b920b1f27fa690d4de9 You're receiving 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 Aug 16 11:23:54 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 Aug 2022 07:23:54 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles in RepType Message-ID: <62fb7e4aec311_3d81494890415241e9@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: c878a5a5 by Simon Peyton Jones at 2022-08-16T12:25:18+01:00 Wibbles in RepType - - - - - 3 changed files: - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1396,14 +1396,14 @@ SelTyCon, SelForAll, and SelFun. * SelTyCon: co : (T s1..sn) ~r0 (T t1..tn) - T is a data type not a newtype + T is a data type, not a newtype, nor an arrow type r = tyConRole tc r0 i i < n (i is zero-indexed) ---------------------------------- SelCo r (SelTyCon i) : si ~r ti - See Note [SelCo and newtypes] - + "Not a newtype": see Note [SelCo and newtypes] + "Not an arrow type": see SelFun below * SelForAll: co : forall (a:k1).t1 ~r0 forall (a:k2).t2 ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -961,9 +961,10 @@ canEqNC ev eq_rel ty1 ty2 Right ty -> canEqReflexive ev eq_rel ty Left (Pair ty1' ty2') -> can_eq_nc False ev' eq_rel ty1' ty1' ty2' ty2' where - ev' | debugIsOn = setCtEvPredType ev $ - mkPrimEqPredRole (eqRelRole eq_rel) ty1' ty2' - | otherwise = ev + ev' = ev +-- ev' | debugIsOn = setCtEvPredType ev $ +-- mkPrimEqPredRole (eqRelRole eq_rel) ty1' ty2' +-- | otherwise = ev -- ev': satisfy the precondition of can_eq_nc } ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Prelude import GHC.Types.Basic (Arity, RepArity) import GHC.Core.DataCon -import GHC.Builtin.Names import GHC.Core.Coercion import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk @@ -56,7 +55,6 @@ import {-# SOURCE #-} GHC.Builtin.Types ( anyTypeOfKind import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import Data.List (sort) import qualified Data.IntSet as IS @@ -589,19 +587,16 @@ kindPrimRep doc ki -- NB: We could implement the partial methods by calling into the maybe -- variants here. But then both would need to pass around the doc argument. --- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's +-- | Take a kind (of shape `TYPE rr` or `CONSTRAINT rr`) and produce the 'PrimRep's -- of values of types of this kind. -- See also Note [Getting from RuntimeRep to PrimRep] -- Returns Nothing if rep can't be determined. Eg. levity polymorphic types. kindPrimRep_maybe :: HasDebugCallStack => Kind -> Maybe [PrimRep] kindPrimRep_maybe ki - | Just ki' <- coreView ki - = kindPrimRep_maybe ki' -kindPrimRep_maybe (TyConApp typ [runtime_rep]) - = assert (typ `hasKey` tYPETyConKey) $ - runtimeRepPrimRep_maybe runtime_rep -kindPrimRep_maybe _ki - = Nothing + | Just (_torc, rep) <- sORTKind_maybe ki + = runtimeRepPrimRep_maybe rep + | otherwise + = pprPanic "kindPrimRep" (ppr ki) -- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that -- it encodes. See also Note [Getting from RuntimeRep to PrimRep] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c878a5a5621c48ae2735cee856d339b69ff61cd1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c878a5a5621c48ae2735cee856d339b69ff61cd1 You're receiving 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 Aug 16 11:46:30 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 Aug 2022 07:46:30 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble Message-ID: <62fb8396d5e0_3d81494887815305f6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 4b0c02e3 by Simon Peyton Jones at 2022-08-16T12:47:38+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Canonical.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -961,10 +961,9 @@ canEqNC ev eq_rel ty1 ty2 Right ty -> canEqReflexive ev eq_rel ty Left (Pair ty1' ty2') -> can_eq_nc False ev' eq_rel ty1' ty1' ty2' ty2' where - ev' = ev --- ev' | debugIsOn = setCtEvPredType ev $ --- mkPrimEqPredRole (eqRelRole eq_rel) ty1' ty2' --- | otherwise = ev + ev' | debugIsOn = setCtEvPredType ev $ + mkPrimEqPredRole (eqRelRole eq_rel) ty1' ty2' + | otherwise = ev -- ev': satisfy the precondition of can_eq_nc } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b0c02e3f2056ded8bd30ebff84b21924ef70450 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b0c02e3f2056ded8bd30ebff84b21924ef70450 You're receiving 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 Aug 16 12:54:01 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 16 Aug 2022 08:54:01 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] 2 commits: Spaces at end Message-ID: <62fb93696bcb9_3d814948828155795@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 8af74b1c by Andreas Klebinger at 2022-08-16T13:19:48+02:00 Spaces at end - - - - - 9b27cd3d by Andreas Klebinger at 2022-08-16T14:53:42+02:00 Fixes for GHCi - - - - - 3 changed files: - compiler/GHC/Stg/InferTags/Rewrite.hs - testsuite/tests/simplStg/should_run/T22042.hs - testsuite/tests/simplStg/should_run/T22042a.hs Changes: ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,42 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When running code in GHCi we perform tag inference/rewrites +for each individual STG expression entered on the prompt. + +This means in GHCi for a sequence of: + > let x = True + > let y = x +We first run tagInference for `x = True`. While that computes a tag signature for `x` that information +is currently not persistet. +Then we process `y = x`, and to do so we check for the tag sig of `x` (which we don't have). +This isn't a problem as we can always just default to TagDunno and nothing bad will happen. + +But in a non-interactive context this would indicate an error as every binding +should be processed in dependency order for the whole module at once. +Therefore taggedness information should be available for every id mentioned in any RHS. + +So if a lookup fails we check if we are in an interactive context. If so we just default +to TagDunno. If we aren't in an interactive context this is an error and we have an assert +to check that. + +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -3,4 +3,4 @@ module Main where import T22042a main = do - putStrLn (foo $ SC A B C) \ No newline at end of file + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -7,4 +7,4 @@ data C = C | AC deriving Show data SC = SC !A !B !C foo :: SC -> String -foo (SC a b c) = show a ++ show b ++ show c \ No newline at end of file +foo (SC a b c) = show a ++ show b ++ show c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08648849359218f1d6943b920b1f27fa690d4de9...9b27cd3d8620dbe32208b2fbc8d98b3aeefc45dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08648849359218f1d6943b920b1f27fa690d4de9...9b27cd3d8620dbe32208b2fbc8d98b3aeefc45dc You're receiving 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 Aug 16 13:01:42 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 09:01:42 -0400 Subject: [Git][ghc/ghc][master] typo Message-ID: <62fb95364645b_3d81494883c156533d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - 1 changed file: - rts/Interpreter.c Changes: ===================================== rts/Interpreter.c ===================================== @@ -1875,7 +1875,7 @@ run_BCO: int flags = BCO_NEXT; bool interruptible = flags & 0x1; bool unsafe_call = flags & 0x2; - void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); + void(*marshal_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); /* the stack looks like this: @@ -1902,7 +1902,7 @@ run_BCO: #define ROUND_UP_WDS(p) ((((StgWord)(p)) + sizeof(W_)-1)/sizeof(W_)) - ffi_cif *cif = (ffi_cif *)marshall_fn; + ffi_cif *cif = (ffi_cif *)marshal_fn; uint32_t nargs = cif->nargs; uint32_t ret_size; uint32_t i; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffc9116e6223c0a90a51c05ff4b471b7f5af1b55 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffc9116e6223c0a90a51c05ff4b471b7f5af1b55 You're receiving 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 Aug 16 13:02:22 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 09:02:22 -0400 Subject: [Git][ghc/ghc][master] CmmToLlvm: Don't aliasify builtin LLVM variables Message-ID: <62fb955ec78b8_3d81494883c15702d4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - 1 changed file: - compiler/GHC/CmmToLlvm/Base.hs Changes: ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Logger import Data.Maybe (fromJust) import Control.Monad (ap) -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, isPrefixOf) import Data.Ord (comparing) -- ---------------------------------------------------------------------------- @@ -504,6 +504,12 @@ generateExternDecls = do modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | Is a variable one of the special @$llvm@ globals? +isBuiltinLlvmVar :: LlvmVar -> Bool +isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) = + "$llvm" `isPrefixOf` unpackFS lbl +isBuiltinLlvmVar _ = False + -- | Here we take a global variable definition, rename it with a -- @$def@ suffix, and generate the appropriate alias. aliasify :: LMGlobal -> LlvmM [LMGlobal] @@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal] -- Here we obtain the indirectee's precise type and introduce -- fresh aliases to both the precise typed label (lbl$def) and the i8* -- typed (regular) label of it with the matching new names. -aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) - (Just orig)) = do +aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias) + (Just orig)) + | not $ isBuiltinLlvmVar var = do let defLbl = llvmDefLabel lbl LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig defOrigLbl = llvmDefLabel origLbl @@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') ] -aliasify (LMGlobal var val) = do +aliasify (LMGlobal var val) + | not $ isBuiltinLlvmVar var = do let LMGlobalVar lbl ty link sect align const = var defLbl = llvmDefLabel lbl @@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do return [ LMGlobal defVar val , LMGlobal aliasVar (Just aliasVal) ] +aliasify global = pure [global] -- Note [Llvm Forward References] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do -- away with casting the alias to the desired type in @getSymbolPtr@ -- and instead just emit a reference to the definition symbol directly. -- This is the @Just@ case in @getSymbolPtr at . +-- +-- Note that we must take care not to turn LLVM's builtin variables into +-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd6f5bfd0cc2bcf74de1d9edb43fe4b338b4c4e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd6f5bfd0cc2bcf74de1d9edb43fe4b338b4c4e3 You're receiving 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 Aug 16 13:02:54 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 09:02:54 -0400 Subject: [Git][ghc/ghc][master] run_ci: remove monoidal-containers Message-ID: <62fb957e9b2bc_3d8149488281575185@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 1 changed file: - .gitlab/gen_ci.hs Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -2,13 +2,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- cabal: -build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring +build-depends: base, aeson >= 1.8.1, containers, bytestring -} +import Data.Coerce import Data.String (String) import Data.Aeson as A -import qualified Data.Map.Monoidal as M +import qualified Data.Map as Map +import Data.Map (Map) import qualified Data.ByteString.Lazy as B hiding (putStrLn) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) @@ -307,10 +310,22 @@ dockerImage _ _ = Nothing -- The "proper" solution would be to use a dependent monoidal map where each key specifies -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error -- or they should be combined. -type Variables = M.MonoidalMap String [String] +newtype MonoidalMap k v = MonoidalMap (Map k v) + deriving (Eq, Show, Functor, ToJSON) + +instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where + (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b) + +instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where + mempty = MonoidalMap (Map.empty) + +mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a +mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m) + +type Variables = MonoidalMap String [String] (=:) :: String -> String -> Variables -a =: b = M.singleton a [b] +a =: b = MonoidalMap (Map.singleton a [b]) opsysVariables :: Arch -> Opsys -> Variables opsysVariables _ FreeBSD13 = mconcat @@ -566,7 +581,7 @@ instance ToJSON Job where , "allow_failure" A..= jobAllowFailure -- Joining up variables like this may well be the wrong thing to do but -- at least it doesn't lose information silently by overriding. - , "variables" A..= (M.map (intercalate " ") jobVariables) + , "variables" A..= fmap (intercalate " ") jobVariables , "artifacts" A..= jobArtifacts , "cache" A..= jobCache , "after_script" A..= jobAfterScript @@ -621,9 +636,9 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) - , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty + , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) + , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty ] jobArtifacts = Artifacts @@ -669,7 +684,7 @@ addJobRule :: Rule -> Job -> Job addJobRule r j = j { jobRules = enableRule r (jobRules j) } addVariable :: String -> String -> Job -> Job -addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) } +addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } -- Building the standard jobs -- @@ -765,8 +780,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b] -- | Specification for all the jobs we want to build. -jobs :: M.MonoidalMap String Job -jobs = M.fromList $ concatMap flattenJobGroup $ +jobs :: Map String Job +jobs = Map.fromList $ concatMap flattenJobGroup $ [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , (validateBuilds Amd64 (Linux Debian10) nativeInt) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7da356daa78fb680f000736cd690f09fa1d856 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7da356daa78fb680f000736cd690f09fa1d856 You're receiving 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 Aug 16 13:03:32 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 09:03:32 -0400 Subject: [Git][ghc/ghc][master] CmmToAsm/AArch64: correct a typo Message-ID: <62fb95a4574f2_3d81494882815786d0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Native code generator for x86 and x86-64 architectures +-- | Native code generator for AArch64 architectures module GHC.CmmToAsm.AArch64 ( ncgAArch64 ) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/641105441d3ed7087c5d59187c8c94bc7bc08061 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/641105441d3ed7087c5d59187c8c94bc7bc08061 You're receiving 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 Aug 16 13:34:23 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 09:34:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: typo Message-ID: <62fb9cdf5d72d_3d814948828158415d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f2cd6512 by Andreas Klebinger at 2022-08-16T09:34:03-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - bbf06355 by Ben Gamari at 2022-08-16T09:34:04-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 614f5478 by Ben Gamari at 2022-08-16T09:34:04-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - d1890fa9 by Ben Gamari at 2022-08-16T09:34:04-04:00 users-guide: Add :ghc-flag: reference - - - - - 7e771e21 by Ben Gamari at 2022-08-16T09:34:04-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 0552dd15 by Ben Gamari at 2022-08-16T09:34:04-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 984380ea by Ben Gamari at 2022-08-16T09:34:04-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - aa3687c9 by Ben Gamari at 2022-08-16T09:34:04-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - e1993fd7 by Ben Gamari at 2022-08-16T09:34:04-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 12 changed files: - .gitlab/gen_ci.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - hadrian/src/Rules/Documentation.hs - libraries/base/changelog.md - libraries/ghc-compact/tests/all.T - rts/Interpreter.c - utils/haddock Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -2,13 +2,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- cabal: -build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring +build-depends: base, aeson >= 1.8.1, containers, bytestring -} +import Data.Coerce import Data.String (String) import Data.Aeson as A -import qualified Data.Map.Monoidal as M +import qualified Data.Map as Map +import Data.Map (Map) import qualified Data.ByteString.Lazy as B hiding (putStrLn) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) @@ -307,10 +310,22 @@ dockerImage _ _ = Nothing -- The "proper" solution would be to use a dependent monoidal map where each key specifies -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error -- or they should be combined. -type Variables = M.MonoidalMap String [String] +newtype MonoidalMap k v = MonoidalMap (Map k v) + deriving (Eq, Show, Functor, ToJSON) + +instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where + (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b) + +instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where + mempty = MonoidalMap (Map.empty) + +mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a +mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m) + +type Variables = MonoidalMap String [String] (=:) :: String -> String -> Variables -a =: b = M.singleton a [b] +a =: b = MonoidalMap (Map.singleton a [b]) opsysVariables :: Arch -> Opsys -> Variables opsysVariables _ FreeBSD13 = mconcat @@ -566,7 +581,7 @@ instance ToJSON Job where , "allow_failure" A..= jobAllowFailure -- Joining up variables like this may well be the wrong thing to do but -- at least it doesn't lose information silently by overriding. - , "variables" A..= (M.map (intercalate " ") jobVariables) + , "variables" A..= fmap (intercalate " ") jobVariables , "artifacts" A..= jobArtifacts , "cache" A..= jobCache , "after_script" A..= jobAfterScript @@ -621,9 +636,9 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) - , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty + , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) + , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty ] jobArtifacts = Artifacts @@ -669,7 +684,7 @@ addJobRule :: Rule -> Job -> Job addJobRule r j = j { jobRules = enableRule r (jobRules j) } addVariable :: String -> String -> Job -> Job -addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) } +addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } -- Building the standard jobs -- @@ -765,8 +780,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b] -- | Specification for all the jobs we want to build. -jobs :: M.MonoidalMap String Job -jobs = M.fromList $ concatMap flattenJobGroup $ +jobs :: Map String Job +jobs = Map.fromList $ concatMap flattenJobGroup $ [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , (validateBuilds Amd64 (Linux Debian10) nativeInt) ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Native code generator for x86 and x86-64 architectures +-- | Native code generator for AArch64 architectures module GHC.CmmToAsm.AArch64 ( ncgAArch64 ) where ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Logger import Data.Maybe (fromJust) import Control.Monad (ap) -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, isPrefixOf) import Data.Ord (comparing) -- ---------------------------------------------------------------------------- @@ -504,6 +504,12 @@ generateExternDecls = do modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | Is a variable one of the special @$llvm@ globals? +isBuiltinLlvmVar :: LlvmVar -> Bool +isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) = + "$llvm" `isPrefixOf` unpackFS lbl +isBuiltinLlvmVar _ = False + -- | Here we take a global variable definition, rename it with a -- @$def@ suffix, and generate the appropriate alias. aliasify :: LMGlobal -> LlvmM [LMGlobal] @@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal] -- Here we obtain the indirectee's precise type and introduce -- fresh aliases to both the precise typed label (lbl$def) and the i8* -- typed (regular) label of it with the matching new names. -aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) - (Just orig)) = do +aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias) + (Just orig)) + | not $ isBuiltinLlvmVar var = do let defLbl = llvmDefLabel lbl LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig defOrigLbl = llvmDefLabel origLbl @@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') ] -aliasify (LMGlobal var val) = do +aliasify (LMGlobal var val) + | not $ isBuiltinLlvmVar var = do let LMGlobalVar lbl ty link sect align const = var defLbl = llvmDefLabel lbl @@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do return [ LMGlobal defVar val , LMGlobal aliasVar (Just aliasVal) ] +aliasify global = pure [global] -- Note [Llvm Forward References] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do -- away with casting the alias to the desired type in @getSymbolPtr@ -- and instead just emit a reference to the definition symbol directly. -- This is the @Just@ case in @getSymbolPtr at . +-- +-- Note that we must take care not to turn LLVM's builtin variables into +-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM. ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -87,3 +87,50 @@ Compiler ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ + + +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/exts/gadt_syntax.rst ===================================== @@ -6,7 +6,7 @@ Declaring data types with explicit constructor signatures .. extension:: GADTSyntax :shortdesc: Enable generalised algebraic data type syntax. - :implied by: :extensions:`GADTs` + :implied by: :extension:`GADTs` :since: 7.2.1 :status: Included in :extension:`GHC2021` ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} ===================================== docs/users_guide/phases.rst ===================================== @@ -467,7 +467,7 @@ defined by your local GHC installation, the following trick is useful: .. index:: single: __GLASGOW_HASKELL_LLVM__ - Only defined when ``-fllvm`` is specified. When GHC is using version + Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero is added, so for example when using version 3.7 of LLVM, @@ -614,8 +614,8 @@ Options affecting code generation .. note:: - Note that this GHC release expects an LLVM version in the |llvm-version| - release series. + Note that this GHC release expects an LLVM version between |llvm-version-min| + and |llvm-version-max|. .. ghc-flag:: -fno-code :shortdesc: Omit code generation ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -41,7 +41,7 @@ archiveRoot :: FilePath archiveRoot = docRoot -/- "archives" manPageBuildPath :: FilePath -manPageBuildPath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1" -- TODO: Get rid of this hack. docContext :: Context ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. @@ -66,14 +66,55 @@ A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md) is available. - * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to - `Debug.Trace`, per - [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36). - * Re-export `augment` and `build` function from `GHC.List` * Re-export the `IsList` typeclass from the new `GHC.IsList` module. + * There's a new special function ``withDict`` in ``GHC.Exts``: :: + + withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r + + where ``cls`` must be a class containing exactly one method, whose type + must be ``meth``. + + This function converts ``meth`` to a type class dictionary. + It removes the need for ``unsafeCoerce`` in implementation of reflection + libraries. It should be used with care, because it can introduce + incoherent instances. + + For example, the ``withTypeable`` function from the + ``Type.Reflection`` module can now be defined as: :: + + withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () + => TypeRep a -> (Typeable a => r) -> r + withTypeable rep k = withDict @(Typeable a) rep k + + Note that the explicit type application is required, as the call to + ``withDict`` would be ambiguous otherwise. + + This replaces the old ``GHC.Exts.magicDict``, which required + an intermediate data type and was less reliable. + + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by + `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these + were rather represented by `Word#` and `Int#`. See GHC #11953. + +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes + ## 4.16.1.0 *Feb 2022* * Shipped with GHC 9.2.2 @@ -498,7 +539,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is ===================================== libraries/ghc-compact/tests/all.T ===================================== @@ -16,8 +16,8 @@ test('compact_pinned', exit_code(1), compile_and_run, ['']) test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_run, ['']) # this test computes closure sizes and those are affected # by the ghci and prof ways, because of BCOs and profiling headers. -test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']), - compile_and_run, ['']) +# Optimization levels slightly change what is/isn't shared so only run in normal mode +test('compact_share', only_ways(['normal']), compile_and_run, ['']) test('compact_bench', [ ignore_stdout, extra_run_opts('100') ], compile_and_run, ['']) test('T17044', normal, compile_and_run, ['']) ===================================== rts/Interpreter.c ===================================== @@ -1875,7 +1875,7 @@ run_BCO: int flags = BCO_NEXT; bool interruptible = flags & 0x1; bool unsafe_call = flags & 0x2; - void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); + void(*marshal_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); /* the stack looks like this: @@ -1902,7 +1902,7 @@ run_BCO: #define ROUND_UP_WDS(p) ((((StgWord)(p)) + sizeof(W_)-1)/sizeof(W_)) - ffi_cif *cif = (ffi_cif *)marshall_fn; + ffi_cif *cif = (ffi_cif *)marshal_fn; uint32_t nargs = cif->nargs; uint32_t ret_size; uint32_t i; ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit a9a312991e55ab99a8dee36a6747f4fc5d5b7c67 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc62f24ecd1c2b8f3a127845ffdfb8159257fc8c...e1993fd7c296a0b43946a18bd98b8457815c5548 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc62f24ecd1c2b8f3a127845ffdfb8159257fc8c...e1993fd7c296a0b43946a18bd98b8457815c5548 You're receiving 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 Aug 16 13:43:59 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 16 Aug 2022 09:43:59 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Update testsuite rests to adjust for outcomes from constructors being tagged. Message-ID: <62fb9f1fde877_3d81494882815931eb@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 743372e3 by Andreas Klebinger at 2022-08-16T15:43:39+02:00 Update testsuite rests to adjust for outcomes from constructors being tagged. - - - - - 2 changed files: - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout Changes: ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/743372e3d8e047aea52269781fdf0df09631cc48 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/743372e3d8e047aea52269781fdf0df09631cc48 You're receiving 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 Aug 16 15:52:14 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 16 Aug 2022 11:52:14 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: Primop: fix quotRem2Word32 Message-ID: <62fbbd2ebd0c2_3d8149488dc167335d@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 195ef078 by Sylvain Henry at 2022-08-16T17:27:52+02:00 Primop: fix quotRem2Word32 - - - - - e27e532f by Sylvain Henry at 2022-08-16T17:54:39+02:00 Primop: fix timesInt2. Progress towards passing arith003 - - - - - 1 changed file: - js/arith.js.pp Changes: ===================================== js/arith.js.pp ===================================== @@ -386,47 +386,42 @@ var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim; // Compute product of two Ints. Returns (nh,ch,cl) // where (ch,cl) are the two parts of the 64-bit result // and nh is 0 if ch can be safely dropped (i.e. it's a sign-extension of cl). -function h$hs_timesInt2(l1,l2) { - TRACE_ARITH("timesInt2 " + l1 + " " + l2); +function h$hs_timesInt2(a,b) { + TRACE_ARITH("timesInt2 " + a + " " + b); + + // adapted from Hacker's Delight (p174) // check for 0 and 1 operands - if (l1 === 0) { + if (a === 0) { RETURN_UBX_TUP3(0,0,0); } - if (l2 === 0) { + if (b === 0) { RETURN_UBX_TUP3(0,0,0); } - if (l1 === 1) { - RETURN_UBX_TUP3(0,l2<0?(-1):0,l2); + if (a === 1) { + RETURN_UBX_TUP3(0,b<0?(-1):0,b); } - if (l2 === 1) { - RETURN_UBX_TUP3(0,l1<0?(-1):0,l1); + if (b === 1) { + RETURN_UBX_TUP3(0,a<0?(-1):0,a); } - var a16 = l1 >>> 16; - var a00 = l1 & 0xFFFF; + var cl = (a * b)|0; - var b16 = l2 >>> 16; - var b00 = l2 & 0xFFFF; + var ha = a >> 16; + var la = a & 0xFFFF; - var c48 = 0, c32 = 0, c16 = 0, c00 = 0; - c00 += a00 * b00; - c16 += c00 >>> 16; - c00 &= 0xFFFF; - c16 += a16 * b00; - c32 += c16 >>> 16; - c16 &= 0xFFFF; - c16 += a00 * b16; - c32 += c16 >>> 16; - c16 &= 0xFFFF; - c32 &= 0xFFFF; - c32 += a16 * b16; - c48 += c32 >>> 16; - c32 &= 0xFFFF; - c48 &= 0xFFFF; - var ch = (c48 << 16) | c32 - var cl = (c16 << 16) | c00 + var hb = b >> 16; + var lb = b & 0xFFFF; + + var w0 = (la*lb)|0; + var t = ((ha*lb)|0 + (w0 >> 16))|0; + var w1 = t & 0xFFFF; + var w2 = t >> 16; + w1 = ((la*hb)|0 + w1)|0; + + var ch = (ha*hb + w2 + w1 >> 16)|0; var nh = ((ch === 0 && cl >= 0) || (ch === -1 && cl < 0)) ? 0 : 1 + TRACE_ARITH("timesInt2 results:" + nh + " " + ch + " " + cl); RETURN_UBX_TUP3(nh, ch, cl); } @@ -536,9 +531,14 @@ function h$quotRemWord32(n,d) { var t = d >> 31; var n2 = n & ~t; var q = ((n2 >>> 1) / d) << 1; - var r = (n - q * d) >>> 0; - var c = (r >>> 0) >= (d >>> 0); - RETURN_UBX_TUP2((q + (c ? 1 : 0)) >>> 0, (r - (c ? d : 0)) >>> 0); + var r = UN(n - q * d); + var c = UN(r) >= UN(d); + var rq = UN(q + (c ? 1 : 0)); + var rr = UN(r - (c ? d : 0)); + + TRACE_ARITH("quotRemWord32 results: " + rq + " " + rr); + + RETURN_UBX_TUP2(rq,rr); } function h$quotRem2Word32(nh,nl,d) { @@ -561,39 +561,56 @@ function h$quotRem2Word32(nh,nl,d) { } var s = Math.clz32(d); // 0 <= s <= 31 - d = d << s; // normalize divisor + d = UN(d << s); // normalize divisor var dh = d >>> 16; // break divisor up into two 16-bit digits var dl = d & 0xFFFF; + TRACE_ARITH("quotRem2Word32 s " + s); + TRACE_ARITH("quotRem2Word32 normalized d " + d + " " + dh + " " + dl); + // shift dividend left too - var un32 = UN((nh << s) | ((nl >>> (32-s)) & (-s >> 31))); + var un32 = UN((nh << s) | ((nl >>> (32-s)) & ((-s) >> 31))); var un10 = UN(nl << s); var un1 = un10 >>> 16; // break lower part of the divisor into two 16-bit digits var un0 = un10 & 0xFFFF; + TRACE_ARITH("quotRem2Word32 uns " + un32 + " " + un10 + " " + un1 + " " + un0); + var q1 = UN(un32 / dh); // compute first quotient digit q1 var rhat = UN(un32 - UN(q1*dh)); - while (q1 >= 0xFFFF || UN(q1*dl) > UN(UN(rhat << 16) + un1)) { + TRACE_ARITH("quotRem2Word32 q1 rhat " + q1 + " " + rhat); + + while (q1 > 0xFFFF || UN(q1*dl) > (UN(UN(rhat << 16) | un1))) { q1 = UN(q1 - 1); rhat = UN(rhat + dh); - if (rhat >= 0xFFFF) break; + if (rhat > 0xFFFF) break; } - var un21 = UN(UN(UN(un32 << 16) + un1) - UN(q1*d)); + TRACE_ARITH("quotRem2Word32 q1' rhat' " + q1 + " " + rhat); + + var un21 = UN(UN(UN(un32 << 16) | un1) - UN(q1*d)); + + TRACE_ARITH("quotRem2Word32 un21 " + un21); var q0 = UN(un21 / dh); // compute second quotient digit q0 rhat = UN(un21 - UN(q0*dh)); - while (q0 >= 0xFFFF || UN(q0*dh) > UN(UN(rhat << 16) + un0)) { + TRACE_ARITH("quotRem2Word32 q0 rhat " + q0 + " " + rhat); + + while (q0 > 0xFFFF || UN(q0*dl) > UN(UN(rhat << 16) + un0)) { q0 = UN(q0 - 1); rhat = UN(rhat + dh); - if (rhat >= 0xFFFF) break; + if (rhat > 0xFFFF) break; } - var rq = UN(q1 << 16 + q0); - var rr = (UN(un21 << 16) + un0 - UN(q0*d)) >>> s; + TRACE_ARITH("quotRem2Word32 q0' rhat' " + q0 + " " + rhat); + + var rq = UN(q1 << 16 | q0); + var rr = (UN(UN(un21 << 16) | un0) - UN(q0*d)) >>> s; + + TRACE_ARITH("quotRem2Word32 results: " + rq + " " + rr); RETURN_UBX_TUP2(rq,rr); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12d3c118933a9c05eb122d8fa51532e02d17d518...e27e532fee0dcb2629f057169d392e9dd6dbcbd9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12d3c118933a9c05eb122d8fa51532e02d17d518...e27e532fee0dcb2629f057169d392e9dd6dbcbd9 You're receiving 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 Aug 16 16:33:58 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 16 Aug 2022 12:33:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22060 Message-ID: <62fbc6f6b2cf1_3d81494899016896d0@gitlab.mail> Ben Gamari pushed new branch wip/T22060 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22060 You're receiving 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 Aug 16 16:47:21 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 Aug 2022 12:47:21 -0400 Subject: [Git][ghc/ghc][wip/T21623] Add mkWpEta Message-ID: <62fbca196c5a7_3d8149488dc16994cd@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: abeb4ba4 by Simon Peyton Jones at 2022-08-16T17:48:42+01:00 Add mkWpEta - - - - - 1 changed file: - compiler/GHC/Hs/Utils.hs Changes: ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -264,7 +264,7 @@ mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches)) mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars - <.> mkWpLams dicts) expr + <.> mkWpEvLams dicts) expr -- |A simple case alternative with a single pattern, no binds, no guards; -- pre-typechecking View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abeb4ba486fc7c1047829723542dd3d7bcc5da3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abeb4ba486fc7c1047829723542dd3d7bcc5da3a You're receiving 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 Aug 16 16:48:08 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 Aug 2022 12:48:08 -0400 Subject: [Git][ghc/ghc][wip/T21623] Really add mkWpEta Message-ID: <62fbca48a92e6_3d8149489a41699878@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: c38e4d35 by Simon Peyton Jones at 2022-08-16T17:49:04+01:00 Really add mkWpEta - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -949,7 +949,7 @@ tcExprSig _ expr sig@(PartialSig { psig_name = name, sig_loc = loc }) ; traceTc "tcExpSig" (ppr qtvs $$ ppr givens $$ ppr inferred_sigma $$ ppr my_sigma) ; let poly_wrap = wrap <.> mkWpTyLams qtvs - <.> mkWpLams givens + <.> mkWpEvLams givens <.> mkWpLet ev_binds ; return (mkLHsWrap poly_wrap expr', my_sigma) } ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1785,7 +1785,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys meth_tau = classMethodInstTy sel_id inst_tys error_string dflags = showSDoc dflags (hcat [ppr inst_loc, vbar, ppr sel_id ]) - lam_wrapper = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars + lam_wrapper = mkWpTyLams tyvars <.> mkWpEvLams dfun_ev_vars ---------------------- -- Check if one of the minimal complete definitions is satisfied ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -8,7 +8,7 @@ module GHC.Tc.Types.Evidence ( -- * HsWrapper HsWrapper(..), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, - mkWpLams, mkWpLet, mkWpFun, mkWpCastN, mkWpCastR, + mkWpEvLams, mkWpLet, mkWpFun, mkWpCastN, mkWpCastR, mkWpEta, collectHsWrapBinders, idHsWrapper, isIdHsWrapper, pprHsWrapper, hsWrapDictBinders, @@ -68,6 +68,7 @@ import GHC.Prelude import GHC.Types.Unique.DFM import GHC.Types.Unique.FM import GHC.Types.Var +import GHC.Types.Id( idScaledType ) import GHC.Core.Coercion.Axiom import GHC.Core.Coercion import GHC.Core.Ppr () -- Instance OutputableBndr TyVar @@ -239,7 +240,8 @@ data HsWrapper -- then WpFun wrap1 wrap2 : (act_arg -> arg_res) ~> (exp_arg -> exp_res) -- This isn't the same as for mkFunCo, but it has to be this way -- because we can't use 'sym' to flip around these HsWrappers - -- The TcType is the "from" type of the first wrapper + -- The TcType is the "from" type of the first wrapper; + -- it always a Type, not a Constraint -- -- NB: a WpFun is always for a VisArg, with (->) function arrow -- @@ -251,8 +253,11 @@ data HsWrapper -- Evidence abstraction and application -- (both dictionaries and coercions) + -- Both WpEvLam and WpEvApp abstract and apply values + -- of kind Constraint or Constraint# | WpEvLam EvVar -- \d. [] the 'd' is an evidence variable | WpEvApp EvTerm -- [] d the 'd' is evidence for a constraint + -- Kind and Type abstraction and application | WpTyLam TyVar -- \a. [] the 'a' is a type/kind variable (not coercion var) | WpTyApp KindOrType -- [] t the 't' is a type (not coercion) @@ -297,8 +302,8 @@ c1 <.> c2 = c1 `WpCompose` c2 mkWpFun :: HsWrapper -> HsWrapper -> Scaled TcTypeFRR -- ^ the "from" type of the first wrapper -- MUST have a fixed RuntimeRep - -> TcType -- ^ either type of the second wrapper (used only when the - -- second wrapper is the identity) + -> TcType -- ^ Either "from" type or "to" type of the second wrapper + -- (used only when the second wrapper is the identity) -> HsWrapper -- NB: we can't check that the argument type has a fixed RuntimeRep with an assertion, -- because of [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep] @@ -309,6 +314,14 @@ mkWpFun (WpCast co1) WpHole (Scaled w _) t2 = WpCast (mk_fun_co w (mkTcSy mkWpFun (WpCast co1) (WpCast co2) (Scaled w _) _ = WpCast (mk_fun_co w (mkTcSymCo co1) co2) mkWpFun co1 co2 t1 _ = WpFun co1 co2 t1 +mkWpEta :: [Id] -> HsWrapper -> HsWrapper +-- (mkWpEta [x1, x2] wrap) [e] +-- = \x1. \x2. wrap[e x1 x2] +-- Just generates a bunch of WpFuns +mkWpEta xs wrap = foldr eta_one wrap xs + where + eta_one x wrap = WpFun idHsWrapper wrap (idScaledType x) + mk_fun_co :: Mult -> TcCoercionR -> TcCoercionR -> TcCoercionR mk_fun_co mult arg_co res_co = mkTcFunCo Representational (multToCo mult) arg_co res_co @@ -338,8 +351,8 @@ mkWpEvVarApps vs = mk_co_app_fn WpEvApp (map (EvExpr . evId) vs) mkWpTyLams :: [TyVar] -> HsWrapper mkWpTyLams ids = mk_co_lam_fn WpTyLam ids -mkWpLams :: [Var] -> HsWrapper -mkWpLams ids = mk_co_lam_fn WpEvLam ids +mkWpEvLams :: [Var] -> HsWrapper +mkWpEvLams ids = mk_co_lam_fn WpEvLam ids mkWpLet :: TcEvBinds -> HsWrapper -- This no-op is a quite a common case ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -187,7 +187,7 @@ topSkolemise skolem_info ty = do { (subst', tvs1) <- tcInstSkolTyVarsX skolem_info subst tvs ; ev_vars1 <- newEvVars (substTheta subst' theta) ; go subst' - (wrap <.> mkWpTyLams tvs1 <.> mkWpLams ev_vars1) + (wrap <.> mkWpTyLams tvs1 <.> mkWpEvLams ev_vars1) (tv_prs ++ (map tyVarName tvs `zip` tvs1)) (ev_vars ++ ev_vars1) inner_ty } ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1381,11 +1381,9 @@ deeplySkolemise skol_info ty ; ev_vars1 <- newEvVars (substTheta subst' theta) ; (wrap, tvs_prs2, ev_vars2, rho) <- go subst' ty' ; let tv_prs1 = map tyVarName tvs `zip` tvs1 - ; return ( mkWpLams ids1 - <.> mkWpTyLams tvs1 - <.> mkWpLams ev_vars1 - <.> wrap - <.> mkWpEvVarApps ids1 + ; return ( mkWpEta ids1 (mkWpTyLams tvs1 + <.> mkWpEvLams ev_vars1 + <.> wrap) , tv_prs1 ++ tvs_prs2 , ev_vars1 ++ ev_vars2 , mkScaledFunTys arg_tys' rho ) } @@ -1408,10 +1406,7 @@ deeplyInstantiate orig ty ; ids1 <- newSysLocalIds (fsLit "di") arg_tys' ; wrap1 <- instCall orig (mkTyVarTys tvs') theta' ; (wrap2, rho2) <- go subst' rho - ; return (mkWpLams ids1 - <.> wrap2 - <.> wrap1 - <.> mkWpEvVarApps ids1, + ; return (mkWpEta ids1 (wrap2 <.> wrap1), mkScaledFunTys arg_tys' rho2) } | otherwise View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c38e4d35b842d4d9c7e9fa448703570eab965e18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c38e4d35b842d4d9c7e9fa448703570eab965e18 You're receiving 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 Aug 16 17:13:01 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Tue, 16 Aug 2022 13:13:01 -0400 Subject: [Git][ghc/ghc][wip/js-staging] configure JS: remove wrapper scripts Message-ID: <62fbd01dbce2e_3d8149488a017045c0@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 0430b9a2 by doyougnu at 2022-08-16T13:11:30-04:00 configure JS: remove wrapper scripts - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -375,46 +375,17 @@ then echo "No emsdk bin set: defaulting to $EMSDK/upstream/emscripten" fi - test -d inplace || mkdir inplace - - ghcjsbin="$hardtop/inplace/ghcjs_toolchain/bin/" - mkdir -p $ghcjsbin - - echo "#!/usr/bin/env bash" > "$ghcjsbin/js-unknown-ghcjs-cc" - echo "exec \"$EMSDK_BIN/emcc\" \"\$@\"" >> "$ghcjsbin/js-unknown-ghcjs-cc" - chmod 755 "$ghcjsbin/js-unknown-ghcjs-cc" - - echo "#!/usr/bin/env bash" > "$ghcjsbin/js-unknown-ghcjs-ar" - echo "exec \"$EMSDK_LLVM/bin/llvm-ar\" \"\$@\"" >> "$ghcjsbin/js-unknown-ghcjs-ar" - chmod 755 "$ghcjsbin/js-unknown-ghcjs-ar" - - echo "#!/usr/bin/env bash" > "$ghcjsbin/js-unknown-ghcjs-ranlib" - echo "exec \"$EMSDK_LLVM/bin/llvm-ranlib\" \"\$@\"" >> "$ghcjsbin/js-unknown-ghcjs-ranlib" - chmod 755 "$ghcjsbin/js-unknown-ghcjs-ranlib" - - echo "#!/usr/bin/env bash" > "$ghcjsbin/js-unknown-ghcjs-nm" - echo "exec \"$EMSDK_LLVM/bin/llvm-nm\" \"\$@\"" >> "$ghcjsbin/js-unknown-ghcjs-nm" - chmod 755 "$ghcjsbin/js-unknown-ghcjs-nm" - - dnl the linker shouldn't be used because GHC does the JS linking. - dnl it makes no harm to pass emscripten's one here though and it avoids - dnl dealing with the rest of the build system that assumes that a linker is - dnl available. - echo "#!/usr/bin/env bash" > "$ghcjsbin/js-unknown-ghcjs-ld" - echo "exec \"$EMSDK_LLVM/bin/llvm-link\" \"\$@\"" >> "$ghcjsbin/js-unknown-ghcjs-ld" - chmod 755 "$ghcjsbin/js-unknown-ghcjs-ld" - - export PATH=$ghcjsbin:$PATH - dnl We need to use AC_CHECK_TARGET_TOOL instead of AC_PATH_PROG below that dnl doesn't take into account the target triple... dnl Why are we inflicting all this to ourselves? - AC_PATH_TARGET_TOOL([CC],[gcc]) - AC_PATH_TARGET_TOOL([CXX],[g++]) - AC_PATH_TARGET_TOOL([NM],[nm]) - AC_PATH_TARGET_TOOL([AR],[ar]) - AC_PATH_TARGET_TOOL([RANLIB],[ranlib]) - AC_PATH_TARGET_TOOL([OBJDUMP],[objdump]) + AC_PATH_TOOL([CC],[emcc],[gcc],[$EMSDK$PATH_SEPERATOR$PATH]) + AC_PATH_TOOL([CXX],[g++]) + AC_PATH_TOOL([NM],[llvm-nm],[nm],[$EMSDK_BIN$PATH_SEPERATOR$PATH]) + AC_PATH_TOOL([AR],[llvm-ar],[ar],[$EMSDK_BIN$PATH_SEPERATOR$PATH]) + AC_PATH_TOOL([RANLIB],[llvm-ranlib],[ranlib],[$EMSDK_BINF$PATH_SEPERATOR$PATH]) + AC_PATH_TOOL([OBJDUMP],[llvm-objdump],[objdump],[$EMSDK_BIN$PATH_SEPERATOR$PATH]) + + else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0430b9a23329269b8e477b514a8cea286e34ea77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0430b9a23329269b8e477b514a8cea286e34ea77 You're receiving 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 Aug 16 18:34:27 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 14:34:27 -0400 Subject: [Git][ghc/ghc][master] Fix #21979 - compact-share failing with -O Message-ID: <62fbe333e83c7_3d8149489901734983@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 1 changed file: - libraries/ghc-compact/tests/all.T Changes: ===================================== libraries/ghc-compact/tests/all.T ===================================== @@ -16,8 +16,8 @@ test('compact_pinned', exit_code(1), compile_and_run, ['']) test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_run, ['']) # this test computes closure sizes and those are affected # by the ghci and prof ways, because of BCOs and profiling headers. -test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']), - compile_and_run, ['']) +# Optimization levels slightly change what is/isn't shared so only run in normal mode +test('compact_share', only_ways(['normal']), compile_and_run, ['']) test('compact_bench', [ ignore_stdout, extra_run_opts('100') ], compile_and_run, ['']) test('T17044', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6a5524abaf744055e9bec40504c7eae28700537 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6a5524abaf744055e9bec40504c7eae28700537 You're receiving 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 Aug 16 18:35:06 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 Aug 2022 14:35:06 -0400 Subject: [Git][ghc/ghc][master] 8 commits: users-guide: Fix reference to dead llvm-version substitution Message-ID: <62fbe35adbeaa_3d8149488a01742594@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 7 changed files: - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - hadrian/src/Rules/Documentation.hs - libraries/base/changelog.md - utils/haddock Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -87,3 +87,50 @@ Compiler ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ + + +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/exts/gadt_syntax.rst ===================================== @@ -6,7 +6,7 @@ Declaring data types with explicit constructor signatures .. extension:: GADTSyntax :shortdesc: Enable generalised algebraic data type syntax. - :implied by: :extensions:`GADTs` + :implied by: :extension:`GADTs` :since: 7.2.1 :status: Included in :extension:`GHC2021` ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} ===================================== docs/users_guide/phases.rst ===================================== @@ -467,7 +467,7 @@ defined by your local GHC installation, the following trick is useful: .. index:: single: __GLASGOW_HASKELL_LLVM__ - Only defined when ``-fllvm`` is specified. When GHC is using version + Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero is added, so for example when using version 3.7 of LLVM, @@ -614,8 +614,8 @@ Options affecting code generation .. note:: - Note that this GHC release expects an LLVM version in the |llvm-version| - release series. + Note that this GHC release expects an LLVM version between |llvm-version-min| + and |llvm-version-max|. .. ghc-flag:: -fno-code :shortdesc: Omit code generation ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -41,7 +41,7 @@ archiveRoot :: FilePath archiveRoot = docRoot -/- "archives" manPageBuildPath :: FilePath -manPageBuildPath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1" -- TODO: Get rid of this hack. docContext :: Context ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. @@ -66,14 +66,55 @@ A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md) is available. - * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to - `Debug.Trace`, per - [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36). - * Re-export `augment` and `build` function from `GHC.List` * Re-export the `IsList` typeclass from the new `GHC.IsList` module. + * There's a new special function ``withDict`` in ``GHC.Exts``: :: + + withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r + + where ``cls`` must be a class containing exactly one method, whose type + must be ``meth``. + + This function converts ``meth`` to a type class dictionary. + It removes the need for ``unsafeCoerce`` in implementation of reflection + libraries. It should be used with care, because it can introduce + incoherent instances. + + For example, the ``withTypeable`` function from the + ``Type.Reflection`` module can now be defined as: :: + + withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () + => TypeRep a -> (Typeable a => r) -> r + withTypeable rep k = withDict @(Typeable a) rep k + + Note that the explicit type application is required, as the call to + ``withDict`` would be ambiguous otherwise. + + This replaces the old ``GHC.Exts.magicDict``, which required + an intermediate data type and was less reliable. + + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by + `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these + were rather represented by `Word#` and `Int#`. See GHC #11953. + +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes + ## 4.16.1.0 *Feb 2022* * Shipped with GHC 9.2.2 @@ -498,7 +539,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit a9a312991e55ab99a8dee36a6747f4fc5d5b7c67 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6a5524abaf744055e9bec40504c7eae28700537...a4212edccceaec475d4aca240cbfe9db98b77d33 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6a5524abaf744055e9bec40504c7eae28700537...a4212edccceaec475d4aca240cbfe9db98b77d33 You're receiving 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 Aug 16 19:12:31 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 16 Aug 2022 15:12:31 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fbec1fcb80b_3d814948864175142f@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 0a6cade1 by Andreas Klebinger at 2022-08-16T21:09:09+02:00 Fix GHCis interaction with tag inference. We had assumed that wrappers were not inlined into GHCi so we would always execute the compiled wrapper inside GHCi. Turs turned out to be a lie. So instead we now run tag inference even when we only generate bytecode. In that case only for correctness reasons. Which is alright as it's fairly cheap. I further fixed a bug where GHCi didn't tag nullary constructor arguments which caused segfaults when calling into compiled functions which expected the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 ------------------------- - - - - - 14 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,7 +186,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Stg.InferTags import GHC.Builtin.Utils @@ -268,6 +268,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1719,11 +1721,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1766,7 +1773,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just cg_infos{ cgTagSigs = stg_cg_infos}) hscInteractive :: HscEnv @@ -1801,7 +1809,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1906,13 +1916,13 @@ doCodeGen hsc_env this_mod denv data_tycons hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - + stg_ppr_opts = (initStgPprOpts dflags) -- Do tag inference on optimized STG (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + {-# SCC "StgTagFields" #-} inferTags stg_ppr_opts logger this_mod stg_binds_w_fvs putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_post_infer) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1960,7 +1970,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1979,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1987,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2009,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2160,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2397,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -221,13 +220,13 @@ the output of itself. -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,42 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When running code in GHCi we perform tag inference/rewrites +for each individual STG expression entered on the prompt. + +This means in GHCi for a sequence of: + > let x = True + > let y = x +We first run tagInference for `x = True`. While that computes a tag signature for `x` that information +is currently not persistet. +Then we process `y = x`, and to do so we check for the tag sig of `x` (which we don't have). +This isn't a problem as we can always just default to TagDunno and nothing bad will happen. + +But in a non-interactive context this would indicate an error as every binding +should be processed in dependency order for the whole module at once. +Therefore taggedness information should be available for every id mentioned in any RHS. + +So if a lookup fails we check if we are in an interactive context. If so we just default +to TagDunno. If we aren't in an interactive context this is an error and we have an assert +to check that. + +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} @@ -16,6 +17,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +66,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg pass. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,7 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -94,6 +94,7 @@ data CgInfos = CgInfos , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information , cgTagSigs :: !(NameEnv TagSig) + -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos. } -------------------------------------------------------------------------------- ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -dtag-inference-checks -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal')], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a6cade119bff19f82573f2975f936af4db3c247 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a6cade119bff19f82573f2975f936af4db3c247 You're receiving 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 Aug 16 19:16:22 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 16 Aug 2022 15:16:22 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fbed061276e_3d814948864175192c@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 9441487e by Andreas Klebinger at 2022-08-16T21:13:41+02:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we only generate bytecode. In that case only for correctness reasons. Which is alright as it's fairly cheap to run. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 ------------------------- - - - - - 14 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,7 +186,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Stg.InferTags import GHC.Builtin.Utils @@ -268,6 +268,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1719,11 +1721,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1766,7 +1773,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just cg_infos{ cgTagSigs = stg_cg_infos}) hscInteractive :: HscEnv @@ -1801,7 +1809,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1906,13 +1916,13 @@ doCodeGen hsc_env this_mod denv data_tycons hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - + stg_ppr_opts = (initStgPprOpts dflags) -- Do tag inference on optimized STG (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + {-# SCC "StgTagFields" #-} inferTags stg_ppr_opts logger this_mod stg_binds_w_fvs putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_post_infer) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1960,7 +1970,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1979,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1987,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2009,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2160,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2397,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -221,13 +220,13 @@ the output of itself. -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,42 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When running code in GHCi we perform tag inference/rewrites +for each individual STG expression entered on the prompt. + +This means in GHCi for a sequence of: + > let x = True + > let y = x +We first run tagInference for `x = True`. While that computes a tag signature for `x` that information +is currently not persistet. +Then we process `y = x`, and to do so we check for the tag sig of `x` (which we don't have). +This isn't a problem as we can always just default to TagDunno and nothing bad will happen. + +But in a non-interactive context this would indicate an error as every binding +should be processed in dependency order for the whole module at once. +Therefore taggedness information should be available for every id mentioned in any RHS. + +So if a lookup fails we check if we are in an interactive context. If so we just default +to TagDunno. If we aren't in an interactive context this is an error and we have an assert +to check that. + +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} @@ -16,6 +17,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +66,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg pass. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,7 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -94,6 +94,7 @@ data CgInfos = CgInfos , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information , cgTagSigs :: !(NameEnv TagSig) + -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos. } -------------------------------------------------------------------------------- ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -dtag-inference-checks -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal')], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9441487eb2de3fcfcb012d8cca63c9fa1ca3f20d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9441487eb2de3fcfcb012d8cca63c9fa1ca3f20d You're receiving 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 Aug 16 19:33:34 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 16 Aug 2022 15:33:34 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Tag inference is great, but not so great that we should run it twice Message-ID: <62fbf10e6bdf2_3d81494882817540a9@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 8ac0f2d9 by Andreas Klebinger at 2022-08-16T21:33:12+02:00 Tag inference is great, but not so great that we should run it twice - - - - - 2 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -27,13 +27,12 @@ import GHC.Settings (Platform, platformUnregisterised) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc +import GHC.Stg.Pipeline (StgCgInfos) {- Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] @@ -180,8 +179,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> StgCgInfos -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos +generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -200,7 +199,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = stg_cg_infos} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -187,7 +187,6 @@ import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) -import GHC.Stg.InferTags import GHC.Builtin.Utils import GHC.Builtin.Names @@ -1752,7 +1751,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do cmms <- {-# SCC "StgToCmm" #-} doCodeGen hsc_env this_mod denv data_tycons cost_centre_info - stg_binds hpc_info + stg_binds stg_cg_infos hpc_info ------------------ Code output ----------------------- rawcmms0 <- {-# SCC "cmmToRawCmm" #-} @@ -1904,25 +1903,23 @@ This reduces residency towards the end of the CodeGen phase significantly doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs + -> StgCgInfos -> HpcInfo -> IO (Stream IO CmmGroupSRTs CgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. doCodeGen hsc_env this_mod denv data_tycons - cost_centre_info stg_binds_w_fvs hpc_info = do + cost_centre_info stg_binds_w_fvs stg_cg_info hpc_info = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags stg_ppr_opts = (initStgPprOpts dflags) - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags stg_ppr_opts logger this_mod stg_binds_w_fvs putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings stg_ppr_opts stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1930,8 +1927,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1962,7 +1959,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv stg_cg_info pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ac0f2d98136c4aa2f4f88eb1d783ff9d84c17dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ac0f2d98136c4aa2f4f88eb1d783ff9d84c17dc You're receiving 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 Aug 16 19:58:28 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 16 Aug 2022 15:58:28 -0400 Subject: [Git][ghc/ghc][wip/T22060] compiler: Drop --build-id=none hack Message-ID: <62fbf6e4788a8_3d81494883c1756346@gitlab.mail> Ben Gamari pushed to branch wip/T22060 at Glasgow Haskell Compiler / GHC Commits: 5aa2a581 by Ben Gamari at 2022-08-16T15:58:21-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 10 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_prog_ld_build_id.m4 - mk/config.mk.in - rts/include/ghc.mk Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -1184,17 +1184,10 @@ joinObjectFiles hsc_env o_files output_fn let toolSettings' = toolSettings dflags ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) ( - map GHC.SysTools.Option ld_build_id - ++ [ GHC.SysTools.Option "-o", + [ GHC.SysTools.Option "-o", GHC.SysTools.FileOption "" output_fn ] ++ args) - -- suppress the generation of the .note.gnu.build-id section, - -- which we don't need and sometimes causes ld to emit a - -- warning: - ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"] - | otherwise = [] - if ldIsGnuLd then do script <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "ldscript" ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -81,7 +81,6 @@ module GHC.Driver.Session ( sTopDir, sGlobalPackageDatabasePath, sLdSupportsCompactUnwind, - sLdSupportsBuildId, sLdSupportsFilelist, sLdIsGnuLd, sGccSupportsNoPie, ===================================== compiler/GHC/Settings.hs ===================================== @@ -18,7 +18,6 @@ module GHC.Settings , sTopDir , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind - , sLdSupportsBuildId , sLdSupportsFilelist , sLdIsGnuLd , sGccSupportsNoPie @@ -87,7 +86,6 @@ data Settings = Settings -- platform-specific and platform-agnostic. data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool - , toolSettings_ldSupportsBuildId :: Bool , toolSettings_ldSupportsFilelist :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool @@ -189,8 +187,6 @@ sGlobalPackageDatabasePath = fileSettings_globalPackageDatabase . sFileSettings sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings -sLdSupportsBuildId :: Settings -> Bool -sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings sLdIsGnuLd :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -94,7 +94,6 @@ initSettings top_dir = do cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" - ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -163,7 +162,6 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind - , toolSettings_ldSupportsBuildId = ldSupportsBuildId , toolSettings_ldSupportsFilelist = ldSupportsFilelist , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie ===================================== hadrian/bindist/Makefile ===================================== @@ -91,7 +91,6 @@ lib/settings : @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -136,7 +136,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ -ld-has-build-id = @LdHasBuildId@ ld-has-filelist = @LdHasFilelist@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -311,7 +311,6 @@ generateSettings = do , ("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 build-id", expr $ lookupSystemConfig "ld-has-build-id") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) ===================================== m4/fp_prog_ld_build_id.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_PROG_LD_BUILD_ID -# ------------ -# Sets the output variable LdHasBuildId to YES if ld supports -# --build-id, or NO otherwise. -AC_DEFUN([FP_PROG_LD_BUILD_ID], -[ -AC_CACHE_CHECK([whether ld understands --build-id], [fp_cv_ld_build_id], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if ${LdCmd} -r --build-id=none -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_ld_build_id=yes -else - fp_cv_ld_build_id=no -fi -rm -rf conftest*]) -FP_CAPITALIZE_YES_NO(["$fp_cv_ld_build_id"], [LdHasBuildId]) -AC_SUBST([LdHasBuildId]) -])# FP_PROG_LD_BUILD_ID - - ===================================== mk/config.mk.in ===================================== @@ -724,10 +724,6 @@ OPT = @OptCmd@ # overflowing command-line length limits. LdIsGNULd = @LdIsGNULd@ -# Set to YES if ld has the --build-id flag. Sometimes we need to -# disable it with --build-id=none. -LdHasBuildId = @LdHasBuildId@ - # Set to YES if ld has the --no_compact_unwind flag. See #5019 # and GHC.Driver.Pipeline. LdHasNoCompactUnwind = @LdHasNoCompactUnwind@ ===================================== rts/include/ghc.mk ===================================== @@ -202,7 +202,6 @@ $(includes_SETTINGS) : rts/include/Makefile | $$(dir $$@)/. @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5aa2a581b68576d6cb57f6ebc21f5a8356a3bb79 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5aa2a581b68576d6cb57f6ebc21f5a8356a3bb79 You're receiving 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 Aug 17 07:56:56 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 17 Aug 2022 03:56:56 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Configure: remove EMSDK hacks. Use emconfigure instead Message-ID: <62fc9f48293cd_3d8149488a01817797@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 9bbb6b10 by Sylvain Henry at 2022-08-17T09:58:52+02:00 Configure: remove EMSDK hacks. Use emconfigure instead emconfigure ./configure --target=js-unknown-ghcjs - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -346,80 +346,36 @@ AC_SUBST(TargetHasRTSLinker) # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT -if test "$TargetOS" = "ghcjs" -then - - AC_ARG_VAR(EMSDK,[Use as the full path to Emscripten. [default=autodetect]]) - AC_ARG_VAR(EMSDK_LLVM,[Use as the full path to Emscripten LLVM. [default=autodetect]]) - AC_ARG_VAR(EMSDK_BIN,[Use as the full path to Emscripten binary folder. [default=autodetect]]) - - if test "$EMSDK" != "" ; then - echo "Using emsdk: $EMSDK" - elif test "$EMSDK_LLVM" != "" && "$EMSDK_BIN" != "" ; then - echo "Using manually defined emsdk LLVM and bin." - else - echo -e "Error: Could not find Emscripten SDK.\nCheck the EMSDK environment variable." - exit 1 - fi - - if test "$EMSDK_LLVM" != "" ; then - echo "Using emsdk LLVM: $EMSDK_LLVM" - else - echo "No emsdk LLVM set: defaulting to $EMSDK/upstream" - EMSDK_LLVM="$EMSDK/upstream" - fi - - if test "$EMSDK_BIN" != "" ; then - echo "Using emsdk bin: $EMSDK_BIN" - else - echo "No emsdk bin set: defaulting to $EMSDK/upstream/emscripten" - fi - - dnl We need to use AC_CHECK_TARGET_TOOL instead of AC_PATH_PROG below that - dnl doesn't take into account the target triple... - dnl Why are we inflicting all this to ourselves? - AC_PATH_TOOL([CC],[emcc],[gcc],[$EMSDK$PATH_SEPERATOR$PATH]) - AC_PATH_TOOL([CXX],[g++]) - AC_PATH_TOOL([NM],[llvm-nm],[nm],[$EMSDK_BIN$PATH_SEPERATOR$PATH]) - AC_PATH_TOOL([AR],[llvm-ar],[ar],[$EMSDK_BIN$PATH_SEPERATOR$PATH]) - AC_PATH_TOOL([RANLIB],[llvm-ranlib],[ranlib],[$EMSDK_BINF$PATH_SEPERATOR$PATH]) - AC_PATH_TOOL([OBJDUMP],[llvm-objdump],[objdump],[$EMSDK_BIN$PATH_SEPERATOR$PATH]) - - - +# Extract and configure the Windows toolchain +if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then + FP_SETUP_WINDOWS_TOOLCHAIN else - - # Extract and configure the Windows toolchain - if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then - FP_SETUP_WINDOWS_TOOLCHAIN - else - # Ideally should use AC_CHECK_TARGET_TOOL but our triples - # are screwed up. Configure doesn't think they're ever equal and - # so never tried without the prefix. - AC_PATH_TOOL([CC],[gcc], [clang]) - AC_PATH_TOOL([CXX],[g++], [clang++]) - AC_PATH_TOOL([NM],[nm]) - # N.B. we don't probe for LD here but instead - # do so in FIND_LD to avoid #21778. - AC_PATH_TOOL([AR],[ar]) - AC_PATH_TOOL([RANLIB],[ranlib]) - AC_PATH_TOOL([OBJDUMP],[objdump]) - AC_PATH_TOOL([DllWrap],[dllwrap]) - AC_PATH_TOOL([Windres],[windres]) - AC_PATH_TOOL([Genlib],[genlib]) - - HAVE_GENLIB=False - if test "$HostOS" = "mingw32"; then - AC_CHECK_TARGET_TOOL([Windres],[windres]) - AC_CHECK_TARGET_TOOL([DllWrap],[dllwrap]) - AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump]) - - if test "$Genlib" != ""; then - GenlibCmd="$(cygpath -m $Genlib)" - HAVE_GENLIB=True - fi - fi - fi + # Ideally should use AC_CHECK_TARGET_TOOL but our triples + # are screwed up. Configure doesn't think they're ever equal and + # so never tried without the prefix. + AC_PATH_TOOL([CC],[gcc], [clang]) + AC_PATH_TOOL([CXX],[g++], [clang++]) + AC_PATH_TOOL([NM],[nm]) + # N.B. we don't probe for LD here but instead + # do so in FIND_LD to avoid #21778. + AC_PATH_TOOL([AR],[ar]) + AC_PATH_TOOL([RANLIB],[ranlib]) + AC_PATH_TOOL([OBJDUMP],[objdump]) + AC_PATH_TOOL([DllWrap],[dllwrap]) + AC_PATH_TOOL([Windres],[windres]) + AC_PATH_TOOL([Genlib],[genlib]) + + HAVE_GENLIB=False + if test "$HostOS" = "mingw32"; then + AC_CHECK_TARGET_TOOL([Windres],[windres]) + AC_CHECK_TARGET_TOOL([DllWrap],[dllwrap]) + AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump]) + + if test "$Genlib" != ""; then + GenlibCmd="$(cygpath -m $Genlib)" + HAVE_GENLIB=True + fi + fi fi if test "$HostOS" = "mingw32"; then View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9bbb6b10e7c51c4114f73f078935001106a18e1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9bbb6b10e7c51c4114f73f078935001106a18e1e You're receiving 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 Aug 17 09:02:55 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Wed, 17 Aug 2022 05:02:55 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fcaebf68b29_3d8149488dc18367bd@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 5a3a0813 by Andreas Klebinger at 2022-08-17T11:02:29+02:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we only generate bytecode. In that case only for correctness reasons. Which is alright as it's fairly cheap to run. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 ------------------------- - - - - - 15 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -27,13 +27,12 @@ import GHC.Settings (Platform, platformUnregisterised) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc +import GHC.Stg.Pipeline (StgCgInfos) {- Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] @@ -180,8 +179,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> StgCgInfos -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos +generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -200,7 +199,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = stg_cg_infos} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,8 +186,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) -import GHC.Stg.InferTags +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Builtin.Utils import GHC.Builtin.Names @@ -268,6 +267,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1719,11 +1720,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1745,7 +1751,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do cmms <- {-# SCC "StgToCmm" #-} doCodeGen hsc_env this_mod denv data_tycons cost_centre_info - stg_binds hpc_info + stg_binds stg_cg_infos hpc_info ------------------ Code output ----------------------- rawcmms0 <- {-# SCC "cmmToRawCmm" #-} @@ -1766,7 +1772,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just cg_infos{ cgTagSigs = stg_cg_infos}) hscInteractive :: HscEnv @@ -1801,7 +1808,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1894,25 +1903,23 @@ This reduces residency towards the end of the CodeGen phase significantly doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs + -> StgCgInfos -> HpcInfo -> IO (Stream IO CmmGroupSRTs CgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. doCodeGen hsc_env this_mod denv data_tycons - cost_centre_info stg_binds_w_fvs hpc_info = do + cost_centre_info stg_binds_w_fvs stg_cg_info hpc_info = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + stg_ppr_opts = (initStgPprOpts dflags) putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1920,8 +1927,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1952,7 +1959,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv stg_cg_info pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool @@ -1960,7 +1967,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1976,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1984,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2006,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2157,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2394,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -221,13 +220,13 @@ the output of itself. -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,42 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When running code in GHCi we perform tag inference/rewrites +for each individual STG expression entered on the prompt. + +This means in GHCi for a sequence of: + > let x = True + > let y = x +We first run tagInference for `x = True`. While that computes a tag signature for `x` that information +is currently not persistet. +Then we process `y = x`, and to do so we check for the tag sig of `x` (which we don't have). +This isn't a problem as we can always just default to TagDunno and nothing bad will happen. + +But in a non-interactive context this would indicate an error as every binding +should be processed in dependency order for the whole module at once. +Therefore taggedness information should be available for every id mentioned in any RHS. + +So if a lookup fails we check if we are in an interactive context. If so we just default +to TagDunno. If we aren't in an interactive context this is an error and we have an assert +to check that. + +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} @@ -16,6 +17,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +66,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg pass. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,7 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -94,6 +94,7 @@ data CgInfos = CgInfos , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information , cgTagSigs :: !(NameEnv TagSig) + -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos. } -------------------------------------------------------------------------------- ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal')], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a3a081308be683500e6b22ca0f10df22b6f9fc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a3a081308be683500e6b22ca0f10df22b6f9fc7 You're receiving 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 Aug 17 10:15:40 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 Aug 2022 06:15:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t22057 Message-ID: <62fcbfcc78bc_3d8149488dc1863227@gitlab.mail> Matthew Pickering pushed new branch wip/t22057 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t22057 You're receiving 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 Aug 17 11:14:12 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 Aug 2022 07:14:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22065 Message-ID: <62fccd843200d_3d814948904188111b@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22065 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22065 You're receiving 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 Aug 17 11:15:59 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 Aug 2022 07:15:59 -0400 Subject: [Git][ghc/ghc][wip/T22065] 77 commits: Add a note about about W/W for unlifting strict arguments Message-ID: <62fccdefe9d9_3d814948850188668c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22065 at Glasgow Haskell Compiler / GHC Commits: fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 1844a430 by Simon Peyton Jones at 2022-08-17T12:17:19+01:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.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/33df3a4e0fe587126f36d11b875f7c4259519ecc...1844a43017af64caaa184abf43aa2725fbaa346a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/33df3a4e0fe587126f36d11b875f7c4259519ecc...1844a43017af64caaa184abf43aa2725fbaa346a You're receiving 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 Aug 17 12:12:32 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Wed, 17 Aug 2022 08:12:32 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fcdb306acff_3d8149488dc19052dd@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 4926ef75 by Andreas Klebinger at 2022-08-17T14:11:27+02:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 ------------------------- - - - - - 15 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -24,13 +24,12 @@ import GHC.Driver.Config.Cmm import GHC.Prelude import GHC.Runtime.Heap.Layout (isStackRep) import GHC.Settings (Platform, platformUnregisterised) +import GHC.Stg.Pipeline (StgCgInfos) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc @@ -180,8 +179,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> StgCgInfos -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos +generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -200,7 +199,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = stg_cg_infos} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,8 +186,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) -import GHC.Stg.InferTags +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Builtin.Utils import GHC.Builtin.Names @@ -268,6 +267,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1719,11 +1720,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1745,7 +1751,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do cmms <- {-# SCC "StgToCmm" #-} doCodeGen hsc_env this_mod denv data_tycons cost_centre_info - stg_binds hpc_info + stg_binds stg_cg_infos hpc_info ------------------ Code output ----------------------- rawcmms0 <- {-# SCC "cmmToRawCmm" #-} @@ -1766,7 +1772,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just cg_infos{ cgTagSigs = stg_cg_infos}) hscInteractive :: HscEnv @@ -1801,7 +1808,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1894,25 +1903,23 @@ This reduces residency towards the end of the CodeGen phase significantly doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs + -> StgCgInfos -> HpcInfo -> IO (Stream IO CmmGroupSRTs CgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. doCodeGen hsc_env this_mod denv data_tycons - cost_centre_info stg_binds_w_fvs hpc_info = do + cost_centre_info stg_binds_w_fvs stg_cg_info hpc_info = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + stg_ppr_opts = (initStgPprOpts dflags) putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1920,8 +1927,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1952,7 +1959,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv stg_cg_info pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool @@ -1960,7 +1967,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1976,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1984,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2006,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2157,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2394,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -221,13 +220,13 @@ the output of itself. -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,49 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When running code in GHCi we perform tag inference/rewrites +for individual expressions as part of stg2stg in order to uphold +Note [Strict Field Invariant]. See also #21083 and #22042. + +This means in GHCi for a sequence of: + > let x = True + > ... + > let y = StrictJust x +We first run tagInference for `x = True`. We compute a tag signature for `x` +but that information is currently not persistent inside GHCi. +When later on we run tag inference for `let y = StrictJust x` we check for +the tag sig of `x` inside inferConTag but we don't have any information about +the tagSig for `x` anymore. +The options to work around this are either have GHCi persist this information. +Or we just default to TagDunno in interactive contexts if the lookup fails. +For simplicity we do the later. + +The difference arises because we call stg2stg once with *all* binders for the +current module in non-interactive mode. E.g we would call stg2stg [x = True, y = StrictJust]. +This allows us to cache information about all in scope binders from the current Module. +This doesn't work in interactive mode where we first call `stg2stg [x = True]` +and later `stg2stg [y = StrictJust x]`. + +As a consequence if a lookup fails for an id from the current module we check if we are +in an interactive context. If so we just default to TagDunno. If we aren't in an interactive +context we consider this an error and we have an assert to check for that. +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -16,6 +16,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +65,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg pass. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,7 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -94,6 +94,7 @@ data CgInfos = CgInfos , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information , cgTagSigs :: !(NameEnv TagSig) + -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos. } -------------------------------------------------------------------------------- ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal')], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4926ef75f2a387865174ff4a93bd603b9c39b57a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4926ef75f2a387865174ff4a93bd603b9c39b57a You're receiving 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 Aug 17 12:18:59 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Wed, 17 Aug 2022 08:18:59 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fcdcb310e3b_3d814948850191233@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: a44dab5a by Andreas Klebinger at 2022-08-17T14:18:38+02:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 ------------------------- - - - - - 15 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -24,13 +24,12 @@ import GHC.Driver.Config.Cmm import GHC.Prelude import GHC.Runtime.Heap.Layout (isStackRep) import GHC.Settings (Platform, platformUnregisterised) +import GHC.Stg.Pipeline (StgCgInfos) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc @@ -180,8 +179,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> StgCgInfos -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos +generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -200,7 +199,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = stg_cg_infos} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,8 +186,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) -import GHC.Stg.InferTags +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Builtin.Utils import GHC.Builtin.Names @@ -268,6 +267,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1719,11 +1720,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1745,7 +1751,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do cmms <- {-# SCC "StgToCmm" #-} doCodeGen hsc_env this_mod denv data_tycons cost_centre_info - stg_binds hpc_info + stg_binds stg_cg_infos hpc_info ------------------ Code output ----------------------- rawcmms0 <- {-# SCC "cmmToRawCmm" #-} @@ -1766,7 +1772,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just cg_infos{ cgTagSigs = stg_cg_infos}) hscInteractive :: HscEnv @@ -1801,7 +1808,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1894,25 +1903,23 @@ This reduces residency towards the end of the CodeGen phase significantly doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs + -> StgCgInfos -> HpcInfo -> IO (Stream IO CmmGroupSRTs CgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. doCodeGen hsc_env this_mod denv data_tycons - cost_centre_info stg_binds_w_fvs hpc_info = do + cost_centre_info stg_binds_w_fvs stg_cg_info hpc_info = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + stg_ppr_opts = (initStgPprOpts dflags) putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1920,8 +1927,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1952,7 +1959,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv stg_cg_info pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool @@ -1960,7 +1967,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1976,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1984,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2006,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2157,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2394,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -221,13 +220,13 @@ the output of itself. -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,49 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When running code in GHCi we perform tag inference/rewrites +for individual expressions as part of stg2stg in order to uphold +Note [Strict Field Invariant]. See also #21083 and #22042. + +This means in GHCi for a sequence of: + > let x = True + > ... + > let y = StrictJust x +We first run tagInference for `x = True`. We compute a tag signature for `x` +but that information is currently not persistent inside GHCi. +When later on we run tag inference for `let y = StrictJust x` we check for +the tag sig of `x` inside inferConTag but we don't have any information about +the tagSig for `x` anymore. +The options to work around this are either have GHCi persist this information. +Or we just default to TagDunno in interactive contexts if the lookup fails. +For simplicity we do the later. + +The difference arises because we call stg2stg once with *all* binders for the +current module in non-interactive mode. E.g we would call stg2stg [x = True, y = StrictJust]. +This allows us to cache information about all in scope binders from the current Module. +This doesn't work in interactive mode where we first call `stg2stg [x = True]` +and later `stg2stg [y = StrictJust x]`. + +As a consequence if a lookup fails for an id from the current module we check if we are +in an interactive context. If so we just default to TagDunno. If we aren't in an interactive +context we consider this an error and we have an assert to check for that. +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -16,6 +16,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +65,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg pass. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,7 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -94,6 +94,7 @@ data CgInfos = CgInfos , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information , cgTagSigs :: !(NameEnv TagSig) + -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos. } -------------------------------------------------------------------------------- ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal',unless(have_dynamic(), skip))], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a44dab5a3f141b0e88a62d3ffd28fe15b0e8a9e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a44dab5a3f141b0e88a62d3ffd28fe15b0e8a9e7 You're receiving 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 Aug 17 13:49:19 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 17 Aug 2022 09:49:19 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: PrimOp: fix timesInt32 Message-ID: <62fcf1dfef6da_3d8149489a419428de@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 030bd453 by Sylvain Henry at 2022-08-17T12:00:54+02:00 PrimOp: fix timesInt32 - - - - - 4382f3e2 by Sylvain Henry at 2022-08-17T15:52:04+02:00 PrimOp: use mulWord32 when appropriate - - - - - 2 changed files: - compiler/GHC/StgToJS/Prim.hs - js/arith.js.pp Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -62,7 +62,6 @@ genPrim prof ty op = case op of IntSubOp -> \[r] [x,y] -> PrimInline $ r |= trunc (Sub x y) IntMulOp -> \[r] [x,y] -> PrimInline $ r |= app "h$mulInt32" [x, y] IntMul2Op -> \[c,hr,lr] [x,y] -> PrimInline $ appT [c,hr,lr] "h$hs_timesInt2" [x, y] --- fixme may will give the wrong result in case of overflow IntMulMayOfloOp -> \[r] [x,y] -> PrimInline $ jVar \tmp -> mconcat [ tmp |= Mul x y , r |= if01 (tmp .===. trunc tmp) @@ -288,7 +287,7 @@ genPrim prof ty op = case op of Int64ToWord64Op -> \[r1,r2] [x1,x2] -> PrimInline $ mconcat - [ r1 |= x1 + [ r1 |= x1 .>>>. 0 , r2 |= x2 ] IntToInt64Op -> \[r1,r2] [x] -> ===================================== js/arith.js.pp ===================================== @@ -405,7 +405,7 @@ function h$hs_timesInt2(a,b) { RETURN_UBX_TUP3(0,a<0?(-1):0,a); } - var cl = (a * b)|0; + var cl = h$mulInt32(a,b); var ha = a >> 16; var la = a & 0xFFFF; @@ -413,13 +413,13 @@ function h$hs_timesInt2(a,b) { var hb = b >> 16; var lb = b & 0xFFFF; - var w0 = (la*lb)|0; - var t = ((ha*lb)|0 + (w0 >> 16))|0; + var w0 = la * lb; + var t = (h$mulInt32(ha,lb) + (w0 >>> 16))|0; var w1 = t & 0xFFFF; var w2 = t >> 16; - w1 = ((la*hb)|0 + w1)|0; + w1 = (h$mulInt32(la,hb) + w1)|0; - var ch = (ha*hb + w2 + w1 >> 16)|0; + var ch = ((h$mulInt32(ha,hb) + w2)|0 + (w1 >> 16))|0; var nh = ((ch === 0 && cl >= 0) || (ch === -1 && cl < 0)) ? 0 : 1 TRACE_ARITH("timesInt2 results:" + nh + " " + ch + " " + cl); @@ -498,7 +498,7 @@ function h$mul2Word32(l1,l2) { c48 += c32 >>> 16; c32 &= 0xFFFF; c48 &= 0xFFFF; - RETURN_UBX_TUP2((c48 << 16) | c32, (c16 << 16) | c00); + RETURN_UBX_TUP2(UN((c48 << 16) | c32), UN((c16 << 16) | c00)); } function h$quotWord32(n,d) { @@ -509,8 +509,8 @@ function h$quotWord32(n,d) { var t = d >> 31; var n2 = n & ~t; var q = ((n2 >>> 1) / d) << 1; - var r = (n - q * d) >>> 0; - var c = (r >>> 0) >= (d >>> 0); + var r = (n - h$mulWord32(q,d)) >>> 0; + var c = UN(r) >= UN(d); return (q + (c ? 1 : 0)) >>> 0; } @@ -520,9 +520,9 @@ function h$remWord32(n,d) { var t = d >> 31; var n2 = n & ~t; var q = ((n2 >>> 1) / d) << 1; - var r = (n - q * d) >>> 0; - var c = (r >>> 0) >= (d >>> 0); - return (r - (c ? d : 0)) >>> 0; + var r = (n - h$mulWord32(q,d)) >>> 0; + var c = UN(r) >= UN(d); + return UN(r - (c ? d : 0)); } function h$quotRemWord32(n,d) { @@ -531,7 +531,7 @@ function h$quotRemWord32(n,d) { var t = d >> 31; var n2 = n & ~t; var q = ((n2 >>> 1) / d) << 1; - var r = UN(n - q * d); + var r = UN(n - h$mulWord32(q,d)); var c = UN(r) >= UN(d); var rq = UN(q + (c ? 1 : 0)); var rr = UN(r - (c ? d : 0)); @@ -544,6 +544,10 @@ function h$quotRemWord32(n,d) { function h$quotRem2Word32(nh,nl,d) { TRACE_ARITH("quotRem2Word32 " + nh + " " + nl + " " + d); + if (nh === 0) { + return h$quotRemWord32(nl,d); + } + // from Hacker's Delight book (p196) nh = UN(nh); @@ -565,8 +569,8 @@ function h$quotRem2Word32(nh,nl,d) { var dh = d >>> 16; // break divisor up into two 16-bit digits var dl = d & 0xFFFF; - TRACE_ARITH("quotRem2Word32 s " + s); - TRACE_ARITH("quotRem2Word32 normalized d " + d + " " + dh + " " + dl); + //TRACE_ARITH("quotRem2Word32 s " + s); + //TRACE_ARITH("quotRem2Word32 normalized d " + d + " " + dh + " " + dl); // shift dividend left too var un32 = UN((nh << s) | ((nl >>> (32-s)) & ((-s) >> 31))); @@ -575,29 +579,29 @@ function h$quotRem2Word32(nh,nl,d) { var un1 = un10 >>> 16; // break lower part of the divisor into two 16-bit digits var un0 = un10 & 0xFFFF; - TRACE_ARITH("quotRem2Word32 uns " + un32 + " " + un10 + " " + un1 + " " + un0); + //TRACE_ARITH("quotRem2Word32 uns " + un32 + " " + un10 + " " + un1 + " " + un0); var q1 = UN(un32 / dh); // compute first quotient digit q1 - var rhat = UN(un32 - UN(q1*dh)); + var rhat = UN(un32 - h$mulWord32(q1,dh)); - TRACE_ARITH("quotRem2Word32 q1 rhat " + q1 + " " + rhat); + //TRACE_ARITH("quotRem2Word32 q1 rhat " + q1 + " " + rhat); - while (q1 > 0xFFFF || UN(q1*dl) > (UN(UN(rhat << 16) | un1))) { + while (q1 > 0xFFFF || h$mulWord32(q1,dl) > (UN(UN(rhat << 16) | un1))) { q1 = UN(q1 - 1); rhat = UN(rhat + dh); if (rhat > 0xFFFF) break; } - TRACE_ARITH("quotRem2Word32 q1' rhat' " + q1 + " " + rhat); + //TRACE_ARITH("quotRem2Word32 q1' rhat' " + q1 + " " + rhat); var un21 = UN(UN(UN(un32 << 16) | un1) - UN(q1*d)); - TRACE_ARITH("quotRem2Word32 un21 " + un21); + //TRACE_ARITH("quotRem2Word32 un21 " + un21); var q0 = UN(un21 / dh); // compute second quotient digit q0 - rhat = UN(un21 - UN(q0*dh)); + rhat = UN(un21 - h$mulWord32(q0,dh)); - TRACE_ARITH("quotRem2Word32 q0 rhat " + q0 + " " + rhat); + //TRACE_ARITH("quotRem2Word32 q0 rhat " + q0 + " " + rhat); while (q0 > 0xFFFF || UN(q0*dl) > UN(UN(rhat << 16) + un0)) { q0 = UN(q0 - 1); @@ -605,10 +609,10 @@ function h$quotRem2Word32(nh,nl,d) { if (rhat > 0xFFFF) break; } - TRACE_ARITH("quotRem2Word32 q0' rhat' " + q0 + " " + rhat); + //TRACE_ARITH("quotRem2Word32 q0' rhat' " + q0 + " " + rhat); var rq = UN(q1 << 16 | q0); - var rr = (UN(UN(un21 << 16) | un0) - UN(q0*d)) >>> s; + var rr = (UN(UN(un21 << 16) | un0) - h$mulWord32(q0,d)) >>> s; TRACE_ARITH("quotRem2Word32 results: " + rq + " " + rr); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbb6b10e7c51c4114f73f078935001106a18e1e...4382f3e2c8ad443dc703411b6bc0e3c98e62487a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbb6b10e7c51c4114f73f078935001106a18e1e...4382f3e2c8ad443dc703411b6bc0e3c98e62487a You're receiving 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 Aug 17 15:47:14 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 Aug 2022 11:47:14 -0400 Subject: [Git][ghc/ghc][wip/T22065] Be more careful in chooseInferredQuantifiers Message-ID: <62fd0d8298cc8_3d81494883c1953270@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22065 at Glasgow Haskell Compiler / GHC Commits: 56b28658 by Simon Peyton Jones at 2022-08-17T16:48:39+01:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 7 changed files: - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/Var.hs - + testsuite/tests/partial-sigs/should_compile/T16152.hs - + testsuite/tests/partial-sigs/should_compile/T16152.stderr - + testsuite/tests/partial-sigs/should_compile/T22065.hs - + testsuite/tests/partial-sigs/should_compile/T22065.stderr - testsuite/tests/partial-sigs/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -43,6 +43,7 @@ import GHC.Tc.Solver import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Core.Predicate +import GHC.Core.TyCo.Ppr( pprTyVars ) import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType @@ -59,7 +60,7 @@ import GHC.Types.SourceText import GHC.Types.Id import GHC.Types.Var as Var import GHC.Types.Var.Set -import GHC.Types.Var.Env( TidyEnv ) +import GHC.Types.Var.Env( TidyEnv, TyVarEnv, mkVarEnv, lookupVarEnv ) import GHC.Unit.Module import GHC.Types.Name import GHC.Types.Name.Set @@ -934,7 +935,8 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; let psig_qtvs = map binderVar psig_qtv_bndrs psig_qtv_set = mkVarSet psig_qtvs psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs - + psig_bndr_map :: TyVarEnv InvisTVBinder + psig_bndr_map = mkVarEnv [ (binderVar tvb, tvb) | tvb <- psig_qtv_bndrs ] -- Check whether the quantified variables of the -- partial signature have been unified together @@ -950,32 +952,35 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; annotated_theta <- zonkTcTypes annotated_theta ; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx + -- NB: free_tvs includes tau_tvs + + ; let (_,final_qtvs) = foldr (choose_qtv psig_bndr_map) (free_tvs, []) qtvs + -- Pulling from qtvs maintains original order + -- NB: qtvs is already in dependency order - ; let keep_me = free_tvs `unionVarSet` psig_qtv_set - final_qtvs = [ mkTyVarBinder vis tv - | tv <- qtvs -- Pulling from qtvs maintains original order - , tv `elemVarSet` keep_me - , let vis = case lookupVarBndr tv psig_qtv_bndrs of - Just spec -> spec - Nothing -> InferredSpec ] + ; traceTc "chooseInferredQuantifiers" $ + vcat [ text "qtvs" <+> pprTyVars qtvs + , text "psig_qtv_bndrs" <+> ppr psig_qtv_bndrs + , text "free_tvs" <+> ppr free_tvs + , text "final_tvs" <+> ppr final_qtvs ] ; return (final_qtvs, my_theta) } where - report_dup_tyvar_tv_err (n1,n2) - = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) - - report_mono_sig_tv_err (n,tv) - = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) - where - m_unif_ty = listToMaybe - [ rhs - -- recall that residuals are always implications - | residual_implic <- bagToList $ wc_impl residual - , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) - , let residual_pred = ctPred residual_ct - , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] - , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] - , lhs_tv == tv ] + choose_qtv :: TyVarEnv InvisTVBinder -> TcTyVar + -> (TcTyVarSet, [InvisTVBinder]) -> (TcTyVarSet, [InvisTVBinder]) + -- Pick which of the original qtvs should be retained + -- Keep it if (a) it is mentioned in the body of the type (free_tvs) + -- (b) it is a forall'd variable of the partial signature (psig_qtv_bndrs) + -- (c) it is mentioned in the kind of a retained qtv (#22065) + choose_qtv psig_bndr_map tv (free_tvs, qtvs) + | Just psig_bndr <- lookupVarEnv psig_bndr_map tv + = (free_tvs', psig_bndr : qtvs) + | tv `elemVarSet` free_tvs + = (free_tvs', mkTyVarBinder InferredSpec tv : qtvs) + | otherwise -- Do not pick it + = (free_tvs, qtvs) + where + free_tvs' = free_tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType -> TcM (VarSet, TcThetaType) @@ -1019,6 +1024,22 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs -- Return (annotated_theta ++ diff_theta) -- See Note [Extra-constraints wildcards] + report_dup_tyvar_tv_err (n1,n2) + = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) + + report_mono_sig_tv_err (n,tv) + = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) + where + m_unif_ty = listToMaybe + [ rhs + -- recall that residuals are always implications + | residual_implic <- bagToList $ wc_impl residual + , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) + , let residual_pred = ctPred residual_ct + , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] + , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] + , lhs_tv == tv ] + mk_ctuple preds = mkBoxedTupleTy preds -- Hack alert! See GHC.Tc.Gen.HsType: -- Note [Extra-constraint holes in partial type signatures] ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Types.Var ( mkTyVarBinder, mkTyVarBinders, isTyVarBinder, tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, - mapVarBndr, mapVarBndrs, lookupVarBndr, + mapVarBndr, mapVarBndrs, -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -696,11 +696,6 @@ mapVarBndr f (Bndr v fl) = Bndr (f v) fl mapVarBndrs :: (var -> var') -> [VarBndr var flag] -> [VarBndr var' flag] mapVarBndrs f = map (mapVarBndr f) -lookupVarBndr :: Eq var => var -> [VarBndr var flag] -> Maybe flag -lookupVarBndr var bndrs = lookup var zipped_bndrs - where - zipped_bndrs = map (\(Bndr v f) -> (v,f)) bndrs - instance Outputable tv => Outputable (VarBndr tv ArgFlag) where ppr (Bndr v Required) = ppr v ppr (Bndr v Specified) = char '@' <> ppr v ===================================== testsuite/tests/partial-sigs/should_compile/T16152.hs ===================================== @@ -0,0 +1,8 @@ +{-# Language PartialTypeSignatures #-} +{-# Language PolyKinds #-} +{-# Language ScopedTypeVariables #-} + +module T16152 where + +top :: forall f. _ +top = undefined ===================================== testsuite/tests/partial-sigs/should_compile/T16152.stderr ===================================== @@ -0,0 +1,7 @@ + +T16152.hs:7:18: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of top :: w + at T16152.hs:8:1-15 + • In the type signature: top :: forall f. _ ===================================== testsuite/tests/partial-sigs/should_compile/T22065.hs ===================================== @@ -0,0 +1,30 @@ +{-# Options_GHC -dcore-lint #-} +{-# Language PartialTypeSignatures #-} + +module T22065 where + +data Foo where + Apply :: (x -> Int) -> x -> Foo + +foo :: Foo +foo = Apply f x :: forall a. _ where + + f :: [_] -> Int + f = length @[] @_ + + x :: [_] + x = mempty @[_] + +{- +Smaller version I used when debuggging + +apply :: (x->Int) -> x -> Bool +apply = apply + +foo :: Bool +foo = apply f x :: forall a. _ + where + f = length @[] + x = mempty + +-} ===================================== testsuite/tests/partial-sigs/should_compile/T22065.stderr ===================================== @@ -0,0 +1,53 @@ + +T22065.hs:10:30: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Foo’ + • In an expression type signature: forall a. _ + In the expression: Apply f x :: forall a. _ + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + f :: forall {w}. [w] -> Int (bound at T22065.hs:13:3) + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of f :: [w] -> Int + at T22065.hs:13:3-19 + • In the type ‘[_] -> Int’ + In the type signature: f :: [_] -> Int + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:15:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of x :: [w] + at T22065.hs:16:3-17 + • In the type ‘[_]’ + In the type signature: x :: [_] + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include foo :: Foo (bound at T22065.hs:10:1) ===================================== testsuite/tests/partial-sigs/should_compile/all.T ===================================== @@ -105,3 +105,5 @@ test('T20921', normal, compile, ['']) test('T21719', normal, compile, ['']) test('InstanceGivenOverlap3', expect_broken(20076), compile, ['']) test('T21667', normal, compile, ['']) +test('T22065', normal, compile, ['']) +test('T16152', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b28658d4220e4258e8bec45aca045c31c9e240 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b28658d4220e4258e8bec45aca045c31c9e240 You're receiving 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 Aug 17 15:47:42 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 Aug 2022 11:47:42 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble Typeable binds etc Message-ID: <62fd0d9ebb9f_3d814948878195379e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 184a8f9d by Simon Peyton Jones at 2022-08-17T16:48:54+01:00 Wibble Typeable binds etc - - - - - 9 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Validity.hs - libraries/ghc-prim/GHC/Types.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -258,6 +258,7 @@ basicKnownKeyNames starKindRepName, starArrStarKindRepName, starArrStarArrStarKindRepName, + constraintKindRepName, -- WithDict withDictClassName, @@ -1401,10 +1402,12 @@ typeCharTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeCharTypeRep") type trGhcPrimModuleName = varQual gHC_TYPES (fsLit "tr$ModuleGHCPrim") trGhcPrimModuleKey -- Typeable KindReps for some common cases -starKindRepName, starArrStarKindRepName, starArrStarArrStarKindRepName :: Name -starKindRepName = varQual gHC_TYPES (fsLit "krep$*") starKindRepKey -starArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*Arr*") starArrStarKindRepKey -starArrStarArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*->*->*") starArrStarArrStarKindRepKey +starKindRepName, starArrStarKindRepName, + starArrStarArrStarKindRepName, constraintKindRepName :: Name +starKindRepName = varQual gHC_TYPES (fsLit "krep$*") starKindRepKey +starArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*Arr*") starArrStarKindRepKey +starArrStarArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*->*->*") starArrStarArrStarKindRepKey +constraintKindRepName = varQual gHC_TYPES (fsLit "krep$Constraint") constraintKindRepKey -- WithDict withDictClassName :: Name @@ -2492,14 +2495,15 @@ tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 515 trLiftedRepKey = mkPreludeMiscIdUnique 516 -- KindReps for common cases -starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique -starKindRepKey = mkPreludeMiscIdUnique 520 -starArrStarKindRepKey = mkPreludeMiscIdUnique 521 +starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey, constraintKindRepKey :: Unique +starKindRepKey = mkPreludeMiscIdUnique 520 +starArrStarKindRepKey = mkPreludeMiscIdUnique 521 starArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522 +constraintKindRepKey = mkPreludeMiscIdUnique 523 -- Dynamic toDynIdKey :: Unique -toDynIdKey = mkPreludeMiscIdUnique 523 +toDynIdKey = mkPreludeMiscIdUnique 530 bitIntegerIdKey :: Unique ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -1087,8 +1087,8 @@ mkAbsentErrorApp :: Type -- The type to instantiate 'a' mkAbsentErrorApp res_ty err_msg = mkApps (Var err_id) [ Type res_ty, err_string ] where - err_id | isConstraintKind (typeKind res_ty) = aBSENT_CONSTRAINT_ERROR_ID - | otherwise = aBSENT_ERROR_ID + err_id | isConstraintLikeKind (typeKind res_ty) = aBSENT_CONSTRAINT_ERROR_ID + | otherwise = aBSENT_ERROR_ID err_string = Lit (mkLitString err_msg) absentErrorName, absentConstraintErrorName :: Name ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -156,9 +156,6 @@ data TypeMapX a -- | Squeeze out any synonyms, and change TyConApps to nested AppTys. Why the -- last one? See Note [Equality on AppTys] in GHC.Core.Type -- --- Note, however, that we keep Constraint and Type apart here, despite the fact --- that they are both synonyms of TYPE 'LiftedRep (see #11715). --- -- We also keep (Eq a => a) as a FunTy, distinct from ((->) (Eq a) a). trieMapView :: Type -> Maybe Type trieMapView ty @@ -168,7 +165,9 @@ trieMapView ty = Just $ foldl' AppTy (mkTyConTy tc) tys -- Then resolve any remaining nullary synonyms. - | Just ty' <- tcView ty = Just ty' + | Just ty' <- tcView ty + = Just ty' + trieMapView _ = Nothing instance TrieMap TypeMapX where ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -156,8 +156,9 @@ module GHC.Core.Type ( -- ** Finding the kind of a type typeKind, tcTypeKind, typeHasFixedRuntimeRep, argsHaveFixedRuntimeRep, - tcIsLiftedTypeKind, isConstraintKind, tcReturnsConstraintKind, - tcIsBoxedTypeKind, tcIsRuntimeTypeKind, + tcIsLiftedTypeKind, + isConstraintKind, isConstraintLikeKind, returnsConstraintKind, + tcIsBoxedTypeKind, isTypeLikeKind, -- ** Common Kind liftedTypeKind, unliftedTypeKind, @@ -1662,63 +1663,6 @@ tcSplitTyConApp_maybe ty mkTyConTy :: TyCon -> Type mkTyConTy tycon = tyConNullaryTy tycon --- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to --- its arguments. Applies its arguments to the constructor from left to right. -mkTyConApp :: TyCon -> [Type] -> Type -mkTyConApp tycon [] - = -- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon - mkTyConTy tycon - -mkTyConApp tycon tys@(ty1:rest) - | Just (af, mult, arg, res) <- tyConAppFun_maybe id tycon tys - = FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res } - - -- See Note [Using synonyms to compress types] - | key == tYPETyConKey - = assert (null rest) $ --- mkTYPEapp_maybe ty1 `orElse` bale_out - case mkTYPEapp_maybe ty1 of - Just ty -> ty -- pprTrace "mkTYPEapp:yes" (ppr ty) ty - Nothing -> bale_out -- pprTrace "mkTYPEapp:no" (ppr bale_out) bale_out - - -- See Note [Using synonyms to compress types] - | key == boxedRepDataConTyConKey - = assert (null rest) $ --- mkBoxedRepApp_maybe ty1 `orElse` bale_out - case mkBoxedRepApp_maybe ty1 of - Just ty -> ty -- pprTrace "mkBoxedRepApp:yes" (ppr ty) ty - Nothing -> bale_out -- pprTrace "mkBoxedRepApp:no" (ppr bale_out) bale_out - - | key == tupleRepDataConTyConKey - = case mkTupleRepApp_maybe ty1 of - Just ty -> ty -- pprTrace "mkTupleRepApp:yes" (ppr ty) ty - Nothing -> bale_out -- pprTrace "mkTupleRepApp:no" (ppr bale_out) bale_out - - -- The catch-all case - | otherwise - = bale_out - where - key = tyConUnique tycon - bale_out = TyConApp tycon tys - - -{- Note [Care using synonyms to compress types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Using a synonym to compress a types has a tricky wrinkle. Consider -coreView applied to (TyConApp LiftedRep []) - -* coreView expands the LiftedRep synonym: - type LiftedRep = BoxedRep Lifted - -* Danger: we might apply the empty substitution to the RHS of the - synonym. And substTy calls mkTyConApp BoxedRep [Lifted]. And - mkTyConApp compresses that back to LiftedRep. Loop! - -* Solution: in expandSynTyConApp_maybe, don't call substTy for nullary - type synonyms. That's more efficient anyway. --} - - ------------------- newTyConInstRhs :: TyCon -> [Type] -> Type -- ^ Unwrap one 'layer' of newtype on a type constructor and its @@ -3085,13 +3029,19 @@ classifiesTypeWithValues :: Kind -> Bool -- ^ True of a kind `TYPE _` or `CONSTRAINT _` classifiesTypeWithValues k = isJust (sORTKind_maybe k) -isConstraintKind :: Kind -> Bool +isConstraintLikeKind :: Kind -> Bool -- True of (CONSTRAINT _) +isConstraintLikeKind kind + = case sORTKind_maybe kind of + Just (ConstraintLike, _) -> True + _ -> False + +isConstraintKind :: Kind -> Bool +-- True of (CONSTRAINT LiftedRep) isConstraintKind kind - | Just (ConstraintLike, _) <- sORTKind_maybe kind - = True - | otherwise - = False + = case sORTKind_maybe kind of + Just (ConstraintLike, rep) -> isLiftedRuntimeRep rep + _ -> False tcIsLiftedTypeKind :: Kind -> Bool -- ^ Is this kind equivalent to 'Type' i.e. TYPE LiftedRep? @@ -3118,23 +3068,21 @@ tcIsBoxedTypeKind kind -- | Is this kind equivalent to @TYPE r@ (for some unknown r)? -- -- This considers 'Constraint' to be distinct from @*@. -tcIsRuntimeTypeKind :: Kind -> Bool -tcIsRuntimeTypeKind kind - | Just (TypeLike, _) <- sORTKind_maybe kind - = True - | otherwise - = False +isTypeLikeKind :: Kind -> Bool +isTypeLikeKind kind + = case sORTKind_maybe kind of + Just (TypeLike, _) -> True + _ -> False -tcReturnsConstraintKind :: Kind -> Bool +returnsConstraintKind :: Kind -> Bool -- True <=> the Kind ultimately returns a Constraint -- E.g. * -> Constraint -- forall k. k -> Constraint -tcReturnsConstraintKind kind - | Just kind' <- tcView kind = tcReturnsConstraintKind kind' -tcReturnsConstraintKind (ForAllTy _ ty) = tcReturnsConstraintKind ty -tcReturnsConstraintKind (FunTy { ft_res = ty }) = tcReturnsConstraintKind ty -tcReturnsConstraintKind (TyConApp tc _) = isConstraintKindCon tc -tcReturnsConstraintKind _ = False +returnsConstraintKind kind + | Just kind' <- tcView kind = returnsConstraintKind kind' +returnsConstraintKind (ForAllTy _ ty) = returnsConstraintKind ty +returnsConstraintKind (FunTy { ft_res = ty }) = returnsConstraintKind ty +returnsConstraintKind kind = isConstraintLikeKind kind -------------------------- typeLiteralKind :: TyLit -> Kind @@ -3959,6 +3907,59 @@ e.g., during comparison. See #17958, #20541 -} +-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to +-- its arguments. Applies its arguments to the constructor from left to right. +mkTyConApp :: TyCon -> [Type] -> Type +mkTyConApp tycon [] + = -- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon + mkTyConTy tycon + +mkTyConApp tycon tys@(ty1:rest) + | Just (af, mult, arg, res) <- tyConAppFun_maybe id tycon tys + = FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res } + + -- See Note [Using synonyms to compress types] + | key == tYPETyConKey + , Just ty <- mkTYPEapp_maybe ty1 + = assert (null rest) ty + + | key == cONSTRAINTTyConKey + , Just ty <- mkCONSTRAINTapp_maybe ty1 + = assert (null rest) ty + + -- See Note [Using synonyms to compress types] + | key == boxedRepDataConTyConKey + , Just ty <- mkBoxedRepApp_maybe ty1 + = assert (null rest) ty + + | key == tupleRepDataConTyConKey + , Just ty <- mkTupleRepApp_maybe ty1 + = assert (null rest) ty + + -- The catch-all case + | otherwise + = TyConApp tycon tys + where + key = tyConUnique tycon + + +{- Note [Care using synonyms to compress types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Using a synonym to compress a types has a tricky wrinkle. Consider +coreView applied to (TyConApp LiftedRep []) + +* coreView expands the LiftedRep synonym: + type LiftedRep = BoxedRep Lifted + +* Danger: we might apply the empty substitution to the RHS of the + synonym. And substTy calls mkTyConApp BoxedRep [Lifted]. And + mkTyConApp compresses that back to LiftedRep. Loop! + +* Solution: in expandSynTyConApp_maybe, don't call substTy for nullary + type synonyms. That's more efficient anyway. +-} + + mkTYPEapp :: RuntimeRepType -> Type mkTYPEapp rr = case mkTYPEapp_maybe rr of ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2078,7 +2078,7 @@ pprTcSolverReportMsg _ 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+> quotes (ppr act)) where - kind_desc | isConstraintKind exp = text "a constraint" + kind_desc | isConstraintLikeKind exp = text "a constraint" | Just arg <- kindRep_maybe exp -- TYPE t0 , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case True -> text "kind" <+> quotes (ppr exp) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1177,7 +1177,7 @@ tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind = tc_lhs_type mode rn_ty exp_kind -- See Note [Body kind of a HsQualTy] - | isConstraintKind exp_kind + | isConstraintLikeKind exp_kind = do { ctxt' <- tc_hs_context mode ctxt ; ty' <- tc_lhs_type mode rn_ty constraintKind ; return (tcMkDFunPhiTy ctxt' ty') } @@ -1395,9 +1395,9 @@ tupKindSort_maybe :: TcKind -> Maybe TupleSort tupKindSort_maybe k | Just (k', _) <- splitCastTy_maybe k = tupKindSort_maybe k' | Just k' <- tcView k = tupKindSort_maybe k' - | isConstraintKind k = Just ConstraintTuple - | tcIsLiftedTypeKind k = Just BoxedTuple - | otherwise = Nothing + | isConstraintKind k = Just ConstraintTuple + | tcIsLiftedTypeKind k = Just BoxedTuple + | otherwise = Nothing tc_tuple :: HsType GhcRn -> TcTyMode -> TupleSort -> [LHsType GhcRn] -> TcKind -> TcM TcType tc_tuple rn_ty mode tup_sort tys exp_kind @@ -3729,8 +3729,8 @@ splitTyConKind skol_info in_scope avoid_occs kind ; return (go new_occs new_uniqs subst [] kind) } isAllowedDataResKind :: AllowedDataResKind -> Kind -> Bool -isAllowedDataResKind AnyTYPEKind kind = tcIsRuntimeTypeKind kind -isAllowedDataResKind AnyBoxedKind kind = tcIsBoxedTypeKind kind +isAllowedDataResKind AnyTYPEKind kind = isTypeLikeKind kind +isAllowedDataResKind AnyBoxedKind kind = tcIsBoxedTypeKind kind isAllowedDataResKind LiftedKind kind = tcIsLiftedTypeKind kind -- | Checks that the return kind in a data declaration's kind signature is @@ -3821,7 +3821,7 @@ checkDataKindSig data_sort kind TcRnInvalidReturnKind data_sort (allowed_kind dflags) kind (ext_hint dflags) ext_hint dflags - | tcIsRuntimeTypeKind kind + | isTypeLikeKind kind , is_newtype , not (xopt LangExt.UnliftedNewtypes dflags) = Just SuggestUnliftedNewtypes ===================================== compiler/GHC/Tc/Instance/Typeable.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Tc.Instance.Typeable(mkTypeableBinds, tyConIsTypeable) where import GHC.Prelude import GHC.Platform -import GHC.Types.Basic ( Boxity(..), neverInlinePragma ) +import GHC.Types.Basic ( Boxity(..), TypeOrConstraint(..), neverInlinePragma ) import GHC.Types.SourceText ( SourceText(..) ) import GHC.Iface.Env( newGlobalBinder ) import GHC.Core.TyCo.Rep( Type(..), TyLit(..) ) @@ -330,9 +330,11 @@ mkPrimTypeableTodos -- Build TypeRepTodos for built-in KindReps ; todo1 <- todoForExportedKindReps builtInKindReps + -- Build TypeRepTodos for types in GHC.Prim ; todo2 <- todoForTyCons gHC_PRIM ghc_prim_module_id ghcPrimTypeableTyCons + ; return ( gbl_env' , [todo1, todo2]) } else do gbl_env <- getGblEnv @@ -464,12 +466,14 @@ newtype KindRepM a = KindRepM { unKindRepM :: StateT KindRepEnv TcRn a } liftTc :: TcRn a -> KindRepM a liftTc = KindRepM . lift --- | We generate @KindRep at s for a few common kinds in @GHC.Types@ so that they +-- | We generate `KindRep`s for a few common kinds, so that they -- can be reused across modules. +-- These definitions are generated in `ghc-prim:GHC.Types`. builtInKindReps :: [(Kind, Name)] builtInKindReps = - [ (star, starKindRepName) - , (mkVisFunTyMany star star, starArrStarKindRepName) + [ (star, starKindRepName) + , (constraintKind, constraintKindRepName) + , (mkVisFunTyMany star star, starArrStarKindRepName) , (mkVisFunTysMany [star, star] star, starArrStarArrStarKindRepName) ] where @@ -481,6 +485,7 @@ initialKindRepEnv = foldlM add_kind_rep emptyTypeMap builtInKindReps add_kind_rep acc (k,n) = do id <- tcLookupId n return $! extendTypeMap acc k (id, Nothing) + -- The TypeMap looks through type synonyms -- | Performed while compiling "GHC.Types" to generate the built-in 'KindRep's. mkExportedKindReps :: TypeableStuff @@ -496,6 +501,7 @@ mkExportedKindReps stuff = mapM_ kindrep_binding -- since the latter would find the built-in 'KindRep's in the -- 'KindRepEnv' (by virtue of being in 'initialKindRepEnv'). rhs <- mkKindRepRhs stuff empty_scope kind + liftTc (traceTc "mkExport" (ppr kind $$ ppr rep_bndr $$ ppr rhs)) addKindRepBind empty_scope kind rep_bndr rhs addKindRepBind :: CmEnv -> Kind -> Id -> LHsExpr GhcTc -> KindRepM () @@ -528,10 +534,8 @@ getKindRep stuff@(Stuff {..}) in_scope = go go' :: Kind -> KindRepEnv -> TcRn (LHsExpr GhcTc, KindRepEnv) go' k env - -- Look through type synonyms - | Just k' <- tcView k = go' k' env - -- We've already generated the needed KindRep + -- This lookup looks through synonyms | Just (id, _) <- lookupTypeMapWithScope env in_scope k = return (nlHsVar id, env) @@ -560,24 +564,27 @@ mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep_shortcut -- We handle (TYPE LiftedRep) etc separately to make it -- clear to consumers (e.g. serializers) that there is -- a loop here (as TYPE :: RuntimeRep -> TYPE 'LiftedRep) - | not (isConstraintKind k) + | Just (TypeLike, rep) <- sORTKind_maybe k -- Typeable respects the Constraint/Type distinction -- so do not follow the special case here - , Just arg <- kindRep_maybe k - = case splitTyConApp_maybe arg of - Just (tc, []) + = -- Here k = TYPE + case splitTyConApp_maybe rep of + Just (tc, []) -- TYPE IntRep, TYPE FloatRep etc | Just dc <- isPromotedDataCon_maybe tc -> return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon dc - Just (rep, [levArg]) - | Just dcRep <- isPromotedDataCon_maybe rep - , Just (lev, []) <- splitTyConApp_maybe levArg - , Just dcLev <- isPromotedDataCon_maybe lev + Just (rep_tc, [levArg]) -- TYPE (BoxedRep lev) + | Just dcRep <- isPromotedDataCon_maybe rep_tc + , Just (lev_tc, []) <- splitTyConApp_maybe levArg + , Just dcLev <- isPromotedDataCon_maybe lev_tc -> return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` (nlHsDataCon dcRep `nlHsApp` nlHsDataCon dcLev) _ -> new_kind_rep k | otherwise = new_kind_rep k + new_kind_rep ki -- Expand synonyms + | Just ki' <- tcView ki + = new_kind_rep ki' new_kind_rep (TyVarTy v) | Just idx <- lookupCME in_scope v ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -445,10 +445,10 @@ checkValidMonoType ty checkTySynRhs :: UserTypeCtxt -> TcType -> TcM () checkTySynRhs ctxt ty - | tcReturnsConstraintKind actual_kind + | returnsConstraintKind actual_kind = do { ck <- xoptM LangExt.ConstraintKinds ; if ck - then when (isConstraintKind actual_kind) + then when (isConstraintLikeKind actual_kind) (do { dflags <- getDynFlags ; expand <- initialExpandMode ; check_pred_ty emptyTidyEnv dflags ctxt expand ty }) ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -63,7 +63,6 @@ import GHC.Prim infixr 5 : - {- ********************************************************************* * * Functions View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/184a8f9d8cc147c71b88756062c05fea2ff1a267 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/184a8f9d8cc147c71b88756062c05fea2ff1a267 You're receiving 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 Aug 17 16:26:35 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 17 Aug 2022 12:26:35 -0400 Subject: [Git][ghc/ghc][wip/js-staging] GHCJS.Prim leftovers Message-ID: <62fd16bb270b_3d81494883c196019b@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 4c9ec8a9 by Sylvain Henry at 2022-08-17T18:29:22+02:00 GHCJS.Prim leftovers - - - - - 5 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Rts/Rts.hs - js/gc.js.pp - js/rts.js.pp - js/thread.js.pp Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -126,17 +126,17 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" + else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException , if profiling - then "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM))\n" - else "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCJSziPrimziJSException_con_e,(msg),(hsMsg)))\n" + then "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM))\n" + else "#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg)))\n" -- Exception dictionary for JSException - , "#define HS_JSEXCEPTION_EXCEPTION h$baseZCGHCJSziPrimzizdfExceptionJSException\n" + , "#define HS_JSEXCEPTION_EXCEPTION h$baseZCGHCziJSziPrimzizdfExceptionJSException\n" -- SomeException , if profiling ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -174,7 +174,7 @@ closureConstructors s = BlockStat checkC :: JStat checkC | csAssertRts s = jVar $ \msg -> - jwhenS (var "arguments" .! 0 .!==. jString "h$baseZCGHCJSziPrimziJSVal_con_e") + jwhenS (var "arguments" .! 0 .!==. jString "h$baseZCGHCziJSziPrimziJSVal_con_e") (loop 1 (.<. var "arguments" .^ "length") (\i -> mconcat [msg |= jString "warning: undefined or null in argument: " ===================================== js/gc.js.pp ===================================== @@ -587,11 +587,11 @@ function h$resolveDeadlocks() { // blocked on MVar if(bo.m === mark) throw "assertion failed: thread should have been marked"; // MVar unreachable - kill = h$baseZCGHCJSziPrimziInternalziblockedIndefinitelyOnMVar; + kill = h$baseZCGHCziJSziPrimziInternalziblockedIndefinitelyOnMVar; break; } else if(t.blockedOn instanceof h$TVarsWaiting) { // blocked in STM transaction - kill = h$baseZCGHCJSziPrimziInternalziblockedIndefinitelyOnSTM; + kill = h$baseZCGHCziJSziPrimziInternalziblockedIndefinitelyOnSTM; break; } else { // blocked on something else, we can't do anything ===================================== js/rts.js.pp ===================================== @@ -2,7 +2,7 @@ var h$start = new Date(); function h$rts_eval(action, unbox) { return new Promise((accept, reject) => - h$run(MK_AP3( h$baseZCGHCJSziPrimziresolveIO + h$run(MK_AP3( h$baseZCGHCziJSziPrimziresolveIO , x => { accept(unbox(x))} , e => { reject(new h$HaskellException(e))} , action @@ -13,7 +13,7 @@ function h$rts_eval(action, unbox) { function h$rts_eval_sync(closure, unbox) { var res, status = 0; try { - h$runSync(MK_AP3( h$baseZCGHCJSziPrimziresolveIO + h$runSync(MK_AP3( h$baseZCGHCziJSziPrimziresolveIO , MK_JSVAL(x => { status = 1; res = unbox(x); }) , MK_JSVAL(e => { status = 2; res = new h$HaskellException(e); }) , closure), false); @@ -149,7 +149,7 @@ function h$rts_getFunPtr(x) { } function h$rts_toIO(x) { - return MK_AP1(h$baseZCGHCJSziPrimzitoIO, x); + return MK_AP1(h$baseZCGHCziJSziPrimzitoIO, x); } // running IO actions ===================================== js/thread.js.pp ===================================== @@ -817,7 +817,7 @@ function h$handleBlockedSyncThread(c) { TRACE_SCHEDULER("blocking synchronous thread: exception"); h$sp += 2; h$currentThread.sp = h$sp; - h$stack[h$sp-1] = h$baseZCGHCJSziPrimziInternalziwouldBlock; + h$stack[h$sp-1] = h$baseZCGHCziJSziPrimziInternalziwouldBlock; h$stack[h$sp] = h$raiseAsync_frame; h$forceWakeupThread(h$currentThread); c = h$raiseAsync_frame; @@ -889,7 +889,7 @@ function h$setCurrentThreadResultValue(v) { function h$runSyncReturn(a, cont) { var t = new h$Thread(); TRACE_SCHEDULER("h$runSyncReturn created thread: " + h$threadString(t)); - var aa = MK_AP1(h$baseZCGHCJSziPrimziInternalzisetCurrentThreadResultValue, a); + var aa = MK_AP1(h$baseZCGHCziJSziPrimziInternalzisetCurrentThreadResultValue, a); h$runSyncAction(t, aa, cont); if(t.status === THREAD_FINISHED) { if(t.resultIsException) { @@ -932,7 +932,7 @@ function h$runSync(a, cont) { function h$runSyncAction(t, a, cont) { h$runInitStatic(); var c = h$return; - t.stack[2] = h$baseZCGHCJSziPrimziInternalzisetCurrentThreadResultException; + t.stack[2] = h$baseZCGHCziJSziPrimziInternalzisetCurrentThreadResultException; t.stack[4] = h$ap_1_0; t.stack[5] = a; t.stack[6] = h$return; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c9ec8a966d1b473a931a8c8a26a07e85b7d2b34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c9ec8a966d1b473a931a8c8a26a07e85b7d2b34 You're receiving 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 Aug 17 17:53:24 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 17 Aug 2022 13:53:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22007 Message-ID: <62fd2b14e948e_3d8149488501981875@gitlab.mail> Ben Gamari pushed new branch wip/T22007 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22007 You're receiving 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 Aug 17 19:55:59 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 17 Aug 2022 15:55:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21066 Message-ID: <62fd47cf4cf1d_3d81494882819987aa@gitlab.mail> Ben Gamari pushed new branch wip/T21066 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21066 You're receiving 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 Aug 17 20:10:26 2022 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Wed, 17 Aug 2022 16:10:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/amg/T21625 Message-ID: <62fd4b3238580_3d8149489042002226@gitlab.mail> Adam Gundry pushed new branch wip/amg/T21625 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/amg/T21625 You're receiving 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 Aug 18 07:23:20 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 03:23:20 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Fix #21979 - compact-share failing with -O Message-ID: <62fde8e86f0d7_3d814948864205472@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 36926cef by Simon Peyton Jones at 2022-08-18T03:22:59-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 23 changed files: - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/Var.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - hadrian/src/Rules/Documentation.hs - libraries/base/changelog.md - libraries/ghc-compact/tests/all.T - libraries/hpc - + testsuite/tests/partial-sigs/should_compile/T16152.hs - + testsuite/tests/partial-sigs/should_compile/T16152.stderr - + testsuite/tests/partial-sigs/should_compile/T22065.hs - + testsuite/tests/partial-sigs/should_compile/T22065.stderr - testsuite/tests/partial-sigs/should_compile/all.T - utils/haddock - utils/hpc/HpcCombine.hs - utils/hpc/HpcDraft.hs - utils/hpc/HpcMarkup.hs - utils/hpc/HpcOverlay.hs - utils/hpc/HpcReport.hs - utils/hpc/HpcShowTix.hs - utils/hpc/Main.hs Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -43,6 +43,7 @@ import GHC.Tc.Solver import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Core.Predicate +import GHC.Core.TyCo.Ppr( pprTyVars ) import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType @@ -59,7 +60,7 @@ import GHC.Types.SourceText import GHC.Types.Id import GHC.Types.Var as Var import GHC.Types.Var.Set -import GHC.Types.Var.Env( TidyEnv ) +import GHC.Types.Var.Env( TidyEnv, TyVarEnv, mkVarEnv, lookupVarEnv ) import GHC.Unit.Module import GHC.Types.Name import GHC.Types.Name.Set @@ -934,7 +935,8 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; let psig_qtvs = map binderVar psig_qtv_bndrs psig_qtv_set = mkVarSet psig_qtvs psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs - + psig_bndr_map :: TyVarEnv InvisTVBinder + psig_bndr_map = mkVarEnv [ (binderVar tvb, tvb) | tvb <- psig_qtv_bndrs ] -- Check whether the quantified variables of the -- partial signature have been unified together @@ -950,32 +952,35 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; annotated_theta <- zonkTcTypes annotated_theta ; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx + -- NB: free_tvs includes tau_tvs + + ; let (_,final_qtvs) = foldr (choose_qtv psig_bndr_map) (free_tvs, []) qtvs + -- Pulling from qtvs maintains original order + -- NB: qtvs is already in dependency order - ; let keep_me = free_tvs `unionVarSet` psig_qtv_set - final_qtvs = [ mkTyVarBinder vis tv - | tv <- qtvs -- Pulling from qtvs maintains original order - , tv `elemVarSet` keep_me - , let vis = case lookupVarBndr tv psig_qtv_bndrs of - Just spec -> spec - Nothing -> InferredSpec ] + ; traceTc "chooseInferredQuantifiers" $ + vcat [ text "qtvs" <+> pprTyVars qtvs + , text "psig_qtv_bndrs" <+> ppr psig_qtv_bndrs + , text "free_tvs" <+> ppr free_tvs + , text "final_tvs" <+> ppr final_qtvs ] ; return (final_qtvs, my_theta) } where - report_dup_tyvar_tv_err (n1,n2) - = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) - - report_mono_sig_tv_err (n,tv) - = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) - where - m_unif_ty = listToMaybe - [ rhs - -- recall that residuals are always implications - | residual_implic <- bagToList $ wc_impl residual - , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) - , let residual_pred = ctPred residual_ct - , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] - , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] - , lhs_tv == tv ] + choose_qtv :: TyVarEnv InvisTVBinder -> TcTyVar + -> (TcTyVarSet, [InvisTVBinder]) -> (TcTyVarSet, [InvisTVBinder]) + -- Pick which of the original qtvs should be retained + -- Keep it if (a) it is mentioned in the body of the type (free_tvs) + -- (b) it is a forall'd variable of the partial signature (psig_qtv_bndrs) + -- (c) it is mentioned in the kind of a retained qtv (#22065) + choose_qtv psig_bndr_map tv (free_tvs, qtvs) + | Just psig_bndr <- lookupVarEnv psig_bndr_map tv + = (free_tvs', psig_bndr : qtvs) + | tv `elemVarSet` free_tvs + = (free_tvs', mkTyVarBinder InferredSpec tv : qtvs) + | otherwise -- Do not pick it + = (free_tvs, qtvs) + where + free_tvs' = free_tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType -> TcM (VarSet, TcThetaType) @@ -1019,6 +1024,22 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs -- Return (annotated_theta ++ diff_theta) -- See Note [Extra-constraints wildcards] + report_dup_tyvar_tv_err (n1,n2) + = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) + + report_mono_sig_tv_err (n,tv) + = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) + where + m_unif_ty = listToMaybe + [ rhs + -- recall that residuals are always implications + | residual_implic <- bagToList $ wc_impl residual + , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) + , let residual_pred = ctPred residual_ct + , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] + , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] + , lhs_tv == tv ] + mk_ctuple preds = mkBoxedTupleTy preds -- Hack alert! See GHC.Tc.Gen.HsType: -- Note [Extra-constraint holes in partial type signatures] ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Types.Var ( mkTyVarBinder, mkTyVarBinders, isTyVarBinder, tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, - mapVarBndr, mapVarBndrs, lookupVarBndr, + mapVarBndr, mapVarBndrs, -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -696,11 +696,6 @@ mapVarBndr f (Bndr v fl) = Bndr (f v) fl mapVarBndrs :: (var -> var') -> [VarBndr var flag] -> [VarBndr var' flag] mapVarBndrs f = map (mapVarBndr f) -lookupVarBndr :: Eq var => var -> [VarBndr var flag] -> Maybe flag -lookupVarBndr var bndrs = lookup var zipped_bndrs - where - zipped_bndrs = map (\(Bndr v f) -> (v,f)) bndrs - instance Outputable tv => Outputable (VarBndr tv ArgFlag) where ppr (Bndr v Required) = ppr v ppr (Bndr v Specified) = char '@' <> ppr v ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -87,3 +87,50 @@ Compiler ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ + + +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/exts/gadt_syntax.rst ===================================== @@ -6,7 +6,7 @@ Declaring data types with explicit constructor signatures .. extension:: GADTSyntax :shortdesc: Enable generalised algebraic data type syntax. - :implied by: :extensions:`GADTs` + :implied by: :extension:`GADTs` :since: 7.2.1 :status: Included in :extension:`GHC2021` ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} ===================================== docs/users_guide/phases.rst ===================================== @@ -467,7 +467,7 @@ defined by your local GHC installation, the following trick is useful: .. index:: single: __GLASGOW_HASKELL_LLVM__ - Only defined when ``-fllvm`` is specified. When GHC is using version + Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero is added, so for example when using version 3.7 of LLVM, @@ -614,8 +614,8 @@ Options affecting code generation .. note:: - Note that this GHC release expects an LLVM version in the |llvm-version| - release series. + Note that this GHC release expects an LLVM version between |llvm-version-min| + and |llvm-version-max|. .. ghc-flag:: -fno-code :shortdesc: Omit code generation ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -41,7 +41,7 @@ archiveRoot :: FilePath archiveRoot = docRoot -/- "archives" manPageBuildPath :: FilePath -manPageBuildPath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1" -- TODO: Get rid of this hack. docContext :: Context ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. @@ -66,14 +66,55 @@ A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md) is available. - * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to - `Debug.Trace`, per - [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36). - * Re-export `augment` and `build` function from `GHC.List` * Re-export the `IsList` typeclass from the new `GHC.IsList` module. + * There's a new special function ``withDict`` in ``GHC.Exts``: :: + + withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r + + where ``cls`` must be a class containing exactly one method, whose type + must be ``meth``. + + This function converts ``meth`` to a type class dictionary. + It removes the need for ``unsafeCoerce`` in implementation of reflection + libraries. It should be used with care, because it can introduce + incoherent instances. + + For example, the ``withTypeable`` function from the + ``Type.Reflection`` module can now be defined as: :: + + withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () + => TypeRep a -> (Typeable a => r) -> r + withTypeable rep k = withDict @(Typeable a) rep k + + Note that the explicit type application is required, as the call to + ``withDict`` would be ambiguous otherwise. + + This replaces the old ``GHC.Exts.magicDict``, which required + an intermediate data type and was less reliable. + + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by + `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these + were rather represented by `Word#` and `Int#`. See GHC #11953. + +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes + ## 4.16.1.0 *Feb 2022* * Shipped with GHC 9.2.2 @@ -498,7 +539,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is ===================================== libraries/ghc-compact/tests/all.T ===================================== @@ -16,8 +16,8 @@ test('compact_pinned', exit_code(1), compile_and_run, ['']) test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_run, ['']) # this test computes closure sizes and those are affected # by the ghci and prof ways, because of BCOs and profiling headers. -test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']), - compile_and_run, ['']) +# Optimization levels slightly change what is/isn't shared so only run in normal mode +test('compact_share', only_ways(['normal']), compile_and_run, ['']) test('compact_bench', [ ignore_stdout, extra_run_opts('100') ], compile_and_run, ['']) test('T17044', normal, compile_and_run, ['']) ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit 7d400662546a262b64af49b5707db22e20b8b9d9 +Subproject commit 76d1a0473d405e194d0c92a1cbeb6c019bbb57cd ===================================== testsuite/tests/partial-sigs/should_compile/T16152.hs ===================================== @@ -0,0 +1,8 @@ +{-# Language PartialTypeSignatures #-} +{-# Language PolyKinds #-} +{-# Language ScopedTypeVariables #-} + +module T16152 where + +top :: forall f. _ +top = undefined ===================================== testsuite/tests/partial-sigs/should_compile/T16152.stderr ===================================== @@ -0,0 +1,7 @@ + +T16152.hs:7:18: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of top :: w + at T16152.hs:8:1-15 + • In the type signature: top :: forall f. _ ===================================== testsuite/tests/partial-sigs/should_compile/T22065.hs ===================================== @@ -0,0 +1,30 @@ +{-# Options_GHC -dcore-lint #-} +{-# Language PartialTypeSignatures #-} + +module T22065 where + +data Foo where + Apply :: (x -> Int) -> x -> Foo + +foo :: Foo +foo = Apply f x :: forall a. _ where + + f :: [_] -> Int + f = length @[] @_ + + x :: [_] + x = mempty @[_] + +{- +Smaller version I used when debuggging + +apply :: (x->Int) -> x -> Bool +apply = apply + +foo :: Bool +foo = apply f x :: forall a. _ + where + f = length @[] + x = mempty + +-} ===================================== testsuite/tests/partial-sigs/should_compile/T22065.stderr ===================================== @@ -0,0 +1,53 @@ + +T22065.hs:10:30: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Foo’ + • In an expression type signature: forall a. _ + In the expression: Apply f x :: forall a. _ + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + f :: forall {w}. [w] -> Int (bound at T22065.hs:13:3) + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of f :: [w] -> Int + at T22065.hs:13:3-19 + • In the type ‘[_] -> Int’ + In the type signature: f :: [_] -> Int + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:15:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of x :: [w] + at T22065.hs:16:3-17 + • In the type ‘[_]’ + In the type signature: x :: [_] + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include foo :: Foo (bound at T22065.hs:10:1) ===================================== testsuite/tests/partial-sigs/should_compile/all.T ===================================== @@ -105,3 +105,5 @@ test('T20921', normal, compile, ['']) test('T21719', normal, compile, ['']) test('InstanceGivenOverlap3', expect_broken(20076), compile, ['']) test('T21667', normal, compile, ['']) +test('T22065', normal, compile, ['']) +test('T16152', normal, compile, ['']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit a9a312991e55ab99a8dee36a6747f4fc5d5b7c67 ===================================== utils/hpc/HpcCombine.hs ===================================== @@ -195,4 +195,3 @@ instance Strict Tix where instance Strict TixModule where strict (TixModule m1 p1 i1 t1) = ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1) - ===================================== utils/hpc/HpcDraft.hs ===================================== @@ -142,4 +142,3 @@ findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick] findNotTickedFromList = concatMap findNotTickedFromTree - ===================================== utils/hpc/HpcMarkup.hs ===================================== @@ -483,4 +483,3 @@ red,green,yellow :: String red = "#f20913" green = "#60de51" yellow = "yellow" - ===================================== utils/hpc/HpcOverlay.hs ===================================== @@ -155,5 +155,3 @@ addParentToTree path (Node (pos,a) children) = addParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])] addParentToList path nodes = map (addParentToTree path) nodes - - ===================================== utils/hpc/HpcReport.hs ===================================== @@ -275,5 +275,3 @@ report_options . resetHpcDirsOpt . xmlOutputOpt . verbosityOpt - - ===================================== utils/hpc/HpcShowTix.hs ===================================== @@ -61,4 +61,3 @@ showtix_main flags (prog:modNames) = do ] return () - ===================================== utils/hpc/Main.hs ===================================== @@ -1,10 +1,17 @@ +{-# LANGUAGE ScopedTypeVariables, TupleSections #-} -- (c) 2007 Andy Gill -- Main driver for Hpc +import Control.Monad (forM, forM_, when) +import Data.Bifunctor (bimap) +import Data.List (intercalate, partition, uncons) +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Maybe (catMaybes, isJust) import Data.Version import System.Environment import System.Exit import System.Console.GetOpt +import System.Directory (doesPathExist) import HpcFlags import HpcReport @@ -16,7 +23,7 @@ import HpcOverlay import Paths_hpc_bin helpList :: IO () -helpList = +helpList = do putStrLn $ "Usage: hpc COMMAND ...\n\n" ++ section "Commands" help ++ @@ -25,6 +32,15 @@ helpList = section "Coverage Overlays" overlays ++ section "Others" other ++ "" + putStrLn "" + putStrLn "or: hpc @response_file_1 @response_file_2 ..." + putStrLn "" + putStrLn "The contents of a Response File must have this format:" + putStrLn "COMMAND ..." + putStrLn "" + putStrLn "example:" + putStrLn "report my_library.tix --include=ModuleA \\" + putStrLn "--include=ModuleB" where help = ["help"] reporting = ["report","markup"] @@ -47,13 +63,74 @@ section msg cmds = msg ++ ":\n" dispatch :: [String] -> IO () dispatch [] = do - helpList - exitWith ExitSuccess + helpList + exitWith ExitSuccess dispatch (txt:args0) = do - case lookup txt hooks' of - Just plugin -> parse plugin args0 - _ -> parse help_plugin (txt:args0) + case lookup txt hooks' of + Just plugin -> parse plugin args0 + _ -> case getResponseFileName txt of + Nothing -> parse help_plugin (txt:args0) + Just firstResponseFileName -> do + let + (responseFileNames', nonResponseFileNames) = partitionFileNames args0 + -- if arguments are combination of Response Files and non-Response Files, exit with error + when (length nonResponseFileNames > 0) $ do + let + putStrLn $ "First argument '" <> txt <> "' is a Response File, " <> + "followed by non-Response File(s): '" <> intercalate "', '" nonResponseFileNames <> "'" + putStrLn $ "When first argument is a Response File, " <> + "all arguments should be Response Files." + exitFailure + let + responseFileNames :: NonEmpty FilePath + responseFileNames = firstResponseFileName :| responseFileNames' + + forM_ responseFileNames $ \responseFileName -> do + exists <- doesPathExist responseFileName + when (not exists) $ do + putStrLn $ "Response File '" <> responseFileName <> "' does not exist" + exitFailure + + -- read all Response Files + responseFileNamesAndText :: NonEmpty (FilePath, String) <- + forM responseFileNames $ \responseFileName -> + fmap (responseFileName, ) (readFile responseFileName) + forM_ responseFileNamesAndText $ \(responseFileName, responseFileText) -> + -- parse first word of Response File, which should be a command + case uncons $ words responseFileText of + Nothing -> do + putStrLn $ "Response File '" <> responseFileName <> "' has no command" + exitFailure + Just (responseFileCommand, args1) -> case lookup responseFileCommand hooks' of + -- check command for validity + -- It is important than a Response File cannot specify another Response File; + -- this is prevented + Nothing -> do + putStrLn $ "Response File '" <> responseFileName <> + "' command '" <> responseFileCommand <> "' invalid" + exitFailure + Just plugin -> do + putStrLn $ "Response File '" <> responseFileName <> "':" + parse plugin args1 + where + getResponseFileName :: String -> Maybe FilePath + getResponseFileName s = do + (firstChar, filename) <- uncons s + if firstChar == '@' + then pure filename + else Nothing + + -- first member of tuple is list of Response File names, + -- second member of tuple is list of all other arguments + partitionFileNames :: [String] -> ([FilePath], [String]) + partitionFileNames xs = let + hasFileName :: [(String, Maybe FilePath)] + hasFileName = fmap (\x -> (x, getResponseFileName x)) xs + (fileNames, nonFileNames) :: ([Maybe FilePath], [String]) = + bimap (fmap snd) (fmap fst) $ partition (isJust . snd) hasFileName + in (catMaybes fileNames, nonFileNames) + parse plugin args = case getOpt Permute (options plugin []) args of (_,_,errs) | not (null errs) @@ -66,7 +143,7 @@ dispatch (txt:args0) = do exitFailure (o,ns,_) -> do let flags = final_flags plugin - $ foldr (.) id o + . foldr (.) id o $ init_flags plugin implementation plugin flags ns @@ -112,7 +189,7 @@ help_main _ [] = do help_main _ (sub_txt:_) = do case lookup sub_txt hooks' of Nothing -> do - putStrLn $ "no such hpc command : " ++ sub_txt + putStrLn $ "no such HPC command: " <> sub_txt exitFailure Just plugin' -> do command_usage plugin' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1993fd7c296a0b43946a18bd98b8457815c5548...36926cef23cc3daa756868488e39e0c386216f76 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1993fd7c296a0b43946a18bd98b8457815c5548...36926cef23cc3daa756868488e39e0c386216f76 You're receiving 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 Aug 18 10:14:07 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 18 Aug 2022 06:14:07 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Refact CgInfo into a Stg and Cmm part Message-ID: <62fe10efef426_3d814948990211291c@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 933f7a8c by Andreas Klebinger at 2022-08-18T12:12:44+02:00 Refact CgInfo into a Stg and Cmm part - - - - - 8 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Name/Set.hs Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -24,10 +24,9 @@ import GHC.Driver.Config.Cmm import GHC.Prelude import GHC.Runtime.Heap.Layout (isStackRep) import GHC.Settings (Platform, platformUnregisterised) -import GHC.Stg.Pipeline (StgCgInfos) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.Tickish (GenTickish (SourceNote)) @@ -179,8 +178,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> StgCgInfos -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CmmCgInfos +generateCgIPEStub hsc_env this_mod denv s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -199,7 +198,7 @@ generateCgIPEStub hsc_env this_mod denv stg_cg_infos s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = stg_cg_infos} + return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -193,7 +193,7 @@ import GHC.Builtin.Names import GHC.Builtin.Uniques ( mkPseudoUniqueE ) import qualified GHC.StgToCmm as StgToCmm ( codeGen ) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Cmm import GHC.Cmm.Info.Build @@ -1670,7 +1670,7 @@ hscSimpleIface' tc_result summary = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe CgInfos) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe StgCgInfos, Maybe CmmCgInfos ) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1751,7 +1751,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do cmms <- {-# SCC "StgToCmm" #-} doCodeGen hsc_env this_mod denv data_tycons cost_centre_info - stg_binds stg_cg_infos hpc_info + stg_binds hpc_info ------------------ Code output ----------------------- rawcmms0 <- {-# SCC "cmmToRawCmm" #-} @@ -1768,12 +1768,12 @@ hscGenHardCode hsc_env cgguts location output_filename = do let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init `appendStubC` cgIPEStub st - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos) <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 return ( output_filename, stub_c_exists, foreign_fps - , Just cg_infos{ cgTagSigs = stg_cg_infos}) + , Just stg_cg_infos, Just cmm_cg_infos) hscInteractive :: HscEnv @@ -1903,14 +1903,13 @@ This reduces residency towards the end of the CodeGen phase significantly doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs - -> StgCgInfos -> HpcInfo - -> IO (Stream IO CmmGroupSRTs CgInfos) + -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. doCodeGen hsc_env this_mod denv data_tycons - cost_centre_info stg_binds_w_fvs stg_cg_info hpc_info = do + cost_centre_info stg_binds_w_fvs hpc_info = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env hooks = hsc_hooks hsc_env @@ -1959,7 +1958,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv stg_cg_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -537,9 +537,9 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do else if backendWritesFiles (backend dflags) then do output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location) - (outputFilename, mStub, foreign_files, mb_cg_infos) <- + (outputFilename, mStub, foreign_files, mb_stg_infos, mb_cg_infos) <- hscGenHardCode hsc_env cgguts mod_location output_fn - final_iface <- mkFullIface hsc_env partial_iface mb_cg_infos + final_iface <- mkFullIface hsc_env partial_iface mb_stg_infos mb_cg_infos -- See Note [Writing interface files] hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location @@ -559,7 +559,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In interpreted mode the regular codeGen backend is not run so we -- generate a interface without codeGen info. do - final_iface <- mkFullIface hsc_env partial_iface Nothing + final_iface <- mkFullIface hsc_env partial_iface Nothing Nothing hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Prelude import GHC.Hs -import GHC.StgToCmm.Types (CgInfos (..)) +import GHC.StgToCmm.Types (CmmCgInfos (..)) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad @@ -99,6 +99,7 @@ import Data.Function import Data.List ( findIndex, mapAccumL, sortBy ) import Data.Ord import Data.IORef +import GHC.Stg.Pipeline (StgCgInfos) {- @@ -134,16 +135,16 @@ mkPartialIface hsc_env mod_details mod_summary -- | Fully instantiate an interface. Adds fingerprints and potentially code -- generator produced information. -- --- CgInfos is not available when not generating code (-fno-code), or when not +-- CmmCgInfos is not available when not generating code (-fno-code), or when not -- generating interface pragmas (-fomit-interface-pragmas). See also -- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types. -mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface -mkFullIface hsc_env partial_iface mb_cg_infos = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface +mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDecl (mi_decls partial_iface) mb_cg_infos + = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -156,11 +157,16 @@ mkFullIface hsc_env partial_iface mb_cg_infos = do return full_iface -updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl] -updateDecl decls Nothing = decls -updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos, cgTagSigs = tag_sigs }) +updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl] +updateDecl decls Nothing Nothing = decls +updateDecl decls m_stg_infos m_cmm_infos = map update_decl decls where + (non_cafs,lf_infos) = maybe (mempty, mempty) + (\cmm_info -> (ncs_nameSet (cgNonCafs cmm_info), cgLFInfos cmm_info)) + m_cmm_infos + tag_sigs = fromMaybe mempty m_stg_infos + update_decl (IfaceId nm ty details infos) | let not_caffy = elemNameSet nm non_cafs , let mb_lf_info = lookupNameEnv lf_infos nm @@ -178,6 +184,9 @@ updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf update_decl decl = decl + + + -- | Make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any -- object code at all ('NoBackend'). @@ -235,7 +244,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary docs mod_summary mod_details - mkFullIface hsc_env partial_iface Nothing + mkFullIface hsc_env partial_iface Nothing Nothing mkIface_ :: HscEnv -> Module -> HscSource -> Bool -> Dependencies -> GlobalRdrEnv ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -216,7 +216,7 @@ the output of itself. -- -> CollectedCCs -- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CgInfos) +-- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -214,9 +214,13 @@ withLcl fv act = do {- Note [Tag inference for interactive contexts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When running code in GHCi we perform tag inference/rewrites -for individual expressions as part of stg2stg in order to uphold -Note [Strict Field Invariant]. See also #21083 and #22042. +When compiling bytecode for GHCi or otherwise we call myCoreToStg which +then calls out to stg2stg which in turn calls inferTags for tag inference. +/rewrites +for individual expressions as part of the stg2stg which does so by +calling inferTags in order to uphold Note [Strict Field Invariant]. +See also #21083 and #22042. + This means in GHCi for a sequence of: > let x = True ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -1,7 +1,7 @@ module GHC.StgToCmm.Types - ( CgInfos (..) + ( CmmCgInfos (..) , LambdaFormInfo (..) , ModuleLFInfos , StandardFormInfo (..) @@ -13,8 +13,6 @@ import GHC.Prelude import GHC.Core.DataCon -import GHC.Stg.InferTags.TagSig - import GHC.Runtime.Heap.Layout import GHC.Types.Basic @@ -85,7 +83,7 @@ moving parts are: -- -- See also Note [Conveying CAF-info and LFInfo between modules] above. -- -data CgInfos = CgInfos +data CmmCgInfos = CmmCgInfos { cgNonCafs :: !NonCaffySet -- ^ Exported Non-CAFFY closures in the current module. Everything else is -- either not exported of CAFFY. @@ -93,8 +91,6 @@ data CgInfos = CgInfos -- ^ LambdaFormInfos of exported closures in the current module. , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information - , cgTagSigs :: !(NameEnv TagSig) - -- ^ Tag sigs. These are produced by stg2stg hence why they end up in CgInfos. } -------------------------------------------------------------------------------- ===================================== compiler/GHC/Types/Name/Set.hs ===================================== @@ -220,5 +220,5 @@ findUses dus uses -- | 'Id's which have no CAF references. This is a result of analysis of C--. -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note. -newtype NonCaffySet = NonCaffySet NameSet +newtype NonCaffySet = NonCaffySet { ncs_nameSet :: NameSet } deriving (Semigroup, Monoid) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/933f7a8cb73bf600abbe602d378f3571d8b91814 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/933f7a8cb73bf600abbe602d378f3571d8b91814 You're receiving 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 Aug 18 10:53:44 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 06:53:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: ghc-heap: Fix decoding of TSO closures Message-ID: <62fe1a384edbb_3d8149488dc212953a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a99f83de by Matthew Pickering at 2022-08-18T06:53:22-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - e73cdf2e by Matthew Pickering at 2022-08-18T06:53:22-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - 8d2a1257 by Simon Peyton Jones at 2022-08-18T06:53:24-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 14 changed files: - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/Var.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T22044.bazoo - testsuite/tests/driver/all.T - + testsuite/tests/partial-sigs/should_compile/T16152.hs - + testsuite/tests/partial-sigs/should_compile/T16152.stderr - + testsuite/tests/partial-sigs/should_compile/T22065.hs - + testsuite/tests/partial-sigs/should_compile/T22065.stderr - testsuite/tests/partial-sigs/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -171,7 +171,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = -> Just (DriverPsHeaderMessage (PsHeaderMessage msg)) _ -> Nothing - pipe_env = mkPipeEnv StopPreprocess input_fn (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv StopPreprocess input_fn mb_phase (Temporary TFL_GhcSession) mkInputFn = case mb_input_buf of Just input_buf -> do @@ -237,7 +237,7 @@ compileOne' mHscMessage [ml_obj_file $ ms_location summary] plugin_hsc_env <- initializePlugins hsc_env - let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput + 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) @@ -512,7 +512,7 @@ oneShot hsc_env stop_phase srcs = do NoStop -> doLink hsc_env o_files compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath) -compileFile hsc_env stop_phase (src, _mb_phase) = do +compileFile hsc_env stop_phase (src, mb_phase) = do exists <- doesFileExist src when (not exists) $ throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src)) @@ -533,8 +533,8 @@ compileFile hsc_env stop_phase (src, _mb_phase) = do | isJust mb_o_file = SpecificFile -- -o foo applies to the file we are compiling now | otherwise = Persistent - pipe_env = mkPipeEnv stop_phase src output - pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src + pipe_env = mkPipeEnv stop_phase src mb_phase output + pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src mb_phase runPipeline (hsc_hooks hsc_env) pipeline @@ -583,7 +583,7 @@ compileForeign hsc_env lang stub_c = do #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif - pipe_env = mkPipeEnv NoStop stub_c (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv NoStop stub_c Nothing (Temporary TFL_GhcSession) res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. @@ -607,7 +607,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) - let pipe_env = (mkPipeEnv NoStop empty_stub Persistent) { src_basename = basename} + let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename} pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline return () @@ -617,15 +617,17 @@ compileEmptyStub dflags hsc_env basename location mod_name = do mkPipeEnv :: StopPhase -- End phase -> FilePath -- input fn + -> Maybe Phase -> PipelineOutput -- Output -> PipeEnv -mkPipeEnv stop_phase input_fn output = +mkPipeEnv stop_phase input_fn start_phase output = let (basename, suffix) = splitExtension input_fn suffix' = drop 1 suffix -- strip off the . env = PipeEnv{ stop_phase, src_filename = input_fn, src_basename = basename, src_suffix = suffix', + start_phase = fromMaybe (startPhase suffix') start_phase, output_spec = output } in env @@ -695,8 +697,7 @@ preprocessPipeline pipe_env hsc_env input_fn = do where platform = targetPlatform (hsc_dflags hsc_env) runAfter :: P p => Phase -> a -> p a -> p a - runAfter = phaseIfAfter platform start_phase - start_phase = startPhase (src_suffix pipe_env) + runAfter = phaseIfAfter platform (start_phase pipe_env) runAfterFlag :: P p => HscEnv -> Phase @@ -829,9 +830,9 @@ applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing -- Pipeline from a given suffix -pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) -pipelineStart pipe_env hsc_env input_fn = - fromSuffix (src_suffix pipe_env) +pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath) +pipelineStart pipe_env hsc_env input_fn mb_phase = + fromPhase (fromMaybe (startPhase $ src_suffix pipe_env) mb_phase) where stop_after = stop_phase pipe_env frontend :: P m => HscSource -> m (Maybe FilePath) @@ -863,33 +864,24 @@ pipelineStart pipe_env hsc_env input_fn = objFromLinkable _ = Nothing - fromSuffix :: P m => String -> m (Maybe FilePath) - fromSuffix "lhs" = frontend HsSrcFile - fromSuffix "lhs-boot" = frontend HsBootFile - fromSuffix "lhsig" = frontend HsigFile - fromSuffix "hs" = frontend HsSrcFile - fromSuffix "hs-boot" = frontend HsBootFile - fromSuffix "hsig" = frontend HsigFile - fromSuffix "hscpp" = frontend HsSrcFile - fromSuffix "hspp" = frontend HsSrcFile - fromSuffix "hc" = c HCc - fromSuffix "c" = c Cc - fromSuffix "cpp" = c Ccxx - fromSuffix "C" = c Cc - fromSuffix "m" = c Cobjc - fromSuffix "M" = c Cobjcxx - fromSuffix "mm" = c Cobjcxx - fromSuffix "cc" = c Ccxx - fromSuffix "cxx" = c Ccxx - fromSuffix "s" = as False - fromSuffix "S" = as True - fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn - fromSuffix "o" = return (Just input_fn) - fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn - fromSuffix _ = return (Just input_fn) + fromPhase :: P m => Phase -> m (Maybe FilePath) + fromPhase (Unlit p) = frontend p + fromPhase (Cpp p) = frontend p + fromPhase (HsPp p) = frontend p + fromPhase (Hsc p) = frontend p + fromPhase HCc = c HCc + fromPhase Cc = c Cc + fromPhase Ccxx = c Ccxx + fromPhase Cobjc = c Cobjc + fromPhase Cobjcxx = c Cobjcxx + fromPhase (As p) = as p + fromPhase LlvmOpt = llvmPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromPhase StopLn = return (Just input_fn) + fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase MergeForeign = panic "fromPhase: MergeForeign" {- Note [The Pipeline Monad] ===================================== compiler/GHC/Driver/Pipeline/Monad.hs ===================================== @@ -29,6 +29,7 @@ data PipeEnv = PipeEnv { src_filename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source src_suffix :: String, -- ^ its extension + start_phase :: Phase, output_spec :: PipelineOutput -- ^ says where to put the pipeline output } ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -43,6 +43,7 @@ import GHC.Tc.Solver import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Core.Predicate +import GHC.Core.TyCo.Ppr( pprTyVars ) import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType @@ -59,7 +60,7 @@ import GHC.Types.SourceText import GHC.Types.Id import GHC.Types.Var as Var import GHC.Types.Var.Set -import GHC.Types.Var.Env( TidyEnv ) +import GHC.Types.Var.Env( TidyEnv, TyVarEnv, mkVarEnv, lookupVarEnv ) import GHC.Unit.Module import GHC.Types.Name import GHC.Types.Name.Set @@ -934,7 +935,8 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; let psig_qtvs = map binderVar psig_qtv_bndrs psig_qtv_set = mkVarSet psig_qtvs psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs - + psig_bndr_map :: TyVarEnv InvisTVBinder + psig_bndr_map = mkVarEnv [ (binderVar tvb, tvb) | tvb <- psig_qtv_bndrs ] -- Check whether the quantified variables of the -- partial signature have been unified together @@ -950,32 +952,35 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; annotated_theta <- zonkTcTypes annotated_theta ; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx + -- NB: free_tvs includes tau_tvs + + ; let (_,final_qtvs) = foldr (choose_qtv psig_bndr_map) (free_tvs, []) qtvs + -- Pulling from qtvs maintains original order + -- NB: qtvs is already in dependency order - ; let keep_me = free_tvs `unionVarSet` psig_qtv_set - final_qtvs = [ mkTyVarBinder vis tv - | tv <- qtvs -- Pulling from qtvs maintains original order - , tv `elemVarSet` keep_me - , let vis = case lookupVarBndr tv psig_qtv_bndrs of - Just spec -> spec - Nothing -> InferredSpec ] + ; traceTc "chooseInferredQuantifiers" $ + vcat [ text "qtvs" <+> pprTyVars qtvs + , text "psig_qtv_bndrs" <+> ppr psig_qtv_bndrs + , text "free_tvs" <+> ppr free_tvs + , text "final_tvs" <+> ppr final_qtvs ] ; return (final_qtvs, my_theta) } where - report_dup_tyvar_tv_err (n1,n2) - = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) - - report_mono_sig_tv_err (n,tv) - = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) - where - m_unif_ty = listToMaybe - [ rhs - -- recall that residuals are always implications - | residual_implic <- bagToList $ wc_impl residual - , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) - , let residual_pred = ctPred residual_ct - , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] - , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] - , lhs_tv == tv ] + choose_qtv :: TyVarEnv InvisTVBinder -> TcTyVar + -> (TcTyVarSet, [InvisTVBinder]) -> (TcTyVarSet, [InvisTVBinder]) + -- Pick which of the original qtvs should be retained + -- Keep it if (a) it is mentioned in the body of the type (free_tvs) + -- (b) it is a forall'd variable of the partial signature (psig_qtv_bndrs) + -- (c) it is mentioned in the kind of a retained qtv (#22065) + choose_qtv psig_bndr_map tv (free_tvs, qtvs) + | Just psig_bndr <- lookupVarEnv psig_bndr_map tv + = (free_tvs', psig_bndr : qtvs) + | tv `elemVarSet` free_tvs + = (free_tvs', mkTyVarBinder InferredSpec tv : qtvs) + | otherwise -- Do not pick it + = (free_tvs, qtvs) + where + free_tvs' = free_tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType -> TcM (VarSet, TcThetaType) @@ -1019,6 +1024,22 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs -- Return (annotated_theta ++ diff_theta) -- See Note [Extra-constraints wildcards] + report_dup_tyvar_tv_err (n1,n2) + = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) + + report_mono_sig_tv_err (n,tv) + = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) + where + m_unif_ty = listToMaybe + [ rhs + -- recall that residuals are always implications + | residual_implic <- bagToList $ wc_impl residual + , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) + , let residual_pred = ctPred residual_ct + , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] + , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] + , lhs_tv == tv ] + mk_ctuple preds = mkBoxedTupleTy preds -- Hack alert! See GHC.Tc.Gen.HsType: -- Note [Extra-constraint holes in partial type signatures] ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Types.Var ( mkTyVarBinder, mkTyVarBinders, isTyVarBinder, tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, - mapVarBndr, mapVarBndrs, lookupVarBndr, + mapVarBndr, mapVarBndrs, -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -696,11 +696,6 @@ mapVarBndr f (Bndr v fl) = Bndr (f v) fl mapVarBndrs :: (var -> var') -> [VarBndr var flag] -> [VarBndr var' flag] mapVarBndrs f = map (mapVarBndr f) -lookupVarBndr :: Eq var => var -> [VarBndr var flag] -> Maybe flag -lookupVarBndr var bndrs = lookup var zipped_bndrs - where - zipped_bndrs = map (\(Bndr v f) -> (v,f)) bndrs - instance Outputable tv => Outputable (VarBndr tv ArgFlag) where ppr (Bndr v Required) = ppr v ppr (Bndr v Specified) = char '@' <> ppr v ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -350,7 +350,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do [p] -> Just p _ -> error $ "Expected 4 or 5 words in WEAK, found " ++ show (length pts) } - TSO | [ u_lnk, u_gbl_lnk, tso_stack, u_trec, u_blk_ex, u_bq] <- pts + TSO | ( u_lnk : u_gbl_lnk : tso_stack : u_trec : u_blk_ex : u_bq : other) <- pts -> withArray rawHeapWords (\ptr -> do fields <- FFIClosures.peekTSOFields decodeCCS ptr pure $ TSOClosure @@ -361,6 +361,10 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do , trec = u_trec , blocked_exceptions = u_blk_ex , bq = u_bq + , thread_label = case other of + [tl] -> Just tl + [] -> Nothing + _ -> error $ "thead_label:Expected 0 or 1 extra arguments" , what_next = FFIClosures.tso_what_next fields , why_blocked = FFIClosures.tso_why_blocked fields , flags = FFIClosures.tso_flags fields @@ -372,7 +376,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do , prof = FFIClosures.tso_prof fields }) | otherwise - -> fail $ "Expected 6 ptr arguments to TSO, found " + -> fail $ "Expected at least 6 ptr arguments to TSO, found " ++ show (length pts) STACK | [] <- pts ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -280,6 +280,7 @@ data GenClosure b , trec :: !b , blocked_exceptions :: !b , bq :: !b + , thread_label :: !(Maybe b) -- values , what_next :: !WhatNext , why_blocked :: !WhyBlocked ===================================== testsuite/tests/driver/Makefile ===================================== @@ -779,3 +779,11 @@ T21869: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T21869.hs -S [ -f T21869.s ] || (echo "assembly file does not exist" && exit 2) [ ! -f T21869.o ] || (echo "object file exists" && exit 2) + +.PHONY: T22044 +T22044: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -E -cpp -x hs T22044.bazoo -o T22044.hs -DBAZOO=1 + # Test the file exists and is preprocessed + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T22044.hs + + ===================================== testsuite/tests/driver/T22044.bazoo ===================================== @@ -0,0 +1,3 @@ +module T22044 where + +bazoo = BAZOO ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22044', normal, makefile_test, []) ===================================== testsuite/tests/partial-sigs/should_compile/T16152.hs ===================================== @@ -0,0 +1,8 @@ +{-# Language PartialTypeSignatures #-} +{-# Language PolyKinds #-} +{-# Language ScopedTypeVariables #-} + +module T16152 where + +top :: forall f. _ +top = undefined ===================================== testsuite/tests/partial-sigs/should_compile/T16152.stderr ===================================== @@ -0,0 +1,7 @@ + +T16152.hs:7:18: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of top :: w + at T16152.hs:8:1-15 + • In the type signature: top :: forall f. _ ===================================== testsuite/tests/partial-sigs/should_compile/T22065.hs ===================================== @@ -0,0 +1,30 @@ +{-# Options_GHC -dcore-lint #-} +{-# Language PartialTypeSignatures #-} + +module T22065 where + +data Foo where + Apply :: (x -> Int) -> x -> Foo + +foo :: Foo +foo = Apply f x :: forall a. _ where + + f :: [_] -> Int + f = length @[] @_ + + x :: [_] + x = mempty @[_] + +{- +Smaller version I used when debuggging + +apply :: (x->Int) -> x -> Bool +apply = apply + +foo :: Bool +foo = apply f x :: forall a. _ + where + f = length @[] + x = mempty + +-} ===================================== testsuite/tests/partial-sigs/should_compile/T22065.stderr ===================================== @@ -0,0 +1,53 @@ + +T22065.hs:10:30: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Foo’ + • In an expression type signature: forall a. _ + In the expression: Apply f x :: forall a. _ + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + f :: forall {w}. [w] -> Int (bound at T22065.hs:13:3) + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of f :: [w] -> Int + at T22065.hs:13:3-19 + • In the type ‘[_] -> Int’ + In the type signature: f :: [_] -> Int + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:15:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of x :: [w] + at T22065.hs:16:3-17 + • In the type ‘[_]’ + In the type signature: x :: [_] + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include foo :: Foo (bound at T22065.hs:10:1) ===================================== testsuite/tests/partial-sigs/should_compile/all.T ===================================== @@ -105,3 +105,5 @@ test('T20921', normal, compile, ['']) test('T21719', normal, compile, ['']) test('InstanceGivenOverlap3', expect_broken(20076), compile, ['']) test('T21667', normal, compile, ['']) +test('T22065', normal, compile, ['']) +test('T16152', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36926cef23cc3daa756868488e39e0c386216f76...8d2a1257ad73f2aa8b80e21303738d84e6b9c8b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36926cef23cc3daa756868488e39e0c386216f76...8d2a1257ad73f2aa8b80e21303738d84e6b9c8b5 You're receiving 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 Aug 18 11:10:15 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 18 Aug 2022 07:10:15 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fe1e171d874_3d8149488642138269@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: c1016432 by Andreas Klebinger at 2022-08-18T13:08:32+02:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 ------------------------- - - - - - 19 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Name/Set.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -26,11 +26,9 @@ import GHC.Runtime.Heap.Layout (isStackRep) import GHC.Settings (Platform, platformUnregisterised) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc @@ -180,8 +178,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CmmCgInfos +generateCgIPEStub hsc_env this_mod denv s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -200,7 +198,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,15 +186,14 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) -import GHC.Stg.InferTags +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Builtin.Utils import GHC.Builtin.Names import GHC.Builtin.Uniques ( mkPseudoUniqueE ) import qualified GHC.StgToCmm as StgToCmm ( codeGen ) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Cmm import GHC.Cmm.Info.Build @@ -268,6 +267,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1669,7 +1670,7 @@ hscSimpleIface' tc_result summary = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe CgInfos) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe StgCgInfos, Maybe CmmCgInfos ) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1719,11 +1720,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1762,11 +1768,12 @@ hscGenHardCode hsc_env cgguts location output_filename = do let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init `appendStubC` cgIPEStub st - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos) <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just stg_cg_infos, Just cmm_cg_infos) hscInteractive :: HscEnv @@ -1801,7 +1808,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1895,7 +1904,7 @@ doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> HpcInfo - -> IO (Stream IO CmmGroupSRTs CgInfos) + -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1906,13 +1915,10 @@ doCodeGen hsc_env this_mod denv data_tycons hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + stg_ppr_opts = (initStgPprOpts dflags) putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1920,8 +1926,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1952,7 +1958,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool @@ -1960,7 +1966,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1975,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1983,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2005,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2156,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2393,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -739,7 +739,7 @@ hscBackendPipeline pipe_env hsc_env mod_sum result = else case result of HscUpdate iface -> return (iface, Nothing) - HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing + HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing) <*> pure Nothing -- TODO: Why is there not a linkable? -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -537,9 +537,9 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do else if backendWritesFiles (backend dflags) then do output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location) - (outputFilename, mStub, foreign_files, mb_cg_infos) <- + (outputFilename, mStub, foreign_files, mb_stg_infos, mb_cg_infos) <- hscGenHardCode hsc_env cgguts mod_location output_fn - final_iface <- mkFullIface hsc_env partial_iface mb_cg_infos + final_iface <- mkFullIface hsc_env partial_iface mb_stg_infos mb_cg_infos -- See Note [Writing interface files] hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location @@ -559,7 +559,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In interpreted mode the regular codeGen backend is not run so we -- generate a interface without codeGen info. do - final_iface <- mkFullIface hsc_env partial_iface Nothing + final_iface <- mkFullIface hsc_env partial_iface Nothing Nothing hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Prelude import GHC.Hs -import GHC.StgToCmm.Types (CgInfos (..)) +import GHC.StgToCmm.Types (CmmCgInfos (..)) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad @@ -99,6 +99,7 @@ import Data.Function import Data.List ( findIndex, mapAccumL, sortBy ) import Data.Ord import Data.IORef +import GHC.Stg.Pipeline (StgCgInfos) {- @@ -134,16 +135,16 @@ mkPartialIface hsc_env mod_details mod_summary -- | Fully instantiate an interface. Adds fingerprints and potentially code -- generator produced information. -- --- CgInfos is not available when not generating code (-fno-code), or when not +-- CmmCgInfos is not available when not generating code (-fno-code), or when not -- generating interface pragmas (-fomit-interface-pragmas). See also -- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types. -mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface -mkFullIface hsc_env partial_iface mb_cg_infos = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface +mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDecl (mi_decls partial_iface) mb_cg_infos + = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -156,11 +157,16 @@ mkFullIface hsc_env partial_iface mb_cg_infos = do return full_iface -updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl] -updateDecl decls Nothing = decls -updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos, cgTagSigs = tag_sigs }) +updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl] +updateDecl decls Nothing Nothing = decls +updateDecl decls m_stg_infos m_cmm_infos = map update_decl decls where + (non_cafs,lf_infos) = maybe (mempty, mempty) + (\cmm_info -> (ncs_nameSet (cgNonCafs cmm_info), cgLFInfos cmm_info)) + m_cmm_infos + tag_sigs = fromMaybe mempty m_stg_infos + update_decl (IfaceId nm ty details infos) | let not_caffy = elemNameSet nm non_cafs , let mb_lf_info = lookupNameEnv lf_infos nm @@ -178,6 +184,9 @@ updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf update_decl decl = decl + + + -- | Make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any -- object code at all ('NoBackend'). @@ -235,7 +244,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary docs mod_summary mod_details - mkFullIface hsc_env partial_iface Nothing + mkFullIface hsc_env partial_iface Nothing Nothing mkIface_ :: HscEnv -> Module -> HscSource -> Bool -> Dependencies -> GlobalRdrEnv ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -217,17 +216,17 @@ the output of itself. -- -> CollectedCCs -- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CgInfos) +-- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,55 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When compiling bytecode we call myCoreToStg to get STG code first. +myCoreToStg in turn calls out to stg2stg which runs the STG to STG +passes followed by free variables analysis and tag inference at the end. +Running tag inference is important as it upholds Note [Strict Field Invariant]. +While code executed by GHCi doesn't take advantage of the SFI it can call into +compiled code which does. So it must still make sure that the SFI is upheld. +See also #21083 and #22042. + +However there one important difference in code generation for GHCi and regular +compilation. When compiling an entire module (not a GHCi expression), we call +`stg2stg` on the entire module which allows us to build up a map which is guaranteed +to have an entry for every binder in the current module. +For non-interactive compilation the tag inference rewrite pass takes advantage +of this by building up a map from binders to their tag signatures. + +When compiling a GHCi expression on the other hand we invoke stg2stg separately +for each expression on the prompt. This means in GHCi for a sequence of: + > let x = True + > let y = StrictJust x +We first run stg2stg for `[x = True]`. And then again for [y = StrictJust x]`. + +While computing the tag signature for `y` during tag inference inferConTag will check +if `x` is already tagged by looking up the tagsig of `x` in the binder->signature mapping. +However since this mapping isn't persistent between stg2stg +invocations the lookup will fail. This isn't a correctness issue since it's always +safe to assume a binding isn't tagged and that's what we do in such cases. + +However for non-interactive mode we *don't* want to do this. Since in non-interactive mode +we have all binders of the module available for each invocation we can expect the binder->signature +mapping to be complete and all lookups to succeed. This means in non-interactive contexts a failed lookup +indicates a bug in the tag inference implementation. +For this reason we assert that we are running in interactive mode if a lookup fails. +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -16,6 +16,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +65,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg passes. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,8 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + -- See Note [Tag inference for interactive contexts] + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -1,7 +1,7 @@ module GHC.StgToCmm.Types - ( CgInfos (..) + ( CmmCgInfos (..) , LambdaFormInfo (..) , ModuleLFInfos , StandardFormInfo (..) @@ -13,8 +13,6 @@ import GHC.Prelude import GHC.Core.DataCon -import GHC.Stg.InferTags.TagSig - import GHC.Runtime.Heap.Layout import GHC.Types.Basic @@ -85,7 +83,7 @@ moving parts are: -- -- See also Note [Conveying CAF-info and LFInfo between modules] above. -- -data CgInfos = CgInfos +data CmmCgInfos = CmmCgInfos { cgNonCafs :: !NonCaffySet -- ^ Exported Non-CAFFY closures in the current module. Everything else is -- either not exported of CAFFY. @@ -93,7 +91,6 @@ data CgInfos = CgInfos -- ^ LambdaFormInfos of exported closures in the current module. , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information - , cgTagSigs :: !(NameEnv TagSig) } -------------------------------------------------------------------------------- ===================================== compiler/GHC/Types/Name/Set.hs ===================================== @@ -220,5 +220,5 @@ findUses dus uses -- | 'Id's which have no CAF references. This is a result of analysis of C--. -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note. -newtype NonCaffySet = NonCaffySet NameSet +newtype NonCaffySet = NonCaffySet { ncs_nameSet :: NameSet } deriving (Semigroup, Monoid) ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal'),unless(have_dynamic(), skip))], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c10164329150bbdc4deb6fcbd341d0e075ccd5db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c10164329150bbdc4deb6fcbd341d0e075ccd5db You're receiving 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 Aug 18 11:53:05 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 18 Aug 2022 07:53:05 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fe2821828c4_3d814948864214587c@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 5759fb74 by Andreas Klebinger at 2022-08-18T13:51:36+02:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 ------------------------- - - - - - 19 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Name/Set.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -26,11 +26,9 @@ import GHC.Runtime.Heap.Layout (isStackRep) import GHC.Settings (Platform, platformUnregisterised) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc @@ -180,8 +178,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CmmCgInfos +generateCgIPEStub hsc_env this_mod denv s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -200,7 +198,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,15 +186,14 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) -import GHC.Stg.InferTags +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Builtin.Utils import GHC.Builtin.Names import GHC.Builtin.Uniques ( mkPseudoUniqueE ) import qualified GHC.StgToCmm as StgToCmm ( codeGen ) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Cmm import GHC.Cmm.Info.Build @@ -268,6 +267,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1669,7 +1670,7 @@ hscSimpleIface' tc_result summary = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe CgInfos) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe StgCgInfos, Maybe CmmCgInfos ) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1719,11 +1720,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1762,11 +1768,12 @@ hscGenHardCode hsc_env cgguts location output_filename = do let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init `appendStubC` cgIPEStub st - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos) <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just stg_cg_infos, Just cmm_cg_infos) hscInteractive :: HscEnv @@ -1801,7 +1808,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1895,7 +1904,7 @@ doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> HpcInfo - -> IO (Stream IO CmmGroupSRTs CgInfos) + -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1906,13 +1915,10 @@ doCodeGen hsc_env this_mod denv data_tycons hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + stg_ppr_opts = (initStgPprOpts dflags) putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1920,8 +1926,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1952,7 +1958,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool @@ -1960,7 +1966,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1975,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1983,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2005,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2156,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2393,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -739,7 +739,7 @@ hscBackendPipeline pipe_env hsc_env mod_sum result = else case result of HscUpdate iface -> return (iface, Nothing) - HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing + HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing) <*> pure Nothing -- TODO: Why is there not a linkable? -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -537,9 +537,9 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do else if backendWritesFiles (backend dflags) then do output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location) - (outputFilename, mStub, foreign_files, mb_cg_infos) <- + (outputFilename, mStub, foreign_files, mb_stg_infos, mb_cg_infos) <- hscGenHardCode hsc_env cgguts mod_location output_fn - final_iface <- mkFullIface hsc_env partial_iface mb_cg_infos + final_iface <- mkFullIface hsc_env partial_iface mb_stg_infos mb_cg_infos -- See Note [Writing interface files] hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location @@ -559,7 +559,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In interpreted mode the regular codeGen backend is not run so we -- generate a interface without codeGen info. do - final_iface <- mkFullIface hsc_env partial_iface Nothing + final_iface <- mkFullIface hsc_env partial_iface Nothing Nothing hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Prelude import GHC.Hs -import GHC.StgToCmm.Types (CgInfos (..)) +import GHC.StgToCmm.Types (CmmCgInfos (..)) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad @@ -99,6 +99,7 @@ import Data.Function import Data.List ( findIndex, mapAccumL, sortBy ) import Data.Ord import Data.IORef +import GHC.Stg.Pipeline (StgCgInfos) {- @@ -134,16 +135,16 @@ mkPartialIface hsc_env mod_details mod_summary -- | Fully instantiate an interface. Adds fingerprints and potentially code -- generator produced information. -- --- CgInfos is not available when not generating code (-fno-code), or when not +-- CmmCgInfos is not available when not generating code (-fno-code), or when not -- generating interface pragmas (-fomit-interface-pragmas). See also -- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types. -mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface -mkFullIface hsc_env partial_iface mb_cg_infos = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface +mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDecl (mi_decls partial_iface) mb_cg_infos + = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -156,11 +157,16 @@ mkFullIface hsc_env partial_iface mb_cg_infos = do return full_iface -updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl] -updateDecl decls Nothing = decls -updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos, cgTagSigs = tag_sigs }) +updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl] +updateDecl decls Nothing Nothing = decls +updateDecl decls m_stg_infos m_cmm_infos = map update_decl decls where + (non_cafs,lf_infos) = maybe (mempty, mempty) + (\cmm_info -> (ncs_nameSet (cgNonCafs cmm_info), cgLFInfos cmm_info)) + m_cmm_infos + tag_sigs = fromMaybe mempty m_stg_infos + update_decl (IfaceId nm ty details infos) | let not_caffy = elemNameSet nm non_cafs , let mb_lf_info = lookupNameEnv lf_infos nm @@ -178,6 +184,9 @@ updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf update_decl decl = decl + + + -- | Make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any -- object code at all ('NoBackend'). @@ -235,7 +244,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary docs mod_summary mod_details - mkFullIface hsc_env partial_iface Nothing + mkFullIface hsc_env partial_iface Nothing Nothing mkIface_ :: HscEnv -> Module -> HscSource -> Bool -> Dependencies -> GlobalRdrEnv ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -217,17 +216,17 @@ the output of itself. -- -> CollectedCCs -- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CgInfos) +-- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,55 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When compiling bytecode we call myCoreToStg to get STG code first. +myCoreToStg in turn calls out to stg2stg which runs the STG to STG +passes followed by free variables analysis and tag inference at the end. +Running tag inference is important as it upholds Note [Strict Field Invariant]. +While code executed by GHCi doesn't take advantage of the SFI it can call into +compiled code which does. So it must still make sure that the SFI is upheld. +See also #21083 and #22042. + +However there one important difference in code generation for GHCi and regular +compilation. When compiling an entire module (not a GHCi expression), we call +`stg2stg` on the entire module which allows us to build up a map which is guaranteed +to have an entry for every binder in the current module. +For non-interactive compilation the tag inference rewrite pass takes advantage +of this by building up a map from binders to their tag signatures. + +When compiling a GHCi expression on the other hand we invoke stg2stg separately +for each expression on the prompt. This means in GHCi for a sequence of: + > let x = True + > let y = StrictJust x +We first run stg2stg for `[x = True]`. And then again for [y = StrictJust x]`. + +While computing the tag signature for `y` during tag inference inferConTag will check +if `x` is already tagged by looking up the tagsig of `x` in the binder->signature mapping. +However since this mapping isn't persistent between stg2stg +invocations the lookup will fail. This isn't a correctness issue since it's always +safe to assume a binding isn't tagged and that's what we do in such cases. + +However for non-interactive mode we *don't* want to do this. Since in non-interactive mode +we have all binders of the module available for each invocation we can expect the binder->signature +mapping to be complete and all lookups to succeed. This means in non-interactive contexts a failed lookup +indicates a bug in the tag inference implementation. +For this reason we assert that we are running in interactive mode if a lookup fails. +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -16,6 +16,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +65,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg passes. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,8 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + -- See Note [Tag inference for interactive contexts] + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -1,7 +1,7 @@ module GHC.StgToCmm.Types - ( CgInfos (..) + ( CmmCgInfos (..) , LambdaFormInfo (..) , ModuleLFInfos , StandardFormInfo (..) @@ -13,8 +13,6 @@ import GHC.Prelude import GHC.Core.DataCon -import GHC.Stg.InferTags.TagSig - import GHC.Runtime.Heap.Layout import GHC.Types.Basic @@ -85,7 +83,7 @@ moving parts are: -- -- See also Note [Conveying CAF-info and LFInfo between modules] above. -- -data CgInfos = CgInfos +data CmmCgInfos = CmmCgInfos { cgNonCafs :: !NonCaffySet -- ^ Exported Non-CAFFY closures in the current module. Everything else is -- either not exported of CAFFY. @@ -93,7 +91,6 @@ data CgInfos = CgInfos -- ^ LambdaFormInfos of exported closures in the current module. , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information - , cgTagSigs :: !(NameEnv TagSig) } -------------------------------------------------------------------------------- ===================================== compiler/GHC/Types/Name/Set.hs ===================================== @@ -220,5 +220,5 @@ findUses dus uses -- | 'Id's which have no CAF references. This is a result of analysis of C--. -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note. -newtype NonCaffySet = NonCaffySet NameSet +newtype NonCaffySet = NonCaffySet { ncs_nameSet :: NameSet } deriving (Semigroup, Monoid) ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal'),unless(have_dynamic(), skip)], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5759fb742f846335126596cafb573f53abee3885 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5759fb742f846335126596cafb573f53abee3885 You're receiving 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 Aug 18 12:27:53 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 Aug 2022 08:27:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t21993 Message-ID: <62fe3049140e6_3d8149488502151690@gitlab.mail> Matthew Pickering pushed new branch wip/t21993 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t21993 You're receiving 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 Aug 18 13:23:51 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 09:23:51 -0400 Subject: [Git][ghc/ghc][master] Implement Response File support for HPC Message-ID: <62fe3d6768a52_3d81494899021690bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 8 changed files: - libraries/hpc - utils/hpc/HpcCombine.hs - utils/hpc/HpcDraft.hs - utils/hpc/HpcMarkup.hs - utils/hpc/HpcOverlay.hs - utils/hpc/HpcReport.hs - utils/hpc/HpcShowTix.hs - utils/hpc/Main.hs Changes: ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit 7d400662546a262b64af49b5707db22e20b8b9d9 +Subproject commit 76d1a0473d405e194d0c92a1cbeb6c019bbb57cd ===================================== utils/hpc/HpcCombine.hs ===================================== @@ -195,4 +195,3 @@ instance Strict Tix where instance Strict TixModule where strict (TixModule m1 p1 i1 t1) = ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1) - ===================================== utils/hpc/HpcDraft.hs ===================================== @@ -142,4 +142,3 @@ findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick] findNotTickedFromList = concatMap findNotTickedFromTree - ===================================== utils/hpc/HpcMarkup.hs ===================================== @@ -483,4 +483,3 @@ red,green,yellow :: String red = "#f20913" green = "#60de51" yellow = "yellow" - ===================================== utils/hpc/HpcOverlay.hs ===================================== @@ -155,5 +155,3 @@ addParentToTree path (Node (pos,a) children) = addParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])] addParentToList path nodes = map (addParentToTree path) nodes - - ===================================== utils/hpc/HpcReport.hs ===================================== @@ -275,5 +275,3 @@ report_options . resetHpcDirsOpt . xmlOutputOpt . verbosityOpt - - ===================================== utils/hpc/HpcShowTix.hs ===================================== @@ -61,4 +61,3 @@ showtix_main flags (prog:modNames) = do ] return () - ===================================== utils/hpc/Main.hs ===================================== @@ -1,10 +1,17 @@ +{-# LANGUAGE ScopedTypeVariables, TupleSections #-} -- (c) 2007 Andy Gill -- Main driver for Hpc +import Control.Monad (forM, forM_, when) +import Data.Bifunctor (bimap) +import Data.List (intercalate, partition, uncons) +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Maybe (catMaybes, isJust) import Data.Version import System.Environment import System.Exit import System.Console.GetOpt +import System.Directory (doesPathExist) import HpcFlags import HpcReport @@ -16,7 +23,7 @@ import HpcOverlay import Paths_hpc_bin helpList :: IO () -helpList = +helpList = do putStrLn $ "Usage: hpc COMMAND ...\n\n" ++ section "Commands" help ++ @@ -25,6 +32,15 @@ helpList = section "Coverage Overlays" overlays ++ section "Others" other ++ "" + putStrLn "" + putStrLn "or: hpc @response_file_1 @response_file_2 ..." + putStrLn "" + putStrLn "The contents of a Response File must have this format:" + putStrLn "COMMAND ..." + putStrLn "" + putStrLn "example:" + putStrLn "report my_library.tix --include=ModuleA \\" + putStrLn "--include=ModuleB" where help = ["help"] reporting = ["report","markup"] @@ -47,13 +63,74 @@ section msg cmds = msg ++ ":\n" dispatch :: [String] -> IO () dispatch [] = do - helpList - exitWith ExitSuccess + helpList + exitWith ExitSuccess dispatch (txt:args0) = do - case lookup txt hooks' of - Just plugin -> parse plugin args0 - _ -> parse help_plugin (txt:args0) + case lookup txt hooks' of + Just plugin -> parse plugin args0 + _ -> case getResponseFileName txt of + Nothing -> parse help_plugin (txt:args0) + Just firstResponseFileName -> do + let + (responseFileNames', nonResponseFileNames) = partitionFileNames args0 + -- if arguments are combination of Response Files and non-Response Files, exit with error + when (length nonResponseFileNames > 0) $ do + let + putStrLn $ "First argument '" <> txt <> "' is a Response File, " <> + "followed by non-Response File(s): '" <> intercalate "', '" nonResponseFileNames <> "'" + putStrLn $ "When first argument is a Response File, " <> + "all arguments should be Response Files." + exitFailure + let + responseFileNames :: NonEmpty FilePath + responseFileNames = firstResponseFileName :| responseFileNames' + + forM_ responseFileNames $ \responseFileName -> do + exists <- doesPathExist responseFileName + when (not exists) $ do + putStrLn $ "Response File '" <> responseFileName <> "' does not exist" + exitFailure + + -- read all Response Files + responseFileNamesAndText :: NonEmpty (FilePath, String) <- + forM responseFileNames $ \responseFileName -> + fmap (responseFileName, ) (readFile responseFileName) + forM_ responseFileNamesAndText $ \(responseFileName, responseFileText) -> + -- parse first word of Response File, which should be a command + case uncons $ words responseFileText of + Nothing -> do + putStrLn $ "Response File '" <> responseFileName <> "' has no command" + exitFailure + Just (responseFileCommand, args1) -> case lookup responseFileCommand hooks' of + -- check command for validity + -- It is important than a Response File cannot specify another Response File; + -- this is prevented + Nothing -> do + putStrLn $ "Response File '" <> responseFileName <> + "' command '" <> responseFileCommand <> "' invalid" + exitFailure + Just plugin -> do + putStrLn $ "Response File '" <> responseFileName <> "':" + parse plugin args1 + where + getResponseFileName :: String -> Maybe FilePath + getResponseFileName s = do + (firstChar, filename) <- uncons s + if firstChar == '@' + then pure filename + else Nothing + + -- first member of tuple is list of Response File names, + -- second member of tuple is list of all other arguments + partitionFileNames :: [String] -> ([FilePath], [String]) + partitionFileNames xs = let + hasFileName :: [(String, Maybe FilePath)] + hasFileName = fmap (\x -> (x, getResponseFileName x)) xs + (fileNames, nonFileNames) :: ([Maybe FilePath], [String]) = + bimap (fmap snd) (fmap fst) $ partition (isJust . snd) hasFileName + in (catMaybes fileNames, nonFileNames) + parse plugin args = case getOpt Permute (options plugin []) args of (_,_,errs) | not (null errs) @@ -66,7 +143,7 @@ dispatch (txt:args0) = do exitFailure (o,ns,_) -> do let flags = final_flags plugin - $ foldr (.) id o + . foldr (.) id o $ init_flags plugin implementation plugin flags ns @@ -112,7 +189,7 @@ help_main _ [] = do help_main _ (sub_txt:_) = do case lookup sub_txt hooks' of Nothing -> do - putStrLn $ "no such hpc command : " ++ sub_txt + putStrLn $ "no such HPC command: " <> sub_txt exitFailure Just plugin' -> do command_usage plugin' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e493dfd4db4b61ffc3f1faf7e38663118473d99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e493dfd4db4b61ffc3f1faf7e38663118473d99 You're receiving 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 Aug 18 13:24:24 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 09:24:24 -0400 Subject: [Git][ghc/ghc][master] ghc-heap: Fix decoding of TSO closures Message-ID: <62fe3d8897fb0_3d81494885021739a5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -350,7 +350,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do [p] -> Just p _ -> error $ "Expected 4 or 5 words in WEAK, found " ++ show (length pts) } - TSO | [ u_lnk, u_gbl_lnk, tso_stack, u_trec, u_blk_ex, u_bq] <- pts + TSO | ( u_lnk : u_gbl_lnk : tso_stack : u_trec : u_blk_ex : u_bq : other) <- pts -> withArray rawHeapWords (\ptr -> do fields <- FFIClosures.peekTSOFields decodeCCS ptr pure $ TSOClosure @@ -361,6 +361,10 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do , trec = u_trec , blocked_exceptions = u_blk_ex , bq = u_bq + , thread_label = case other of + [tl] -> Just tl + [] -> Nothing + _ -> error $ "thead_label:Expected 0 or 1 extra arguments" , what_next = FFIClosures.tso_what_next fields , why_blocked = FFIClosures.tso_why_blocked fields , flags = FFIClosures.tso_flags fields @@ -372,7 +376,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do , prof = FFIClosures.tso_prof fields }) | otherwise - -> fail $ "Expected 6 ptr arguments to TSO, found " + -> fail $ "Expected at least 6 ptr arguments to TSO, found " ++ show (length pts) STACK | [] <- pts ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -280,6 +280,7 @@ data GenClosure b , trec :: !b , blocked_exceptions :: !b , bq :: !b + , thread_label :: !(Maybe b) -- values , what_next :: !WhatNext , why_blocked :: !WhyBlocked View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/436867d6b07c69170e8e51283ac57ed3eab52ae4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/436867d6b07c69170e8e51283ac57ed3eab52ae4 You're receiving 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 Aug 18 13:24:58 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 09:24:58 -0400 Subject: [Git][ghc/ghc][master] driver: Honour -x option Message-ID: <62fe3daabb8cf_3d8149489a421791d5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - 5 changed files: - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T22044.bazoo - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -171,7 +171,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = -> Just (DriverPsHeaderMessage (PsHeaderMessage msg)) _ -> Nothing - pipe_env = mkPipeEnv StopPreprocess input_fn (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv StopPreprocess input_fn mb_phase (Temporary TFL_GhcSession) mkInputFn = case mb_input_buf of Just input_buf -> do @@ -237,7 +237,7 @@ compileOne' mHscMessage [ml_obj_file $ ms_location summary] plugin_hsc_env <- initializePlugins hsc_env - let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput + 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) @@ -512,7 +512,7 @@ oneShot hsc_env stop_phase srcs = do NoStop -> doLink hsc_env o_files compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath) -compileFile hsc_env stop_phase (src, _mb_phase) = do +compileFile hsc_env stop_phase (src, mb_phase) = do exists <- doesFileExist src when (not exists) $ throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src)) @@ -533,8 +533,8 @@ compileFile hsc_env stop_phase (src, _mb_phase) = do | isJust mb_o_file = SpecificFile -- -o foo applies to the file we are compiling now | otherwise = Persistent - pipe_env = mkPipeEnv stop_phase src output - pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src + pipe_env = mkPipeEnv stop_phase src mb_phase output + pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src mb_phase runPipeline (hsc_hooks hsc_env) pipeline @@ -583,7 +583,7 @@ compileForeign hsc_env lang stub_c = do #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif - pipe_env = mkPipeEnv NoStop stub_c (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv NoStop stub_c Nothing (Temporary TFL_GhcSession) res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. @@ -607,7 +607,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) - let pipe_env = (mkPipeEnv NoStop empty_stub Persistent) { src_basename = basename} + let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename} pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline return () @@ -617,15 +617,17 @@ compileEmptyStub dflags hsc_env basename location mod_name = do mkPipeEnv :: StopPhase -- End phase -> FilePath -- input fn + -> Maybe Phase -> PipelineOutput -- Output -> PipeEnv -mkPipeEnv stop_phase input_fn output = +mkPipeEnv stop_phase input_fn start_phase output = let (basename, suffix) = splitExtension input_fn suffix' = drop 1 suffix -- strip off the . env = PipeEnv{ stop_phase, src_filename = input_fn, src_basename = basename, src_suffix = suffix', + start_phase = fromMaybe (startPhase suffix') start_phase, output_spec = output } in env @@ -695,8 +697,7 @@ preprocessPipeline pipe_env hsc_env input_fn = do where platform = targetPlatform (hsc_dflags hsc_env) runAfter :: P p => Phase -> a -> p a -> p a - runAfter = phaseIfAfter platform start_phase - start_phase = startPhase (src_suffix pipe_env) + runAfter = phaseIfAfter platform (start_phase pipe_env) runAfterFlag :: P p => HscEnv -> Phase @@ -829,9 +830,9 @@ applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing -- Pipeline from a given suffix -pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) -pipelineStart pipe_env hsc_env input_fn = - fromSuffix (src_suffix pipe_env) +pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath) +pipelineStart pipe_env hsc_env input_fn mb_phase = + fromPhase (fromMaybe (startPhase $ src_suffix pipe_env) mb_phase) where stop_after = stop_phase pipe_env frontend :: P m => HscSource -> m (Maybe FilePath) @@ -863,33 +864,24 @@ pipelineStart pipe_env hsc_env input_fn = objFromLinkable _ = Nothing - fromSuffix :: P m => String -> m (Maybe FilePath) - fromSuffix "lhs" = frontend HsSrcFile - fromSuffix "lhs-boot" = frontend HsBootFile - fromSuffix "lhsig" = frontend HsigFile - fromSuffix "hs" = frontend HsSrcFile - fromSuffix "hs-boot" = frontend HsBootFile - fromSuffix "hsig" = frontend HsigFile - fromSuffix "hscpp" = frontend HsSrcFile - fromSuffix "hspp" = frontend HsSrcFile - fromSuffix "hc" = c HCc - fromSuffix "c" = c Cc - fromSuffix "cpp" = c Ccxx - fromSuffix "C" = c Cc - fromSuffix "m" = c Cobjc - fromSuffix "M" = c Cobjcxx - fromSuffix "mm" = c Cobjcxx - fromSuffix "cc" = c Ccxx - fromSuffix "cxx" = c Ccxx - fromSuffix "s" = as False - fromSuffix "S" = as True - fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn - fromSuffix "o" = return (Just input_fn) - fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn - fromSuffix _ = return (Just input_fn) + fromPhase :: P m => Phase -> m (Maybe FilePath) + fromPhase (Unlit p) = frontend p + fromPhase (Cpp p) = frontend p + fromPhase (HsPp p) = frontend p + fromPhase (Hsc p) = frontend p + fromPhase HCc = c HCc + fromPhase Cc = c Cc + fromPhase Ccxx = c Ccxx + fromPhase Cobjc = c Cobjc + fromPhase Cobjcxx = c Cobjcxx + fromPhase (As p) = as p + fromPhase LlvmOpt = llvmPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromPhase StopLn = return (Just input_fn) + fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase MergeForeign = panic "fromPhase: MergeForeign" {- Note [The Pipeline Monad] ===================================== compiler/GHC/Driver/Pipeline/Monad.hs ===================================== @@ -29,6 +29,7 @@ data PipeEnv = PipeEnv { src_filename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source src_suffix :: String, -- ^ its extension + start_phase :: Phase, output_spec :: PipelineOutput -- ^ says where to put the pipeline output } ===================================== testsuite/tests/driver/Makefile ===================================== @@ -779,3 +779,11 @@ T21869: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T21869.hs -S [ -f T21869.s ] || (echo "assembly file does not exist" && exit 2) [ ! -f T21869.o ] || (echo "object file exists" && exit 2) + +.PHONY: T22044 +T22044: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -E -cpp -x hs T22044.bazoo -o T22044.hs -DBAZOO=1 + # Test the file exists and is preprocessed + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T22044.hs + + ===================================== testsuite/tests/driver/T22044.bazoo ===================================== @@ -0,0 +1,3 @@ +module T22044 where + +bazoo = BAZOO ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22044', normal, makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a740a4c56416c7c1bc914a7a9207207e17833573 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a740a4c56416c7c1bc914a7a9207207e17833573 You're receiving 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 Aug 18 13:25:38 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 09:25:38 -0400 Subject: [Git][ghc/ghc][master] Be more careful in chooseInferredQuantifiers Message-ID: <62fe3dd2b9615_3d81494882821846c8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 7 changed files: - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/Var.hs - + testsuite/tests/partial-sigs/should_compile/T16152.hs - + testsuite/tests/partial-sigs/should_compile/T16152.stderr - + testsuite/tests/partial-sigs/should_compile/T22065.hs - + testsuite/tests/partial-sigs/should_compile/T22065.stderr - testsuite/tests/partial-sigs/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -43,6 +43,7 @@ import GHC.Tc.Solver import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Core.Predicate +import GHC.Core.TyCo.Ppr( pprTyVars ) import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType @@ -59,7 +60,7 @@ import GHC.Types.SourceText import GHC.Types.Id import GHC.Types.Var as Var import GHC.Types.Var.Set -import GHC.Types.Var.Env( TidyEnv ) +import GHC.Types.Var.Env( TidyEnv, TyVarEnv, mkVarEnv, lookupVarEnv ) import GHC.Unit.Module import GHC.Types.Name import GHC.Types.Name.Set @@ -934,7 +935,8 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; let psig_qtvs = map binderVar psig_qtv_bndrs psig_qtv_set = mkVarSet psig_qtvs psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs - + psig_bndr_map :: TyVarEnv InvisTVBinder + psig_bndr_map = mkVarEnv [ (binderVar tvb, tvb) | tvb <- psig_qtv_bndrs ] -- Check whether the quantified variables of the -- partial signature have been unified together @@ -950,32 +952,35 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; annotated_theta <- zonkTcTypes annotated_theta ; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx + -- NB: free_tvs includes tau_tvs + + ; let (_,final_qtvs) = foldr (choose_qtv psig_bndr_map) (free_tvs, []) qtvs + -- Pulling from qtvs maintains original order + -- NB: qtvs is already in dependency order - ; let keep_me = free_tvs `unionVarSet` psig_qtv_set - final_qtvs = [ mkTyVarBinder vis tv - | tv <- qtvs -- Pulling from qtvs maintains original order - , tv `elemVarSet` keep_me - , let vis = case lookupVarBndr tv psig_qtv_bndrs of - Just spec -> spec - Nothing -> InferredSpec ] + ; traceTc "chooseInferredQuantifiers" $ + vcat [ text "qtvs" <+> pprTyVars qtvs + , text "psig_qtv_bndrs" <+> ppr psig_qtv_bndrs + , text "free_tvs" <+> ppr free_tvs + , text "final_tvs" <+> ppr final_qtvs ] ; return (final_qtvs, my_theta) } where - report_dup_tyvar_tv_err (n1,n2) - = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) - - report_mono_sig_tv_err (n,tv) - = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) - where - m_unif_ty = listToMaybe - [ rhs - -- recall that residuals are always implications - | residual_implic <- bagToList $ wc_impl residual - , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) - , let residual_pred = ctPred residual_ct - , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] - , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] - , lhs_tv == tv ] + choose_qtv :: TyVarEnv InvisTVBinder -> TcTyVar + -> (TcTyVarSet, [InvisTVBinder]) -> (TcTyVarSet, [InvisTVBinder]) + -- Pick which of the original qtvs should be retained + -- Keep it if (a) it is mentioned in the body of the type (free_tvs) + -- (b) it is a forall'd variable of the partial signature (psig_qtv_bndrs) + -- (c) it is mentioned in the kind of a retained qtv (#22065) + choose_qtv psig_bndr_map tv (free_tvs, qtvs) + | Just psig_bndr <- lookupVarEnv psig_bndr_map tv + = (free_tvs', psig_bndr : qtvs) + | tv `elemVarSet` free_tvs + = (free_tvs', mkTyVarBinder InferredSpec tv : qtvs) + | otherwise -- Do not pick it + = (free_tvs, qtvs) + where + free_tvs' = free_tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType -> TcM (VarSet, TcThetaType) @@ -1019,6 +1024,22 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs -- Return (annotated_theta ++ diff_theta) -- See Note [Extra-constraints wildcards] + report_dup_tyvar_tv_err (n1,n2) + = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) + + report_mono_sig_tv_err (n,tv) + = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) + where + m_unif_ty = listToMaybe + [ rhs + -- recall that residuals are always implications + | residual_implic <- bagToList $ wc_impl residual + , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) + , let residual_pred = ctPred residual_ct + , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] + , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] + , lhs_tv == tv ] + mk_ctuple preds = mkBoxedTupleTy preds -- Hack alert! See GHC.Tc.Gen.HsType: -- Note [Extra-constraint holes in partial type signatures] ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Types.Var ( mkTyVarBinder, mkTyVarBinders, isTyVarBinder, tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, - mapVarBndr, mapVarBndrs, lookupVarBndr, + mapVarBndr, mapVarBndrs, -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -696,11 +696,6 @@ mapVarBndr f (Bndr v fl) = Bndr (f v) fl mapVarBndrs :: (var -> var') -> [VarBndr var flag] -> [VarBndr var' flag] mapVarBndrs f = map (mapVarBndr f) -lookupVarBndr :: Eq var => var -> [VarBndr var flag] -> Maybe flag -lookupVarBndr var bndrs = lookup var zipped_bndrs - where - zipped_bndrs = map (\(Bndr v f) -> (v,f)) bndrs - instance Outputable tv => Outputable (VarBndr tv ArgFlag) where ppr (Bndr v Required) = ppr v ppr (Bndr v Specified) = char '@' <> ppr v ===================================== testsuite/tests/partial-sigs/should_compile/T16152.hs ===================================== @@ -0,0 +1,8 @@ +{-# Language PartialTypeSignatures #-} +{-# Language PolyKinds #-} +{-# Language ScopedTypeVariables #-} + +module T16152 where + +top :: forall f. _ +top = undefined ===================================== testsuite/tests/partial-sigs/should_compile/T16152.stderr ===================================== @@ -0,0 +1,7 @@ + +T16152.hs:7:18: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of top :: w + at T16152.hs:8:1-15 + • In the type signature: top :: forall f. _ ===================================== testsuite/tests/partial-sigs/should_compile/T22065.hs ===================================== @@ -0,0 +1,30 @@ +{-# Options_GHC -dcore-lint #-} +{-# Language PartialTypeSignatures #-} + +module T22065 where + +data Foo where + Apply :: (x -> Int) -> x -> Foo + +foo :: Foo +foo = Apply f x :: forall a. _ where + + f :: [_] -> Int + f = length @[] @_ + + x :: [_] + x = mempty @[_] + +{- +Smaller version I used when debuggging + +apply :: (x->Int) -> x -> Bool +apply = apply + +foo :: Bool +foo = apply f x :: forall a. _ + where + f = length @[] + x = mempty + +-} ===================================== testsuite/tests/partial-sigs/should_compile/T22065.stderr ===================================== @@ -0,0 +1,53 @@ + +T22065.hs:10:30: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Foo’ + • In an expression type signature: forall a. _ + In the expression: Apply f x :: forall a. _ + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + f :: forall {w}. [w] -> Int (bound at T22065.hs:13:3) + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of f :: [w] -> Int + at T22065.hs:13:3-19 + • In the type ‘[_] -> Int’ + In the type signature: f :: [_] -> Int + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:15:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of x :: [w] + at T22065.hs:16:3-17 + • In the type ‘[_]’ + In the type signature: x :: [_] + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include foo :: Foo (bound at T22065.hs:10:1) ===================================== testsuite/tests/partial-sigs/should_compile/all.T ===================================== @@ -105,3 +105,5 @@ test('T20921', normal, compile, ['']) test('T21719', normal, compile, ['']) test('InstanceGivenOverlap3', expect_broken(20076), compile, ['']) test('T21667', normal, compile, ['']) +test('T22065', normal, compile, ['']) +test('T16152', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e293029db0d60852908feaf2312794849194b08c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e293029db0d60852908feaf2312794849194b08c You're receiving 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 Aug 18 13:41:51 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 18 Aug 2022 09:41:51 -0400 Subject: [Git][ghc/ghc][wip/T21694] 83 commits: Add a note about about W/W for unlifting strict arguments Message-ID: <62fe419ff24cd_3d8149488a02184859@gitlab.mail> Andreas Klebinger pushed to branch wip/T21694 at Glasgow Haskell Compiler / GHC Commits: fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 20d6d212 by Simon Peyton Jones at 2022-08-18T15:40:19+02:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694 and #21755 * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * I realised that, now we have ae_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. And finally, it was the strange treatment of join-point Ids (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring * Rewrote Note [Combining case branches: optimistic one-shot-ness] Compile time improves slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- CoOpt_Read(normal) ghc/alloc 803,788,056 747,832,680 -7.1% GOOD T18223(normal) ghc/alloc 928,207,320 959,424,016 +3.1% BAD geo. mean -0.3% minimum -7.1% maximum +3.1% On Windows it's a bit better: geo mean is -0.6%, and three more benchmarks trip their compile-time bytes-allocated threshold (they were all close on the other build): T18698b(normal) ghc/alloc 235,619,776 233,219,008 -1.0% GOOD T6048(optasm) ghc/alloc 112,208,192 109,704,936 -2.2% GOOD T18140(normal) ghc/alloc 85,064,192 83,168,360 -2.2% GOOD I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3.4% increase in exchange for goodness elsewhere. Metric Decrease: CoOpt_Read T18140 T18698b T6048 Metric Increase: T18223 - - - - - 734bb04f by Simon Peyton Jones at 2022-08-18T15:40:19+02:00 Try giving join points proper ArityInfo work in progress - - - - - 3993bbb2 by Simon Peyton Jones at 2022-08-18T15:40:19+02:00 Further wibbles - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa90ffc39473a9a6b57e0afa7afe5dfd055e8f58...3993bbb202499fdef3292f9e34c929d96db4529c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa90ffc39473a9a6b57e0afa7afe5dfd055e8f58...3993bbb202499fdef3292f9e34c929d96db4529c You're receiving 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 Aug 18 13:42:22 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 18 Aug 2022 09:42:22 -0400 Subject: [Git][ghc/ghc][wip/T21694] 2 commits: Revert "Further wibbles" Message-ID: <62fe41be7692e_3d8149489042185566@gitlab.mail> Andreas Klebinger pushed to branch wip/T21694 at Glasgow Haskell Compiler / GHC Commits: cda970b7 by Andreas Klebinger at 2022-08-18T15:40:45+02:00 Revert "Further wibbles" This reverts commit 3993bbb202499fdef3292f9e34c929d96db4529c. - - - - - 85048c98 by Andreas Klebinger at 2022-08-18T15:40:53+02:00 Revert "Try giving join points proper ArityInfo" This reverts commit 734bb04f1863b1c200108fd608bb80189b0c4869. - - - - - 5 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -746,18 +746,18 @@ Join points must follow these invariants: the binder. Reason: if we want to push a continuation into the RHS we must push it into the unfolding as well. - 2b. The Arity (in the IdInfo) of a join point varies independently of the - join-arity. For example, we could have - j x = case x of { T -> \y.y; F -> \y.3 } - Its join-arity is 1, but its idArity is 2; and we do not eta-expand - join points: see Note [Do not eta-expand join points] in - GHC.Core.Opt.Simplify.Utils. - - Allowing the idArity to be bigger than the join-arity is - important in arityType; see GHC.Core.Opt.Arity - Note [Arity type for recursive join bindings] - - Historical note: see #17294. + 2b. The Arity (in the IdInfo) of a join point is the number of value + binders in the top n lambdas, where n is the join arity. + + So arity <= join arity; the former counts only value binders + while the latter counts all binders. + e.g. Suppose $j has join arity 1 + let j = \x y. e in case x of { A -> j 1; B -> j 2 } + Then its ordinary arity is also 1, not 2. + + The arity of a join point isn't very important; but short of setting + it to zero, it is helpful to have an invariant. E.g. #17294. + See also Note [Do not eta-expand join points] in GHC.Core.Opt.Simplify.Utils. 3. If the binding is recursive, then all other bindings in the recursive group must also be join points. ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Core.Opt.Arity , tryEtaReduce -- ** ArityType - , ArityType, mkBotArityType + , ArityType, mkBotArityType, mkManifestArityType , arityTypeArity, idArityType, getBotArity -- ** typeArity and the state hack @@ -813,6 +813,14 @@ mkBotArityType oss = AT [(IsCheap,os) | os <- oss] botDiv botArityType :: ArityType botArityType = mkBotArityType [] +mkManifestArityType :: [Var] -> CoreExpr -> ArityType +mkManifestArityType bndrs body + = AT oss div + where + oss = [(IsCheap, idOneShotInfo bndr) | bndr <- bndrs, isId bndr] + div | exprIsDeadEnd body = botDiv + | otherwise = topDiv + topArityType :: ArityType topArityType = AT [] topDiv @@ -848,7 +856,7 @@ trimArityType :: Arity -> ArityType -> ArityType -- they end in 'ABot'. See Note [Arity trimming] trimArityType max_arity at@(AT lams _) | lams `lengthAtMost` max_arity = at - | otherwise = AT (take max_arity lams) topDiv + | otherwise = AT (take max_arity lams) topDiv data ArityOpts = ArityOpts { ao_ped_bot :: !Bool -- See Note [Dealing with bottom] @@ -867,7 +875,7 @@ exprEtaExpandArity opts e | otherwise = Just arity_type where - arity_type = safeArityType (arityType (findRhsArityEnv opts False) e) + arity_type = safeArityType (arityType (findRhsArityEnv opts) e) getBotArity :: ArityType -> Maybe Arity -- Arity of a divergent function @@ -898,7 +906,7 @@ findRhsArity opts is_rec bndr rhs old_arity NonRecursive -> step init_env where init_env :: ArityEnv - init_env = findRhsArityEnv opts (isJoinId bndr) + init_env = findRhsArityEnv opts ty_arity = typeArity (idType bndr) id_one_shots = idDemandOneShots bndr @@ -943,9 +951,8 @@ combineWithDemandOneShots at@(AT lams div) oss where zip_lams :: [ATLamInfo] -> [OneShotInfo] -> [ATLamInfo] zip_lams lams [] = lams - zip_lams [] oss | isDeadEndDiv div = [] - | otherwise = [ (IsExpensive,OneShotLam) - | _ <- takeWhile isOneShotInfo oss] + zip_lams [] oss = [ (IsExpensive,OneShotLam) + | _ <- takeWhile isOneShotInfo oss] zip_lams ((ch,os1):lams) (os2:oss) = (ch, os1 `bestOneShot` os2) : zip_lams lams oss @@ -1270,14 +1277,16 @@ data AnalysisMode = BotStrictness -- ^ Used during 'exprBotStrictness_maybe'. - | FindRhsArity { am_opts :: !ArityOpts - , am_no_eta :: !Bool - , am_sigs :: !(IdEnv SafeArityType) } + | EtaExpandArity { am_opts :: !ArityOpts } + -- ^ Used for finding an expression's eta-expanding arity quickly, + -- without fixed-point iteration ('exprEtaExpandArity'). + + | FindRhsArity { am_opts :: !ArityOpts + , am_sigs :: !(IdEnv SafeArityType) } -- ^ Used for regular, fixed-point arity analysis ('findRhsArity'). -- See Note [Arity analysis] for details about fixed-point iteration. - -- am_sigs: NB `SafeArityType` so we can use this in myIsCheapApp - -- am_no_eta: see Note [Arity type for recursive join bindings] - -- point 5 + -- am_dicts_cheap: see Note [Eta expanding through dictionaries] + -- am_sigs: note `SafeArityType` so we can use this in myIsCheapApp data ArityEnv = AE @@ -1285,36 +1294,34 @@ data ArityEnv -- ^ The analysis mode. See 'AnalysisMode'. } -instance Outputable ArityEnv where - ppr (AE mode) = ppr mode - -instance Outputable AnalysisMode where - ppr BotStrictness = text "BotStrictness" - ppr (FindRhsArity { am_sigs = sigs }) = text "FindRhsArity" <+> ppr sigs - -- | The @ArityEnv@ used by 'exprBotStrictness_maybe'. Pedantic about bottoms -- and no application is ever considered cheap. botStrictnessArityEnv :: ArityEnv botStrictnessArityEnv = AE { ae_mode = BotStrictness } +{- +-- | The @ArityEnv@ used by 'exprEtaExpandArity'. +etaExpandArityEnv :: ArityOpts -> ArityEnv +etaExpandArityEnv opts + = AE { ae_mode = EtaExpandArity { am_opts = opts } } +-} + -- | The @ArityEnv@ used by 'findRhsArity'. -findRhsArityEnv :: ArityOpts -> Bool -> ArityEnv -findRhsArityEnv opts no_eta +findRhsArityEnv :: ArityOpts -> ArityEnv +findRhsArityEnv opts = AE { ae_mode = FindRhsArity { am_opts = opts - , am_no_eta = no_eta , am_sigs = emptyVarEnv } } -isNoEtaEnv :: ArityEnv -> Bool -isNoEtaEnv ae = case ae_mode ae of - FindRhsArity { am_no_eta = no_eta } -> no_eta - BotStrictness -> True +isFindRhsArity :: ArityEnv -> Bool +isFindRhsArity (AE { ae_mode = FindRhsArity {} }) = True +isFindRhsArity _ = False -- First some internal functions in snake_case for deleting in certain VarEnvs -- of the ArityType. Don't call these; call delInScope* instead! modifySigEnv :: (IdEnv ArityType -> IdEnv ArityType) -> ArityEnv -> ArityEnv -modifySigEnv f env at AE { ae_mode = am at FindRhsArity{am_sigs = sigs} } - = env { ae_mode = am { am_sigs = f sigs } } +modifySigEnv f env at AE { ae_mode = am at FindRhsArity{am_sigs = sigs} } = + env { ae_mode = am { am_sigs = f sigs } } modifySigEnv _ env = env {-# INLINE modifySigEnv #-} @@ -1342,6 +1349,7 @@ delInScopeList env ids = del_sig_env_list ids env lookupSigEnv :: ArityEnv -> Id -> Maybe SafeArityType lookupSigEnv AE{ ae_mode = mode } id = case mode of BotStrictness -> Nothing + EtaExpandArity{} -> Nothing FindRhsArity{ am_sigs = sigs } -> lookupVarEnv sigs id -- | Whether the analysis should be pedantic about bottoms. @@ -1349,6 +1357,7 @@ lookupSigEnv AE{ ae_mode = mode } id = case mode of pedanticBottoms :: ArityEnv -> Bool pedanticBottoms AE{ ae_mode = mode } = case mode of BotStrictness -> True + EtaExpandArity{ am_opts = ArityOpts{ ao_ped_bot = ped_bot } } -> ped_bot FindRhsArity{ am_opts = ArityOpts{ ao_ped_bot = ped_bot } } -> ped_bot exprCost :: ArityEnv -> CoreExpr -> Maybe Type -> Cost @@ -1375,6 +1384,7 @@ myExprIsCheap AE{ae_mode = mode} e mb_ty = case mode of #if __GLASGOW_HASKELL__ <= 900 BotStrictness -> panic "impossible" #endif + EtaExpandArity{} -> exprIsCheap e FindRhsArity{am_sigs = sigs} -> exprIsCheapX (myIsCheapApp sigs) e -- | A version of 'isCheapApp' that considers results from arity analysis. @@ -1406,7 +1416,7 @@ arityType env (Var v) | Just at <- lookupSigEnv env v -- Local binding = at | otherwise - = assertPpr (isNoEtaEnv env || not (isJoinId v)) (ppr v) $ + = assertPpr (not (isFindRhsArity env && isJoinId v)) (ppr v) $ -- All join-point should be in the ae_sigs -- See Note [No free join points in arityType] idArityType v @@ -1463,6 +1473,22 @@ arityType env (Let (NonRec b rhs) e) rhs_cost = exprCost env rhs (Just (idType b)) env' = extendSigEnv env b (safeArityType (arityType env rhs)) +arityType env (Let (Rec pairs) body) + | ((j,_):_) <- pairs + , isJoinId j + = -- See Note [arityType for join bindings] + foldr (andArityType env . do_one) (arityType rec_env body) pairs + where + rec_env = foldl add_bot env pairs + add_bot env (j,_) = extendSigEnv env j botArityType + + do_one :: (JoinId, CoreExpr) -> ArityType + do_one (j,rhs) + | Just arity <- isJoinId_maybe j + = arityType rec_env $ snd $ collectNBinders arity rhs + | otherwise + = pprPanic "arityType:joinrec" (ppr pairs) + arityType env (Let (Rec prs) e) = -- See Note [arityType for let-bindings] floatIn (allCosts bind_cost prs) (arityType env' e) @@ -1470,12 +1496,14 @@ arityType env (Let (Rec prs) e) bind_cost (b,e) = exprCost env' e (Just (idType b)) env' = foldl extend_rec env prs extend_rec :: ArityEnv -> (Id,CoreExpr) -> ArityEnv - extend_rec env (b,_) = extendSigEnv env b $ - idArityType b + extend_rec env (b,e) = extendSigEnv env b $ + mkManifestArityType bndrs body + where + (bndrs, body) = collectBinders e -- We can't call arityType on the RHS, because it might mention -- join points bound in this very letrec, and we don't want to -- do a fixpoint calculation here. So we make do with the - -- idArityType. See Note [arityType for let-bindings] + -- manifest arity arityType env (Tick t e) | not (tickishIsCode t) = arityType env e @@ -1503,28 +1531,20 @@ propagate it to the usage site as usual. But how can we get (EX1)? It doesn't make much sense, because $j can't be a join point under the \x anyway. So we make it a precondition of arityType that the argument has no free join-point Ids. (This is checked -with an assert in the Var case of arityType.) - -Wrinkles - -* We /do/ allow free join point when doing findRhsArity for join-point - right-hand sides. See Note [Arity type for recursive join bindings] - point (5). - -* The invariant (no free join point in arityType) risks being - invalidated by one very narrow special case: runRW# +with an assesrt in the Var case of arityType.) +BUT the invariant risks being invalidated by one very narrow special case: runRW# join $j y = blah runRW# (\s. case x of True -> \y. e False -> $j x) - We have special magic in OccurAnal, and Simplify to allow continuations to - move into the body of a runRW# call. +We have special magic in OccurAnal, and Simplify to allow continuations to +move into the body of a runRW# call. - So we are careful never to attempt to eta-expand the (\s.blah) in the - argument to runRW#, at least not when there is a literal lambda there, - so that OccurAnal has seen it and allowed join points bound outside. - See Note [No eta-expansion in runRW#] in GHC.Core.Opt.Simplify.Iteration. +So we are careful never to attempt to eta-expand the (\s.blah) in the +argument to runRW#, at least not when there is a literal lambda there, +so that OccurAnal has seen it and allowed join points bound outside. +See Note [No eta-expansion in runRW#] in GHC.Core.Opt.Simplify.Iteration. Note [arityType for let-bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1555,16 +1575,18 @@ All this is particularly important for join points. Consider this (#18328) and suppose the join point is too big to inline. Now, what is the arity of f? If we inlined the join point, we'd definitely say "arity 2" because we are prepared to push case-scrutinisation inside a -lambda. It's important that we extend the envt with j's ArityType, so -that we can use that information in the A/C branch of the case. +lambda. It's important that we extend the envt with j's ArityType, +so that we can use that information in the A/C branch of the case. For /recursive/ bindings it's more difficult, to call arityType, because we don't have an ArityType to put in the envt for the recursively bound Ids. So for non-join-point bindings we satisfy -ourselves with whizzing up up an ArityType from the idArity of the -function, via idArityType. +ourselves with mkManifestArityType. Typically we'll have eta-expanded +the binding (based on an earlier fixpoint calculation in +findRhsArity), so the manifest arity is good. -But see Note [Arity type for recursive join bindings] for dark corners. +But for /recursive join points/ things are not so good. +See Note [Arity type for recursive join bindings] See Note [Arity type for recursive join bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1573,59 +1595,54 @@ Consider j n = j (n-1) in j 20 -Obviously `f` should get arity 4. But it's a bit tricky: - -1. Remember, we don't eta-expand join points; see GHC.Core.Opt.Simplify.Utils - Note [Do not eta-expand join points]. - -2. But even though we aren't going to eta-expand it, we still want `j` to get - idArity=4, via findRhsArity, so that in arityType, - - At the letrec-binding for `j` we'll whiz up an arity-4 ArityType - for `j` (Note [arityType for let-bindings]) - - At the occurrence (j 20) that arity-4 ArityType will leave an arity-3 - result. - -3. All this, even though j's /join-arity/ (stored in the JoinId) is 1. - This is is the Main Reason that we want the idArity to sometimes be - larger than the join-arity c.f. Note [Invariants on join points] item 2b - in GHC.Core. - -4. Be very careful of things like this (#21755): - g x = let j 0 = \y -> (x,y) - j n = expensive n `seq` j (n-1) - in j x - Here we do /not/ want eta-expand `g`, lest we duplicate all those - (expensive n) calls. - - But it's fine: the findRhsArity fixpoint calculation will compute arity-1 - for `j` (not arity 2); and that's just what we want. But we do need that - fixpoint. - - Historical note: an earlier version of GHC did a hack in which we gave - join points an ArityType of ABot, but that did not work with this #21755 - case. - -5. arityType does not usually expect to encounter free join points; - see Note [No free join points in arityType]. But consider - f x = join j1 y = .... in - joinrec j2 z = ...j1 y... in - j2 v - - When doing findRhsArity on `j2` we'll encounter the free `j1`. - But that is fine, because we aren't going to eta-expand `j2`; - we just want to know its arity. So we have a flag am_no_eta, - switched on when doing findRhsArity on a join point RHS. If - the flag is on, we allow free join points, but not otherwise. +Obviously `f` should get arity 4. But the manifest arity of `j` +is 1. Remember, we don't eta-expand join points; see +GHC.Core.Opt.Simplify.Utils Note [Do not eta-expand join points]. +And the ArityInfo on `j` will be just 1 too; see GHC.Core +Note [Invariants on join points], item (2b). So using +Note [ArityType for let-bindings] won't work well. + +We could do a fixpoint iteration, but that's a heavy hammer +to use in arityType. So we take advantage of it being a join +point: + +* Extend the ArityEnv to bind each of the recursive binders + (all join points) to `botArityType`. This means that any + jump to the join point will return botArityType, which is + unit for `andArityType`: + botAritType `andArityType` at = at + So it's almost as if those "jump" branches didn't exist. + +* In this extended env, find the ArityType of each of the RHS, after + stripping off the join-point binders. + +* Use andArityType to combine all these RHS ArityTypes. + +* Find the ArityType of the body, also in this strange extended + environment + +* And combine that into the result with andArityType. + +In our example, the jump (j 20) will yield Bot, as will the jump +(j (n-1)). We'll 'and' those the ArityType of (\abc. blah). Good! + +In effect we are treating the RHSs as alternative bodies (like +in a case), and ignoring all jumps. In this way we don't need +to take a fixpoint. Tricky! + +NB: we treat /non-recursive/ join points in the same way, but +actually it works fine to treat them uniformly with normal +let-bindings, and that takes less code. -} idArityType :: Id -> ArityType idArityType v | strict_sig <- idDmdSig v + , not $ isNopSig strict_sig , (ds, div) <- splitDmdSig strict_sig - , isDeadEndDiv div , let arity = length ds + -- Every strictness signature admits an arity signature! = AT (take arity one_shots) div - | otherwise = AT (take (idArity v) one_shots) topDiv where @@ -1876,7 +1893,7 @@ nested newtypes. This is expressed by the EtaInfo type: Note [Check for reflexive casts in eta expansion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It turns out that the casts created by the above mechanism are often Refl. +It turns out that the casts created by teh above mechanism are often Refl. When casts are very deeply nested (as happens in #18223), the repetition of types can make the overall term very large. So there is a big payoff in cancelling out casts aggressively wherever possible. ===================================== compiler/GHC/Core/Opt/FloatOut.hs ===================================== @@ -15,13 +15,12 @@ import GHC.Prelude import GHC.Core import GHC.Core.Utils import GHC.Core.Make --- import GHC.Core.Opt.Arity ( exprArity, etaExpand ) +import GHC.Core.Opt.Arity ( exprArity, etaExpand ) import GHC.Core.Opt.Monad ( FloatOutSwitches(..) ) import GHC.Driver.Flags ( DumpFlag (..) ) import GHC.Utils.Logger -import GHC.Types.Id ( Id, idType, --- idArity, isDeadEndId, +import GHC.Types.Id ( Id, idArity, idType, isDeadEndId, isJoinId, isJoinId_maybe ) import GHC.Types.Tickish import GHC.Core.Opt.SetLevels @@ -222,11 +221,11 @@ floatBind (NonRec (TB var _) rhs) -- A tiresome hack: -- see Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels --- let rhs'' | isDeadEndId var --- , exprArity rhs' < idArity var = etaExpand (idArity var) rhs' --- | otherwise = rhs' + let rhs'' | isDeadEndId var + , exprArity rhs' < idArity var = etaExpand (idArity var) rhs' + | otherwise = rhs' - (fs, rhs_floats, [NonRec var rhs']) } + in (fs, rhs_floats, [NonRec var rhs'']) } floatBind (Rec pairs) = case floatList do_pair pairs of { (fs, rhs_floats, new_pairs) -> ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -301,8 +301,8 @@ simplRecOrTopPair env bind_cxt old_bndr new_bndr rhs | otherwise = case bind_cxt of - BC_Join is_rec cont -> simplTrace "SimplBind:join" (ppr old_bndr) $ - simplJoinBind env is_rec cont old_bndr new_bndr rhs env + BC_Join cont -> simplTrace "SimplBind:join" (ppr old_bndr) $ + simplJoinBind env cont old_bndr new_bndr rhs env BC_Let top_lvl is_rec -> simplTrace "SimplBind:normal" (ppr old_bndr) $ simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env @@ -385,17 +385,16 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se -------------------------- simplJoinBind :: SimplEnv - -> RecFlag -> SimplCont -> InId -> OutId -- Binder, both pre-and post simpl -- The OutId has IdInfo, except arity, -- unfolding -> InExpr -> SimplEnv -- The right hand side and its env -> SimplM (SimplFloats, SimplEnv) -simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se +simplJoinBind env cont old_bndr new_bndr rhs rhs_se = do { let rhs_env = rhs_se `setInScopeFromE` env ; rhs' <- simplJoinRhs rhs_env old_bndr rhs cont - ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } + ; completeBind env (BC_Join cont) old_bndr new_bndr rhs' } -------------------------- simplNonRecX :: SimplEnv @@ -1870,8 +1869,8 @@ simplNonRecJoinPoint env bndr rhs body cont ; let mult = contHoleScaling cont res_ty = contResultType cont ; (env1, bndr1) <- simplNonRecJoinBndr env bndr mult res_ty - ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Join NonRecursive cont) - ; (floats1, env3) <- simplJoinBind env2 NonRecursive cont bndr bndr2 rhs env + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Join cont) + ; (floats1, env3) <- simplJoinBind env2 cont bndr bndr2 rhs env ; (floats2, body') <- simplExprF env3 body cont ; return (floats1 `addFloats` floats2, body') } @@ -1888,7 +1887,7 @@ simplRecJoinPoint env pairs body cont ; env1 <- simplRecJoinBndrs env bndrs mult res_ty -- NB: bndrs' don't have unfoldings or rules -- We add them as we go down - ; (floats1, env2) <- simplRecBind env1 (BC_Join Recursive cont) pairs + ; (floats1, env2) <- simplRecBind env1 (BC_Join cont) pairs ; (floats2, body') <- simplExprF env2 body cont ; return (floats1 `addFloats` floats2, body') } @@ -4150,9 +4149,9 @@ simplStableUnfolding env bind_cxt id rhs_ty id_arity unf CoreUnfolding { uf_tmpl = expr, uf_src = src, uf_guidance = guide } | isStableSource src -> do { expr' <- case bind_cxt of - BC_Join _ cont -> -- Binder is a join point - -- See Note [Rules and unfolding for join points] - simplJoinRhs unf_env id expr cont + BC_Join cont -> -- Binder is a join point + -- See Note [Rules and unfolding for join points] + simplJoinRhs unf_env id expr cont BC_Let _ is_rec -> -- Binder is not a join point do { let cont = mkRhsStop rhs_ty is_rec topDmd -- mkRhsStop: switch off eta-expansion at the top level @@ -4205,7 +4204,6 @@ simplStableUnfolding env bind_cxt id rhs_ty id_arity unf -- See Note [Eta-expand stable unfoldings] -- Use the arity from the main Id (in id_arity), rather than computing it from rhs - -- Not used for join points eta_expand expr | seEtaExpand env , exprArity expr < arityTypeArity id_arity , wantEtaExpansion expr @@ -4244,7 +4242,7 @@ Wrinkles * Don't eta-expand join points; see Note [Do not eta-expand join points] in GHC.Core.Opt.Simplify.Utils. We uphold this because the join-point - case (bind_cxt = BC_Join {}) doesn't use eta_expand. + case (bind_cxt = BC_Join _) doesn't use eta_expand. Note [Force bottoming field] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -4317,8 +4315,8 @@ simplRules env mb_new_id rules bind_cxt = do { (env', bndrs') <- simplBinders env bndrs ; let rhs_ty = substTy env' (exprType rhs) rhs_cont = case bind_cxt of -- See Note [Rules and unfolding for join points] - BC_Let {} -> mkBoringStop rhs_ty - BC_Join _ cont -> assertPpr join_ok bad_join_msg cont + BC_Let {} -> mkBoringStop rhs_ty + BC_Join cont -> assertPpr join_ok bad_join_msg cont lhs_env = updMode updModeForRules env' rhs_env = updMode (updModeForStableUnfoldings act) env' -- See Note [Simplifying the RHS of a RULE] ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -95,8 +95,8 @@ data BindContext TopLevelFlag RecFlag | BC_Join -- A join point with continuation k - RecFlag -- See Note [Rules and unfolding for join points] - SimplCont -- in GHC.Core.Opt.Simplify + SimplCont -- See Note [Rules and unfolding for join points] + -- in GHC.Core.Opt.Simplify bindContextLevel :: BindContext -> TopLevelFlag bindContextLevel (BC_Let top_lvl _) = top_lvl @@ -1779,20 +1779,18 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -- If tryEtaExpandRhs rhs = (n, is_bot, rhs') then -- (a) rhs' has manifest arity n -- (b) if is_bot is True then rhs' applied to n args is guaranteed bottom -tryEtaExpandRhs env (BC_Join is_rec _) bndr rhs - | isJoinId bndr - = return (arity_type, rhs) - -- Note [Do not eta-expand join points] - -- But do return the correct arity and bottom-ness, because - -- these are used to set the bndr's IdInfo (#15517) - -- Note [Invariants on join points] invariant 2b, in GHC.Core +tryEtaExpandRhs _env (BC_Join {}) bndr rhs + | Just join_arity <- isJoinId_maybe bndr + = do { let (join_bndrs, join_body) = collectNBinders join_arity rhs + arity_type = mkManifestArityType join_bndrs join_body + ; return (arity_type, rhs) } + -- Note [Do not eta-expand join points] + -- But do return the correct arity and bottom-ness, because + -- these are used to set the bndr's IdInfo (#15517) + -- Note [Invariants on join points] invariant 2b, in GHC.Core | otherwise = pprPanic "tryEtaExpandRhs" (ppr bndr) - where - old_arity = exprArity rhs - arity_type = findRhsArity arity_opts is_rec bndr rhs old_arity - arity_opts = seArityOpts env tryEtaExpandRhs env (BC_Let _ is_rec) bndr rhs | seEtaExpand env -- Provided eta-expansion is on View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3993bbb202499fdef3292f9e34c929d96db4529c...85048c986d6b8763f818de8e46c9b979f056e3e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3993bbb202499fdef3292f9e34c929d96db4529c...85048c986d6b8763f818de8e46c9b979f056e3e7 You're receiving 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 Aug 18 14:12:16 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 18 Aug 2022 10:12:16 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] Fix GHCis interaction with tag inference. Message-ID: <62fe48c0fd29_3d814948904219124f@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary at Glasgow Haskell Compiler / GHC Commits: 0ba257a3 by Andreas Klebinger at 2022-08-18T16:10:31+02:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 19 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Name/Set.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -26,11 +26,9 @@ import GHC.Runtime.Heap.Layout (isStackRep) import GHC.Settings (Platform, platformUnregisterised) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc @@ -180,8 +178,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CmmCgInfos +generateCgIPEStub hsc_env this_mod denv s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags logger = hsc_logger hsc_env @@ -200,7 +198,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -186,15 +186,14 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) -import GHC.Stg.InferTags +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Builtin.Utils import GHC.Builtin.Names import GHC.Builtin.Uniques ( mkPseudoUniqueE ) import qualified GHC.StgToCmm as StgToCmm ( codeGen ) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Cmm import GHC.Cmm.Info.Build @@ -268,6 +267,8 @@ import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1669,7 +1670,7 @@ hscSimpleIface' tc_result summary = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe CgInfos) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe StgCgInfos, Maybe CmmCgInfos ) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1719,11 +1720,16 @@ 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_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1762,11 +1768,12 @@ hscGenHardCode hsc_env cgguts location output_filename = do let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init `appendStubC` cgIPEStub st - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos) <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just stg_cg_infos, Just cmm_cg_infos) hscInteractive :: HscEnv @@ -1801,7 +1808,9 @@ hscInteractive hsc_env cgguts location = do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1895,7 +1904,7 @@ doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> HpcInfo - -> IO (Stream IO CmmGroupSRTs CgInfos) + -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1906,13 +1915,10 @@ doCodeGen hsc_env this_mod denv data_tycons hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + stg_ppr_opts = (initStgPprOpts dflags) putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1920,8 +1926,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1952,7 +1958,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool @@ -1960,7 +1966,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1968,7 +1975,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1976,20 +1983,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1997,7 +2005,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2148,7 +2156,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_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2385,7 +2393,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr logger dflags ictxt ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -739,7 +739,7 @@ hscBackendPipeline pipe_env hsc_env mod_sum result = else case result of HscUpdate iface -> return (iface, Nothing) - HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing + HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing) <*> pure Nothing -- TODO: Why is there not a linkable? -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -537,9 +537,9 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do else if backendWritesFiles (backend dflags) then do output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location) - (outputFilename, mStub, foreign_files, mb_cg_infos) <- + (outputFilename, mStub, foreign_files, mb_stg_infos, mb_cg_infos) <- hscGenHardCode hsc_env cgguts mod_location output_fn - final_iface <- mkFullIface hsc_env partial_iface mb_cg_infos + final_iface <- mkFullIface hsc_env partial_iface mb_stg_infos mb_cg_infos -- See Note [Writing interface files] hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location @@ -559,7 +559,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In interpreted mode the regular codeGen backend is not run so we -- generate a interface without codeGen info. do - final_iface <- mkFullIface hsc_env partial_iface Nothing + final_iface <- mkFullIface hsc_env partial_iface Nothing Nothing hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Prelude import GHC.Hs -import GHC.StgToCmm.Types (CgInfos (..)) +import GHC.StgToCmm.Types (CmmCgInfos (..)) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad @@ -99,6 +99,7 @@ import Data.Function import Data.List ( findIndex, mapAccumL, sortBy ) import Data.Ord import Data.IORef +import GHC.Stg.Pipeline (StgCgInfos) {- @@ -134,16 +135,16 @@ mkPartialIface hsc_env mod_details mod_summary -- | Fully instantiate an interface. Adds fingerprints and potentially code -- generator produced information. -- --- CgInfos is not available when not generating code (-fno-code), or when not +-- CmmCgInfos is not available when not generating code (-fno-code), or when not -- generating interface pragmas (-fomit-interface-pragmas). See also -- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types. -mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface -mkFullIface hsc_env partial_iface mb_cg_infos = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface +mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDecl (mi_decls partial_iface) mb_cg_infos + = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -156,11 +157,16 @@ mkFullIface hsc_env partial_iface mb_cg_infos = do return full_iface -updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl] -updateDecl decls Nothing = decls -updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos, cgTagSigs = tag_sigs }) +updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl] +updateDecl decls Nothing Nothing = decls +updateDecl decls m_stg_infos m_cmm_infos = map update_decl decls where + (non_cafs,lf_infos) = maybe (mempty, mempty) + (\cmm_info -> (ncs_nameSet (cgNonCafs cmm_info), cgLFInfos cmm_info)) + m_cmm_infos + tag_sigs = fromMaybe mempty m_stg_infos + update_decl (IfaceId nm ty details infos) | let not_caffy = elemNameSet nm non_cafs , let mb_lf_info = lookupNameEnv lf_infos nm @@ -178,6 +184,9 @@ updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf update_decl decl = decl + + + -- | Make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any -- object code at all ('NoBackend'). @@ -235,7 +244,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary docs mod_summary mod_details - mkFullIface hsc_env partial_iface Nothing + mkFullIface hsc_env partial_iface Nothing Nothing mkIface_ :: HscEnv -> Module -> HscSource -> Bool -> Dependencies -> GlobalRdrEnv ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -217,17 +216,17 @@ the output of itself. -- -> CollectedCCs -- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CgInfos) +-- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,55 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When compiling bytecode we call myCoreToStg to get STG code first. +myCoreToStg in turn calls out to stg2stg which runs the STG to STG +passes followed by free variables analysis and tag inference at the end. +Running tag inference is important as it upholds Note [Strict Field Invariant]. +While code executed by GHCi doesn't take advantage of the SFI it can call into +compiled code which does. So it must still make sure that the SFI is upheld. +See also #21083 and #22042. + +However there one important difference in code generation for GHCi and regular +compilation. When compiling an entire module (not a GHCi expression), we call +`stg2stg` on the entire module which allows us to build up a map which is guaranteed +to have an entry for every binder in the current module. +For non-interactive compilation the tag inference rewrite pass takes advantage +of this by building up a map from binders to their tag signatures. + +When compiling a GHCi expression on the other hand we invoke stg2stg separately +for each expression on the prompt. This means in GHCi for a sequence of: + > let x = True + > let y = StrictJust x +We first run stg2stg for `[x = True]`. And then again for [y = StrictJust x]`. + +While computing the tag signature for `y` during tag inference inferConTag will check +if `x` is already tagged by looking up the tagsig of `x` in the binder->signature mapping. +However since this mapping isn't persistent between stg2stg +invocations the lookup will fail. This isn't a correctness issue since it's always +safe to assume a binding isn't tagged and that's what we do in such cases. + +However for non-interactive mode we *don't* want to do this. Since in non-interactive mode +we have all binders of the module available for each invocation we can expect the binder->signature +mapping to be complete and all lookups to succeed. This means in non-interactive contexts a failed lookup +indicates a bug in the tag inference implementation. +For this reason we assert that we are running in interactive mode if a lookup fails. +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -16,6 +16,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +65,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -39,6 +40,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -52,6 +56,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg passes. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -66,7 +74,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], 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" @@ -85,7 +93,8 @@ stg2stg logger extra_vars opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + -- See Note [Tag inference for interactive contexts] + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -1,7 +1,7 @@ module GHC.StgToCmm.Types - ( CgInfos (..) + ( CmmCgInfos (..) , LambdaFormInfo (..) , ModuleLFInfos , StandardFormInfo (..) @@ -13,8 +13,6 @@ import GHC.Prelude import GHC.Core.DataCon -import GHC.Stg.InferTags.TagSig - import GHC.Runtime.Heap.Layout import GHC.Types.Basic @@ -85,7 +83,7 @@ moving parts are: -- -- See also Note [Conveying CAF-info and LFInfo between modules] above. -- -data CgInfos = CgInfos +data CmmCgInfos = CmmCgInfos { cgNonCafs :: !NonCaffySet -- ^ Exported Non-CAFFY closures in the current module. Everything else is -- either not exported of CAFFY. @@ -93,7 +91,6 @@ data CgInfos = CgInfos -- ^ LambdaFormInfos of exported closures in the current module. , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information - , cgTagSigs :: !(NameEnv TagSig) } -------------------------------------------------------------------------------- ===================================== compiler/GHC/Types/Name/Set.hs ===================================== @@ -220,5 +220,5 @@ findUses dus uses -- | 'Id's which have no CAF references. This is a result of analysis of C--. -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note. -newtype NonCaffySet = NonCaffySet NameSet +newtype NonCaffySet = NonCaffySet { ncs_nameSet :: NameSet } deriving (Semigroup, Monoid) ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal'),unless(have_dynamic(), skip)], makefile_test, ['T22042']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ba257a34f4bd4ecc1b3a93b40711dc04e39e995 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ba257a34f4bd4ecc1b3a93b40711dc04e39e995 You're receiving 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 Aug 18 14:18:56 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 Aug 2022 10:18:56 -0400 Subject: [Git][ghc/ghc][wip/unfolding-leaks] 72 commits: Remove backported items from 9.6 release notes Message-ID: <62fe4a50aabc1_3d81494887821955d@gitlab.mail> Matthew Pickering pushed to branch wip/unfolding-leaks at Glasgow Haskell Compiler / GHC Commits: 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - f55c7b32 by Matthew Pickering at 2022-08-18T15:11:15+01:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 93d379a1 by Matthew Pickering at 2022-08-18T15:18:10+01:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 1f968018 by Matthew Pickering at 2022-08-18T15:18:28+01:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToStg/Prep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5353d311d2da4aee9405b61fcc41f056963a5365...1f968018733e6afefd623c0f87c0460c6c035292 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5353d311d2da4aee9405b61fcc41f056963a5365...1f968018733e6afefd623c0f87c0460c6c035292 You're receiving 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 Aug 18 14:39:16 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 Aug 2022 10:39:16 -0400 Subject: [Git][ghc/ghc][wip/t22001] 14 commits: typo Message-ID: <62fe4f14cff69_3d81494886422035a6@gitlab.mail> Matthew Pickering pushed to branch wip/t22001 at Glasgow Haskell Compiler / GHC Commits: ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 4c44d330 by Matthew Pickering at 2022-08-18T15:39:04+01:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 13 changed files: - .gitlab/gen_ci.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Haddock.hs - libraries/base/changelog.md - libraries/ghc-compact/tests/all.T - rts/Interpreter.c - utils/haddock Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -2,13 +2,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- cabal: -build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring +build-depends: base, aeson >= 1.8.1, containers, bytestring -} +import Data.Coerce import Data.String (String) import Data.Aeson as A -import qualified Data.Map.Monoidal as M +import qualified Data.Map as Map +import Data.Map (Map) import qualified Data.ByteString.Lazy as B hiding (putStrLn) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) @@ -307,10 +310,22 @@ dockerImage _ _ = Nothing -- The "proper" solution would be to use a dependent monoidal map where each key specifies -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error -- or they should be combined. -type Variables = M.MonoidalMap String [String] +newtype MonoidalMap k v = MonoidalMap (Map k v) + deriving (Eq, Show, Functor, ToJSON) + +instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where + (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b) + +instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where + mempty = MonoidalMap (Map.empty) + +mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a +mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m) + +type Variables = MonoidalMap String [String] (=:) :: String -> String -> Variables -a =: b = M.singleton a [b] +a =: b = MonoidalMap (Map.singleton a [b]) opsysVariables :: Arch -> Opsys -> Variables opsysVariables _ FreeBSD13 = mconcat @@ -566,7 +581,7 @@ instance ToJSON Job where , "allow_failure" A..= jobAllowFailure -- Joining up variables like this may well be the wrong thing to do but -- at least it doesn't lose information silently by overriding. - , "variables" A..= (M.map (intercalate " ") jobVariables) + , "variables" A..= fmap (intercalate " ") jobVariables , "artifacts" A..= jobArtifacts , "cache" A..= jobCache , "after_script" A..= jobAfterScript @@ -621,9 +636,9 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) - , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty + , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) + , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty ] jobArtifacts = Artifacts @@ -669,7 +684,7 @@ addJobRule :: Rule -> Job -> Job addJobRule r j = j { jobRules = enableRule r (jobRules j) } addVariable :: String -> String -> Job -> Job -addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) } +addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } -- Building the standard jobs -- @@ -765,8 +780,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b] -- | Specification for all the jobs we want to build. -jobs :: M.MonoidalMap String Job -jobs = M.fromList $ concatMap flattenJobGroup $ +jobs :: Map String Job +jobs = Map.fromList $ concatMap flattenJobGroup $ [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , (validateBuilds Amd64 (Linux Debian10) nativeInt) ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Native code generator for x86 and x86-64 architectures +-- | Native code generator for AArch64 architectures module GHC.CmmToAsm.AArch64 ( ncgAArch64 ) where ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Logger import Data.Maybe (fromJust) import Control.Monad (ap) -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, isPrefixOf) import Data.Ord (comparing) -- ---------------------------------------------------------------------------- @@ -504,6 +504,12 @@ generateExternDecls = do modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | Is a variable one of the special @$llvm@ globals? +isBuiltinLlvmVar :: LlvmVar -> Bool +isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) = + "$llvm" `isPrefixOf` unpackFS lbl +isBuiltinLlvmVar _ = False + -- | Here we take a global variable definition, rename it with a -- @$def@ suffix, and generate the appropriate alias. aliasify :: LMGlobal -> LlvmM [LMGlobal] @@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal] -- Here we obtain the indirectee's precise type and introduce -- fresh aliases to both the precise typed label (lbl$def) and the i8* -- typed (regular) label of it with the matching new names. -aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) - (Just orig)) = do +aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias) + (Just orig)) + | not $ isBuiltinLlvmVar var = do let defLbl = llvmDefLabel lbl LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig defOrigLbl = llvmDefLabel origLbl @@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') ] -aliasify (LMGlobal var val) = do +aliasify (LMGlobal var val) + | not $ isBuiltinLlvmVar var = do let LMGlobalVar lbl ty link sect align const = var defLbl = llvmDefLabel lbl @@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do return [ LMGlobal defVar val , LMGlobal aliasVar (Just aliasVal) ] +aliasify global = pure [global] -- Note [Llvm Forward References] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do -- away with casting the alias to the desired type in @getSymbolPtr@ -- and instead just emit a reference to the definition symbol directly. -- This is the @Just@ case in @getSymbolPtr at . +-- +-- Note that we must take care not to turn LLVM's builtin variables into +-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM. ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -87,3 +87,50 @@ Compiler ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ + + +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/exts/gadt_syntax.rst ===================================== @@ -6,7 +6,7 @@ Declaring data types with explicit constructor signatures .. extension:: GADTSyntax :shortdesc: Enable generalised algebraic data type syntax. - :implied by: :extensions:`GADTs` + :implied by: :extension:`GADTs` :since: 7.2.1 :status: Included in :extension:`GHC2021` ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} ===================================== docs/users_guide/phases.rst ===================================== @@ -467,7 +467,7 @@ defined by your local GHC installation, the following trick is useful: .. index:: single: __GLASGOW_HASKELL_LLVM__ - Only defined when ``-fllvm`` is specified. When GHC is using version + Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero is added, so for example when using version 3.7 of LLVM, @@ -614,8 +614,8 @@ Options affecting code generation .. note:: - Note that this GHC release expects an LLVM version in the |llvm-version| - release series. + Note that this GHC release expects an LLVM version between |llvm-version-min| + and |llvm-version-max|. .. ghc-flag:: -fno-code :shortdesc: Omit code generation ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -41,7 +41,7 @@ archiveRoot :: FilePath archiveRoot = docRoot -/- "archives" manPageBuildPath :: FilePath -manPageBuildPath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1" -- TODO: Get rid of this hack. docContext :: Context @@ -249,7 +249,7 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ haddocks + need $ srcs ++ (map snd haddocks) -- Build Haddock documentation -- TODO: Pass the correct way from Rules via Context. @@ -364,8 +364,8 @@ buildManPage = do copyFileUntracked (dir -/- "ghc.1") file -- | Find the Haddock files for the dependencies of the current library. -haddockDependencies :: Context -> Action [FilePath] +haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do depNames <- interpretInContext context (getContextData depNames) - sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg + sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext Stage1 depPkg) | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -43,9 +43,8 @@ haddockBuilderArgs = mconcat context <- getContext version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg - trans_deps <- expr $ contextDependencies context - pkgs <- expr $ mapM (pkgIdentifier . C.package) $ trans_deps haddocks <- expr $ haddockDependencies context + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) @@ -69,7 +68,7 @@ haddockBuilderArgs = mconcat , map ("--hide=" ++) <$> getContextData otherModules , pure [ "--read-interface=../" ++ p ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME}," - ++ haddock | (p, haddock) <- zip pkgs haddocks ] + ++ haddock | (p, haddock) <- haddocks_with_versions ] , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] , getInputs , arg "+RTS" ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. @@ -66,14 +66,55 @@ A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md) is available. - * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to - `Debug.Trace`, per - [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36). - * Re-export `augment` and `build` function from `GHC.List` * Re-export the `IsList` typeclass from the new `GHC.IsList` module. + * There's a new special function ``withDict`` in ``GHC.Exts``: :: + + withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r + + where ``cls`` must be a class containing exactly one method, whose type + must be ``meth``. + + This function converts ``meth`` to a type class dictionary. + It removes the need for ``unsafeCoerce`` in implementation of reflection + libraries. It should be used with care, because it can introduce + incoherent instances. + + For example, the ``withTypeable`` function from the + ``Type.Reflection`` module can now be defined as: :: + + withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () + => TypeRep a -> (Typeable a => r) -> r + withTypeable rep k = withDict @(Typeable a) rep k + + Note that the explicit type application is required, as the call to + ``withDict`` would be ambiguous otherwise. + + This replaces the old ``GHC.Exts.magicDict``, which required + an intermediate data type and was less reliable. + + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by + `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these + were rather represented by `Word#` and `Int#`. See GHC #11953. + +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes + ## 4.16.1.0 *Feb 2022* * Shipped with GHC 9.2.2 @@ -498,7 +539,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is ===================================== libraries/ghc-compact/tests/all.T ===================================== @@ -16,8 +16,8 @@ test('compact_pinned', exit_code(1), compile_and_run, ['']) test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_run, ['']) # this test computes closure sizes and those are affected # by the ghci and prof ways, because of BCOs and profiling headers. -test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']), - compile_and_run, ['']) +# Optimization levels slightly change what is/isn't shared so only run in normal mode +test('compact_share', only_ways(['normal']), compile_and_run, ['']) test('compact_bench', [ ignore_stdout, extra_run_opts('100') ], compile_and_run, ['']) test('T17044', normal, compile_and_run, ['']) ===================================== rts/Interpreter.c ===================================== @@ -1875,7 +1875,7 @@ run_BCO: int flags = BCO_NEXT; bool interruptible = flags & 0x1; bool unsafe_call = flags & 0x2; - void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); + void(*marshal_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); /* the stack looks like this: @@ -1902,7 +1902,7 @@ run_BCO: #define ROUND_UP_WDS(p) ((((StgWord)(p)) + sizeof(W_)-1)/sizeof(W_)) - ffi_cif *cif = (ffi_cif *)marshall_fn; + ffi_cif *cif = (ffi_cif *)marshal_fn; uint32_t nargs = cif->nargs; uint32_t ret_size; uint32_t i; ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit a9a312991e55ab99a8dee36a6747f4fc5d5b7c67 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29494d7010e171978792bce67b3e1b859edc8c70...4c44d3303ec732daf20d317a368b084969a0b07a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29494d7010e171978792bce67b3e1b859edc8c70...4c44d3303ec732daf20d317a368b084969a0b07a You're receiving 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 Aug 18 14:51:02 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Thu, 18 Aug 2022 10:51:02 -0400 Subject: [Git][ghc/ghc][wip/21611-move-corem] 51 commits: typo Message-ID: <62fe51d6434fc_3d8149488dc2209339@gitlab.mail> Dominik Peteler pushed to branch wip/21611-move-corem at Glasgow Haskell Compiler / GHC Commits: ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 27d2c180 by Dominik Peteler at 2022-08-18T16:50:14+02:00 Move CoreM to GHC.Plugins.Monad Removes the uses of CoreM in the Specialise, SpecConstr and CallerCC pass. Since CoreM is now only used by Core2core plugins within the Core pipeline the monad got moved to an own module. Additionally CoreToDo and related types got moved to an own module GHC.Core.Opt.Pipeline.Types. Moved the remaining code from GHC.Core.Opt.Monad to GHC.Core.Opt.Utils. GHC.Core.Opt.{SpecConstr,CallerCC} got proper configs / the usual treatment. Split out GHC.Core.Opt.CallerCC.Filter to avoid hs-boot. Removed explicit PrintUnqualified argument from `endPassIO` Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep Fixes #21611. - - - - - 6652eb0b by Dominik Peteler at 2022-08-18T16:50:15+02:00 Removed CoreM uses from GHC.Core.Lint - - - - - 96e32496 by Dominik Peteler at 2022-08-18T16:50:16+02:00 Purified GHC.Core.LateCC.addLateCostCentres * GHC.Driver.Config.Core.Lint: * Removed: endPass * Renamed: endPassHscEnvIO -> endPass * Moved GHC.Core.Opt.Pipeline.initLintAnnotationsConfig to GHC.Driver.Config.Core.Lint - - - - - 78b64de1 by Dominik Peteler at 2022-08-18T16:50:17+02:00 Run the CoreToDo interpreter in an own monad `SimplCountM` This monad is just `StateT SimplCount IO` wrapped in a newtype. This way we get rid of some `Core.Opt.Pipeline` boilerplate. It lives in GHC.Core.Opt.Counting and `Tick` and `SimplCount` got moved there as well. Also: * GHC.Core.Opt.Pipeline.runCorePasses: Take logger service as an argument - - - - - c191d2e0 by Dominik Peteler at 2022-08-18T16:50:19+02:00 Removed references to driver from Specialise pass - - - - - 5d7dba18 by Dominik Peteler at 2022-08-18T16:50:20+02:00 Split `Core.EndPass` from `Core.Lint` This better sepates concerns (linting is domain layer, end pass diagnostics is application later), and `Core.Lint` is a huge module to boot. - - - - - c1726582 by Dominik Peteler at 2022-08-18T16:50:21+02:00 Get rid of `CoreDesugar`, `CoreDesugarOpt`, `CoreTidy`, `CorePrep` Those are not Core -> Core passes and so they don't belong in that sum type. Also cleaned up a bit: * Removed 'GHC.Driver.Config.Core.Lint.lintCoreBindings' It was dead code. * Removed 'GHC.Driver.Config.Core.Lint.lintPassResult' It run the actual linting and therefore it didn't belong to the GHC.Driver.Config namespace. As it was used only once the definition got inlined. * GHC.Core.Lint: Renamed lintPassResult' to lintPassResult. Also renamed lintCoreBindings' to lintCoreBindings. * GHC.Driver.Config.Core.Lint: Stick to the defaults when initializing the config records. * GHC.Driver.Config.Core.EndPass: Inlined `endPass` * GHC.Driver.Config.Core.EndPass: Removed `endPassLintFlags` as it was never used - - - - - f1df7cf5 by Dominik Peteler at 2022-08-18T16:50:22+02:00 Simplified initSimplifyOpts - - - - - 239651a9 by Dominik Peteler at 2022-08-18T16:50:24+02:00 Adjusted tests - - - - - 044553f1 by Dominik Peteler at 2022-08-18T16:50:25+02:00 Removed RuleBase from getCoreToDo - - - - - 0202a6c2 by Dominik Peteler at 2022-08-18T16:50:26+02:00 Purified initSpecialiseOpts Also pass the rule bases and the visible orphan modules as arguments to the Specialise pass. - - - - - 09200e59 by Dominik Peteler at 2022-08-18T16:50:27+02:00 Simplified CoreToDo interpreter a bit - - - - - 598a86f5 by Dominik Peteler at 2022-08-18T16:50:28+02:00 Config records of some Core passes are now provided by CoreToDo * CoreAddCallerCcs * CoreAddLateCcs * CoreDoFloatInwards * CoreLiberateCase * CoreDoSpecConstr - - - - - 80fe358b by Dominik Peteler at 2022-08-18T16:50:29+02:00 Move Core pipeline to the driver * Moved `getCoreToDo` to an own module GHC.Driver.Config.Core.Opt * Moved the remaining part of GHC.Core.Opt.Pipeline to a new module GHC.Driver.Core.Opt * Renamed GHC.Core.Opt.Pipeline.Types to GHC.Core.Opt.Config - - - - - 245d0645 by Dominik Peteler at 2022-08-18T16:50:31+02:00 Fixed tests - - - - - 0fc79dee by Dominik Peteler at 2022-08-18T16:50:32+02:00 Fixed note - - - - - ccf8e7fc by John Ericson at 2022-08-18T16:50:33+02:00 Add some haddocks - - - - - aee3e2bb by John Ericson at 2022-08-18T16:50:34+02:00 Move `core2core` to `GHC.Driver.Main` This "pushes up" the planning vs execution split, by not combining the two until a further downstream module. That helps encourage this separation we are very much fans of. Also deduplicate some logic with `liftCoreMToSimplCountM`, which abstracts over a number of details to eliminate a `CoreM` to a `SimpleCountM`. It might be a bit too opinionated at the moment, in which case we will think about how to shuffle some things around. In addition, deduplicate `simplMask`, which is indeed sketchy thing to export, but we can deal with that later. - - - - - ae282309 by John Ericson at 2022-08-18T16:50:35+02:00 Factor out `readRuleEnv` into its own module nad give haddocks Might end up up recombining this but its good separation of concerns for now. - - - - - 84b43b36 by John Ericson at 2022-08-18T16:50:36+02:00 Quick and dirty chop up modules once again I decided my earlier recommendation to mmhat was not quite write. It was the one I implemented too. So through this together real quick and dirty. We can make it nicer afterwords Things that are not yet nice: - `CoreOptEnv` is a grab bag of junk. Of course, it is merely reifying how was were accessing `HscEnv` before --- also rather junky! So maybe it cannot totally be improved. But it would be good to go over bits and ask / make issues (like #21926) that would help us clean up later. - Logging tricks for annotations linting is broken from the planning vs execution separation. We'll need to "delay that part of planning too. Can hack it up with more higher order function tricks, might be also a good oppertunity to rethink what should go in which config. - Some of the per-pass config records require info that isn't available at planning time. I hacked up up with functions in `CoreToDo` but we could do better. Conversely, per #21926, perhaps we *should* include the module name in the config after all, since we know it from downsweep before upsweep begins. - `GHC.Driver.Core.Rules` could just go inside `GHC.Driver.Core.Opt`. - - - - - d80d5ad7 by John Ericson at 2022-08-18T16:50:37+02:00 Split `GHC.Core.Opt.Utils` Half of it was domain layer (float out switches) but the other half was infrastructure / driver (annotations). - - - - - b899c482 by Dominik Peteler at 2022-08-18T16:50:39+02:00 Fixed tests - - - - - f0a4641c by Dominik Peteler at 2022-08-18T16:50:40+02:00 Better configuration of Core lint debug options - - - - - 0ef746da by Dominik Peteler at 2022-08-18T16:50:41+02:00 Configuration record for rule check pass - - - - - 8202226b by Dominik Peteler at 2022-08-18T16:50:42+02:00 Renamed dmdAnal to demandAnalysis and moved it to GHC.Core.Opt.DmdAnal - - - - - 19e48965 by Dominik Peteler at 2022-08-18T16:50:43+02:00 Fix tests - - - - - 6334054a by Dominik Peteler at 2022-08-18T16:50:44+02:00 Added environment for worker/wrapper pass - - - - - 11bd4d83 by Dominik Peteler at 2022-08-18T16:50:46+02:00 Refactored configuration of Specialise pass again Also removed GHC.Core.Opt.Specialise.Config again. We may introduce separate *.Config modules for the passes once we had a look at the module graph and decide whether the addition of these modules is justified. - - - - - c01d5c86 by Dominik Peteler at 2022-08-18T16:50:47+02:00 Removed GHC.Driver.Core.Rules - - - - - 5e0e18c4 by Dominik Peteler at 2022-08-18T16:50:48+02:00 Removed CoreDoNothing and CoreDoPasses Rewrote the getCoreToDo function using a Writer monad. This makes these data constructors superfluous. - - - - - b7709ff8 by Dominik Peteler at 2022-08-18T16:50:49+02:00 Renamed endPassIO to endPass - - - - - 80b24e6e by Dominik Peteler at 2022-08-18T16:50:50+02:00 Renamed hscSimplify/hscSimplify' to optimizeCoreIO/optimizeCoreHsc - - - - - d941710f by Dominik Peteler at 2022-08-18T16:50:51+02:00 Run simplifyPgm in SimplCountM - - - - - ffaadeb9 by Dominik Peteler at 2022-08-18T16:50:53+02:00 Added note on the architecture of the Core optimizer - - - - - 30 changed files: - .gitlab/gen_ci.hs - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - + compiler/GHC/Core/EndPass.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Lint/Interactive.hs - + compiler/GHC/Core/Opt.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Filter.hs - compiler/GHC/Core/Opt/Pipeline/Types.hs → compiler/GHC/Core/Opt/Config.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatOut.hs - + compiler/GHC/Core/Opt/FloatOutSwitches.hs - − compiler/GHC/Core/Opt/Pipeline.hs - + compiler/GHC/Core/Opt/RuleCheck.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/Stats.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/CoreToStg/Prep.hs - + compiler/GHC/Driver/Config/Core/EndPass.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/dd0a2286a2a9abb93e4984e2441c31967f4e57a5...ffaadeb905fc6fca09ed0aed0b32629804290330 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd0a2286a2a9abb93e4984e2441c31967f4e57a5...ffaadeb905fc6fca09ed0aed0b32629804290330 You're receiving 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 Aug 18 14:54:48 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 Aug 2022 10:54:48 -0400 Subject: [Git][ghc/ghc][wip/T21623] Improve error messages Message-ID: <62fe52b875d73_3d81494883c221038b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: a0051bb5 by Simon Peyton Jones at 2022-08-18T15:55:54+01:00 Improve error messages - - - - - 2 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Tc/Errors/Ppr.hs Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -734,11 +734,11 @@ isBoxedRuntimeRep_maybe rep -- | Check whether a type of kind 'RuntimeRep' is lifted, unlifted, or unknown. -- --- @isLiftedRuntimeRep rr@ returns: +-- `isLiftedRuntimeRep rr` returns: -- --- * @Just Lifted@ if @rr@ is @LiftedRep :: RuntimeRep@ --- * @Just Unlifted@ if @rr@ is definitely unlifted, e.g. @IntRep@ --- * @Nothing@ if not known (e.g. it's a type variable or a type family application). +-- * `Just Lifted` if `rr` is `LiftedRep :: RuntimeRep` +-- * `Just Unlifted` if `rr` is definitely unlifted, e.g. `IntRep` +-- * `Nothing` if not known (e.g. it's a type variable or a type family application). runtimeRepLevity_maybe :: Type -> Maybe Levity runtimeRepLevity_maybe rep | TyConApp rr_tc args <- coreFullView rep @@ -756,14 +756,14 @@ runtimeRepLevity_maybe rep -- hence the isPromotedDataCon rr_tc runtimeRepLevity_maybe _ = Nothing --- | Check whether a kind is of the form @TYPE (BoxedRep Lifted)@ --- or @TYPE (BoxedRep Unlifted)@. +-- | Check whether a kind is of the form `TYPE (BoxedRep Lifted)` +-- or `TYPE (BoxedRep Unlifted)`. -- -- Returns: -- --- - @Just Lifted@ for @TYPE (BoxedRep Lifted)@ and @Type@, --- - @Just Unlifted@ for @TYPE (BoxedRep Unlifted)@ and @UnliftedType@, --- - @Nothing@ for anything else, e.g. @TYPE IntRep@, @TYPE (BoxedRep l)@, etc. +-- - `Just Lifted` for `TYPE (BoxedRep Lifted)` and `Type`, +-- - `Just Unlifted` for `TYPE (BoxedRep Unlifted)` and `UnliftedType`, +-- - `Nothing` for anything else, e.g. `TYPE IntRep`, `TYPE (BoxedRep l)`, etc. kindBoxedRepLevity_maybe :: Type -> Maybe Levity kindBoxedRepLevity_maybe ty | Just rep <- kindRep_maybe ty ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2096,41 +2096,63 @@ pprTcSolverReportMsg ctxt , teq_mismatch_what = mb_thing }) = addArising ct_loc $ pprWithExplicitKindsWhen ppr_explicit_kinds msg where - msg - | isUnliftedTypeKind act, isLiftedTypeKind exp - = sep [ text "Expecting a lifted type, but" - , thing_msg mb_thing (text "an") (text "unlifted") ] - | isLiftedTypeKind act, isUnliftedTypeKind exp - = sep [ text "Expecting an unlifted type, but" - , thing_msg mb_thing (text "a") (text "lifted") ] - | tcIsLiftedTypeKind exp - = maybe_num_args_msg $$ - sep [ text "Expected a type, but" + msg | Just (torc, rep) <- sORTKind_maybe exp + = msg_for_exp_sort torc rep + + | Just nargs_msg <- num_args_msg + , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig + = nargs_msg $$ pprTcSolverReportMsg ctxt ea_msg + + | -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $ + ea_looks_same ty1 ty2 exp act + , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig + = pprTcSolverReportMsg ctxt ea_msg + + | otherwise = bale_out_msg + + -- bale_out_msg: the mismatched types are /inside/ exp and act + bale_out_msg = vcat $ map (pprTcSolverReportMsg ctxt) errs + where + errs = case mk_ea_msg ctxt Nothing level orig of + Left ea_info -> [ mkTcReportWithInfo mismatch_err ea_info ] + Right ea_err -> [ mismatch_err, ea_err ] + mismatch_err = Mismatch False item ty1 ty2 + + -- 'expected' is (TYPE rep) or (CONSTRAINT rep) + msg_for_exp_sort exp_torc exp_rep + | Just (act_torc, act_rep) <- sORTKind_maybe act + , act_torc == exp_torc + = -- (TYPE exp_rep) ~ (TYPE act_rep) or similar with CONSTRAINT + case (runtimeRepLevity_maybe exp_rep, runtimeRepLevity_maybe act_rep) of + (Just exp_lev, Just act_lev) + -> sep [ text "Expecting" <+> ppr_an_lev exp_lev <+> pp_exp_thing <+> text "but" + , case mb_thing of + Just thing -> quotes (ppr thing) <+> text "is" <+> ppr_lev act_lev + Nothing -> text "got" <+> ppr_an_lev act_lev <+> pp_exp_thing ] + _ -> bale_out_msg + + | otherwise + = -- (TYPE _) ~ (CONSTRAINT _) or (TYPE _) ~ Bool, etc + maybe_num_args_msg $$ + sep [ text "Expected a" <+> pp_exp_thing <+> text "but" , case mb_thing of Nothing -> text "found something with kind" Just thing -> quotes (ppr thing) <+> text "has kind" , quotes (pprWithTYPE act) ] - | Just nargs_msg <- num_args_msg - , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = nargs_msg $$ pprTcSolverReportMsg ctxt ea_msg - | -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $ - ea_looks_same ty1 ty2 exp act - , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = pprTcSolverReportMsg ctxt ea_msg - -- The mismatched types are /inside/ exp and act - | let mismatch_err = Mismatch False item ty1 ty2 - errs = case mk_ea_msg ctxt Nothing level orig of - Left ea_info -> [ mkTcReportWithInfo mismatch_err ea_info ] - Right ea_err -> [ mismatch_err, ea_err ] - = vcat $ map (pprTcSolverReportMsg ctxt) errs + + where + pp_exp_thing = case exp_torc of TypeLike -> text "type"; + ConstraintLike -> text "constraint" + ppr_lev Lifted = text "lifted" + ppr_lev Unlifted = text "unlifted" + ppr_an_lev Lifted = text "a lifted" + ppr_an_lev Unlifted = text "an unlifted" + ct_loc = errorItemCtLoc item orig = errorItemOrigin item level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel - thing_msg (Just thing) _ levity = quotes (ppr thing) <+> text "is" <+> levity - thing_msg Nothing an levity = text "got" <+> an <+> levity <+> text "type" - num_args_msg = case level of KindLevel | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0051bb591192b18be0894a47b00a67ba59b4a6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0051bb591192b18be0894a47b00a67ba59b4a6f You're receiving 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 Aug 18 15:13:26 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 Aug 2022 11:13:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21694a Message-ID: <62fe5716afc_125b2b487ec-38b@gitlab.mail> Simon Peyton Jones pushed new branch wip/T21694a at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21694a You're receiving 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 Aug 18 15:19:36 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 11:19:36 -0400 Subject: [Git][ghc/ghc][ghc-9.4] 2 commits: linters-common: Add LICENSE Message-ID: <62fe5888830d3_125b2b50258116da@gitlab.mail> Ben Gamari pushed to branch ghc-9.4 at Glasgow Haskell Compiler / GHC Commits: 4f70fbff by Ben Gamari at 2022-08-17T16:39:43+00:00 linters-common: Add LICENSE - - - - - d04c592d by Ben Gamari at 2022-08-17T17:50:22+00:00 make: Fix bindist installation - - - - - 2 changed files: - ghc.mk - + linters/linters-common/LICENSE Changes: ===================================== ghc.mk ===================================== @@ -135,10 +135,13 @@ include mk/config.mk ifeq "$(ProjectVersion)" "" $(error Please run ./configure first) endif + +ifneq "$(BINDIST)" "YES" ifneq "$(CanBootWithMake)" "YES" $(error The make build system requires a boot compiler older than ghc-9.2. Your boot compiler is too new and cannot be used to build ghc-9.4 with make. Either boot with ghc 9.0.2 or build with hadrian. See https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html for advice on transitioning to hadrian.) endif endif +endif include mk/ways.mk @@ -493,6 +496,8 @@ libraries/ghc-bignum_CONFIGURE_OPTS += -f $(BIGNUM_BACKEND) CABAL_DEPS = text transformers mtl parsec Cabal/Cabal-syntax CABAL_BOOT_DEPS = process array filepath base bytestring containers deepseq time unix pretty directory +# N.B. This shouldn't be needed while installing a binary distribution. +ifneq "$(BINDIST)" "YES" BOOT_PKG_DEPS := \ $(foreach p,$(CABAL_BOOT_DEPS),\ --dependency="$p=$p-$(shell $(GHC_PKG) --simple-output field $p version)") @@ -501,6 +506,7 @@ STAGE0_PKG_DEPS := \ $(foreach d,$(CABAL_DEPS),\ $(foreach p,$(basename $(notdir $(wildcard libraries/$d/*.cabal))),\ --dependency="$p=$p-$(shell grep -i "^Version:" libraries/$d/$p.cabal | sed "s/[^0-9.]//g")")) +endif libraries/Cabal/Cabal_dist-boot_CONFIGURE_OPTS += --exact-configuration $(BOOT_PKG_DEPS) $(STAGE0_PKG_DEPS) ===================================== linters/linters-common/LICENSE ===================================== @@ -0,0 +1,31 @@ +The Glasgow Haskell Compiler License + +Copyright 2002, The University Court of the University of Glasgow. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither name of the University nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bea62ff81bd05ed4c88b6c96a1d77f857936114...d04c592df1643b1f3bdf1824a9c88887c054402e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bea62ff81bd05ed4c88b6c96a1d77f857936114...d04c592df1643b1f3bdf1824a9c88887c054402e You're receiving 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 Aug 18 15:19:38 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 11:19:38 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/T22007 Message-ID: <62fe588a9674e_125b2b502bc11887@gitlab.mail> Ben Gamari deleted branch wip/T22007 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 Aug 18 15:37:07 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 18 Aug 2022 11:37:07 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Apply: doc and refactoring Message-ID: <62fe5ca349621_125b2b4e4a820914@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 41616e1c by Sylvain Henry at 2022-08-18T17:39:50+02:00 Apply: doc and refactoring - use new types instead of Bool/Int - factorize some code - - - - - 2 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Apply.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -100,7 +100,7 @@ module GHC.JS.Make , mask8, mask16 , signExtend8, signExtend16 , typeof - , returnStack, assignAllEqual, assignAll + , returnStack, assignAllEqual, assignAll, assignAllReverseOrder , declAssignAll , nullStat, (.^) -- ** Hash combinators @@ -530,6 +530,10 @@ assignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" (|=) xs ys) assignAll :: [JExpr] -> [JExpr] -> JStat assignAll xs ys = mconcat (zipWith (|=) xs ys) +assignAllReverseOrder :: [JExpr] -> [JExpr] -> JStat +assignAllReverseOrder xs ys = mconcat (reverse (zipWith (|=) xs ys)) + + declAssignAll :: [Ident] -> [JExpr] -> JStat declAssignAll xs ys = mconcat (zipWith (||=) xs ys) ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -74,8 +74,7 @@ import Data.Array -- These are bundled with the RTS. rtsApply :: StgToJSConfig -> JStat rtsApply cfg = BlockStat $ - map (uncurry (stackApply cfg)) applySpec - ++ map (uncurry (fastApply cfg)) applySpec + map (specApply cfg) applySpec ++ map (pap cfg) specPap ++ [ mkApplyArr , genericStackApply cfg @@ -259,78 +258,153 @@ genApp ctx i args -- avoid one indirection for global ids -- fixme in many cases we can also jump directly to the entry for local? jumpToII :: Id -> [JExpr] -> JStat -> G JStat -jumpToII i args afterLoad +jumpToII i vars load_app_in_r1 | isLocalId i = do ii <- varForId i return $ mconcat - [ ra - , afterLoad + [ assignAllReverseOrder jsRegsFromR2 vars + , load_app_in_r1 , returnS (closureEntry ii) ] | otherwise = do ei <- varForEntryId i return $ mconcat - [ ra - , afterLoad + [ assignAllReverseOrder jsRegsFromR2 vars + , load_app_in_r1 , returnS ei ] - where - ra = mconcat . reverse $ zipWith (\r a -> r |= a) jsRegsFromR2 args -- | Try to use a specialized pre-generated application function. -- If there is none, use h$ap_gen_fast instead jumpToFast :: HasDebugCallStack => [StgArg] -> JStat -> G JStat -jumpToFast as afterLoad = do - regs <- concatMapM genArg as - spec <- selectApply True as regs +jumpToFast args load_app_in_r1 = do + -- get JS expressions for every argument + -- Arguments may have more than one expression (e.g. Word64#) + vars <- concatMapM genArg args + -- try to find a specialized apply function + let spec = mkApplySpec RegsConv args vars + ap_fun <- selectApply spec pure $ mconcat - [ mconcat (ra regs) - , afterLoad - , case spec of + [ assignAllReverseOrder jsRegsFromR2 vars + , load_app_in_r1 + , case ap_fun of + -- specialized apply: no tag Right fun -> returnS (ApplExpr fun []) - Left fun -> returnS (ApplExpr fun [toJExpr (mkTag regs as)]) + -- generic apply: pass a tag indicating number of args/slots + Left fun -> returnS (ApplExpr fun [specTagExpr spec]) ] - where - ra regs = reverse $ zipWith (\r ex -> r |= ex) jsRegsFromR2 regs - mkTag rs as = (length rs `Bits.shiftL` 8) Bits..|. length as + +-- | Calling convention for an apply function +data ApplyConv + = RegsConv -- ^ Fast calling convention: use registers + | StackConv -- ^ Slow calling convention: use the stack + deriving (Show,Eq,Ord) + +-- | Name of the generic apply function +genericApplyName :: ApplyConv -> FastString +genericApplyName = \case + RegsConv -> "h$ap_gen_fast" + StackConv -> "h$ap_gen" + +-- | Expr of the generic apply function +genericApplyExpr :: ApplyConv -> JExpr +genericApplyExpr conv = var (genericApplyName conv) + + +-- | Return the name of the specialized apply function for the given number of +-- args, number of arg variables, and calling convention. +specApplyName :: ApplySpec -> FastString +specApplyName = \case + -- specialize a few for compiler performance (avoid building FastStrings over + -- and over for common cases) + ApplySpec RegsConv 0 0 -> "h$ap_0_0_fast" + ApplySpec StackConv 0 0 -> "h$ap_0_0" + ApplySpec RegsConv 1 0 -> "h$ap_1_0_fast" + ApplySpec StackConv 1 0 -> "h$ap_1_0" + ApplySpec RegsConv 1 1 -> "h$ap_1_1_fast" + ApplySpec StackConv 1 1 -> "h$ap_1_1" + ApplySpec RegsConv 1 2 -> "h$ap_1_2_fast" + ApplySpec StackConv 1 2 -> "h$ap_1_2" + ApplySpec RegsConv 2 1 -> "h$ap_2_1_fast" + ApplySpec StackConv 2 1 -> "h$ap_2_1" + ApplySpec RegsConv 2 2 -> "h$ap_2_2_fast" + ApplySpec StackConv 2 2 -> "h$ap_2_2" + ApplySpec RegsConv 2 3 -> "h$ap_2_3_fast" + ApplySpec StackConv 2 3 -> "h$ap_2_3" + ApplySpec conv nargs nvars -> mkFastString $ mconcat + [ "h$ap_", show nargs + , "_" , show nvars + , case conv of + RegsConv -> "_fast" + StackConv -> "" + ] + +-- | Return the expression of the specialized apply function for the given +-- number of args, number of arg variables, and calling convention. +-- +-- Warning: the returned function may not be generated! Use specApplyExprMaybe +-- if you want to ensure that it exists. +specApplyExpr :: ApplySpec -> JExpr +specApplyExpr spec = var (specApplyName spec) + +-- | Return the expression of the specialized apply function for the given +-- number of args, number of arg variables, and calling convention. +-- Return Nothing if it isn't generated. +specApplyExprMaybe :: ApplySpec -> Maybe JExpr +specApplyExprMaybe spec = + if spec `elem` applySpec + then Just (specApplyExpr spec) + else Nothing + +-- | Make an ApplySpec from a calling convention, a list of Haskell args, and a +-- list of corresponding JS variables +mkApplySpec :: ApplyConv -> [StgArg] -> [JExpr] -> ApplySpec +mkApplySpec conv args vars = ApplySpec + { specConv = conv + , specArgs = length args + , specVars = length vars + } -- | Find a specialized application function if there is one selectApply - :: Bool -- ^ true for fast apply, false for stack apply - -> [StgArg] -- ^ Raw arguments - -> [JExpr] -- ^ JS arguments + :: ApplySpec -> G (Either JExpr JExpr) -- ^ the function to call (Left for generic, Right for specialized) -selectApply fast args as = - case specApply fast (length args) (length as) of +selectApply spec = + case specApplyExprMaybe spec of Just e -> return (Right e) - Nothing -> return (Left (var $ "h$ap_gen" <> fastSuff)) - where - fastSuff | fast = "_fast" - | otherwise = "" + Nothing -> return (Left (genericApplyExpr (specConv spec))) + + +-- | Apply specification +data ApplySpec = ApplySpec + { specConv :: !ApplyConv -- ^ Calling convention + , specArgs :: !Int -- ^ number of Haskell arguments + , specVars :: !Int -- ^ number of JavaScript variables for the arguments + } + deriving (Show,Eq,Ord) + +-- | List of specialized apply function templates +applySpec :: [ApplySpec] +applySpec = [ ApplySpec conv nargs nvars + | conv <- [RegsConv, StackConv] + , nargs <- [0..4] + , nvars <- [max 0 (nargs-1)..(nargs*2)] + ] +-- | Generate a tag for the given ApplySpec +-- +-- Warning: tag doesn't take into account the calling convention +specTag :: ApplySpec -> Int +specTag spec = Bits.shiftL (specVars spec) 8 Bits..|. (specArgs spec) --- specialized apply for these --- make sure that once you are in spec, you stay there -applySpec :: [(Int,Int)] -- regs,arity -applySpec = [ (regs,arity) | arity <- [1..4], regs <- [max 0 (arity-1)..(arity*2)]] +-- | Generate a tag expression for the given ApplySpec +specTagExpr :: ApplySpec -> JExpr +specTagExpr = toJExpr . specTag -specApply :: Bool -> Int -> Int -> Maybe JExpr -specApply fast n r - | (r,n) == (0,0) = Just (var . mkFastString $ ("h$ap_0_0" ++ fastSuff)) - | (r,n) == (0,1) = Just (var . mkFastString $ ("h$ap_1_0" ++ fastSuff)) - | (r,n) `elem` applySpec = Just (var . mkFastString $ ("h$ap_" ++ show n ++ "_" ++ show r ++ fastSuff)) - | otherwise = Nothing - where - fastSuff | fast = "_fast" - | otherwise = "" - -{- - Build arrays to quickly lookup apply functions, getting the fast variant when possible - - h$apply[r << 8 | n] = function application for r regs, n args - - h$paps[r] = partial application for r registers (number of args is in the object) - -} - -- FIXME (Jeff, 2022/03): Perf: This code would benefit a great deal by using - -- a datastucture that supports fast merging. +-- | Build arrays to quickly lookup apply functions +-- +-- h$apply[r << 8 | n] = function application for r regs, n args +-- h$paps[r] = partial application for r registers (number of args is in the object) mkApplyArr :: JStat mkApplyArr = mconcat [ TxtI "h$apply" ||= toJExpr (JList []) @@ -347,17 +421,19 @@ mkApplyArr = mconcat [ var "h$paps" .! i |= var "h$pap_gen" , preIncrS i ] - , var "h$apply" .! zero_ |= var "h$ap_0_0" , mconcat (map assignSpec applySpec) , mconcat (map assignPap specPap) ] ] ] where - assignSpec :: (Int, Int) -> JStat - assignSpec (r,n) = - var "h$apply" .! (toJExpr $ Bits.shiftL r 8 Bits..|. n) |= - (var (mkFastString ("h$ap_" ++ show n ++ "_" ++ show r))) + assignSpec :: ApplySpec -> JStat + assignSpec spec = case specConv spec of + -- both fast/slow (regs/stack) specialized apply functions have the same + -- tags. We store the stack ones in the array because they are used as + -- continuation stack frames. + StackConv -> var "h$apply" .! specTagExpr spec |= specApplyExpr spec + RegsConv -> mempty assignPap :: Int -> JStat assignPap p = var "h$paps" .! toJExpr p |= @@ -370,44 +446,41 @@ mkApplyArr = mconcat pushCont :: HasDebugCallStack => [StgArg] -> G JStat -pushCont as = do - as' <- concatMapM genArg as - spec <- selectApply False as as' - case spec of - Right app -> push $ reverse $ app : as' - Left app -> push $ reverse $ app : mkTag as' as : as' - where - mkTag rs ns = toJExpr ((length rs `Bits.shiftL` 8) Bits..|. length ns) +pushCont args = do + vars <- concatMapM genArg args + let spec = mkApplySpec StackConv args vars + selectApply spec >>= \case + Right app -> push $ reverse $ app : vars + Left app -> push $ reverse $ app : specTagExpr spec : vars -- | Generic stack apply function (h$ap_gen) that can do everything, but less -- efficiently than other more specialized functions. -- -- Stack layout: --- -x: ... --- -y: args... -- -3: ... --- -2: register values to enter R1 --- -1: tag (number of register values << 8 | number of args) +-- -2: args +-- -1: tag (number of arg slots << 8 | number of args) -- -- Regs: --- R1 = closure to apply to +-- R1 = applied closure -- --- FIXME: set closure info of stack frame genericStackApply :: StgToJSConfig -> JStat -genericStackApply cfg = - closure info $ jVar \cf -> - [ traceRts cfg (jString "h$ap_gen") - , cf |= closureEntry r1 - -- switch on closure type - , SwitchStat (entryClosureType cf) - [ (toJExpr Thunk , thunk_case cfg cf) - , (toJExpr Fun , fun_case cf (funArity' cf)) - , (toJExpr Pap , fun_case cf (papArity r1)) - , (toJExpr Blackhole, blackhole_case cfg) - ] - (default_case cf) - ] +genericStackApply cfg = closure info body where + -- h$ap_gen body + body = jVar \cf -> + [ traceRts cfg (jString "h$ap_gen") + , cf |= closureEntry r1 + -- switch on closure type + , SwitchStat (entryClosureType cf) + [ (toJExpr Thunk , thunk_case cfg cf) + , (toJExpr Fun , fun_case cf (funArity' cf)) + , (toJExpr Pap , fun_case cf (papArity r1)) + , (toJExpr Blackhole, blackhole_case cfg) + ] + (default_case cf) + ] + -- info table for h$ap_gen info = ClosureInfo { ciVar = "h$ap_gen" @@ -512,9 +585,6 @@ genericStackApply cfg = -- alloc PAP closure, store reference to it in R1. , r1 |= initClosure cfg p dat jCurrentCCS - -- FIXME (Sylvain 2022-08): why don't we pop/store the given args - -- too? - -- return to the continuation on the stack , returnStack ] @@ -633,51 +703,65 @@ genericFastApply s = <> postDecrS i ) -stackApply :: StgToJSConfig - -> Int -- ^ number of registers in stack frame - -> Int -- ^ number of arguments - -> JStat -stackApply s r n = - closure (ClosureInfo funcName (CIRegs 0 [PtrV]) funcName layout CIStackFrame mempty) - body +-- | Make specialized apply function for the given ApplySpec +specApply :: StgToJSConfig -> ApplySpec -> JStat +specApply cfg spec@(ApplySpec conv nargs nvars) = + let fun_name = specApplyName spec + in case conv of + RegsConv -> fastApply cfg fun_name nargs nvars + StackConv -> stackApply cfg fun_name nargs nvars + +-- | Make specialized apply function with Stack calling convention +stackApply + :: StgToJSConfig + -> FastString + -> Int + -> Int + -> JStat +stackApply s fun_name nargs nvars = + -- special case for h$ap_0_0 + if nargs == 0 && nvars == 0 + then closure info0 body0 + else closure info body where - layout = CILayoutUnknown r + info = ClosureInfo fun_name (CIRegs 0 [PtrV]) fun_name (CILayoutUnknown nvars) CIStackFrame mempty + info0 = ClosureInfo fun_name (CIRegs 0 [PtrV]) fun_name (CILayoutFixed 0 []) CIStackFrame mempty - funcName = mkFastString ("h$ap_" ++ show n ++ "_" ++ show r) + body0 = adjSpN' 1 <> enter s r1 body = jVar \c -> [ c |= closureEntry r1 - , traceRts s (toJExpr funcName + , traceRts s (toJExpr fun_name + jString " " + (c .^ "n") + jString " sp: " + sp + jString " a: " + (c .^ "a")) , SwitchStat (entryClosureType c) - [ (toJExpr Thunk, traceRts s (toJExpr $ funcName <> ": thunk") <> profStat s pushRestoreCCS <> returnS c) - , (toJExpr Fun, traceRts s (toJExpr $ funcName <> ": fun") <> funCase c) - , (toJExpr Pap, traceRts s (toJExpr $ funcName <> ": pap") <> papCase c) + [ (toJExpr Thunk, traceRts s (toJExpr $ fun_name <> ": thunk") <> profStat s pushRestoreCCS <> returnS c) + , (toJExpr Fun, traceRts s (toJExpr $ fun_name <> ": fun") <> funCase c) + , (toJExpr Pap, traceRts s (toJExpr $ fun_name <> ": pap") <> papCase c) , (toJExpr Blackhole, push' s [r1, var "h$return"] <> returnS (app "h$blockOnBlackhole" [r1])) - ] (appS "throw" [toJExpr ("panic: " <> funcName <> ", unexpected closure type: ") + (entryClosureType c)]) + ] (appS "throw" [toJExpr ("panic: " <> fun_name <> ", unexpected closure type: ") + (entryClosureType c)]) ] - funExact c = popSkip' 1 (reverse $ take r jsRegsFromR2) <> returnS c - stackArgs = map (\x -> stack .! (sp - toJExpr x)) [1..r] + funExact c = popSkip' 1 (reverse $ take nvars jsRegsFromR2) <> returnS c + stackArgs = map (\x -> stack .! (sp - toJExpr x)) [1..nvars] papCase :: JExpr -> JStat papCase c = jVar \expr arity0 arity -> case expr of ValExpr (JVar pap) -> [ arity0 |= papArity r1 , arity |= mask8 arity0 - , traceRts s (toJExpr (funcName <> ": found pap, arity: ") + arity) - , ifS (toJExpr n .===. arity) + , traceRts s (toJExpr (fun_name <> ": found pap, arity: ") + arity) + , ifS (toJExpr nargs .===. arity) --then - (traceRts s (toJExpr (funcName <> ": exact")) <> funExact c) + (traceRts s (toJExpr (fun_name <> ": exact")) <> funExact c) -- else - (ifS (toJExpr n .>. arity) - (traceRts s (toJExpr (funcName <> ": oversat")) <> oversatCase c arity0 arity) - (traceRts s (toJExpr (funcName <> ": undersat")) - <> mkPap s pap r1 (toJExpr n) stackArgs -- FIXME do we want double pap? - <> (sp |= sp - toJExpr (r + 1)) + (ifS (toJExpr nargs .>. arity) + (traceRts s (toJExpr (fun_name <> ": oversat")) <> oversatCase c arity0 arity) + (traceRts s (toJExpr (fun_name <> ": undersat")) + <> mkPap s pap r1 (toJExpr nargs) stackArgs -- FIXME do we want double pap? + <> (sp |= sp - toJExpr (nvars + 1)) <> (r1 |= toJExpr pap) <> returnStack)) ] @@ -694,14 +778,14 @@ stackApply s r n = case expr of ValExpr (JVar pap) -> [ ar0 |= funArity' c , ar |= mask8 ar0 - , ifS (toJExpr n .===. ar) - (traceRts s (toJExpr (funcName <> ": exact")) <> funExact c) - (ifS (toJExpr n .>. ar) - (traceRts s (toJExpr (funcName <> ": oversat")) + , ifS (toJExpr nargs .===. ar) + (traceRts s (toJExpr (fun_name <> ": exact")) <> funExact c) + (ifS (toJExpr nargs .>. ar) + (traceRts s (toJExpr (fun_name <> ": oversat")) <> oversatCase c ar0 ar) - (traceRts s (toJExpr (funcName <> ": undersat")) - <> mkPap s pap (toJExpr R1) (toJExpr n) stackArgs - <> (sp |= sp - toJExpr (r+1)) + (traceRts s (toJExpr (fun_name <> ": undersat")) + <> mkPap s pap (toJExpr R1) (toJExpr nargs) stackArgs + <> (sp |= sp - toJExpr (nvars+1)) <> (r1 |= toJExpr pap) <> returnStack)) ] @@ -723,64 +807,68 @@ stackApply s r n = [ rs |= (arity .>>. 8) , loadRegs rs , sp |= sp - rs - , newAp |= (var "h$apply" .! (toJExpr n-arity0.|.((toJExpr r-rs).<<.8))) + , newAp |= (var "h$apply" .! (toJExpr nargs-arity0.|.((toJExpr nvars-rs).<<.8))) , stack .! sp |= newAp , profStat s pushRestoreCCS - , traceRts s (toJExpr (funcName <> ": new stack frame: ") + (newAp .^ "n")) + , traceRts s (toJExpr (fun_name <> ": new stack frame: ") + (newAp .^ "n")) , returnS c ] where loadRegs rs = SwitchStat rs switchAlts mempty where - switchAlts = map (\x -> (toJExpr x, jsReg (x+1) |= stack .! (sp - toJExpr x))) [r,r-1..1] - -{- - stg_ap_r_n_fast is entered if a function of unknown arity - is called, n arguments are already in r registers --} -fastApply :: StgToJSConfig -> Int -> Int -> JStat -fastApply s r n = func ||= toJExpr (JFunc myFunArgs body) - where - funName = mkFastString ("h$ap_" ++ show n ++ "_" ++ show r ++ "_fast") - func = TxtI funName + switchAlts = map (\x -> (toJExpr x, jsReg (x+1) |= stack .! (sp - toJExpr x))) [nvars,nvars-1..1] + +-- | Make specialized apply function with Regs calling convention +-- +-- h$ap_n_r_fast is entered if a function of unknown arity is called, n +-- arguments are already in r registers +fastApply :: StgToJSConfig -> FastString -> Int -> Int -> JStat +fastApply s fun_name nargs nvars = func ||= body0 + where + -- special case for h$ap_0_0_fast + body0 = if nargs == 0 && nvars == 0 + then jLam (enter s r1) + else toJExpr (JFunc myFunArgs body) + + func = TxtI fun_name myFunArgs = [] - regArgs = take r jsRegsFromR2 + regArgs = take nvars jsRegsFromR2 mkAp :: Int -> Int -> [JExpr] - mkAp n' r' = [ var . mkFastString $ "h$ap_" ++ show n' ++ "_" ++ show r' ] + mkAp n' r' = [ specApplyExpr (ApplySpec StackConv n' r') ] body = jVar \c farity arity -> [ c |= closureEntry r1 - , traceRts s (toJExpr (funName <> ": sp ") + sp) + , traceRts s (toJExpr (fun_name <> ": sp ") + sp) -- TODO: Jeff (2022,03): factor our and dry out this code , SwitchStat (entryClosureType c) - [(toJExpr Fun, traceRts s (toJExpr (funName <> ": ") + [(toJExpr Fun, traceRts s (toJExpr (fun_name <> ": ") + clName c + jString " (arity: " + (c .^ "a") + jString ")") <> (farity |= funArity' c) <> funCase c farity) - ,(toJExpr Pap, traceRts s (toJExpr (funName <> ": pap")) <> (arity |= papArity r1) <> funCase c arity) - ,(toJExpr Thunk, traceRts s (toJExpr (funName <> ": thunk")) <> push' s (reverse regArgs ++ mkAp n r) <> profStat s pushRestoreCCS <> returnS c) - ,(toJExpr Blackhole, traceRts s (toJExpr (funName <> ": blackhole")) <> push' s (reverse regArgs ++ mkAp n r) <> push' s [r1, var "h$return"] <> returnS (app "h$blockOnBlackhole" [r1]))] - (appS "throw" [toJExpr (funName <> ": unexpected closure type: ") + entryClosureType c]) + ,(toJExpr Pap, traceRts s (toJExpr (fun_name <> ": pap")) <> (arity |= papArity r1) <> funCase c arity) + ,(toJExpr Thunk, traceRts s (toJExpr (fun_name <> ": thunk")) <> push' s (reverse regArgs ++ mkAp nargs nvars) <> profStat s pushRestoreCCS <> returnS c) + ,(toJExpr Blackhole, traceRts s (toJExpr (fun_name <> ": blackhole")) <> push' s (reverse regArgs ++ mkAp nargs nvars) <> push' s [r1, var "h$return"] <> returnS (app "h$blockOnBlackhole" [r1]))] + (appS "throw" [toJExpr (fun_name <> ": unexpected closure type: ") + entryClosureType c]) ] funCase :: JExpr -> JExpr -> JStat funCase c arity = jVar \arg ar -> case arg of ValExpr (JVar pap) -> [ ar |= mask8 arity - , ifS (toJExpr n .===. ar) + , ifS (toJExpr nargs .===. ar) -- then - (traceRts s (toJExpr (funName <> ": exact")) <> returnS c) + (traceRts s (toJExpr (fun_name <> ": exact")) <> returnS c) -- else - (ifS (toJExpr n .>. ar) + (ifS (toJExpr nargs .>. ar) --then - (traceRts s (toJExpr (funName <> ": oversat")) <> oversatCase c arity) + (traceRts s (toJExpr (fun_name <> ": oversat")) <> oversatCase c arity) -- else - (traceRts s (toJExpr (funName <> ": undersat")) - <> mkPap s pap r1 (toJExpr n) regArgs + (traceRts s (toJExpr (fun_name <> ": undersat")) + <> mkPap s pap r1 (toJExpr nargs) regArgs <> (r1 |= toJExpr pap) <> returnStack)) ] @@ -795,29 +883,26 @@ fastApply s r n = func ||= toJExpr (JFunc myFunArgs body) oversatCase c arity = jVar \rs rsRemain -> [ rs |= arity .>>. 8 - , rsRemain |= toJExpr r - rs + , rsRemain |= toJExpr nvars - rs , traceRts s (toJExpr - (funName <> " regs oversat ") + (fun_name <> " regs oversat ") + rs + jString " remain: " + rsRemain) , saveRegs rs , sp |= sp + rsRemain + 1 - , stack .! sp |= var "h$apply" .! ((rsRemain.<<.8).|. toJExpr n - mask8 arity) + , stack .! sp |= var "h$apply" .! ((rsRemain.<<.8).|. toJExpr nargs - mask8 arity) , profStat s pushRestoreCCS , returnS c ] where saveRegs n = SwitchStat n switchAlts mempty where - switchAlts = map (\x -> (toJExpr x, stack .! (sp + toJExpr (r-x)) |= jsReg (x+2))) [0..r-1] + switchAlts = map (\x -> (toJExpr x, stack .! (sp + toJExpr (nvars-x)) |= jsReg (x+2))) [0..nvars-1] zeroApply :: StgToJSConfig -> JStat zeroApply s = mconcat - [ TxtI "h$ap_0_0_fast" ||= jLam (enter s r1) - , closure (ClosureInfo "h$ap_0_0" (CIRegs 0 [PtrV]) "h$ap_0_0" (CILayoutFixed 0 []) CIStackFrame mempty) - (adjSpN' 1 <> enter s r1) - , TxtI "h$e" ||= jLam (\c -> (r1 |= c) <> enter s c) + [ TxtI "h$e" ||= jLam (\c -> (r1 |= c) <> enter s c) ] -- carefully enter a closure that might be a thunk or a function @@ -1066,18 +1151,16 @@ moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch -- Initalize a variable sized object from an array of values initClosure :: StgToJSConfig -> JExpr -> JExpr -> JExpr -> JExpr -initClosure cfg entry values ccs = - let cc | csProf cfg = Just ccs - | otherwise = Nothing - in app "h$init_closure" [ newClosure $ Closure - { clEntry = entry - , clField1 = null_ - , clField2 = null_ - , clMeta = 0 - , clCC = cc - } - , values - ] +initClosure cfg entry values ccs = app "h$init_closure" + [ newClosure $ Closure + { clEntry = entry + , clField1 = null_ + , clField2 = null_ + , clMeta = 0 + , clCC = if csProf cfg then Just ccs else Nothing + } + , values + ] -- | Return an expression for every field of the given Id getIdFields :: Id -> G [TypedExpr] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41616e1ce425d62ff428b7e188d8d5f36d8da37b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41616e1ce425d62ff428b7e188d8d5f36d8da37b You're receiving 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 Aug 18 15:51:29 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 18 Aug 2022 11:51:29 -0400 Subject: [Git][ghc/ghc][wip/andreask/rules-omit-fix] 18 commits: typo Message-ID: <62fe600154e35_125b2b4881421184@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC Commits: ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 4c4ac1bc by Andreas Klebinger at 2022-08-18T17:49:43+02:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 30 changed files: - .gitlab/gen_ci.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/Var.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - hadrian/src/Rules/Documentation.hs - libraries/base/changelog.md - libraries/ghc-compact/tests/all.T - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/hpc - rts/Interpreter.c - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T22044.bazoo - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T - + testsuite/tests/partial-sigs/should_compile/T16152.hs - + testsuite/tests/partial-sigs/should_compile/T16152.stderr - + testsuite/tests/partial-sigs/should_compile/T22065.hs - + testsuite/tests/partial-sigs/should_compile/T22065.stderr - testsuite/tests/partial-sigs/should_compile/all.T - utils/haddock - utils/hpc/HpcCombine.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28ba4f3d488ff70f46dab0272bc597995bb387f1...4c4ac1bc3cd11cde2667f00562b3d20e647afff2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28ba4f3d488ff70f46dab0272bc597995bb387f1...4c4ac1bc3cd11cde2667f00562b3d20e647afff2 You're receiving 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 Aug 18 15:57:34 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 11:57:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ghc-heap: Fix decoding of TSO closures Message-ID: <62fe616e7f98c_125b2b4e4a827626@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 04640cb2 by Bryan Richter at 2022-08-18T11:57:07-04:00 testsuite: Add test for #21583 - - - - - dd7a14e5 by Ben Gamari at 2022-08-18T11:57:14-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 27 changed files: - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/Var.hs - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - − m4/fp_prog_ld_build_id.m4 - mk/config.mk.in - rts/include/ghc.mk - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T22044.bazoo - testsuite/tests/driver/all.T - + testsuite/tests/partial-sigs/should_compile/T16152.hs - + testsuite/tests/partial-sigs/should_compile/T16152.stderr - + testsuite/tests/partial-sigs/should_compile/T22065.hs - + testsuite/tests/partial-sigs/should_compile/T22065.stderr - testsuite/tests/partial-sigs/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T21583.hs - + testsuite/tests/typecheck/should_fail/T21583.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -171,7 +171,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = -> Just (DriverPsHeaderMessage (PsHeaderMessage msg)) _ -> Nothing - pipe_env = mkPipeEnv StopPreprocess input_fn (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv StopPreprocess input_fn mb_phase (Temporary TFL_GhcSession) mkInputFn = case mb_input_buf of Just input_buf -> do @@ -237,7 +237,7 @@ compileOne' mHscMessage [ml_obj_file $ ms_location summary] plugin_hsc_env <- initializePlugins hsc_env - let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput + 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) @@ -512,7 +512,7 @@ oneShot hsc_env stop_phase srcs = do NoStop -> doLink hsc_env o_files compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath) -compileFile hsc_env stop_phase (src, _mb_phase) = do +compileFile hsc_env stop_phase (src, mb_phase) = do exists <- doesFileExist src when (not exists) $ throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src)) @@ -533,8 +533,8 @@ compileFile hsc_env stop_phase (src, _mb_phase) = do | isJust mb_o_file = SpecificFile -- -o foo applies to the file we are compiling now | otherwise = Persistent - pipe_env = mkPipeEnv stop_phase src output - pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src + pipe_env = mkPipeEnv stop_phase src mb_phase output + pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src mb_phase runPipeline (hsc_hooks hsc_env) pipeline @@ -583,7 +583,7 @@ compileForeign hsc_env lang stub_c = do #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif - pipe_env = mkPipeEnv NoStop stub_c (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv NoStop stub_c Nothing (Temporary TFL_GhcSession) res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. @@ -607,7 +607,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) - let pipe_env = (mkPipeEnv NoStop empty_stub Persistent) { src_basename = basename} + let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename} pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline return () @@ -617,15 +617,17 @@ compileEmptyStub dflags hsc_env basename location mod_name = do mkPipeEnv :: StopPhase -- End phase -> FilePath -- input fn + -> Maybe Phase -> PipelineOutput -- Output -> PipeEnv -mkPipeEnv stop_phase input_fn output = +mkPipeEnv stop_phase input_fn start_phase output = let (basename, suffix) = splitExtension input_fn suffix' = drop 1 suffix -- strip off the . env = PipeEnv{ stop_phase, src_filename = input_fn, src_basename = basename, src_suffix = suffix', + start_phase = fromMaybe (startPhase suffix') start_phase, output_spec = output } in env @@ -695,8 +697,7 @@ preprocessPipeline pipe_env hsc_env input_fn = do where platform = targetPlatform (hsc_dflags hsc_env) runAfter :: P p => Phase -> a -> p a -> p a - runAfter = phaseIfAfter platform start_phase - start_phase = startPhase (src_suffix pipe_env) + runAfter = phaseIfAfter platform (start_phase pipe_env) runAfterFlag :: P p => HscEnv -> Phase @@ -829,9 +830,9 @@ applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing -- Pipeline from a given suffix -pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) -pipelineStart pipe_env hsc_env input_fn = - fromSuffix (src_suffix pipe_env) +pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath) +pipelineStart pipe_env hsc_env input_fn mb_phase = + fromPhase (fromMaybe (startPhase $ src_suffix pipe_env) mb_phase) where stop_after = stop_phase pipe_env frontend :: P m => HscSource -> m (Maybe FilePath) @@ -863,33 +864,24 @@ pipelineStart pipe_env hsc_env input_fn = objFromLinkable _ = Nothing - fromSuffix :: P m => String -> m (Maybe FilePath) - fromSuffix "lhs" = frontend HsSrcFile - fromSuffix "lhs-boot" = frontend HsBootFile - fromSuffix "lhsig" = frontend HsigFile - fromSuffix "hs" = frontend HsSrcFile - fromSuffix "hs-boot" = frontend HsBootFile - fromSuffix "hsig" = frontend HsigFile - fromSuffix "hscpp" = frontend HsSrcFile - fromSuffix "hspp" = frontend HsSrcFile - fromSuffix "hc" = c HCc - fromSuffix "c" = c Cc - fromSuffix "cpp" = c Ccxx - fromSuffix "C" = c Cc - fromSuffix "m" = c Cobjc - fromSuffix "M" = c Cobjcxx - fromSuffix "mm" = c Cobjcxx - fromSuffix "cc" = c Ccxx - fromSuffix "cxx" = c Ccxx - fromSuffix "s" = as False - fromSuffix "S" = as True - fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn - fromSuffix "o" = return (Just input_fn) - fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn - fromSuffix _ = return (Just input_fn) + fromPhase :: P m => Phase -> m (Maybe FilePath) + fromPhase (Unlit p) = frontend p + fromPhase (Cpp p) = frontend p + fromPhase (HsPp p) = frontend p + fromPhase (Hsc p) = frontend p + fromPhase HCc = c HCc + fromPhase Cc = c Cc + fromPhase Ccxx = c Ccxx + fromPhase Cobjc = c Cobjc + fromPhase Cobjcxx = c Cobjcxx + fromPhase (As p) = as p + fromPhase LlvmOpt = llvmPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromPhase StopLn = return (Just input_fn) + fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase MergeForeign = panic "fromPhase: MergeForeign" {- Note [The Pipeline Monad] ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -1184,17 +1184,10 @@ joinObjectFiles hsc_env o_files output_fn let toolSettings' = toolSettings dflags ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) ( - map GHC.SysTools.Option ld_build_id - ++ [ GHC.SysTools.Option "-o", + [ GHC.SysTools.Option "-o", GHC.SysTools.FileOption "" output_fn ] ++ args) - -- suppress the generation of the .note.gnu.build-id section, - -- which we don't need and sometimes causes ld to emit a - -- warning: - ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"] - | otherwise = [] - if ldIsGnuLd then do script <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "ldscript" ===================================== compiler/GHC/Driver/Pipeline/Monad.hs ===================================== @@ -29,6 +29,7 @@ data PipeEnv = PipeEnv { src_filename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source src_suffix :: String, -- ^ its extension + start_phase :: Phase, output_spec :: PipelineOutput -- ^ says where to put the pipeline output } ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -81,7 +81,6 @@ module GHC.Driver.Session ( sTopDir, sGlobalPackageDatabasePath, sLdSupportsCompactUnwind, - sLdSupportsBuildId, sLdSupportsFilelist, sLdIsGnuLd, sGccSupportsNoPie, ===================================== compiler/GHC/Settings.hs ===================================== @@ -18,7 +18,6 @@ module GHC.Settings , sTopDir , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind - , sLdSupportsBuildId , sLdSupportsFilelist , sLdIsGnuLd , sGccSupportsNoPie @@ -87,7 +86,6 @@ data Settings = Settings -- platform-specific and platform-agnostic. data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool - , toolSettings_ldSupportsBuildId :: Bool , toolSettings_ldSupportsFilelist :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool @@ -189,8 +187,6 @@ sGlobalPackageDatabasePath = fileSettings_globalPackageDatabase . sFileSettings sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings -sLdSupportsBuildId :: Settings -> Bool -sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings sLdIsGnuLd :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -94,7 +94,6 @@ initSettings top_dir = do cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" - ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -163,7 +162,6 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind - , toolSettings_ldSupportsBuildId = ldSupportsBuildId , toolSettings_ldSupportsFilelist = ldSupportsFilelist , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -43,6 +43,7 @@ import GHC.Tc.Solver import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Core.Predicate +import GHC.Core.TyCo.Ppr( pprTyVars ) import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType @@ -59,7 +60,7 @@ import GHC.Types.SourceText import GHC.Types.Id import GHC.Types.Var as Var import GHC.Types.Var.Set -import GHC.Types.Var.Env( TidyEnv ) +import GHC.Types.Var.Env( TidyEnv, TyVarEnv, mkVarEnv, lookupVarEnv ) import GHC.Unit.Module import GHC.Types.Name import GHC.Types.Name.Set @@ -934,7 +935,8 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; let psig_qtvs = map binderVar psig_qtv_bndrs psig_qtv_set = mkVarSet psig_qtvs psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs - + psig_bndr_map :: TyVarEnv InvisTVBinder + psig_bndr_map = mkVarEnv [ (binderVar tvb, tvb) | tvb <- psig_qtv_bndrs ] -- Check whether the quantified variables of the -- partial signature have been unified together @@ -950,32 +952,35 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs ; annotated_theta <- zonkTcTypes annotated_theta ; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx + -- NB: free_tvs includes tau_tvs + + ; let (_,final_qtvs) = foldr (choose_qtv psig_bndr_map) (free_tvs, []) qtvs + -- Pulling from qtvs maintains original order + -- NB: qtvs is already in dependency order - ; let keep_me = free_tvs `unionVarSet` psig_qtv_set - final_qtvs = [ mkTyVarBinder vis tv - | tv <- qtvs -- Pulling from qtvs maintains original order - , tv `elemVarSet` keep_me - , let vis = case lookupVarBndr tv psig_qtv_bndrs of - Just spec -> spec - Nothing -> InferredSpec ] + ; traceTc "chooseInferredQuantifiers" $ + vcat [ text "qtvs" <+> pprTyVars qtvs + , text "psig_qtv_bndrs" <+> ppr psig_qtv_bndrs + , text "free_tvs" <+> ppr free_tvs + , text "final_tvs" <+> ppr final_qtvs ] ; return (final_qtvs, my_theta) } where - report_dup_tyvar_tv_err (n1,n2) - = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) - - report_mono_sig_tv_err (n,tv) - = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) - where - m_unif_ty = listToMaybe - [ rhs - -- recall that residuals are always implications - | residual_implic <- bagToList $ wc_impl residual - , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) - , let residual_pred = ctPred residual_ct - , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] - , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] - , lhs_tv == tv ] + choose_qtv :: TyVarEnv InvisTVBinder -> TcTyVar + -> (TcTyVarSet, [InvisTVBinder]) -> (TcTyVarSet, [InvisTVBinder]) + -- Pick which of the original qtvs should be retained + -- Keep it if (a) it is mentioned in the body of the type (free_tvs) + -- (b) it is a forall'd variable of the partial signature (psig_qtv_bndrs) + -- (c) it is mentioned in the kind of a retained qtv (#22065) + choose_qtv psig_bndr_map tv (free_tvs, qtvs) + | Just psig_bndr <- lookupVarEnv psig_bndr_map tv + = (free_tvs', psig_bndr : qtvs) + | tv `elemVarSet` free_tvs + = (free_tvs', mkTyVarBinder InferredSpec tv : qtvs) + | otherwise -- Do not pick it + = (free_tvs, qtvs) + where + free_tvs' = free_tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType -> TcM (VarSet, TcThetaType) @@ -1019,6 +1024,22 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs -- Return (annotated_theta ++ diff_theta) -- See Note [Extra-constraints wildcards] + report_dup_tyvar_tv_err (n1,n2) + = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty) + + report_mono_sig_tv_err (n,tv) + = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty) + where + m_unif_ty = listToMaybe + [ rhs + -- recall that residuals are always implications + | residual_implic <- bagToList $ wc_impl residual + , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) + , let residual_pred = ctPred residual_ct + , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] + , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] + , lhs_tv == tv ] + mk_ctuple preds = mkBoxedTupleTy preds -- Hack alert! See GHC.Tc.Gen.HsType: -- Note [Extra-constraint holes in partial type signatures] ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Types.Var ( mkTyVarBinder, mkTyVarBinders, isTyVarBinder, tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, - mapVarBndr, mapVarBndrs, lookupVarBndr, + mapVarBndr, mapVarBndrs, -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -696,11 +696,6 @@ mapVarBndr f (Bndr v fl) = Bndr (f v) fl mapVarBndrs :: (var -> var') -> [VarBndr var flag] -> [VarBndr var' flag] mapVarBndrs f = map (mapVarBndr f) -lookupVarBndr :: Eq var => var -> [VarBndr var flag] -> Maybe flag -lookupVarBndr var bndrs = lookup var zipped_bndrs - where - zipped_bndrs = map (\(Bndr v f) -> (v,f)) bndrs - instance Outputable tv => Outputable (VarBndr tv ArgFlag) where ppr (Bndr v Required) = ppr v ppr (Bndr v Specified) = char '@' <> ppr v ===================================== hadrian/bindist/Makefile ===================================== @@ -91,7 +91,6 @@ lib/settings : @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -136,7 +136,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ -ld-has-build-id = @LdHasBuildId@ ld-has-filelist = @LdHasFilelist@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -311,7 +311,6 @@ generateSettings = do , ("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 build-id", expr $ lookupSystemConfig "ld-has-build-id") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -350,7 +350,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do [p] -> Just p _ -> error $ "Expected 4 or 5 words in WEAK, found " ++ show (length pts) } - TSO | [ u_lnk, u_gbl_lnk, tso_stack, u_trec, u_blk_ex, u_bq] <- pts + TSO | ( u_lnk : u_gbl_lnk : tso_stack : u_trec : u_blk_ex : u_bq : other) <- pts -> withArray rawHeapWords (\ptr -> do fields <- FFIClosures.peekTSOFields decodeCCS ptr pure $ TSOClosure @@ -361,6 +361,10 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do , trec = u_trec , blocked_exceptions = u_blk_ex , bq = u_bq + , thread_label = case other of + [tl] -> Just tl + [] -> Nothing + _ -> error $ "thead_label:Expected 0 or 1 extra arguments" , what_next = FFIClosures.tso_what_next fields , why_blocked = FFIClosures.tso_why_blocked fields , flags = FFIClosures.tso_flags fields @@ -372,7 +376,7 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do , prof = FFIClosures.tso_prof fields }) | otherwise - -> fail $ "Expected 6 ptr arguments to TSO, found " + -> fail $ "Expected at least 6 ptr arguments to TSO, found " ++ show (length pts) STACK | [] <- pts ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -280,6 +280,7 @@ data GenClosure b , trec :: !b , blocked_exceptions :: !b , bq :: !b + , thread_label :: !(Maybe b) -- values , what_next :: !WhatNext , why_blocked :: !WhyBlocked ===================================== m4/fp_prog_ld_build_id.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_PROG_LD_BUILD_ID -# ------------ -# Sets the output variable LdHasBuildId to YES if ld supports -# --build-id, or NO otherwise. -AC_DEFUN([FP_PROG_LD_BUILD_ID], -[ -AC_CACHE_CHECK([whether ld understands --build-id], [fp_cv_ld_build_id], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if ${LdCmd} -r --build-id=none -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_ld_build_id=yes -else - fp_cv_ld_build_id=no -fi -rm -rf conftest*]) -FP_CAPITALIZE_YES_NO(["$fp_cv_ld_build_id"], [LdHasBuildId]) -AC_SUBST([LdHasBuildId]) -])# FP_PROG_LD_BUILD_ID - - ===================================== mk/config.mk.in ===================================== @@ -724,10 +724,6 @@ OPT = @OptCmd@ # overflowing command-line length limits. LdIsGNULd = @LdIsGNULd@ -# Set to YES if ld has the --build-id flag. Sometimes we need to -# disable it with --build-id=none. -LdHasBuildId = @LdHasBuildId@ - # Set to YES if ld has the --no_compact_unwind flag. See #5019 # and GHC.Driver.Pipeline. LdHasNoCompactUnwind = @LdHasNoCompactUnwind@ ===================================== rts/include/ghc.mk ===================================== @@ -202,7 +202,6 @@ $(includes_SETTINGS) : rts/include/Makefile | $$(dir $$@)/. @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ ===================================== testsuite/tests/driver/Makefile ===================================== @@ -779,3 +779,11 @@ T21869: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T21869.hs -S [ -f T21869.s ] || (echo "assembly file does not exist" && exit 2) [ ! -f T21869.o ] || (echo "object file exists" && exit 2) + +.PHONY: T22044 +T22044: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -E -cpp -x hs T22044.bazoo -o T22044.hs -DBAZOO=1 + # Test the file exists and is preprocessed + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T22044.hs + + ===================================== testsuite/tests/driver/T22044.bazoo ===================================== @@ -0,0 +1,3 @@ +module T22044 where + +bazoo = BAZOO ===================================== testsuite/tests/driver/all.T ===================================== @@ -311,3 +311,4 @@ test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) +test('T22044', normal, makefile_test, []) ===================================== testsuite/tests/partial-sigs/should_compile/T16152.hs ===================================== @@ -0,0 +1,8 @@ +{-# Language PartialTypeSignatures #-} +{-# Language PolyKinds #-} +{-# Language ScopedTypeVariables #-} + +module T16152 where + +top :: forall f. _ +top = undefined ===================================== testsuite/tests/partial-sigs/should_compile/T16152.stderr ===================================== @@ -0,0 +1,7 @@ + +T16152.hs:7:18: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of top :: w + at T16152.hs:8:1-15 + • In the type signature: top :: forall f. _ ===================================== testsuite/tests/partial-sigs/should_compile/T22065.hs ===================================== @@ -0,0 +1,30 @@ +{-# Options_GHC -dcore-lint #-} +{-# Language PartialTypeSignatures #-} + +module T22065 where + +data Foo where + Apply :: (x -> Int) -> x -> Foo + +foo :: Foo +foo = Apply f x :: forall a. _ where + + f :: [_] -> Int + f = length @[] @_ + + x :: [_] + x = mempty @[_] + +{- +Smaller version I used when debuggging + +apply :: (x->Int) -> x -> Bool +apply = apply + +foo :: Bool +foo = apply f x :: forall a. _ + where + f = length @[] + x = mempty + +-} ===================================== testsuite/tests/partial-sigs/should_compile/T22065.stderr ===================================== @@ -0,0 +1,53 @@ + +T22065.hs:10:30: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Foo’ + • In an expression type signature: forall a. _ + In the expression: Apply f x :: forall a. _ + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + f :: forall {w}. [w] -> Int (bound at T22065.hs:13:3) + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of f :: [w] -> Int + at T22065.hs:13:3-19 + • In the type ‘[_] -> Int’ + In the type signature: f :: [_] -> Int + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include + x :: forall {w}. [w] (bound at T22065.hs:16:3) + foo :: Foo (bound at T22065.hs:10:1) + +T22065.hs:15:9: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of x :: [w] + at T22065.hs:16:3-17 + • In the type ‘[_]’ + In the type signature: x :: [_] + In an equation for ‘foo’: + foo + = Apply f x :: forall a. _ + where + f :: [_] -> Int + f = length @[] @_ + x :: [_] + x = mempty @[_] + • Relevant bindings include foo :: Foo (bound at T22065.hs:10:1) ===================================== testsuite/tests/partial-sigs/should_compile/all.T ===================================== @@ -105,3 +105,5 @@ test('T20921', normal, compile, ['']) test('T21719', normal, compile, ['']) test('InstanceGivenOverlap3', expect_broken(20076), compile, ['']) test('T21667', normal, compile, ['']) +test('T22065', normal, compile, ['']) +test('T16152', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T21583.hs ===================================== @@ -0,0 +1,90 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE FlexibleContexts #-} +module Telomare.Possible where + +data PartExprF f + = ZeroSF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +newtype EnhancedExpr f = EnhancedExpr {unEnhanceExpr :: SplitFunctor f PartExprF (EnhancedExpr f)} -- deriving (Eq, Show) + +type family Base t :: * -> * + +type instance Base (EnhancedExpr f) = SplitFunctor f PartExprF + +class Functor (Base t) => Recursive t where + project :: t -> Base t t + +instance Functor f => Recursive (EnhancedExpr f) where + project = unEnhanceExpr + +class Functor (Base t) => Corecursive t where + embed :: Base t t -> t + +instance Functor f => Corecursive (EnhancedExpr f) where + embed = EnhancedExpr + +type SimpleExpr = EnhancedExpr VoidF +type BasicBase f = SplitFunctor f PartExprF +type SuperBase f = BasicBase (SplitFunctor f SuperPositionF) +type AbortBase f = SuperBase (SplitFunctor f AbortableF) +type UnsizedBase = AbortBase UnsizedRecursionF + +pattern UnsizedFW :: UnsizedRecursionF a -> UnsizedBase a +pattern UnsizedFW x = SplitFunctor (Left (SplitFunctor (Left (SplitFunctor (Left x))))) +pattern BasicExpr :: PartExprF (EnhancedExpr f) -> EnhancedExpr f +pattern BasicExpr x = EnhancedExpr (SplitFunctor (Right x)) +pattern UnsizedWrap :: UnsizedRecursionF UnsizedExpr -> UnsizedExpr +pattern UnsizedWrap x = EnhancedExpr (UnsizedFW x) + +data VoidF f + deriving (Functor, Foldable, Traversable) + +data SuperPositionF f + = AnyPF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +data AbortableF f + = AbortF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +newtype SplitFunctor g f x = SplitFunctor { unSplitF :: Either (g x) (f x) } deriving (Eq, Show) + +instance (Functor f, Functor g) => Functor (SplitFunctor g f) where + +instance (Foldable f, Foldable g) => Foldable (SplitFunctor g f) where + +instance (Traversable f, Traversable g) => Traversable (SplitFunctor g f) where + +type SuperExpr f = EnhancedExpr (SplitFunctor f SuperPositionF) + +type AbortExpr f = SuperExpr (SplitFunctor f AbortableF) + +type BreakExtras = () + +data UnsizedRecursionF f + = UnsizedRecursionF BreakExtras f + | UnsizedBarrierF f + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +type UnsizedExpr = AbortExpr UnsizedRecursionF + +cata :: Recursive t => (Base t a -> a) -> t -> a +cata = undefined + +sizeTerm :: UnsizedExpr -> Maybe (AbortExpr VoidF) +sizeTerm term = + let sizingTerm = eval term + eval :: UnsizedExpr -> UnsizedExpr + eval = undefined + setSizes sizes = cata $ \case + UnsizedFW (UnsizedRecursionF be env) -> BasicExpr ZeroSF + clean = undefined + hoist = undefined + maybeSized = pure sizingTerm + in hoist clean <$> maybeSized + + ===================================== testsuite/tests/typecheck/should_fail/T21583.stderr ===================================== @@ -0,0 +1,22 @@ +T21583.hs:14:23: error: [-Wstar-is-type (in -Wall, -Wcompat), -Werror=star-is-type] + Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’ + relies on the StarIsType extension, which will become + deprecated in the future. + Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead. +T21583.hs:14:28: error: [-Wstar-is-type (in -Wall, -Wcompat), -Werror=star-is-type] + Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’ + relies on the StarIsType extension, which will become + deprecated in the future. + Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead. +T21583.hs:56:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘fmap’ + • In the instance declaration for ‘Functor (SplitFunctor g f)’ +T21583.hs:58:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘foldMap’ or ‘foldr’ + • In the instance declaration for ‘Foldable (SplitFunctor g f)’ +T21583.hs:60:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘traverse’ or ‘sequenceA’ + • In the instance declaration for ‘Traversable (SplitFunctor g f)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -657,3 +657,4 @@ test('T20768_fail', normal, compile_fail, ['']) test('T21327', normal, compile_fail, ['']) test('T21338', normal, compile_fail, ['']) test('T21158', normal, compile_fail, ['']) +test('T21583', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d2a1257ad73f2aa8b80e21303738d84e6b9c8b5...dd7a14e5cb04e9a65e212f56f62896adeb95dde7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d2a1257ad73f2aa8b80e21303738d84e6b9c8b5...dd7a14e5cb04e9a65e212f56f62896adeb95dde7 You're receiving 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 Aug 18 16:17:16 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 18 Aug 2022 12:17:16 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Linker: fix linking issue for tuples Message-ID: <62fe660cc05e7_125b2b4880038716@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: fe32e903 by Sylvain Henry at 2022-08-18T18:19:28+02:00 Linker: fix linking issue for tuples - - - - - 1 changed file: - compiler/GHC/StgToJS/Linker/Linker.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -51,7 +51,6 @@ -- - Employ the type system more effectively for @readSystemDeps'@, in -- particular get rid of the string literals -- - fix foldl' memory leak in @staticDeps@ --- - move @mkSymb@ ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Linker where @@ -783,21 +782,17 @@ readSystemDeps' file | otherwise = pure (mempty, mempty) where - d :: UnitId -> String -> [String] -> [ExportedFun] - d uid mod symbols = map (let pkg_module = mkJsModule uid mod - in ExportedFun pkg_module - . LexicalFastString - . mkHaskellSym pkg_module (mkFastString mod) - . mkFastString) - symbols - zenc = mkFastString . zEncodeString . unpackFS - - mkHaskellSym :: Module -> FastString -> FastString -> FastString - mkHaskellSym mod _m s = "h$" <> zenc (mkFastString (unitModuleString mod) - <> "." - <> s) - mkJsModule :: UnitId -> String -> GenModule Unit - mkJsModule uid mod = mkModule (RealUnit (Definite uid)) (mkModuleName mod) + d :: UnitId -> FastString -> [FastString] -> [ExportedFun] + d uid mod symbols = + let pkg_module = mkJsModule uid mod + in map (ExportedFun pkg_module + . LexicalFastString + . mkJsSymbol pkg_module + ) + symbols + + mkJsModule :: UnitId -> FastString -> Module + mkJsModule uid mod = mkModule (RealUnit (Definite uid)) (mkModuleNameFS mod) {- b <- readBinaryFile (getLibDir dflags file) @@ -818,6 +813,16 @@ readSystemDeps' file -} +-- | Make JS symbol corresponding to the given Haskell symbol in the given +-- module +mkJsSymbol :: Module -> FastString -> FastString +mkJsSymbol mod s = mkFastString $ mconcat + [ "h$" + , zEncodeString (unitModuleString mod <> ".") + , zString (zEncodeFS s) + ] + + readSystemWiredIn :: HscEnv -> IO [(FastString, UnitId)] readSystemWiredIn _ = pure [] -- XXX {- @@ -851,7 +856,6 @@ staticDeps :: UnitEnv -- for which no package could be found staticDeps unit_env wiredin sdeps = mkDeps sdeps where - zenc = mkFastString . zEncodeString . unpackFS u_st = ue_units unit_env mkDeps (StaticDeps ds) = -- FIXME: Jeff (2022,03): this foldl' will leak memory due to the tuple @@ -887,16 +891,8 @@ staticDeps unit_env wiredin sdeps = mkDeps sdeps Just _ -> ( unresolved , S.insert mod_uid pkgs , S.insert (ExportedFun mod - . LexicalFastString $ mkSymb mod mod_name s) resolved + . LexicalFastString $ mkJsSymbol mod s) resolved ) - -- confusingly with the new ghc api we now use Module where we formerly had - -- Package, so this becomes Module -> Module -> Symbol where the first - -- Module is GHC's module type and the second is the SDep Moudle read as a - -- FastString - -- FIXME: Jeff (2022,03): should mkSymb be in the UnitUtils? - mkSymb :: Module -> FastString -> FastString -> FastString - mkSymb p _m s = - "h$" <> zenc (mkFastString (unitModuleString p) <> "." <> s) closePackageDeps :: UnitState -> Set UnitId -> Set UnitId closePackageDeps u_st pkgs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe32e90306487693c242f15351ee9a33eeb3aea4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe32e90306487693c242f15351ee9a33eeb3aea4 You're receiving 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 Aug 18 16:31:50 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 Aug 2022 12:31:50 -0400 Subject: [Git][ghc/ghc][wip/t22057] 14 commits: typo Message-ID: <62fe69761a2e5_125b2b4e4a8454ef@gitlab.mail> Matthew Pickering pushed to branch wip/t22057 at Glasgow Haskell Compiler / GHC Commits: ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 04f464f9 by Matthew Pickering at 2022-08-18T17:29:50+01:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 17 changed files: - .gitlab/gen_ci.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Rename/Bind.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - hadrian/src/Rules/Documentation.hs - libraries/base/changelog.md - libraries/ghc-compact/tests/all.T - rts/Interpreter.c - + testsuite/tests/rename/should_compile/T22057.hs - + testsuite/tests/rename/should_compile/T22067.hs - + testsuite/tests/rename/should_compile/T22067.stderr - testsuite/tests/rename/should_compile/all.T - utils/haddock Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -2,13 +2,16 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- cabal: -build-depends: base, monoidal-containers, aeson >= 1.8.1, containers, bytestring +build-depends: base, aeson >= 1.8.1, containers, bytestring -} +import Data.Coerce import Data.String (String) import Data.Aeson as A -import qualified Data.Map.Monoidal as M +import qualified Data.Map as Map +import Data.Map (Map) import qualified Data.ByteString.Lazy as B hiding (putStrLn) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) @@ -307,10 +310,22 @@ dockerImage _ _ = Nothing -- The "proper" solution would be to use a dependent monoidal map where each key specifies -- the combination behaviour of it's values. Ie, whether setting it multiple times is an error -- or they should be combined. -type Variables = M.MonoidalMap String [String] +newtype MonoidalMap k v = MonoidalMap (Map k v) + deriving (Eq, Show, Functor, ToJSON) + +instance (Ord k, Semigroup v) => Semigroup (MonoidalMap k v) where + (MonoidalMap a) <> (MonoidalMap b) = MonoidalMap (Map.unionWith (<>) a b) + +instance (Ord k, Semigroup v) => Monoid (MonoidalMap k v) where + mempty = MonoidalMap (Map.empty) + +mminsertWith :: Ord k => (a -> a -> a) -> k -> a -> MonoidalMap k a -> MonoidalMap k a +mminsertWith f k v (MonoidalMap m) = MonoidalMap (Map.insertWith f k v m) + +type Variables = MonoidalMap String [String] (=:) :: String -> String -> Variables -a =: b = M.singleton a [b] +a =: b = MonoidalMap (Map.singleton a [b]) opsysVariables :: Arch -> Opsys -> Variables opsysVariables _ FreeBSD13 = mconcat @@ -566,7 +581,7 @@ instance ToJSON Job where , "allow_failure" A..= jobAllowFailure -- Joining up variables like this may well be the wrong thing to do but -- at least it doesn't lose information silently by overriding. - , "variables" A..= (M.map (intercalate " ") jobVariables) + , "variables" A..= fmap (intercalate " ") jobVariables , "artifacts" A..= jobArtifacts , "cache" A..= jobCache , "after_script" A..= jobAfterScript @@ -621,9 +636,9 @@ job arch opsys buildConfig = (jobName, Job {..}) , "BUILD_FLAVOUR" =: flavourString jobFlavour , "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig) , "CONFIGURE_ARGS" =: configureArgsStr buildConfig - , maybe M.empty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe M.empty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) - , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else M.empty + , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) + , maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig) + , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty ] jobArtifacts = Artifacts @@ -669,7 +684,7 @@ addJobRule :: Rule -> Job -> Job addJobRule r j = j { jobRules = enableRule r (jobRules j) } addVariable :: String -> String -> Job -> Job -addVariable k v j = j { jobVariables = M.insertWith (++) k [v] (jobVariables j) } +addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } -- Building the standard jobs -- @@ -765,8 +780,8 @@ flattenJobGroup (ValidateOnly a b) = [a, b] -- | Specification for all the jobs we want to build. -jobs :: M.MonoidalMap String Job -jobs = M.fromList $ concatMap flattenJobGroup $ +jobs :: Map String Job +jobs = Map.fromList $ concatMap flattenJobGroup $ [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , (validateBuilds Amd64 (Linux Debian10) nativeInt) ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Native code generator for x86 and x86-64 architectures +-- | Native code generator for AArch64 architectures module GHC.CmmToAsm.AArch64 ( ncgAArch64 ) where ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Logger import Data.Maybe (fromJust) import Control.Monad (ap) -import Data.List (sortBy, groupBy) +import Data.List (sortBy, groupBy, isPrefixOf) import Data.Ord (comparing) -- ---------------------------------------------------------------------------- @@ -504,6 +504,12 @@ generateExternDecls = do modifyEnv $ \env -> env { envAliases = emptyUniqSet } return (concat defss, []) +-- | Is a variable one of the special @$llvm@ globals? +isBuiltinLlvmVar :: LlvmVar -> Bool +isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) = + "$llvm" `isPrefixOf` unpackFS lbl +isBuiltinLlvmVar _ = False + -- | Here we take a global variable definition, rename it with a -- @$def@ suffix, and generate the appropriate alias. aliasify :: LMGlobal -> LlvmM [LMGlobal] @@ -511,8 +517,9 @@ aliasify :: LMGlobal -> LlvmM [LMGlobal] -- Here we obtain the indirectee's precise type and introduce -- fresh aliases to both the precise typed label (lbl$def) and the i8* -- typed (regular) label of it with the matching new names. -aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) - (Just orig)) = do +aliasify (LMGlobal var@(LMGlobalVar lbl ty at LMAlias{} link sect align Alias) + (Just orig)) + | not $ isBuiltinLlvmVar var = do let defLbl = llvmDefLabel lbl LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig defOrigLbl = llvmDefLabel origLbl @@ -525,7 +532,8 @@ aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias) pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig) , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig') ] -aliasify (LMGlobal var val) = do +aliasify (LMGlobal var val) + | not $ isBuiltinLlvmVar var = do let LMGlobalVar lbl ty link sect align const = var defLbl = llvmDefLabel lbl @@ -543,6 +551,7 @@ aliasify (LMGlobal var val) = do return [ LMGlobal defVar val , LMGlobal aliasVar (Just aliasVal) ] +aliasify global = pure [global] -- Note [Llvm Forward References] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -601,3 +610,6 @@ aliasify (LMGlobal var val) = do -- away with casting the alias to the desired type in @getSymbolPtr@ -- and instead just emit a reference to the definition symbol directly. -- This is the @Just@ case in @getSymbolPtr at . +-- +-- Note that we must take care not to turn LLVM's builtin variables into +-- aliases (e.g. $llvm.global_ctors) since this confuses LLVM. ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -493,18 +493,10 @@ rnBind _ bind@(PatBind { pat_lhs = pat bind' = bind { pat_rhs = grhss' , pat_ext = fvs' } - ok_nobind_pat - = -- See Note [Pattern bindings that bind no variables] - case unLoc pat of - WildPat {} -> True - BangPat {} -> True -- #9127, #13646 - SplicePat {} -> True - _ -> False - -- Warn if the pattern binds no variables -- See Note [Pattern bindings that bind no variables] ; whenWOptM Opt_WarnUnusedPatternBinds $ - when (null bndrs && not ok_nobind_pat) $ + when (null bndrs && not (isOkNoBindPattern pat)) $ addTcRnDiagnostic (TcRnUnusedPatternBinds bind') ; fvs' `seq` -- See Note [Free-variable space leak] @@ -540,29 +532,66 @@ rnBind sig_fn (PatSynBind x bind) rnBind _ b = pprPanic "rnBind" (ppr b) + -- See Note [Pattern bindings that bind no variables] +isOkNoBindPattern :: LPat GhcRn -> Bool +isOkNoBindPattern (L _ pat) = + case pat of + WildPat{} -> True -- Exception (1) + BangPat {} -> True -- Exception (2) #9127, #13646 + p -> patternContainsSplice p -- Exception (3) + + where + lpatternContainsSplice :: LPat GhcRn -> Bool + lpatternContainsSplice (L _ p) = patternContainsSplice p + patternContainsSplice :: Pat GhcRn -> Bool + patternContainsSplice p = + case p of + -- A top-level splice has been evaluated by this point, so we know the pattern it is evaluated to + SplicePat (HsUntypedSpliceTop _ p) _ -> patternContainsSplice p + -- A nested splice isn't evaluated so we can't guess what it will expand to + SplicePat (HsUntypedSpliceNested {}) _ -> True + -- The base cases + VarPat {} -> False + WildPat {} -> False + LitPat {} -> False + NPat {} -> False + NPlusKPat {} -> False + -- Recursive cases + BangPat _ lp -> lpatternContainsSplice lp + LazyPat _ lp -> lpatternContainsSplice lp + AsPat _ _ _ lp -> lpatternContainsSplice lp + ParPat _ _ lp _ -> lpatternContainsSplice lp + ViewPat _ _ lp -> lpatternContainsSplice lp + SigPat _ lp _ -> lpatternContainsSplice lp + ListPat _ lps -> any lpatternContainsSplice lps + TuplePat _ lps _ -> any lpatternContainsSplice lps + SumPat _ lp _ _ -> lpatternContainsSplice lp + ConPat _ _ cpd -> any lpatternContainsSplice (hsConPatArgs cpd) + XPat (HsPatExpanded _orig new) -> patternContainsSplice new + {- Note [Pattern bindings that bind no variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Generally, we want to warn about pattern bindings like Just _ = e because they don't do anything! But we have three exceptions: -* A wildcard pattern +(1) A wildcard pattern _ = rhs which (a) is not that different from _v = rhs (b) is sometimes used to give a type sig for, or an occurrence of, a variable on the RHS -* A strict pattern binding; that is, one with an outermost bang +(2) A strict pattern binding; that is, one with an outermost bang !Just _ = e This can fail, so unlike the lazy variant, it is not a no-op. Moreover, #13646 argues that even for single constructor types, you might want to write the constructor. See also #9127. -* A splice pattern +(3) A splice pattern $(th-lhs) = rhs It is impossible to determine whether or not th-lhs really - binds any variable. We should disable the warning for any pattern - which contain splices, but that is a more expensive check. + binds any variable. You have to recurse all the way into the pattern to check + it doesn't contain any splices like this. See #22057. Note [Free-variable space leak] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -87,3 +87,50 @@ Compiler ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ + + +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/exts/gadt_syntax.rst ===================================== @@ -6,7 +6,7 @@ Declaring data types with explicit constructor signatures .. extension:: GADTSyntax :shortdesc: Enable generalised algebraic data type syntax. - :implied by: :extensions:`GADTs` + :implied by: :extension:`GADTs` :since: 7.2.1 :status: Included in :extension:`GHC2021` ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} ===================================== docs/users_guide/phases.rst ===================================== @@ -467,7 +467,7 @@ defined by your local GHC installation, the following trick is useful: .. index:: single: __GLASGOW_HASKELL_LLVM__ - Only defined when ``-fllvm`` is specified. When GHC is using version + Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero is added, so for example when using version 3.7 of LLVM, @@ -614,8 +614,8 @@ Options affecting code generation .. note:: - Note that this GHC release expects an LLVM version in the |llvm-version| - release series. + Note that this GHC release expects an LLVM version between |llvm-version-min| + and |llvm-version-max|. .. ghc-flag:: -fno-code :shortdesc: Omit code generation ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -41,7 +41,7 @@ archiveRoot :: FilePath archiveRoot = docRoot -/- "archives" manPageBuildPath :: FilePath -manPageBuildPath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1" -- TODO: Get rid of this hack. docContext :: Context ===================================== libraries/base/changelog.md ===================================== @@ -22,7 +22,7 @@ * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. -## 4.17.0.0 *TBA* +## 4.17.0.0 *August 2022* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. @@ -66,14 +66,55 @@ A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md) is available. - * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to - `Debug.Trace`, per - [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36). - * Re-export `augment` and `build` function from `GHC.List` * Re-export the `IsList` typeclass from the new `GHC.IsList` module. + * There's a new special function ``withDict`` in ``GHC.Exts``: :: + + withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r + + where ``cls`` must be a class containing exactly one method, whose type + must be ``meth``. + + This function converts ``meth`` to a type class dictionary. + It removes the need for ``unsafeCoerce`` in implementation of reflection + libraries. It should be used with care, because it can introduce + incoherent instances. + + For example, the ``withTypeable`` function from the + ``Type.Reflection`` module can now be defined as: :: + + withTypeable :: forall k (a :: k) rep (r :: TYPE rep). () + => TypeRep a -> (Typeable a => r) -> r + withTypeable rep k = withDict @(Typeable a) rep k + + Note that the explicit type application is required, as the call to + ``withDict`` would be ambiguous otherwise. + + This replaces the old ``GHC.Exts.magicDict``, which required + an intermediate data type and was less reliable. + + * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by + `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these + were rather represented by `Word#` and `Int#`. See GHC #11953. + +## 4.16.3.0 *May 2022* + + * Shipped with GHC 9.2.4 + + * winio: make consoleReadNonBlocking not wait for any events at all. + + * winio: Add support to console handles to handleToHANDLE + +## 4.16.2.0 *May 2022* + + * Shipped with GHC 9.2.2 + + * Export GHC.Event.Internal on Windows (#21245) + + # Documentation Fixes + ## 4.16.1.0 *Feb 2022* * Shipped with GHC 9.2.2 @@ -498,7 +539,7 @@ in constant space when applied to lists. (#10830) * `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist. - This functionality is superseded by the interfaces provided by + This functionality is superceded by the interfaces provided by `Type.Reflection`. * `mkTyCon3` is no longer exported by `Data.Typeable`. This function is ===================================== libraries/ghc-compact/tests/all.T ===================================== @@ -16,8 +16,8 @@ test('compact_pinned', exit_code(1), compile_and_run, ['']) test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_run, ['']) # this test computes closure sizes and those are affected # by the ghci and prof ways, because of BCOs and profiling headers. -test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']), - compile_and_run, ['']) +# Optimization levels slightly change what is/isn't shared so only run in normal mode +test('compact_share', only_ways(['normal']), compile_and_run, ['']) test('compact_bench', [ ignore_stdout, extra_run_opts('100') ], compile_and_run, ['']) test('T17044', normal, compile_and_run, ['']) ===================================== rts/Interpreter.c ===================================== @@ -1875,7 +1875,7 @@ run_BCO: int flags = BCO_NEXT; bool interruptible = flags & 0x1; bool unsafe_call = flags & 0x2; - void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); + void(*marshal_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); /* the stack looks like this: @@ -1902,7 +1902,7 @@ run_BCO: #define ROUND_UP_WDS(p) ((((StgWord)(p)) + sizeof(W_)-1)/sizeof(W_)) - ffi_cif *cif = (ffi_cif *)marshall_fn; + ffi_cif *cif = (ffi_cif *)marshal_fn; uint32_t nargs = cif->nargs; uint32_t ret_size; uint32_t i; ===================================== testsuite/tests/rename/should_compile/T22057.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} +{-# OPTIONS -Wall #-} +module Thing (thing) where + +import Language.Haskell.TH + +thing :: Q () +thing = do + name <- newName "x" + -- warning: + _ <- [| let ($(pure (VarP name)), _) = (3.0, 4.0) in $(pure (VarE name)) |] + -- warning: + _ <- [| let ($(pure (VarP name)) ) = 3.0 in $(pure (VarE name)) |] + -- no warning: + _ <- [| let $(pure (VarP name)) = 3.0 in $(pure (VarE name)) |] + return () ===================================== testsuite/tests/rename/should_compile/T22067.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} +module TTT where + +a :: () +a = let () = () in () + +b :: () +b = let $([p|()|]) = () in () + ===================================== testsuite/tests/rename/should_compile/T22067.stderr ===================================== @@ -0,0 +1,6 @@ + +T22067.hs:5:9: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] + This pattern-binding binds no variables: () = () + +T22067.hs:8:9: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] + This pattern-binding binds no variables: (()) = () ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -188,3 +188,5 @@ test('T18862', normal, compile, ['']) test('unused_haddock', normal, compile, ['-haddock -Wall']) test('T19984', normal, compile, ['-fwarn-unticked-promoted-constructors']) test('T21654', normal, compile, ['-Wunused-top-binds']) +test('T22057', normal, compile, ['-Wall']) +test('T22067', normal, compile, ['-Wall']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6 +Subproject commit a9a312991e55ab99a8dee36a6747f4fc5d5b7c67 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4be1c7ad0028d2c8906f246489148abf3f060bc5...04f464f99533083d979641d1db496bd0fba22eb5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4be1c7ad0028d2c8906f246489148abf3f060bc5...04f464f99533083d979641d1db496bd0fba22eb5 You're receiving 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 Aug 18 16:32:01 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 18 Aug 2022 12:32:01 -0400 Subject: [Git][ghc/ghc][wip/js-staging] FFI: remove narrowing Message-ID: <62fe698114c1c_125b2b487ec459bb@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 3936af4d by Sylvain Henry at 2022-08-18T18:29:48+02:00 FFI: remove narrowing Fix tests such as cgrun015 (Core lint error) - - - - - 1 changed file: - compiler/GHC/HsToCore/Foreign/JavaScript.hs Changes: ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -56,8 +56,6 @@ import GHC.Driver.Config import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Builtin.Names -import GHC.Builtin.PrimOps -import GHC.Builtin.PrimOps.Ids import GHC.Data.FastString import GHC.Data.Pair @@ -667,15 +665,13 @@ jsResultWrapper result_ty -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr - | Just (tycon, tycon_arg_tys, data_con, data_con_arg_tys) <- splitDataProductType_maybe result_ty, + | Just (_tycon, tycon_arg_tys, data_con, data_con_arg_tys) <- splitDataProductType_maybe result_ty, dataConSourceArity data_con == 1 - = do let - (unwrapped_res_ty : _) = data_con_arg_tys - narrow_wrapper = maybeJsNarrow tycon + = do let (unwrapped_res_ty : _) = data_con_arg_tys (maybe_ty, wrapper) <- jsResultWrapper (scaledThing unwrapped_res_ty) return (maybe_ty, \e -> mkApps (Var (dataConWrapId data_con)) - (map Type tycon_arg_tys ++ [wrapper (narrow_wrapper e)])) + (map Type tycon_arg_tys ++ [wrapper e])) | otherwise = pprPanic "jsResultWrapper" (ppr result_ty) @@ -690,16 +686,3 @@ mkJsCall u tgt args t = mkFCall u ccall args t (StaticTarget NoSourceText (mkFastString tgt) (Just primUnit) True) JavaScriptCallConv PlayRisky - --- narrow int32 and word32 since JS numbers can contain more -maybeJsNarrow :: TyCon -> (CoreExpr -> CoreExpr) -maybeJsNarrow tycon - | tycon `hasKey` intTyConKey = \e -> App (Var (primOpId Narrow32IntOp)) e - | tycon `hasKey` int8TyConKey = \e -> App (Var (primOpId Narrow8IntOp)) e - | tycon `hasKey` int16TyConKey = \e -> App (Var (primOpId Narrow16IntOp)) e - | tycon `hasKey` int32TyConKey = \e -> App (Var (primOpId Narrow32IntOp)) e - | tycon `hasKey` wordTyConKey = \e -> App (Var (primOpId Narrow32WordOp)) e - | tycon `hasKey` word8TyConKey = \e -> App (Var (primOpId Narrow8WordOp)) e - | tycon `hasKey` word16TyConKey = \e -> App (Var (primOpId Narrow16WordOp)) e - | tycon `hasKey` word32TyConKey = \e -> App (Var (primOpId Narrow32WordOp)) e - | otherwise = id View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3936af4da705a5f99b3713e04578e177fb610b66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3936af4da705a5f99b3713e04578e177fb610b66 You're receiving 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 Aug 18 17:01:11 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 13:01:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22038 Message-ID: <62fe705773297_125b2b4e4bc4817b@gitlab.mail> Ben Gamari pushed new branch wip/T22038 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22038 You're receiving 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 Aug 18 17:02:29 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 13:02:29 -0400 Subject: [Git][ghc/ghc][wip/T22038] compiler: Rework handling of mutator aborting Message-ID: <62fe70a584a61_125b2b4881448380@gitlab.mail> Ben Gamari pushed to branch wip/T22038 at Glasgow Haskell Compiler / GHC Commits: 9e19c367 by Ben Gamari at 2022-08-18T13:01:23-04:00 compiler: Rework handling of mutator aborting Previously `-dtag-inference-checks`, `-dcheck-prim-bounds`, and `-falignment-sanitization` all aborted by calling `barf` from the mutator. However, this can lead to deadlocks in the threaded RTS. For instance, in the case of `-dcheck-prim-bounds` the following can happen 1. the mutator takes a capability and begins execution 2. the bounds check fails, calling `barf` 3. `barf` calls `rtsFatalInternalErrorFn`, which in turn calls `endEventLogging` 4. `endEventLogging` calls `flushEventLog`, which it turn initiates a sync to request that all capabilities flush their local event logs 5. we deadlock as the the capability held by the crashing mutator can never join the sync To avoid this we now have a more principled means of aborting: we return to the scheduler setting the thread's return value to ThreadAborting. The scheduler will see this and call `barf`. Fixes #22038. - - - - - 9 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/TagCheck.hs - compiler/GHC/StgToCmm/Utils.hs - rts/PrimOps.cmm - rts/RtsMessages.c - rts/Schedule.c - rts/StgMiscClosures.cmm - rts/include/rts/Constants.h Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -656,7 +656,8 @@ mkSMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsL mkSMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo mkBadAlignmentLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment") CmmEntry -mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") Nothing ForeignLabelInExternalPackage IsFunction +mkOutOfBoundsAccessLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_outOfBoundsAccess") CmmEntry +mkTagInferenceCheckFailureLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_tagInferenceCheckFailure") CmmEntry mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo mkSRTInfoLabel :: Int -> CLabel ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -3211,7 +3211,7 @@ doBoundsCheck idx sz = do when do_bounds_check (doCheck platform) where doCheck platform = do - boundsCheckFailed <- getCode $ emitCCall [] (mkLblExpr mkOutOfBoundsAccessLabel) [] + boundsCheckFailed <- getCode $ emitCall (NativeNodeCall, NativeReturn) (mkLblExpr mkOutOfBoundsAccessLabel) [idx, sz] emit =<< mkCmmIfThen' isOutOfBounds boundsCheckFailed (Just False) where uGE = cmmUGeWord platform ===================================== compiler/GHC/StgToCmm/TagCheck.hs ===================================== @@ -95,7 +95,8 @@ emitTagAssertion onWhat fun = do ; needsArgTag fun lbarf lret ; emitLabel lbarf - ; emitBarf ("Tag inference failed on:" ++ onWhat) + ; onWhat_str <- newStringCLit onWhat + ; emitCall (NativeNodeCall, NativeReturn) (mkLblExpr mkTagInferenceCheckFailureLabel) [onWhat_str] ; emitLabel lret } ===================================== compiler/GHC/StgToCmm/Utils.hs ===================================== @@ -12,7 +12,6 @@ module GHC.StgToCmm.Utils ( emitDataLits, emitRODataLits, emitDataCon, emitRtsCall, emitRtsCallWithResult, emitRtsCallGen, - emitBarf, assignTemp, newTemp, newUnboxedTupleRegs, @@ -158,11 +157,6 @@ tagToClosure platform tycon tag -- ------------------------------------------------------------------------- -emitBarf :: String -> FCode () -emitBarf msg = do - strLbl <- newStringCLit msg - emitRtsCall rtsUnitId (fsLit "barf") [(CmmLit strLbl,AddrHint)] False - emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCall pkg fun = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) ===================================== rts/PrimOps.cmm ===================================== @@ -42,7 +42,7 @@ import CLOSURE CCS_MAIN; #if defined(DEBUG) #define ASSERT_IN_BOUNDS(ind, sz) \ - if (ind >= sz) { ccall rtsOutOfBoundsAccess(); } + if (ind >= sz) { ccall stg_outOfBoundsAccess(ind, sz); } #else #define ASSERT_IN_BOUNDS(ind, sz) #endif ===================================== rts/RtsMessages.c ===================================== @@ -320,21 +320,3 @@ rtsDebugMsgFn(const char *s, va_list ap) return r; } - -// Used in stg_badAlignment_entry defined in StgStartup.cmm. -void rtsBadAlignmentBarf(void) GNUC3_ATTRIBUTE(__noreturn__); - -void -rtsBadAlignmentBarf() -{ - barf("Encountered incorrectly aligned pointer. This can't be good."); -} - -// Used by code generator -void rtsOutOfBoundsAccess(void) GNUC3_ATTRIBUTE(__noreturn__); - -void -rtsOutOfBoundsAccess() -{ - barf("Encountered out of bounds array access."); -} ===================================== rts/Schedule.c ===================================== @@ -571,6 +571,9 @@ run_thread: ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task); break; + case ThreadAborted: + barf("internal error"); + default: barf("schedule: invalid thread return code %d", (int)ret); } ===================================== rts/StgMiscClosures.cmm ===================================== @@ -1486,3 +1486,50 @@ section "data" { } #endif + +/* Note [Aborting from the mutator] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * GHC supports a number of runtime checking modes (largely for debugging + * purposes) which may need to abort execution at runtime. This include + * -dtag-inference-check, -dcheck-prim-bounds, and -falignment-sanitisation. + * To abort execution one might think that we could just call `barf`; however + * this is not ideal since it doesn't allow the RTS to gracefully shutdown. + * + * In #22038 we saw this manifest as a deadlock when -dcheck-prim-bounds + * failed. In particular, we saw the following: + * + * 1. the mutator takes a capability and begins execution + * 2. the bounds check fails, calling `barf` + * 3. `barf` calls `rtsFatalInternalErrorFn`, which in turn calls `endEventLogging` + * 4. `endEventLogging` calls `flushEventLog`, which it turn initiates a + * sync to request that all capabilities flush their local event logs + * 5. we deadlock as the the capability held by the crashing mutator can + * never yields to the sync + * + * Consequently, we instead crash in a more principled manner by yielding back + * to the scheduler, indicating that we should abort by setting the thread's + * return value to ThreadAborted. This is done by stg_abort(). + */ + +stg_tagInferenceCheckFailure(W_ what) { + ccall debugBelch("Tag inference failed on: %s\n", what); + jump stg_abort(); +} + +stg_outOfBoundsAccess(W_ ind, W_ sz) { + ccall debugBelch("Encountered out of bounds array access (index=%d, size=%d)", ind, sz); + jump stg_abort(); +} + +stg_badAlignment() { + ccall debugBelch("Encountered incorrectly aligned pointer. This can't be good."); + jump stg_abort(); +} + +stg_abort() { + PRE_RETURN(ret,ThreadRunGHC); + StgTSO_what_next(CurrentTSO) = ThreadKilled :: I16; + StgRegTable_rRet(BaseReg) = ThreadAborted :: W_; + R1 = BaseReg; + jump stg_returnToSched [R1]; +} ===================================== rts/include/rts/Constants.h ===================================== @@ -268,6 +268,7 @@ #define ThreadYielding 3 #define ThreadBlocked 4 #define ThreadFinished 5 +#define ThreadAborted 6 /* See Note [Aborting from the mutator] */ /* * Flags for the tso->flags field. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e19c367c2096c58aabcdaf948a52ed4be3a18dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e19c367c2096c58aabcdaf948a52ed4be3a18dd You're receiving 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 Aug 18 19:58:14 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 15:58:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.4 Message-ID: <62fe99d6f32c4_125b2b502bc73962@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.4 You're receiving 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 Aug 18 20:01:38 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 16:01:38 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] 4 commits: gitlab-ci: Fix ARMv7 build Message-ID: <62fe9aa2b7232_125b2b4e4a8778b3@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: aeb04c72 by Ben Gamari at 2022-08-18T15:59:46-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. (cherry picked from commit 5bc489cac104717f09be73f2b578719bcc1e3fcb) - - - - - aa10e2ca by Ben Gamari at 2022-08-18T16:00:51-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used (cherry picked from commit 596db9a5f966643bcc9994d45f2f6ffb4037ad74) - - - - - 12f7a429 by Matthew Pickering at 2022-08-18T16:01:18-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 (cherry picked from commit a740a4c56416c7c1bc914a7a9207207e17833573) - - - - - 8bbf9da7 by Ben Gamari at 2022-08-18T16:01:18-04:00 make: Add containers as a stage0 package Closes #21981. - - - - - 8 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - ghc.mk - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T22044.bazoo - testsuite/tests/driver/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -311,8 +311,15 @@ opsysVariables _ FreeBSD13 = mconcat ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -480,6 +487,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -500,6 +508,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -769,7 +779,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -120,6 +120,67 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, +<<<<<<< HEAD +======= + "aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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\") && (\"disabled\" != \"disabled\")", + "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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate" + } + }, +>>>>>>> e7bedef11ee (gitlab-ci: Run ARMv7 jobs when ~ARM label is used) "armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -155,7 +216,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -174,7 +235,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -213,7 +277,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -271,7 +335,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -334,7 +398,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -358,6 +422,68 @@ "XZ_OPT": "-9" } }, +<<<<<<< HEAD +======= + "nightly-aarch64-linux-deb11-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-aarch64-linux-deb11-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "", + "TEST_ENV": "aarch64-linux-deb11-validate", + "XZ_OPT": "-9" + } + }, +>>>>>>> e7bedef11ee (gitlab-ci: Run ARMv7 jobs when ~ARM label is used) "nightly-armv7-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -393,7 +519,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -412,7 +538,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -452,7 +581,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -511,7 +640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -576,7 +705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -637,7 +766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -699,7 +828,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -761,7 +890,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -821,7 +950,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -880,7 +1009,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -939,7 +1068,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -999,7 +1128,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1058,7 +1187,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1117,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1176,7 +1305,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1235,7 +1364,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1261,6 +1390,70 @@ "XZ_OPT": "-9" } }, +<<<<<<< HEAD +======= + "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", + "XZ_OPT": "-9" + } + }, +>>>>>>> e7bedef11ee (gitlab-ci: Run ARMv7 jobs when ~ARM label is used) "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1296,7 +1489,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1355,7 +1548,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1414,7 +1607,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1475,7 +1668,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1537,7 +1730,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1598,7 +1791,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1846,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1712,7 +1905,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1775,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1839,7 +2032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1864,6 +2057,69 @@ "XZ_OPT": "-9" } }, +<<<<<<< HEAD +======= + "release-aarch64-linux-deb11-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-aarch64-linux-deb11-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "aarch64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb11:$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": [ + "aarch64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-aarch64-linux-deb11-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "aarch64-linux-deb11-release", + "XZ_OPT": "-9" + } + }, +>>>>>>> e7bedef11ee (gitlab-ci: Run ARMv7 jobs when ~ARM label is used) "release-armv7-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1899,7 +2155,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1918,8 +2174,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -1959,7 +2218,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2019,7 +2278,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2085,7 +2344,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2147,7 +2406,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2210,7 +2469,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2273,7 +2532,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2334,7 +2593,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2394,7 +2653,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2454,7 +2713,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2514,7 +2773,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2574,7 +2833,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2636,7 +2895,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2698,7 +2957,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2761,7 +3020,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2817,7 +3076,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2877,7 +3136,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2941,7 +3200,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3005,7 +3264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3065,7 +3324,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3126,7 +3385,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3187,7 +3446,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3246,7 +3505,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3305,7 +3564,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3363,7 +3622,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3681,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3480,7 +3739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3538,7 +3797,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3596,7 +3855,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3655,7 +3914,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3680,6 +3939,69 @@ "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, +<<<<<<< HEAD +======= + "x86_64-linux-deb11-cross_aarch64-linux-gnu-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-deb11-cross_aarch64-linux-gnu-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$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-deb11-cross_aarch64-linux-gnu-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", + "CROSS_TARGET": "aarch64-linux-gnu", + "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" + } + }, +>>>>>>> e7bedef11ee (gitlab-ci: Run ARMv7 jobs when ~ARM label is used) "x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3715,7 +4037,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3773,7 +4095,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3831,7 +4153,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3891,7 +4213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3952,7 +4274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4012,7 +4334,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4066,7 +4388,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4124,7 +4446,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -171,7 +171,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = -> Just (DriverPsHeaderMessage (PsHeaderMessage msg)) _ -> Nothing - pipe_env = mkPipeEnv StopPreprocess input_fn (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv StopPreprocess input_fn mb_phase (Temporary TFL_GhcSession) mkInputFn = case mb_input_buf of Just input_buf -> do @@ -238,7 +238,7 @@ compileOne' mHscMessage [ml_obj_file $ ms_location summary] plugin_hsc_env <- initializePlugins hsc_env - let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput + 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) @@ -513,7 +513,7 @@ oneShot hsc_env stop_phase srcs = do NoStop -> doLink hsc_env o_files compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath) -compileFile hsc_env stop_phase (src, _mb_phase) = do +compileFile hsc_env stop_phase (src, mb_phase) = do exists <- doesFileExist src when (not exists) $ throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src)) @@ -534,8 +534,8 @@ compileFile hsc_env stop_phase (src, _mb_phase) = do | isJust mb_o_file = SpecificFile -- -o foo applies to the file we are compiling now | otherwise = Persistent - pipe_env = mkPipeEnv stop_phase src output - pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src + pipe_env = mkPipeEnv stop_phase src mb_phase output + pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src mb_phase runPipeline (hsc_hooks hsc_env) pipeline @@ -584,7 +584,7 @@ compileForeign hsc_env lang stub_c = do #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif - pipe_env = mkPipeEnv NoStop stub_c (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv NoStop stub_c Nothing (Temporary TFL_GhcSession) res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. @@ -608,7 +608,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) - let pipe_env = (mkPipeEnv NoStop empty_stub Persistent) { src_basename = basename} + let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename} pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline return () @@ -618,15 +618,17 @@ compileEmptyStub dflags hsc_env basename location mod_name = do mkPipeEnv :: StopPhase -- End phase -> FilePath -- input fn + -> Maybe Phase -> PipelineOutput -- Output -> PipeEnv -mkPipeEnv stop_phase input_fn output = +mkPipeEnv stop_phase input_fn start_phase output = let (basename, suffix) = splitExtension input_fn suffix' = drop 1 suffix -- strip off the . env = PipeEnv{ stop_phase, src_filename = input_fn, src_basename = basename, src_suffix = suffix', + start_phase = fromMaybe (startPhase suffix') start_phase, output_spec = output } in env @@ -696,8 +698,7 @@ preprocessPipeline pipe_env hsc_env input_fn = do where platform = targetPlatform (hsc_dflags hsc_env) runAfter :: P p => Phase -> a -> p a -> p a - runAfter = phaseIfAfter platform start_phase - start_phase = startPhase (src_suffix pipe_env) + runAfter = phaseIfAfter platform (start_phase pipe_env) runAfterFlag :: P p => HscEnv -> Phase @@ -823,9 +824,9 @@ hscPostBackendPipeline pipe_env hsc_env _ bcknd ml input_fn = Interpreter -> return Nothing -- Pipeline from a given suffix -pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) -pipelineStart pipe_env hsc_env input_fn = - fromSuffix (src_suffix pipe_env) +pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath) +pipelineStart pipe_env hsc_env input_fn mb_phase = + fromPhase (fromMaybe (startPhase $ src_suffix pipe_env) mb_phase) where stop_after = stop_phase pipe_env frontend :: P m => HscSource -> m (Maybe FilePath) @@ -857,33 +858,24 @@ pipelineStart pipe_env hsc_env input_fn = objFromLinkable _ = Nothing - fromSuffix :: P m => String -> m (Maybe FilePath) - fromSuffix "lhs" = frontend HsSrcFile - fromSuffix "lhs-boot" = frontend HsBootFile - fromSuffix "lhsig" = frontend HsigFile - fromSuffix "hs" = frontend HsSrcFile - fromSuffix "hs-boot" = frontend HsBootFile - fromSuffix "hsig" = frontend HsigFile - fromSuffix "hscpp" = frontend HsSrcFile - fromSuffix "hspp" = frontend HsSrcFile - fromSuffix "hc" = c HCc - fromSuffix "c" = c Cc - fromSuffix "cpp" = c Ccxx - fromSuffix "C" = c Cc - fromSuffix "m" = c Cobjc - fromSuffix "M" = c Cobjcxx - fromSuffix "mm" = c Cobjcxx - fromSuffix "cc" = c Ccxx - fromSuffix "cxx" = c Ccxx - fromSuffix "s" = as False - fromSuffix "S" = as True - fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn - fromSuffix "o" = return (Just input_fn) - fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn - fromSuffix _ = return (Just input_fn) + fromPhase :: P m => Phase -> m (Maybe FilePath) + fromPhase (Unlit p) = frontend p + fromPhase (Cpp p) = frontend p + fromPhase (HsPp p) = frontend p + fromPhase (Hsc p) = frontend p + fromPhase HCc = c HCc + fromPhase Cc = c Cc + fromPhase Ccxx = c Ccxx + fromPhase Cobjc = c Cobjc + fromPhase Cobjcxx = c Cobjcxx + fromPhase (As p) = as p + fromPhase LlvmOpt = llvmPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromPhase StopLn = return (Just input_fn) + fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase MergeForeign = panic "fromPhase: MergeForeign" {- Note [The Pipeline Monad] ===================================== compiler/GHC/Driver/Pipeline/Monad.hs ===================================== @@ -29,6 +29,7 @@ data PipeEnv = PipeEnv { src_filename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source src_suffix :: String, -- ^ its extension + start_phase :: Phase, output_spec :: PipelineOutput -- ^ says where to put the pipeline output } ===================================== ghc.mk ===================================== @@ -426,7 +426,7 @@ else # CLEANING # programs such as GHC and ghc-pkg, that we do not assume the stage0 # compiler already has installed (or up-to-date enough). # Note that these must be given in topological order. -PACKAGES_STAGE0 = binary transformers mtl hpc ghc-boot-th ghc-boot template-haskell text parsec Cabal/Cabal-syntax Cabal/Cabal ghc-heap exceptions ghci +PACKAGES_STAGE0 = containers/containers binary transformers mtl hpc ghc-boot-th ghc-boot template-haskell text parsec Cabal/Cabal-syntax Cabal/Cabal ghc-heap exceptions ghci ifeq "$(Windows_Host)" "NO" PACKAGES_STAGE0 += terminfo endif ===================================== testsuite/tests/driver/Makefile ===================================== @@ -750,3 +750,11 @@ T21869: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T21869.hs -S [ -f T21869.s ] || (echo "assembly file does not exist" && exit 2) [ ! -f T21869.o ] || (echo "object file exists" && exit 2) + +.PHONY: T22044 +T22044: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -E -cpp -x hs T22044.bazoo -o T22044.hs -DBAZOO=1 + # Test the file exists and is preprocessed + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T22044.hs + + ===================================== testsuite/tests/driver/T22044.bazoo ===================================== @@ -0,0 +1,3 @@ +module T22044 where + +bazoo = BAZOO ===================================== testsuite/tests/driver/all.T ===================================== @@ -308,3 +308,4 @@ test('patch-level2', normal, compile, ['-Wcpp-undef']) test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21869', normal, makefile_test, []) +test('T22044', normal, makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e035051fa3b149708fa043832a05dd80c58941a5...8bbf9da7aef35d8cf2a3dd039a61ace020743b4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e035051fa3b149708fa043832a05dd80c58941a5...8bbf9da7aef35d8cf2a3dd039a61ace020743b4c You're receiving 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 Aug 18 20:06:59 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 16:06:59 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] 3 commits: gitlab-ci: Run ARMv7 jobs when ~ARM label is used Message-ID: <62fe9be35cf60_125b2b502bc78498@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: c534eb5d by Ben Gamari at 2022-08-18T16:06:45-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used (cherry picked from commit 596db9a5f966643bcc9994d45f2f6ffb4037ad74) - - - - - ed84e10b by Matthew Pickering at 2022-08-18T16:06:45-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 (cherry picked from commit a740a4c56416c7c1bc914a7a9207207e17833573) - - - - - 3e2f7cdf by Ben Gamari at 2022-08-18T16:06:45-04:00 make: Add containers as a stage0 package Closes #21981. - - - - - 8 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - ghc.mk - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T22044.bazoo - testsuite/tests/driver/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -487,6 +487,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -507,6 +508,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -776,7 +779,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -216,7 +216,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -274,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -337,7 +337,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -396,7 +396,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -458,7 +458,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -517,7 +517,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -582,7 +582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -643,7 +643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -705,7 +705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -767,7 +767,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -827,7 +827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -886,7 +886,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -945,7 +945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1005,7 +1005,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1064,7 +1064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1123,7 +1123,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1182,7 +1182,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1241,7 +1241,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1302,7 +1302,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1361,7 +1361,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1420,7 +1420,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1481,7 +1481,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1543,7 +1543,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1604,7 +1604,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1659,7 +1659,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1718,7 +1718,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1781,7 +1781,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1905,7 +1905,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2094,7 +2094,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2156,7 +2156,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2219,7 +2219,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2282,7 +2282,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2343,7 +2343,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2403,7 +2403,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2463,7 +2463,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2523,7 +2523,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2583,7 +2583,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2645,7 +2645,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2707,7 +2707,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2770,7 +2770,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2826,7 +2826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2886,7 +2886,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2950,7 +2950,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3014,7 +3014,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3074,7 +3074,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3196,7 +3196,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3255,7 +3255,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3314,7 +3314,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3372,7 +3372,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3431,7 +3431,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3489,7 +3489,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3547,7 +3547,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3605,7 +3605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3664,7 +3664,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3724,7 +3724,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3782,7 +3782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3840,7 +3840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3900,7 +3900,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3961,7 +3961,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4021,7 +4021,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4075,7 +4075,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4133,7 +4133,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -171,7 +171,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = -> Just (DriverPsHeaderMessage (PsHeaderMessage msg)) _ -> Nothing - pipe_env = mkPipeEnv StopPreprocess input_fn (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv StopPreprocess input_fn mb_phase (Temporary TFL_GhcSession) mkInputFn = case mb_input_buf of Just input_buf -> do @@ -238,7 +238,7 @@ compileOne' mHscMessage [ml_obj_file $ ms_location summary] plugin_hsc_env <- initializePlugins hsc_env - let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput + 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) @@ -513,7 +513,7 @@ oneShot hsc_env stop_phase srcs = do NoStop -> doLink hsc_env o_files compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath) -compileFile hsc_env stop_phase (src, _mb_phase) = do +compileFile hsc_env stop_phase (src, mb_phase) = do exists <- doesFileExist src when (not exists) $ throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src)) @@ -534,8 +534,8 @@ compileFile hsc_env stop_phase (src, _mb_phase) = do | isJust mb_o_file = SpecificFile -- -o foo applies to the file we are compiling now | otherwise = Persistent - pipe_env = mkPipeEnv stop_phase src output - pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src + pipe_env = mkPipeEnv stop_phase src mb_phase output + pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src mb_phase runPipeline (hsc_hooks hsc_env) pipeline @@ -584,7 +584,7 @@ compileForeign hsc_env lang stub_c = do #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif - pipe_env = mkPipeEnv NoStop stub_c (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv NoStop stub_c Nothing (Temporary TFL_GhcSession) res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. @@ -608,7 +608,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) - let pipe_env = (mkPipeEnv NoStop empty_stub Persistent) { src_basename = basename} + let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename} pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline return () @@ -618,15 +618,17 @@ compileEmptyStub dflags hsc_env basename location mod_name = do mkPipeEnv :: StopPhase -- End phase -> FilePath -- input fn + -> Maybe Phase -> PipelineOutput -- Output -> PipeEnv -mkPipeEnv stop_phase input_fn output = +mkPipeEnv stop_phase input_fn start_phase output = let (basename, suffix) = splitExtension input_fn suffix' = drop 1 suffix -- strip off the . env = PipeEnv{ stop_phase, src_filename = input_fn, src_basename = basename, src_suffix = suffix', + start_phase = fromMaybe (startPhase suffix') start_phase, output_spec = output } in env @@ -696,8 +698,7 @@ preprocessPipeline pipe_env hsc_env input_fn = do where platform = targetPlatform (hsc_dflags hsc_env) runAfter :: P p => Phase -> a -> p a -> p a - runAfter = phaseIfAfter platform start_phase - start_phase = startPhase (src_suffix pipe_env) + runAfter = phaseIfAfter platform (start_phase pipe_env) runAfterFlag :: P p => HscEnv -> Phase @@ -823,9 +824,9 @@ hscPostBackendPipeline pipe_env hsc_env _ bcknd ml input_fn = Interpreter -> return Nothing -- Pipeline from a given suffix -pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) -pipelineStart pipe_env hsc_env input_fn = - fromSuffix (src_suffix pipe_env) +pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath) +pipelineStart pipe_env hsc_env input_fn mb_phase = + fromPhase (fromMaybe (startPhase $ src_suffix pipe_env) mb_phase) where stop_after = stop_phase pipe_env frontend :: P m => HscSource -> m (Maybe FilePath) @@ -857,33 +858,24 @@ pipelineStart pipe_env hsc_env input_fn = objFromLinkable _ = Nothing - fromSuffix :: P m => String -> m (Maybe FilePath) - fromSuffix "lhs" = frontend HsSrcFile - fromSuffix "lhs-boot" = frontend HsBootFile - fromSuffix "lhsig" = frontend HsigFile - fromSuffix "hs" = frontend HsSrcFile - fromSuffix "hs-boot" = frontend HsBootFile - fromSuffix "hsig" = frontend HsigFile - fromSuffix "hscpp" = frontend HsSrcFile - fromSuffix "hspp" = frontend HsSrcFile - fromSuffix "hc" = c HCc - fromSuffix "c" = c Cc - fromSuffix "cpp" = c Ccxx - fromSuffix "C" = c Cc - fromSuffix "m" = c Cobjc - fromSuffix "M" = c Cobjcxx - fromSuffix "mm" = c Cobjcxx - fromSuffix "cc" = c Ccxx - fromSuffix "cxx" = c Ccxx - fromSuffix "s" = as False - fromSuffix "S" = as True - fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn - fromSuffix "o" = return (Just input_fn) - fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn - fromSuffix _ = return (Just input_fn) + fromPhase :: P m => Phase -> m (Maybe FilePath) + fromPhase (Unlit p) = frontend p + fromPhase (Cpp p) = frontend p + fromPhase (HsPp p) = frontend p + fromPhase (Hsc p) = frontend p + fromPhase HCc = c HCc + fromPhase Cc = c Cc + fromPhase Ccxx = c Ccxx + fromPhase Cobjc = c Cobjc + fromPhase Cobjcxx = c Cobjcxx + fromPhase (As p) = as p + fromPhase LlvmOpt = llvmPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromPhase StopLn = return (Just input_fn) + fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase MergeForeign = panic "fromPhase: MergeForeign" {- Note [The Pipeline Monad] ===================================== compiler/GHC/Driver/Pipeline/Monad.hs ===================================== @@ -29,6 +29,7 @@ data PipeEnv = PipeEnv { src_filename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source src_suffix :: String, -- ^ its extension + start_phase :: Phase, output_spec :: PipelineOutput -- ^ says where to put the pipeline output } ===================================== ghc.mk ===================================== @@ -426,7 +426,7 @@ else # CLEANING # programs such as GHC and ghc-pkg, that we do not assume the stage0 # compiler already has installed (or up-to-date enough). # Note that these must be given in topological order. -PACKAGES_STAGE0 = binary transformers mtl hpc ghc-boot-th ghc-boot template-haskell text parsec Cabal/Cabal-syntax Cabal/Cabal ghc-heap exceptions ghci +PACKAGES_STAGE0 = containers/containers binary transformers mtl hpc ghc-boot-th ghc-boot template-haskell text parsec Cabal/Cabal-syntax Cabal/Cabal ghc-heap exceptions ghci ifeq "$(Windows_Host)" "NO" PACKAGES_STAGE0 += terminfo endif ===================================== testsuite/tests/driver/Makefile ===================================== @@ -750,3 +750,11 @@ T21869: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T21869.hs -S [ -f T21869.s ] || (echo "assembly file does not exist" && exit 2) [ ! -f T21869.o ] || (echo "object file exists" && exit 2) + +.PHONY: T22044 +T22044: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -E -cpp -x hs T22044.bazoo -o T22044.hs -DBAZOO=1 + # Test the file exists and is preprocessed + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T22044.hs + + ===================================== testsuite/tests/driver/T22044.bazoo ===================================== @@ -0,0 +1,3 @@ +module T22044 where + +bazoo = BAZOO ===================================== testsuite/tests/driver/all.T ===================================== @@ -308,3 +308,4 @@ test('patch-level2', normal, compile, ['-Wcpp-undef']) test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21869', normal, makefile_test, []) +test('T22044', normal, makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8bbf9da7aef35d8cf2a3dd039a61ace020743b4c...3e2f7cdf04b82eda494731751d032b00dbb57280 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8bbf9da7aef35d8cf2a3dd039a61ace020743b4c...3e2f7cdf04b82eda494731751d032b00dbb57280 You're receiving 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 Aug 18 20:28:17 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 Aug 2022 16:28:17 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] Deleted 1 commit: make: Add containers as a stage0 package Message-ID: <62fea0e1eed65_125b2b4e4a88137b@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 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: 3e2f7cdf by Ben Gamari at 2022-08-18T16:06:45-04:00 make: Add containers as a stage0 package Closes #21981. - - - - - 1 changed file: - ghc.mk Changes: ===================================== ghc.mk ===================================== @@ -426,7 +426,7 @@ else # CLEANING # programs such as GHC and ghc-pkg, that we do not assume the stage0 # compiler already has installed (or up-to-date enough). # Note that these must be given in topological order. -PACKAGES_STAGE0 = binary transformers mtl hpc ghc-boot-th ghc-boot template-haskell text parsec Cabal/Cabal-syntax Cabal/Cabal ghc-heap exceptions ghci +PACKAGES_STAGE0 = containers/containers binary transformers mtl hpc ghc-boot-th ghc-boot template-haskell text parsec Cabal/Cabal-syntax Cabal/Cabal ghc-heap exceptions ghci ifeq "$(Windows_Host)" "NO" PACKAGES_STAGE0 += terminfo endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e2f7cdf04b82eda494731751d032b00dbb57280 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e2f7cdf04b82eda494731751d032b00dbb57280 You're receiving 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 Aug 18 22:37:36 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 18:37:36 -0400 Subject: [Git][ghc/ghc][master] testsuite: Add test for #21583 Message-ID: <62febf303a71_125b2b4880094017@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 3 changed files: - + testsuite/tests/typecheck/should_fail/T21583.hs - + testsuite/tests/typecheck/should_fail/T21583.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== testsuite/tests/typecheck/should_fail/T21583.hs ===================================== @@ -0,0 +1,90 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE FlexibleContexts #-} +module Telomare.Possible where + +data PartExprF f + = ZeroSF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +newtype EnhancedExpr f = EnhancedExpr {unEnhanceExpr :: SplitFunctor f PartExprF (EnhancedExpr f)} -- deriving (Eq, Show) + +type family Base t :: * -> * + +type instance Base (EnhancedExpr f) = SplitFunctor f PartExprF + +class Functor (Base t) => Recursive t where + project :: t -> Base t t + +instance Functor f => Recursive (EnhancedExpr f) where + project = unEnhanceExpr + +class Functor (Base t) => Corecursive t where + embed :: Base t t -> t + +instance Functor f => Corecursive (EnhancedExpr f) where + embed = EnhancedExpr + +type SimpleExpr = EnhancedExpr VoidF +type BasicBase f = SplitFunctor f PartExprF +type SuperBase f = BasicBase (SplitFunctor f SuperPositionF) +type AbortBase f = SuperBase (SplitFunctor f AbortableF) +type UnsizedBase = AbortBase UnsizedRecursionF + +pattern UnsizedFW :: UnsizedRecursionF a -> UnsizedBase a +pattern UnsizedFW x = SplitFunctor (Left (SplitFunctor (Left (SplitFunctor (Left x))))) +pattern BasicExpr :: PartExprF (EnhancedExpr f) -> EnhancedExpr f +pattern BasicExpr x = EnhancedExpr (SplitFunctor (Right x)) +pattern UnsizedWrap :: UnsizedRecursionF UnsizedExpr -> UnsizedExpr +pattern UnsizedWrap x = EnhancedExpr (UnsizedFW x) + +data VoidF f + deriving (Functor, Foldable, Traversable) + +data SuperPositionF f + = AnyPF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +data AbortableF f + = AbortF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +newtype SplitFunctor g f x = SplitFunctor { unSplitF :: Either (g x) (f x) } deriving (Eq, Show) + +instance (Functor f, Functor g) => Functor (SplitFunctor g f) where + +instance (Foldable f, Foldable g) => Foldable (SplitFunctor g f) where + +instance (Traversable f, Traversable g) => Traversable (SplitFunctor g f) where + +type SuperExpr f = EnhancedExpr (SplitFunctor f SuperPositionF) + +type AbortExpr f = SuperExpr (SplitFunctor f AbortableF) + +type BreakExtras = () + +data UnsizedRecursionF f + = UnsizedRecursionF BreakExtras f + | UnsizedBarrierF f + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +type UnsizedExpr = AbortExpr UnsizedRecursionF + +cata :: Recursive t => (Base t a -> a) -> t -> a +cata = undefined + +sizeTerm :: UnsizedExpr -> Maybe (AbortExpr VoidF) +sizeTerm term = + let sizingTerm = eval term + eval :: UnsizedExpr -> UnsizedExpr + eval = undefined + setSizes sizes = cata $ \case + UnsizedFW (UnsizedRecursionF be env) -> BasicExpr ZeroSF + clean = undefined + hoist = undefined + maybeSized = pure sizingTerm + in hoist clean <$> maybeSized + + ===================================== testsuite/tests/typecheck/should_fail/T21583.stderr ===================================== @@ -0,0 +1,22 @@ +T21583.hs:14:23: error: [-Wstar-is-type (in -Wall, -Wcompat), -Werror=star-is-type] + Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’ + relies on the StarIsType extension, which will become + deprecated in the future. + Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead. +T21583.hs:14:28: error: [-Wstar-is-type (in -Wall, -Wcompat), -Werror=star-is-type] + Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’ + relies on the StarIsType extension, which will become + deprecated in the future. + Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead. +T21583.hs:56:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘fmap’ + • In the instance declaration for ‘Functor (SplitFunctor g f)’ +T21583.hs:58:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘foldMap’ or ‘foldr’ + • In the instance declaration for ‘Foldable (SplitFunctor g f)’ +T21583.hs:60:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘traverse’ or ‘sequenceA’ + • In the instance declaration for ‘Traversable (SplitFunctor g f)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -657,3 +657,4 @@ test('T20768_fail', normal, compile_fail, ['']) test('T21327', normal, compile_fail, ['']) test('T21338', normal, compile_fail, ['']) test('T21158', normal, compile_fail, ['']) +test('T21583', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/714c936fa31d83cb46b52d1dd920081474793a71 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/714c936fa31d83cb46b52d1dd920081474793a71 You're receiving 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 Aug 18 22:38:14 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 18:38:14 -0400 Subject: [Git][ghc/ghc][master] compiler: Drop --build-id=none hack Message-ID: <62febf562a1ae_125b2b48800992a4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 10 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_prog_ld_build_id.m4 - mk/config.mk.in - rts/include/ghc.mk Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -1184,17 +1184,10 @@ joinObjectFiles hsc_env o_files output_fn let toolSettings' = toolSettings dflags ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) ( - map GHC.SysTools.Option ld_build_id - ++ [ GHC.SysTools.Option "-o", + [ GHC.SysTools.Option "-o", GHC.SysTools.FileOption "" output_fn ] ++ args) - -- suppress the generation of the .note.gnu.build-id section, - -- which we don't need and sometimes causes ld to emit a - -- warning: - ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"] - | otherwise = [] - if ldIsGnuLd then do script <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "ldscript" ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -81,7 +81,6 @@ module GHC.Driver.Session ( sTopDir, sGlobalPackageDatabasePath, sLdSupportsCompactUnwind, - sLdSupportsBuildId, sLdSupportsFilelist, sLdIsGnuLd, sGccSupportsNoPie, ===================================== compiler/GHC/Settings.hs ===================================== @@ -18,7 +18,6 @@ module GHC.Settings , sTopDir , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind - , sLdSupportsBuildId , sLdSupportsFilelist , sLdIsGnuLd , sGccSupportsNoPie @@ -87,7 +86,6 @@ data Settings = Settings -- platform-specific and platform-agnostic. data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool - , toolSettings_ldSupportsBuildId :: Bool , toolSettings_ldSupportsFilelist :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool @@ -189,8 +187,6 @@ sGlobalPackageDatabasePath = fileSettings_globalPackageDatabase . sFileSettings sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings -sLdSupportsBuildId :: Settings -> Bool -sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings sLdIsGnuLd :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -94,7 +94,6 @@ initSettings top_dir = do cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" - ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -163,7 +162,6 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind - , toolSettings_ldSupportsBuildId = ldSupportsBuildId , toolSettings_ldSupportsFilelist = ldSupportsFilelist , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie ===================================== hadrian/bindist/Makefile ===================================== @@ -91,7 +91,6 @@ lib/settings : @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -136,7 +136,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ -ld-has-build-id = @LdHasBuildId@ ld-has-filelist = @LdHasFilelist@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -311,7 +311,6 @@ generateSettings = do , ("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 build-id", expr $ lookupSystemConfig "ld-has-build-id") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) ===================================== m4/fp_prog_ld_build_id.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_PROG_LD_BUILD_ID -# ------------ -# Sets the output variable LdHasBuildId to YES if ld supports -# --build-id, or NO otherwise. -AC_DEFUN([FP_PROG_LD_BUILD_ID], -[ -AC_CACHE_CHECK([whether ld understands --build-id], [fp_cv_ld_build_id], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if ${LdCmd} -r --build-id=none -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_ld_build_id=yes -else - fp_cv_ld_build_id=no -fi -rm -rf conftest*]) -FP_CAPITALIZE_YES_NO(["$fp_cv_ld_build_id"], [LdHasBuildId]) -AC_SUBST([LdHasBuildId]) -])# FP_PROG_LD_BUILD_ID - - ===================================== mk/config.mk.in ===================================== @@ -724,10 +724,6 @@ OPT = @OptCmd@ # overflowing command-line length limits. LdIsGNULd = @LdIsGNULd@ -# Set to YES if ld has the --build-id flag. Sometimes we need to -# disable it with --build-id=none. -LdHasBuildId = @LdHasBuildId@ - # Set to YES if ld has the --no_compact_unwind flag. See #5019 # and GHC.Driver.Pipeline. LdHasNoCompactUnwind = @LdHasNoCompactUnwind@ ===================================== rts/include/ghc.mk ===================================== @@ -202,7 +202,6 @@ $(includes_SETTINGS) : rts/include/Makefile | $$(dir $$@)/. @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/989b844d7598fd71ffd76e00d8d1f5207d58fd61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/989b844d7598fd71ffd76e00d8d1f5207d58fd61 You're receiving 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 Aug 18 23:09:09 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 19:09:09 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: testsuite: Add test for #21583 Message-ID: <62fec69597b94_125b2b4e4bc102740@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 55e7c11b by Matthew Pickering at 2022-08-18T19:08:45-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 6c555da7 by Matthew Pickering at 2022-08-18T19:08:45-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 2797960e by Matthew Pickering at 2022-08-18T19:08:45-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 666ef374 by Matthew Pickering at 2022-08-18T19:08:46-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 021b1184 by Matthew Pickering at 2022-08-18T19:08:47-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 20 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Haddock.hs - − m4/fp_prog_ld_build_id.m4 - mk/config.mk.in - rts/include/ghc.mk - + testsuite/tests/typecheck/should_fail/T21583.hs - + testsuite/tests/typecheck/should_fail/T21583.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1151,7 +1151,7 @@ data CoreRule -- Rough-matching stuff -- see comments with InstEnv.ClsInst( is_cls, is_rough ) - ru_fn :: Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule + ru_fn :: !Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side -- Proper-matching stuff ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -634,7 +634,8 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) floats' = floats `extendFloats` NonRec bndr' triv_rhs ; return ( floats', setInScopeFromF env floats' ) } } where - occ_fs = getOccFS bndr + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr uf_opts = seUnfoldingOpts env work_ty = coercionLKind co info = idInfo bndr @@ -711,9 +712,11 @@ prepareBinding env top_lvl is_rec strict_bind bndr rhs_floats rhs -- rhs_env: add to in-scope set the binders from rhs_floats -- so that prepareRhs knows what is in scope in rhs ; let rhs_env = env `setInScopeFromF` rhs_floats1 + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr -- Now ANF-ise the remaining rhs - ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl (getOccFS bndr) rhs1 + ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl occ_fs rhs1 -- Finally, decide whether or not to float ; let all_floats = rhs_floats1 `addLetFloats` anf_floats @@ -4294,7 +4297,8 @@ simplRules env mb_new_id rules bind_cxt lhs_env = updMode updModeForRules env' rhs_env = updMode (updModeForStableUnfoldings act) env' -- See Note [Simplifying the RHS of a RULE] - fn_name' = case mb_new_id of + -- Force this to avoid retaining reference to old Id + !fn_name' = case mb_new_id of Just id -> idName id Nothing -> fn_name ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,6 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) -import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) {- @@ -375,14 +374,11 @@ The recursive call ends up looking like So we want to spot the constructor application inside the cast. That's why we have the Cast case in argToPat -Note [Seeding recursive groups] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For a recursive group that is either - * nested, or - * top-level, but with no exported Ids -we can see all the calls to the function, so we seed the specialisation -loop from the calls in the body, and /not/ from the calls in the RHS. -Consider: +Note [Local recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a *local* recursive group, we can see all the calls to the +function, so we seed the specialisation loop from the calls in the +body, not from the calls in the RHS. Consider: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -405,42 +401,52 @@ a local function. In a case like the above we end up never calling the original un-specialised function. (Although we still leave its code around just in case.) -Wrinkles - -* Boring calls. If we find any boring calls in the body, including - *unsaturated* ones, such as +However, if we find any boring calls in the body, including *unsaturated* +ones, such as letrec foo x y = ....foo... in map foo xs - then we will end up calling the un-specialised function, so then we - *should* use the calls in the un-specialised RHS as seeds. We call - these "boring call patterns", and callsToNewPats reports if it finds - any of these. Then 'specialise' unleashes the usage info from the - un-specialised RHS. - -* Exported Ids. `specialise` /also/ unleashes `si_mb_unspec` - for exported Ids. That way we are sure to generate usage info from - the /un-specialised/ RHS of an exported function. - -More precisely: - -* Always start from the calls in the body of the let or (for top level) - calls in the rest of the module. See the body_calls in the call to - `specialise` in `specNonRec`, and to `go` in `specRec`. - -* si_mb_unspec holds the usage from the unspecialised RHS. - See `initSpecInfo`. - -* `specialise` will unleash si_mb_unspec, if - - `callsToNewPats` reports "boring calls found", or - - this is a top-level exported Id. - -Historical note. At an earlier point, if a top-level Id was exported, -we used only seeds from the RHS, and /not/from the body. But Dimitrios -had an example where using call patterns from the body (the other defns -in the module) was crucial. And doing so improved nofib allocation results: - multiplier: 4% better - minimax: 2.8% better -In any case, it is easier to do! +then we will end up calling the un-specialised function, so then we *should* +use the calls in the un-specialised RHS as seeds. We call these +"boring call patterns", and callsToPats reports if it finds any of these. + +Note [Seeding top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This seeding is done in the binding for seed_calls in specRec. + +1. If all the bindings in a top-level recursive group are local (not + exported), then all the calls are in the rest of the top-level + bindings. This means we can specialise with those call patterns + ONLY, and NOT with the RHSs of the recursive group (exactly like + Note [Local recursive groups]) + +2. But if any of the bindings are exported, the function may be called + with any old arguments, so (for lack of anything better) we specialise + based on + (a) the call patterns in the RHS + (b) the call patterns in the rest of the top-level bindings + NB: before Apr 15 we used (a) only, but Dimitrios had an example + where (b) was crucial, so I added that. + Adding (b) also improved nofib allocation results: + multiplier: 4% better + minimax: 2.8% better + +Actually in case (2), instead of using the calls from the RHS, it +would be better to specialise in the importing module. We'd need to +add an INLINABLE pragma to the function, and then it can be +specialised in the importing scope, just as is done for type classes +in GHC.Core.Opt.Specialise.specImports. This remains to be done (#10346). + +Note [Top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To get the call usage information from "the rest of the top level +bindings" (c.f. Note [Seeding top-level recursive groups]), we work +backwards through the top-level bindings so we see the usage before we +get to the binding of the function. Before we can collect the usage +though, we go through all the bindings and add them to the +environment. This is necessary because usage is only tracked for +functions in the environment. These two passes are called + 'go' and 'goEnv' +in specConstrProgram. (Looks a bit revolting to me.) Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -758,18 +764,35 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = do { env0 <- initScEnv guts - ; us <- getUniqueSupplyM - ; let (_usg, binds') = initUs_ us $ - scTopBinds env0 (mg_binds guts) - - ; return (guts { mg_binds = binds' }) } - -scTopBinds :: ScEnv -> [InBind] -> UniqSM (ScUsage, [OutBind]) -scTopBinds _env [] = return (nullUsage, []) -scTopBinds env (b:bs) = do { (usg, b', bs') <- scBind TopLevel env b $ - (\env -> scTopBinds env bs) - ; return (usg, b' ++ bs') } + = do + dflags <- getDynFlags + us <- getUniqueSupplyM + (_, annos) <- getFirstAnnotations deserializeWithData guts + this_mod <- getModule + -- pprTraceM "specConstrInput" (ppr $ mg_binds guts) + let binds' = reverse $ fst $ initUs us $ do + -- Note [Top-level recursive groups] + (env, binds) <- goEnv (initScEnv (initScOpts dflags this_mod) annos) + (mg_binds guts) + -- binds is identical to (mg_binds guts), except that the + -- binders on the LHS have been replaced by extendBndr + -- (SPJ this seems like overkill; I don't think the binders + -- will change at all; and we don't substitute in the RHSs anyway!!) + go env nullUsage (reverse binds) + + return (guts { mg_binds = binds' }) + where + -- See Note [Top-level recursive groups] + goEnv env [] = return (env, []) + goEnv env (bind:binds) = do (env', bind') <- scTopBindEnv env bind + (env'', binds') <- goEnv env' binds + return (env'', bind' : binds') + + -- Arg list of bindings is in reverse order + go _ _ [] = return [] + go env usg (bind:binds) = do (usg', bind') <- scTopBind env usg bind + binds' <- go env usg' binds + return (bind' : binds') {- ************************************************************************ @@ -933,24 +956,14 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -initScEnv :: ModGuts -> CoreM ScEnv -initScEnv guts - = do { dflags <- getDynFlags - ; (_, anns) <- getFirstAnnotations deserializeWithData guts - ; this_mod <- getModule - ; return (SCE { sc_opts = initScOpts dflags this_mod, - sc_force = False, - sc_subst = init_subst, - sc_how_bound = emptyVarEnv, - sc_vals = emptyVarEnv, - sc_annotations = anns }) } - where - init_subst = mkEmptySubst $ mkInScopeSet $ mkVarSet $ - bindersOfBinds (mg_binds guts) - -- Acccount for top-level bindings that are not in dependency order; - -- see Note [Glomming] in GHC.Core.Opt.OccurAnal - -- Easiest thing is to bring all the top level binders into scope at once, - -- as if at once, as if all the top-level decls were mutually recursive. +initScEnv :: SpecConstrOpts -> UniqFM Name SpecConstrAnnotation -> ScEnv +initScEnv opts anns + = SCE { sc_opts = opts, + sc_force = False, + sc_subst = emptySubst, + sc_how_bound = emptyVarEnv, + sc_vals = emptyVarEnv, + sc_annotations = anns } data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -1174,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -- Domain is OutIds -data Call = Call OutId [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] +data Call = Call Id [CoreArg] ValueEnv -- The arguments of the call, together with the -- env giving the constructor bindings at the call site -- We keep the function mainly for debug output @@ -1197,9 +1210,6 @@ nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv } combineCalls :: CallEnv -> CallEnv -> CallEnv combineCalls = plusVarEnv_C (++) -delCallsFor :: ScUsage -> [Var] -> ScUsage -delCallsFor env bndrs = env { scu_calls = scu_calls env `delVarEnvList` bndrs } - combineUsage :: ScUsage -> ScUsage -> ScUsage combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2), scu_occs = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) } @@ -1282,121 +1292,6 @@ The main recursive function gathers up usage information, and creates specialised versions of functions. -} -scBind :: TopLevelFlag -> ScEnv -> InBind - -> (ScEnv -> UniqSM (ScUsage, a)) -- Specialise the scope of the binding - -> UniqSM (ScUsage, [OutBind], a) -scBind top_lvl env (NonRec bndr rhs) do_body - | isTyVar bndr -- Type-lets may be created by doBeta - = do { (final_usage, body') <- do_body (extendScSubst env bndr rhs) - ; return (final_usage, [], body') } - - | not (isTopLevel top_lvl) -- Nested non-recursive value binding - -- See Note [Specialising local let bindings] - = do { let (body_env, bndr') = extendBndr env bndr - -- Not necessary at top level; but here we are nested - - ; rhs_info <- scRecRhs env (bndr',rhs) - - ; let body_env2 = extendHowBound body_env [bndr'] RecFun - rhs' = ri_new_rhs rhs_info - body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') - - ; (body_usg, body') <- do_body body_env3 - - -- Now make specialised copies of the binding, - -- based on calls in body_usg - ; (spec_usg, specs) <- specNonRec env (scu_calls body_usg) rhs_info - -- NB: For non-recursive bindings we inherit sc_force flag from - -- the parent function (see Note [Forcing specialisation]) - - -- Specialized + original binding - ; let spec_bnds = [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] - bind_usage = (body_usg `delCallsFor` [bndr']) - `combineUsage` spec_usg -- Note [spec_usg includes rhs_usg] - - ; return (bind_usage, spec_bnds, body') - } - - | otherwise -- Top-level, non-recursive value binding - -- At top level we do not specialise non-recursive bindings; that - -- is, we do not call specNonRec, passing the calls from the body. - -- The original paper only specialised /recursive/ bindings, but - -- we later started specialising nested non-recursive bindings: - -- see Note [Specialising local let bindings] - -- - -- I tried always specialising non-recursive top-level bindings too, - -- but found some regressions (see !8135). So I backed off. - = do { (rhs_usage, rhs') <- scExpr env rhs - - -- At top level, we've already put all binders into scope; see initScEnv - -- Hence no need to call `extendBndr`. But we still want to - -- extend the `ValueEnv` to record the value of this binder. - ; let body_env = extendValEnv env bndr (isValue (sc_vals env) rhs') - ; (body_usage, body') <- do_body body_env - - ; return (rhs_usage `combineUsage` body_usage, [NonRec bndr rhs'], body') } - -scBind top_lvl env (Rec prs) do_body - | isTopLevel top_lvl - , Just threshold <- sc_size (sc_opts env) - , not force_spec - , not (all (couldBeSmallEnoughToInline (sc_uf_opts (sc_opts env)) threshold) rhss) - = -- Do no specialisation if the RHSs are too big - -- ToDo: I'm honestly not sure of the rationale of this size-testing, nor - -- why it only applies at top level. But that's the way it has been - -- for a while. See #21456. - do { (body_usg, body') <- do_body rhs_env2 - ; (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss - ; let all_usg = (combineUsages rhs_usgs `combineUsage` body_usg) - `delCallsFor` bndrs' - bind' = Rec (bndrs' `zip` rhss') - ; return (all_usg, [bind'], body') } - - | otherwise - = do { rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) - ; (body_usg, body') <- do_body rhs_env2 - - ; (spec_usg, specs) <- specRec (scForce rhs_env2 force_spec) - (scu_calls body_usg) rhs_infos - -- Do not unconditionally generate specialisations from rhs_usgs - -- Instead use them only if we find an unspecialised call - -- See Note [Seeding recursive groups] - - ; let all_usg = (spec_usg `combineUsage` body_usg) -- Note [spec_usg includes rhs_usg] - `delCallsFor` bndrs' - bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) - -- zipWithEqual: length of returned [SpecInfo] - -- should be the same as incoming [RhsInfo] - - ; return (all_usg, [bind'], body') } - where - (bndrs,rhss) = unzip prs - force_spec = any (forceSpecBndr env) bndrs -- Note [Forcing specialisation] - - (rhs_env1,bndrs') | isTopLevel top_lvl = (env, bndrs) - | otherwise = extendRecBndrs env bndrs - -- At top level, we've already put all binders into scope; see initScEnv - - rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun - -{- Note [Specialising local let bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is not uncommon to find this - - let $j = \x. in ...$j True...$j True... - -Here $j is an arbitrary let-bound function, but it often comes up for -join points. We might like to specialise $j for its call patterns. -Notice the difference from a letrec, where we look for call patterns -in the *RHS* of the function. Here we look for call patterns in the -*body* of the let. - -At one point I predicated this on the RHS mentioning the outer -recursive function, but that's not essential and might even be -harmful. I'm not sure. --} - ------------------------- scExpr, scExpr' :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr) -- The unique supply is needed when we invent -- a new name for the specialised function and its args @@ -1421,11 +1316,6 @@ scExpr' env (Lam b e) = do let (env', b') = extendBndr env b (usg, e') <- scExpr env' e return (usg, Lam b' e') -scExpr' env (Let bind body) - = do { (final_usage, binds', body') <- scBind NotTopLevel env bind $ - (\env -> scExpr env body) - ; return (final_usage, mkLets binds' body') } - scExpr' env (Case scrut b ty alts) = do { (scrut_usg, scrut') <- scExpr env scrut ; case isValue (sc_vals env) scrut' of @@ -1465,7 +1355,79 @@ scExpr' env (Case scrut b ty alts) _ -> evalScrutOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } +scExpr' env (Let (NonRec bndr rhs) body) + | isTyVar bndr -- Type-lets may be created by doBeta + = scExpr' (extendScSubst env bndr rhs) body + + | otherwise + = do { let (body_env, bndr') = extendBndr env bndr + ; rhs_info <- scRecRhs env (bndr',rhs) + + ; let body_env2 = extendHowBound body_env [bndr'] RecFun + -- See Note [Local let bindings] + rhs' = ri_new_rhs rhs_info + body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') + + ; (body_usg, body') <- scExpr body_env3 body + + -- NB: For non-recursive bindings we inherit sc_force flag from + -- the parent function (see Note [Forcing specialisation]) + ; (spec_usg, specs) <- specNonRec env body_usg rhs_info + + -- Specialized + original binding + ; let spec_bnds = mkLets [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] body' + -- ; pprTraceM "spec_bnds" $ (ppr spec_bnds) + + ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' } + `combineUsage` spec_usg, -- Note [spec_usg includes rhs_usg] + spec_bnds + ) + } + + +-- A *local* recursive group: see Note [Local recursive groups] +scExpr' env (Let (Rec prs) body) + = do { let (bndrs,rhss) = unzip prs + (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun + force_spec = any (forceSpecBndr env) bndrs' + -- Note [Forcing specialisation] + + ; rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) + ; (body_usg, body') <- scExpr rhs_env2 body + + -- NB: start specLoop from body_usg + ; (spec_usg, specs) <- specRec NotTopLevel (scForce rhs_env2 force_spec) + body_usg rhs_infos + -- Do not unconditionally generate specialisations from rhs_usgs + -- Instead use them only if we find an unspecialised call + -- See Note [Local recursive groups] + + ; let all_usg = spec_usg `combineUsage` body_usg -- Note [spec_usg includes rhs_usg] + bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) + -- zipWithEqual: length of returned [SpecInfo] + -- should be the same as incoming [RhsInfo] + + ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' }, + Let bind' body') } + +{- +Note [Local let bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~ +It is not uncommon to find this + + let $j = \x. in ...$j True...$j True... +Here $j is an arbitrary let-bound function, but it often comes up for +join points. We might like to specialise $j for its call patterns. +Notice the difference from a letrec, where we look for call patterns +in the *RHS* of the function. Here we look for call patterns in the +*body* of the let. + +At one point I predicated this on the RHS mentioning the outer +recursive function, but that's not essential and might even be +harmful. I'm not sure. +-} scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) @@ -1520,6 +1482,51 @@ mkVarUsage env fn args arg_occ | null args = UnkOcc | otherwise = evalScrutOcc +---------------------- +scTopBindEnv :: ScEnv -> CoreBind -> UniqSM (ScEnv, CoreBind) +scTopBindEnv env (Rec prs) + = do { let (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs RecFun + + prs' = zip bndrs' rhss + ; return (rhs_env2, Rec prs') } + where + (bndrs,rhss) = unzip prs + +scTopBindEnv env (NonRec bndr rhs) + = do { let (env1, bndr') = extendBndr env bndr + env2 = extendValEnv env1 bndr' (isValue (sc_vals env) rhs) + ; return (env2, NonRec bndr' rhs) } + +---------------------- +scTopBind :: ScEnv -> ScUsage -> CoreBind -> UniqSM (ScUsage, CoreBind) + +scTopBind env body_usage (Rec prs) + | Just threshold <- sc_size $ sc_opts env + , not force_spec + , not (all (couldBeSmallEnoughToInline (sc_uf_opts $ sc_opts env) threshold) rhss) + -- No specialisation + = -- pprTrace "scTopBind: nospec" (ppr bndrs) $ + do { (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss + ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) } + + | otherwise -- Do specialisation + = do { rhs_infos <- mapM (scRecRhs env) prs + + ; (spec_usage, specs) <- specRec TopLevel (scForce env force_spec) + body_usage rhs_infos + + ; return (body_usage `combineUsage` spec_usage, + Rec (concat (zipWith ruleInfoBinds rhs_infos specs))) } + where + (bndrs,rhss) = unzip prs + force_spec = any (forceSpecBndr env) bndrs + -- Note [Forcing specialisation] + +scTopBind env usage (NonRec bndr rhs) -- Oddly, we don't seem to specialise top-level non-rec functions + = do { (rhs_usg', rhs') <- scExpr env rhs + ; return (usage `combineUsage` rhs_usg', NonRec bndr rhs') } + ---------------------- scRecRhs :: ScEnv -> (OutId, InExpr) -> UniqSM RhsInfo scRecRhs env (bndr,rhs) @@ -1567,8 +1574,7 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have - -- generated for this function + = SI { si_specs :: [OneSpec] -- The specialisations we have generated , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1579,7 +1585,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Seeding recursive groups] + -- See Note [Local recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1589,62 +1595,57 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -initSpecInfo :: RhsInfo -> SpecInfo -initSpecInfo (RI { ri_rhs_usg = rhs_usg }) - = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Just rhs_usg } - -- si_mb_unspec: add in rhs_usg if there are any boring calls, - -- or if the bndr is exported +noSpecInfo :: SpecInfo +noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } ---------------------- specNonRec :: ScEnv - -> CallEnv -- Calls in body + -> ScUsage -- Body usage -> RhsInfo -- Structure info usage info for un-specialised RHS -> UniqSM (ScUsage, SpecInfo) -- Usage from RHSs (specialised and not) -- plus details of specialisations -specNonRec env body_calls rhs_info - = specialise env body_calls rhs_info (initSpecInfo rhs_info) +specNonRec env body_usg rhs_info + = specialise env (scu_calls body_usg) rhs_info + (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) ---------------------- -specRec :: ScEnv - -> CallEnv -- Calls in body +specRec :: TopLevelFlag -> ScEnv + -> ScUsage -- Body usage -> [RhsInfo] -- Structure info and usage info for un-specialised RHSs -> UniqSM (ScUsage, [SpecInfo]) -- Usage from all RHSs (specialised and not) -- plus details of specialisations -specRec env body_calls rhs_infos - = go 1 body_calls nullUsage (map initSpecInfo rhs_infos) - -- body_calls: see Note [Seeding recursive groups] - -- NB: 'go' always calls 'specialise' once, which in turn unleashes - -- si_mb_unspec if there are any boring calls in body_calls, - -- or if any of the Id(s) are exported +specRec top_lvl env body_usg rhs_infos + = go 1 seed_calls nullUsage init_spec_infos where opts = sc_opts env + (seed_calls, init_spec_infos) -- Note [Seeding top-level recursive groups] + | isTopLevel top_lvl + , any (isExportedId . ri_fn) rhs_infos -- Seed from body and RHSs + = (all_calls, [noSpecInfo | _ <- rhs_infos]) + | otherwise -- Seed from body only + = (calls_in_body, [noSpecInfo { si_mb_unspec = Just (ri_rhs_usg ri) } + | ri <- rhs_infos]) + + calls_in_body = scu_calls body_usg + calls_in_rhss = foldr (combineCalls . scu_calls . ri_rhs_usg) emptyVarEnv rhs_infos + all_calls = calls_in_rhss `combineCalls` calls_in_body -- Loop, specialising, until you get no new specialisations - go, go_again :: Int -- Which iteration of the "until no new specialisations" - -- loop we are on; first iteration is 1 - -> CallEnv -- Seed calls - -- Two accumulating parameters: - -> ScUsage -- Usage from earlier specialisations - -> [SpecInfo] -- Details of specialisations so far - -> UniqSM (ScUsage, [SpecInfo]) + go :: Int -- Which iteration of the "until no new specialisations" + -- loop we are on; first iteration is 1 + -> CallEnv -- Seed calls + -- Two accumulating parameters: + -> ScUsage -- Usage from earlier specialisations + -> [SpecInfo] -- Details of specialisations so far + -> UniqSM (ScUsage, [SpecInfo]) go n_iter seed_calls usg_so_far spec_infos - = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) - -- , text "iteration" <+> int n_iter - -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) - -- ]) $ - do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos - ; let (extra_usg_s, all_spec_infos) = unzip specs_w_usg - extra_usg = combineUsages extra_usg_s - all_usg = usg_so_far `combineUsage` extra_usg - new_calls = scu_calls extra_usg - ; go_again n_iter new_calls all_usg all_spec_infos } - - -- go_again deals with termination - go_again n_iter seed_calls usg_so_far spec_infos | isEmptyVarEnv seed_calls - = return (usg_so_far, spec_infos) + = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) + -- , ppr seed_calls + -- , ppr body_usg ]) $ + return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1653,20 +1654,26 @@ specRec env body_calls rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- Give up on specialisation, but don't forget to include the rhs_usg - -- for the unspecialised function, since it may now be called - -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - let rhs_usgs = combineUsages (mapMaybe si_mb_unspec spec_infos) - in return (usg_so_far `combineUsage` rhs_usgs, spec_infos) + = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ + return (usg_so_far, spec_infos) | otherwise - = go (n_iter + 1) seed_calls usg_so_far spec_infos + = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) + -- , text "iteration" <+> int n_iter + -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) + -- ]) $ + do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos + ; let (extra_usg_s, new_spec_infos) = unzip specs_w_usg + extra_usg = combineUsages extra_usg_s + all_usg = usg_so_far `combineUsage` extra_usg + ; go (n_iter + 1) (scu_calls extra_usg) all_usg new_spec_infos } -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max + ---------------------- specialise :: ScEnv @@ -1689,12 +1696,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs spec_info@(SI { si_specs = specs, si_n_specs = spec_count , si_mb_unspec = mb_unspec }) | isDeadEndId fn -- Note [Do not specialise diverging functions] - -- /and/ do not generate specialisation seeds from its RHS + -- and do not generate specialisation seeds from its RHS = -- pprTrace "specialise bot" (ppr fn) $ return (nullUsage, spec_info) | not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation] + -- + -- -- Don't specialise OPAQUE things, see Note [OPAQUE pragma]. -- Since OPAQUE things are always never-active (see -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for @@ -1720,16 +1729,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs ; let spec_usg = combineUsages spec_usgs - unspec_rhs_needed = boring_call || isExportedId fn - -- If there were any boring calls among the seeds (= all_calls), then those -- calls will call the un-specialised function. So we should use the seeds -- from the _unspecialised_ function's RHS, which are in mb_unspec, by returning -- then in new_usg. - (new_usg, mb_unspec') = case mb_unspec of - Just rhs_usg | unspec_rhs_needed - -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') + = case mb_unspec of + Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1737,8 +1744,8 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs -- , text "new calls:" <+> ppr (scu_calls new_usg)]) $ -- return () - ; return (new_usg, SI { si_specs = new_specs ++ specs - , si_n_specs = spec_count + n_pats + ; return (new_usg, SI { si_specs = new_specs ++ specs + , si_n_specs = spec_count + n_pats , si_mb_unspec = mb_unspec' }) } | otherwise -- No calls, inactive, or not a function @@ -2020,8 +2027,7 @@ calcSpecInfo fn (CP { cp_qvars = qvars, cp_args = pats }) extra_bndrs Note [spec_usg includes rhs_usg] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In calls to 'specialise', the returned ScUsage must include the rhs_usg in -the passed-in SpecInfo in si_mb_unspec, unless there are no calls at all to -the function. +the passed-in SpecInfo, unless there are no calls at all to the function. The caller can, indeed must, assume this. They should not combine in rhs_usg themselves, or they'll get rhs_usg twice -- and that can lead to an exponential @@ -2239,11 +2245,9 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) --- Result has no duplicate patterns, --- nor ones mentioned in si_specs (hence "new" patterns) --- Bool indicates that there was at least one boring pattern --- The "New" in the name means "patterns that are not already covered --- by an existing specialisation" + -- Result has no duplicate patterns, + -- nor ones mentioned in done_pats + -- Bool indicates that there was at least one boring pattern callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -2153,7 +2153,9 @@ cpCloneBndr env bndr -- Drop (now-useless) rules/unfoldings -- See Note [Drop unfoldings and rules] -- and Note [Preserve evaluatedness] in GHC.Core.Tidy - ; let unfolding' = trimUnfolding (realIdUnfolding bndr) + -- And force it.. otherwise the old unfolding is just retained. + -- See #22071 + ; let !unfolding' = trimUnfolding (realIdUnfolding bndr) -- Simplifier will set the Id's unfolding bndr'' = bndr' `setIdUnfolding` unfolding' ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -1184,17 +1184,10 @@ joinObjectFiles hsc_env o_files output_fn let toolSettings' = toolSettings dflags ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) ( - map GHC.SysTools.Option ld_build_id - ++ [ GHC.SysTools.Option "-o", + [ GHC.SysTools.Option "-o", GHC.SysTools.FileOption "" output_fn ] ++ args) - -- suppress the generation of the .note.gnu.build-id section, - -- which we don't need and sometimes causes ld to emit a - -- warning: - ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"] - | otherwise = [] - if ldIsGnuLd then do script <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "ldscript" ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -81,7 +81,6 @@ module GHC.Driver.Session ( sTopDir, sGlobalPackageDatabasePath, sLdSupportsCompactUnwind, - sLdSupportsBuildId, sLdSupportsFilelist, sLdIsGnuLd, sGccSupportsNoPie, ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1292,12 +1292,14 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf --------- Unfolding ------------ unf_info = realUnfoldingInfo idinfo - unfold_info + -- Force this, otherwise the old unfolding is retained over code generation + -- See #22071 + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs | otherwise = minimal_unfold_info - minimal_unfold_info = trimUnfolding unf_info + !minimal_unfold_info = trimUnfolding unf_info unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or ===================================== compiler/GHC/Settings.hs ===================================== @@ -18,7 +18,6 @@ module GHC.Settings , sTopDir , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind - , sLdSupportsBuildId , sLdSupportsFilelist , sLdIsGnuLd , sGccSupportsNoPie @@ -87,7 +86,6 @@ data Settings = Settings -- platform-specific and platform-agnostic. data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool - , toolSettings_ldSupportsBuildId :: Bool , toolSettings_ldSupportsFilelist :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool @@ -189,8 +187,6 @@ sGlobalPackageDatabasePath = fileSettings_globalPackageDatabase . sFileSettings sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings -sLdSupportsBuildId :: Settings -> Bool -sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings sLdIsGnuLd :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -94,7 +94,6 @@ initSettings top_dir = do cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" - ldSupportsBuildId <- getBooleanSetting "ld supports build-id" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -163,7 +162,6 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind - , toolSettings_ldSupportsBuildId = ldSupportsBuildId , toolSettings_ldSupportsFilelist = ldSupportsFilelist , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie ===================================== hadrian/bindist/Makefile ===================================== @@ -91,7 +91,6 @@ lib/settings : @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -136,7 +136,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ -ld-has-build-id = @LdHasBuildId@ ld-has-filelist = @LdHasFilelist@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -249,7 +249,7 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ haddocks + need $ srcs ++ (map snd haddocks) -- Build Haddock documentation -- TODO: Pass the correct way from Rules via Context. @@ -364,8 +364,8 @@ buildManPage = do copyFileUntracked (dir -/- "ghc.1") file -- | Find the Haddock files for the dependencies of the current library. -haddockDependencies :: Context -> Action [FilePath] +haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do depNames <- interpretInContext context (getContextData depNames) - sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg + sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext Stage1 depPkg) | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -311,7 +311,6 @@ generateSettings = do , ("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 build-id", expr $ lookupSystemConfig "ld-has-build-id") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -43,9 +43,8 @@ haddockBuilderArgs = mconcat context <- getContext version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg - trans_deps <- expr $ contextDependencies context - pkgs <- expr $ mapM (pkgIdentifier . C.package) $ trans_deps haddocks <- expr $ haddockDependencies context + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) @@ -69,7 +68,7 @@ haddockBuilderArgs = mconcat , map ("--hide=" ++) <$> getContextData otherModules , pure [ "--read-interface=../" ++ p ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME}," - ++ haddock | (p, haddock) <- zip pkgs haddocks ] + ++ haddock | (p, haddock) <- haddocks_with_versions ] , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] , getInputs , arg "+RTS" ===================================== m4/fp_prog_ld_build_id.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_PROG_LD_BUILD_ID -# ------------ -# Sets the output variable LdHasBuildId to YES if ld supports -# --build-id, or NO otherwise. -AC_DEFUN([FP_PROG_LD_BUILD_ID], -[ -AC_CACHE_CHECK([whether ld understands --build-id], [fp_cv_ld_build_id], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if ${LdCmd} -r --build-id=none -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_ld_build_id=yes -else - fp_cv_ld_build_id=no -fi -rm -rf conftest*]) -FP_CAPITALIZE_YES_NO(["$fp_cv_ld_build_id"], [LdHasBuildId]) -AC_SUBST([LdHasBuildId]) -])# FP_PROG_LD_BUILD_ID - - ===================================== mk/config.mk.in ===================================== @@ -724,10 +724,6 @@ OPT = @OptCmd@ # overflowing command-line length limits. LdIsGNULd = @LdIsGNULd@ -# Set to YES if ld has the --build-id flag. Sometimes we need to -# disable it with --build-id=none. -LdHasBuildId = @LdHasBuildId@ - # Set to YES if ld has the --no_compact_unwind flag. See #5019 # and GHC.Driver.Pipeline. LdHasNoCompactUnwind = @LdHasNoCompactUnwind@ ===================================== rts/include/ghc.mk ===================================== @@ -202,7 +202,6 @@ $(includes_SETTINGS) : rts/include/Makefile | $$(dir $$@)/. @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports build-id", "$(LdHasBuildId)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ ===================================== testsuite/tests/typecheck/should_fail/T21583.hs ===================================== @@ -0,0 +1,90 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE FlexibleContexts #-} +module Telomare.Possible where + +data PartExprF f + = ZeroSF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +newtype EnhancedExpr f = EnhancedExpr {unEnhanceExpr :: SplitFunctor f PartExprF (EnhancedExpr f)} -- deriving (Eq, Show) + +type family Base t :: * -> * + +type instance Base (EnhancedExpr f) = SplitFunctor f PartExprF + +class Functor (Base t) => Recursive t where + project :: t -> Base t t + +instance Functor f => Recursive (EnhancedExpr f) where + project = unEnhanceExpr + +class Functor (Base t) => Corecursive t where + embed :: Base t t -> t + +instance Functor f => Corecursive (EnhancedExpr f) where + embed = EnhancedExpr + +type SimpleExpr = EnhancedExpr VoidF +type BasicBase f = SplitFunctor f PartExprF +type SuperBase f = BasicBase (SplitFunctor f SuperPositionF) +type AbortBase f = SuperBase (SplitFunctor f AbortableF) +type UnsizedBase = AbortBase UnsizedRecursionF + +pattern UnsizedFW :: UnsizedRecursionF a -> UnsizedBase a +pattern UnsizedFW x = SplitFunctor (Left (SplitFunctor (Left (SplitFunctor (Left x))))) +pattern BasicExpr :: PartExprF (EnhancedExpr f) -> EnhancedExpr f +pattern BasicExpr x = EnhancedExpr (SplitFunctor (Right x)) +pattern UnsizedWrap :: UnsizedRecursionF UnsizedExpr -> UnsizedExpr +pattern UnsizedWrap x = EnhancedExpr (UnsizedFW x) + +data VoidF f + deriving (Functor, Foldable, Traversable) + +data SuperPositionF f + = AnyPF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +data AbortableF f + = AbortF + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +newtype SplitFunctor g f x = SplitFunctor { unSplitF :: Either (g x) (f x) } deriving (Eq, Show) + +instance (Functor f, Functor g) => Functor (SplitFunctor g f) where + +instance (Foldable f, Foldable g) => Foldable (SplitFunctor g f) where + +instance (Traversable f, Traversable g) => Traversable (SplitFunctor g f) where + +type SuperExpr f = EnhancedExpr (SplitFunctor f SuperPositionF) + +type AbortExpr f = SuperExpr (SplitFunctor f AbortableF) + +type BreakExtras = () + +data UnsizedRecursionF f + = UnsizedRecursionF BreakExtras f + | UnsizedBarrierF f + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +type UnsizedExpr = AbortExpr UnsizedRecursionF + +cata :: Recursive t => (Base t a -> a) -> t -> a +cata = undefined + +sizeTerm :: UnsizedExpr -> Maybe (AbortExpr VoidF) +sizeTerm term = + let sizingTerm = eval term + eval :: UnsizedExpr -> UnsizedExpr + eval = undefined + setSizes sizes = cata $ \case + UnsizedFW (UnsizedRecursionF be env) -> BasicExpr ZeroSF + clean = undefined + hoist = undefined + maybeSized = pure sizingTerm + in hoist clean <$> maybeSized + + ===================================== testsuite/tests/typecheck/should_fail/T21583.stderr ===================================== @@ -0,0 +1,22 @@ +T21583.hs:14:23: error: [-Wstar-is-type (in -Wall, -Wcompat), -Werror=star-is-type] + Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’ + relies on the StarIsType extension, which will become + deprecated in the future. + Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead. +T21583.hs:14:28: error: [-Wstar-is-type (in -Wall, -Wcompat), -Werror=star-is-type] + Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’ + relies on the StarIsType extension, which will become + deprecated in the future. + Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead. +T21583.hs:56:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘fmap’ + • In the instance declaration for ‘Functor (SplitFunctor g f)’ +T21583.hs:58:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘foldMap’ or ‘foldr’ + • In the instance declaration for ‘Foldable (SplitFunctor g f)’ +T21583.hs:60:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + either ‘traverse’ or ‘sequenceA’ + • In the instance declaration for ‘Traversable (SplitFunctor g f)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -657,3 +657,4 @@ test('T20768_fail', normal, compile_fail, ['']) test('T21327', normal, compile_fail, ['']) test('T21338', normal, compile_fail, ['']) test('T21158', normal, compile_fail, ['']) +test('T21583', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd7a14e5cb04e9a65e212f56f62896adeb95dde7...021b1184857c8e68cc38d2d11ece0a6addf41b94 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd7a14e5cb04e9a65e212f56f62896adeb95dde7...021b1184857c8e68cc38d2d11ece0a6addf41b94 You're receiving 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 Aug 19 01:39:26 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 Aug 2022 21:39:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Make ru_fn field strict to avoid retaining Ids Message-ID: <62fee9cee7dcf_125b2b487ec11789e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8dc5087b by Matthew Pickering at 2022-08-18T21:39:05-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - a0501f81 by Matthew Pickering at 2022-08-18T21:39:05-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 6aab5846 by Matthew Pickering at 2022-08-18T21:39:05-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - ad054b6e by Matthew Pickering at 2022-08-18T21:39:05-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 805462db by Matthew Pickering at 2022-08-18T21:39:07-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 7 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Tidy.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1151,7 +1151,7 @@ data CoreRule -- Rough-matching stuff -- see comments with InstEnv.ClsInst( is_cls, is_rough ) - ru_fn :: Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule + ru_fn :: !Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side -- Proper-matching stuff ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -634,7 +634,8 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) floats' = floats `extendFloats` NonRec bndr' triv_rhs ; return ( floats', setInScopeFromF env floats' ) } } where - occ_fs = getOccFS bndr + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr uf_opts = seUnfoldingOpts env work_ty = coercionLKind co info = idInfo bndr @@ -711,9 +712,11 @@ prepareBinding env top_lvl is_rec strict_bind bndr rhs_floats rhs -- rhs_env: add to in-scope set the binders from rhs_floats -- so that prepareRhs knows what is in scope in rhs ; let rhs_env = env `setInScopeFromF` rhs_floats1 + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr -- Now ANF-ise the remaining rhs - ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl (getOccFS bndr) rhs1 + ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl occ_fs rhs1 -- Finally, decide whether or not to float ; let all_floats = rhs_floats1 `addLetFloats` anf_floats @@ -4294,7 +4297,8 @@ simplRules env mb_new_id rules bind_cxt lhs_env = updMode updModeForRules env' rhs_env = updMode (updModeForStableUnfoldings act) env' -- See Note [Simplifying the RHS of a RULE] - fn_name' = case mb_new_id of + -- Force this to avoid retaining reference to old Id + !fn_name' = case mb_new_id of Just id -> idName id Nothing -> fn_name ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,6 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) -import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) {- @@ -375,14 +374,11 @@ The recursive call ends up looking like So we want to spot the constructor application inside the cast. That's why we have the Cast case in argToPat -Note [Seeding recursive groups] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For a recursive group that is either - * nested, or - * top-level, but with no exported Ids -we can see all the calls to the function, so we seed the specialisation -loop from the calls in the body, and /not/ from the calls in the RHS. -Consider: +Note [Local recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a *local* recursive group, we can see all the calls to the +function, so we seed the specialisation loop from the calls in the +body, not from the calls in the RHS. Consider: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -405,42 +401,52 @@ a local function. In a case like the above we end up never calling the original un-specialised function. (Although we still leave its code around just in case.) -Wrinkles - -* Boring calls. If we find any boring calls in the body, including - *unsaturated* ones, such as +However, if we find any boring calls in the body, including *unsaturated* +ones, such as letrec foo x y = ....foo... in map foo xs - then we will end up calling the un-specialised function, so then we - *should* use the calls in the un-specialised RHS as seeds. We call - these "boring call patterns", and callsToNewPats reports if it finds - any of these. Then 'specialise' unleashes the usage info from the - un-specialised RHS. - -* Exported Ids. `specialise` /also/ unleashes `si_mb_unspec` - for exported Ids. That way we are sure to generate usage info from - the /un-specialised/ RHS of an exported function. - -More precisely: - -* Always start from the calls in the body of the let or (for top level) - calls in the rest of the module. See the body_calls in the call to - `specialise` in `specNonRec`, and to `go` in `specRec`. - -* si_mb_unspec holds the usage from the unspecialised RHS. - See `initSpecInfo`. - -* `specialise` will unleash si_mb_unspec, if - - `callsToNewPats` reports "boring calls found", or - - this is a top-level exported Id. - -Historical note. At an earlier point, if a top-level Id was exported, -we used only seeds from the RHS, and /not/from the body. But Dimitrios -had an example where using call patterns from the body (the other defns -in the module) was crucial. And doing so improved nofib allocation results: - multiplier: 4% better - minimax: 2.8% better -In any case, it is easier to do! +then we will end up calling the un-specialised function, so then we *should* +use the calls in the un-specialised RHS as seeds. We call these +"boring call patterns", and callsToPats reports if it finds any of these. + +Note [Seeding top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This seeding is done in the binding for seed_calls in specRec. + +1. If all the bindings in a top-level recursive group are local (not + exported), then all the calls are in the rest of the top-level + bindings. This means we can specialise with those call patterns + ONLY, and NOT with the RHSs of the recursive group (exactly like + Note [Local recursive groups]) + +2. But if any of the bindings are exported, the function may be called + with any old arguments, so (for lack of anything better) we specialise + based on + (a) the call patterns in the RHS + (b) the call patterns in the rest of the top-level bindings + NB: before Apr 15 we used (a) only, but Dimitrios had an example + where (b) was crucial, so I added that. + Adding (b) also improved nofib allocation results: + multiplier: 4% better + minimax: 2.8% better + +Actually in case (2), instead of using the calls from the RHS, it +would be better to specialise in the importing module. We'd need to +add an INLINABLE pragma to the function, and then it can be +specialised in the importing scope, just as is done for type classes +in GHC.Core.Opt.Specialise.specImports. This remains to be done (#10346). + +Note [Top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To get the call usage information from "the rest of the top level +bindings" (c.f. Note [Seeding top-level recursive groups]), we work +backwards through the top-level bindings so we see the usage before we +get to the binding of the function. Before we can collect the usage +though, we go through all the bindings and add them to the +environment. This is necessary because usage is only tracked for +functions in the environment. These two passes are called + 'go' and 'goEnv' +in specConstrProgram. (Looks a bit revolting to me.) Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -758,18 +764,35 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = do { env0 <- initScEnv guts - ; us <- getUniqueSupplyM - ; let (_usg, binds') = initUs_ us $ - scTopBinds env0 (mg_binds guts) - - ; return (guts { mg_binds = binds' }) } - -scTopBinds :: ScEnv -> [InBind] -> UniqSM (ScUsage, [OutBind]) -scTopBinds _env [] = return (nullUsage, []) -scTopBinds env (b:bs) = do { (usg, b', bs') <- scBind TopLevel env b $ - (\env -> scTopBinds env bs) - ; return (usg, b' ++ bs') } + = do + dflags <- getDynFlags + us <- getUniqueSupplyM + (_, annos) <- getFirstAnnotations deserializeWithData guts + this_mod <- getModule + -- pprTraceM "specConstrInput" (ppr $ mg_binds guts) + let binds' = reverse $ fst $ initUs us $ do + -- Note [Top-level recursive groups] + (env, binds) <- goEnv (initScEnv (initScOpts dflags this_mod) annos) + (mg_binds guts) + -- binds is identical to (mg_binds guts), except that the + -- binders on the LHS have been replaced by extendBndr + -- (SPJ this seems like overkill; I don't think the binders + -- will change at all; and we don't substitute in the RHSs anyway!!) + go env nullUsage (reverse binds) + + return (guts { mg_binds = binds' }) + where + -- See Note [Top-level recursive groups] + goEnv env [] = return (env, []) + goEnv env (bind:binds) = do (env', bind') <- scTopBindEnv env bind + (env'', binds') <- goEnv env' binds + return (env'', bind' : binds') + + -- Arg list of bindings is in reverse order + go _ _ [] = return [] + go env usg (bind:binds) = do (usg', bind') <- scTopBind env usg bind + binds' <- go env usg' binds + return (bind' : binds') {- ************************************************************************ @@ -933,24 +956,14 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -initScEnv :: ModGuts -> CoreM ScEnv -initScEnv guts - = do { dflags <- getDynFlags - ; (_, anns) <- getFirstAnnotations deserializeWithData guts - ; this_mod <- getModule - ; return (SCE { sc_opts = initScOpts dflags this_mod, - sc_force = False, - sc_subst = init_subst, - sc_how_bound = emptyVarEnv, - sc_vals = emptyVarEnv, - sc_annotations = anns }) } - where - init_subst = mkEmptySubst $ mkInScopeSet $ mkVarSet $ - bindersOfBinds (mg_binds guts) - -- Acccount for top-level bindings that are not in dependency order; - -- see Note [Glomming] in GHC.Core.Opt.OccurAnal - -- Easiest thing is to bring all the top level binders into scope at once, - -- as if at once, as if all the top-level decls were mutually recursive. +initScEnv :: SpecConstrOpts -> UniqFM Name SpecConstrAnnotation -> ScEnv +initScEnv opts anns + = SCE { sc_opts = opts, + sc_force = False, + sc_subst = emptySubst, + sc_how_bound = emptyVarEnv, + sc_vals = emptyVarEnv, + sc_annotations = anns } data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -1174,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -- Domain is OutIds -data Call = Call OutId [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] +data Call = Call Id [CoreArg] ValueEnv -- The arguments of the call, together with the -- env giving the constructor bindings at the call site -- We keep the function mainly for debug output @@ -1197,9 +1210,6 @@ nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv } combineCalls :: CallEnv -> CallEnv -> CallEnv combineCalls = plusVarEnv_C (++) -delCallsFor :: ScUsage -> [Var] -> ScUsage -delCallsFor env bndrs = env { scu_calls = scu_calls env `delVarEnvList` bndrs } - combineUsage :: ScUsage -> ScUsage -> ScUsage combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2), scu_occs = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) } @@ -1282,121 +1292,6 @@ The main recursive function gathers up usage information, and creates specialised versions of functions. -} -scBind :: TopLevelFlag -> ScEnv -> InBind - -> (ScEnv -> UniqSM (ScUsage, a)) -- Specialise the scope of the binding - -> UniqSM (ScUsage, [OutBind], a) -scBind top_lvl env (NonRec bndr rhs) do_body - | isTyVar bndr -- Type-lets may be created by doBeta - = do { (final_usage, body') <- do_body (extendScSubst env bndr rhs) - ; return (final_usage, [], body') } - - | not (isTopLevel top_lvl) -- Nested non-recursive value binding - -- See Note [Specialising local let bindings] - = do { let (body_env, bndr') = extendBndr env bndr - -- Not necessary at top level; but here we are nested - - ; rhs_info <- scRecRhs env (bndr',rhs) - - ; let body_env2 = extendHowBound body_env [bndr'] RecFun - rhs' = ri_new_rhs rhs_info - body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') - - ; (body_usg, body') <- do_body body_env3 - - -- Now make specialised copies of the binding, - -- based on calls in body_usg - ; (spec_usg, specs) <- specNonRec env (scu_calls body_usg) rhs_info - -- NB: For non-recursive bindings we inherit sc_force flag from - -- the parent function (see Note [Forcing specialisation]) - - -- Specialized + original binding - ; let spec_bnds = [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] - bind_usage = (body_usg `delCallsFor` [bndr']) - `combineUsage` spec_usg -- Note [spec_usg includes rhs_usg] - - ; return (bind_usage, spec_bnds, body') - } - - | otherwise -- Top-level, non-recursive value binding - -- At top level we do not specialise non-recursive bindings; that - -- is, we do not call specNonRec, passing the calls from the body. - -- The original paper only specialised /recursive/ bindings, but - -- we later started specialising nested non-recursive bindings: - -- see Note [Specialising local let bindings] - -- - -- I tried always specialising non-recursive top-level bindings too, - -- but found some regressions (see !8135). So I backed off. - = do { (rhs_usage, rhs') <- scExpr env rhs - - -- At top level, we've already put all binders into scope; see initScEnv - -- Hence no need to call `extendBndr`. But we still want to - -- extend the `ValueEnv` to record the value of this binder. - ; let body_env = extendValEnv env bndr (isValue (sc_vals env) rhs') - ; (body_usage, body') <- do_body body_env - - ; return (rhs_usage `combineUsage` body_usage, [NonRec bndr rhs'], body') } - -scBind top_lvl env (Rec prs) do_body - | isTopLevel top_lvl - , Just threshold <- sc_size (sc_opts env) - , not force_spec - , not (all (couldBeSmallEnoughToInline (sc_uf_opts (sc_opts env)) threshold) rhss) - = -- Do no specialisation if the RHSs are too big - -- ToDo: I'm honestly not sure of the rationale of this size-testing, nor - -- why it only applies at top level. But that's the way it has been - -- for a while. See #21456. - do { (body_usg, body') <- do_body rhs_env2 - ; (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss - ; let all_usg = (combineUsages rhs_usgs `combineUsage` body_usg) - `delCallsFor` bndrs' - bind' = Rec (bndrs' `zip` rhss') - ; return (all_usg, [bind'], body') } - - | otherwise - = do { rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) - ; (body_usg, body') <- do_body rhs_env2 - - ; (spec_usg, specs) <- specRec (scForce rhs_env2 force_spec) - (scu_calls body_usg) rhs_infos - -- Do not unconditionally generate specialisations from rhs_usgs - -- Instead use them only if we find an unspecialised call - -- See Note [Seeding recursive groups] - - ; let all_usg = (spec_usg `combineUsage` body_usg) -- Note [spec_usg includes rhs_usg] - `delCallsFor` bndrs' - bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) - -- zipWithEqual: length of returned [SpecInfo] - -- should be the same as incoming [RhsInfo] - - ; return (all_usg, [bind'], body') } - where - (bndrs,rhss) = unzip prs - force_spec = any (forceSpecBndr env) bndrs -- Note [Forcing specialisation] - - (rhs_env1,bndrs') | isTopLevel top_lvl = (env, bndrs) - | otherwise = extendRecBndrs env bndrs - -- At top level, we've already put all binders into scope; see initScEnv - - rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun - -{- Note [Specialising local let bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is not uncommon to find this - - let $j = \x. in ...$j True...$j True... - -Here $j is an arbitrary let-bound function, but it often comes up for -join points. We might like to specialise $j for its call patterns. -Notice the difference from a letrec, where we look for call patterns -in the *RHS* of the function. Here we look for call patterns in the -*body* of the let. - -At one point I predicated this on the RHS mentioning the outer -recursive function, but that's not essential and might even be -harmful. I'm not sure. --} - ------------------------- scExpr, scExpr' :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr) -- The unique supply is needed when we invent -- a new name for the specialised function and its args @@ -1421,11 +1316,6 @@ scExpr' env (Lam b e) = do let (env', b') = extendBndr env b (usg, e') <- scExpr env' e return (usg, Lam b' e') -scExpr' env (Let bind body) - = do { (final_usage, binds', body') <- scBind NotTopLevel env bind $ - (\env -> scExpr env body) - ; return (final_usage, mkLets binds' body') } - scExpr' env (Case scrut b ty alts) = do { (scrut_usg, scrut') <- scExpr env scrut ; case isValue (sc_vals env) scrut' of @@ -1465,7 +1355,79 @@ scExpr' env (Case scrut b ty alts) _ -> evalScrutOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } +scExpr' env (Let (NonRec bndr rhs) body) + | isTyVar bndr -- Type-lets may be created by doBeta + = scExpr' (extendScSubst env bndr rhs) body + + | otherwise + = do { let (body_env, bndr') = extendBndr env bndr + ; rhs_info <- scRecRhs env (bndr',rhs) + + ; let body_env2 = extendHowBound body_env [bndr'] RecFun + -- See Note [Local let bindings] + rhs' = ri_new_rhs rhs_info + body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') + + ; (body_usg, body') <- scExpr body_env3 body + + -- NB: For non-recursive bindings we inherit sc_force flag from + -- the parent function (see Note [Forcing specialisation]) + ; (spec_usg, specs) <- specNonRec env body_usg rhs_info + + -- Specialized + original binding + ; let spec_bnds = mkLets [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] body' + -- ; pprTraceM "spec_bnds" $ (ppr spec_bnds) + + ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' } + `combineUsage` spec_usg, -- Note [spec_usg includes rhs_usg] + spec_bnds + ) + } + + +-- A *local* recursive group: see Note [Local recursive groups] +scExpr' env (Let (Rec prs) body) + = do { let (bndrs,rhss) = unzip prs + (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun + force_spec = any (forceSpecBndr env) bndrs' + -- Note [Forcing specialisation] + + ; rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) + ; (body_usg, body') <- scExpr rhs_env2 body + + -- NB: start specLoop from body_usg + ; (spec_usg, specs) <- specRec NotTopLevel (scForce rhs_env2 force_spec) + body_usg rhs_infos + -- Do not unconditionally generate specialisations from rhs_usgs + -- Instead use them only if we find an unspecialised call + -- See Note [Local recursive groups] + + ; let all_usg = spec_usg `combineUsage` body_usg -- Note [spec_usg includes rhs_usg] + bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) + -- zipWithEqual: length of returned [SpecInfo] + -- should be the same as incoming [RhsInfo] + + ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' }, + Let bind' body') } + +{- +Note [Local let bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~ +It is not uncommon to find this + + let $j = \x. in ...$j True...$j True... +Here $j is an arbitrary let-bound function, but it often comes up for +join points. We might like to specialise $j for its call patterns. +Notice the difference from a letrec, where we look for call patterns +in the *RHS* of the function. Here we look for call patterns in the +*body* of the let. + +At one point I predicated this on the RHS mentioning the outer +recursive function, but that's not essential and might even be +harmful. I'm not sure. +-} scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) @@ -1520,6 +1482,51 @@ mkVarUsage env fn args arg_occ | null args = UnkOcc | otherwise = evalScrutOcc +---------------------- +scTopBindEnv :: ScEnv -> CoreBind -> UniqSM (ScEnv, CoreBind) +scTopBindEnv env (Rec prs) + = do { let (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs RecFun + + prs' = zip bndrs' rhss + ; return (rhs_env2, Rec prs') } + where + (bndrs,rhss) = unzip prs + +scTopBindEnv env (NonRec bndr rhs) + = do { let (env1, bndr') = extendBndr env bndr + env2 = extendValEnv env1 bndr' (isValue (sc_vals env) rhs) + ; return (env2, NonRec bndr' rhs) } + +---------------------- +scTopBind :: ScEnv -> ScUsage -> CoreBind -> UniqSM (ScUsage, CoreBind) + +scTopBind env body_usage (Rec prs) + | Just threshold <- sc_size $ sc_opts env + , not force_spec + , not (all (couldBeSmallEnoughToInline (sc_uf_opts $ sc_opts env) threshold) rhss) + -- No specialisation + = -- pprTrace "scTopBind: nospec" (ppr bndrs) $ + do { (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss + ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) } + + | otherwise -- Do specialisation + = do { rhs_infos <- mapM (scRecRhs env) prs + + ; (spec_usage, specs) <- specRec TopLevel (scForce env force_spec) + body_usage rhs_infos + + ; return (body_usage `combineUsage` spec_usage, + Rec (concat (zipWith ruleInfoBinds rhs_infos specs))) } + where + (bndrs,rhss) = unzip prs + force_spec = any (forceSpecBndr env) bndrs + -- Note [Forcing specialisation] + +scTopBind env usage (NonRec bndr rhs) -- Oddly, we don't seem to specialise top-level non-rec functions + = do { (rhs_usg', rhs') <- scExpr env rhs + ; return (usage `combineUsage` rhs_usg', NonRec bndr rhs') } + ---------------------- scRecRhs :: ScEnv -> (OutId, InExpr) -> UniqSM RhsInfo scRecRhs env (bndr,rhs) @@ -1567,8 +1574,7 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have - -- generated for this function + = SI { si_specs :: [OneSpec] -- The specialisations we have generated , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1579,7 +1585,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Seeding recursive groups] + -- See Note [Local recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1589,62 +1595,57 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -initSpecInfo :: RhsInfo -> SpecInfo -initSpecInfo (RI { ri_rhs_usg = rhs_usg }) - = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Just rhs_usg } - -- si_mb_unspec: add in rhs_usg if there are any boring calls, - -- or if the bndr is exported +noSpecInfo :: SpecInfo +noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } ---------------------- specNonRec :: ScEnv - -> CallEnv -- Calls in body + -> ScUsage -- Body usage -> RhsInfo -- Structure info usage info for un-specialised RHS -> UniqSM (ScUsage, SpecInfo) -- Usage from RHSs (specialised and not) -- plus details of specialisations -specNonRec env body_calls rhs_info - = specialise env body_calls rhs_info (initSpecInfo rhs_info) +specNonRec env body_usg rhs_info + = specialise env (scu_calls body_usg) rhs_info + (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) ---------------------- -specRec :: ScEnv - -> CallEnv -- Calls in body +specRec :: TopLevelFlag -> ScEnv + -> ScUsage -- Body usage -> [RhsInfo] -- Structure info and usage info for un-specialised RHSs -> UniqSM (ScUsage, [SpecInfo]) -- Usage from all RHSs (specialised and not) -- plus details of specialisations -specRec env body_calls rhs_infos - = go 1 body_calls nullUsage (map initSpecInfo rhs_infos) - -- body_calls: see Note [Seeding recursive groups] - -- NB: 'go' always calls 'specialise' once, which in turn unleashes - -- si_mb_unspec if there are any boring calls in body_calls, - -- or if any of the Id(s) are exported +specRec top_lvl env body_usg rhs_infos + = go 1 seed_calls nullUsage init_spec_infos where opts = sc_opts env + (seed_calls, init_spec_infos) -- Note [Seeding top-level recursive groups] + | isTopLevel top_lvl + , any (isExportedId . ri_fn) rhs_infos -- Seed from body and RHSs + = (all_calls, [noSpecInfo | _ <- rhs_infos]) + | otherwise -- Seed from body only + = (calls_in_body, [noSpecInfo { si_mb_unspec = Just (ri_rhs_usg ri) } + | ri <- rhs_infos]) + + calls_in_body = scu_calls body_usg + calls_in_rhss = foldr (combineCalls . scu_calls . ri_rhs_usg) emptyVarEnv rhs_infos + all_calls = calls_in_rhss `combineCalls` calls_in_body -- Loop, specialising, until you get no new specialisations - go, go_again :: Int -- Which iteration of the "until no new specialisations" - -- loop we are on; first iteration is 1 - -> CallEnv -- Seed calls - -- Two accumulating parameters: - -> ScUsage -- Usage from earlier specialisations - -> [SpecInfo] -- Details of specialisations so far - -> UniqSM (ScUsage, [SpecInfo]) + go :: Int -- Which iteration of the "until no new specialisations" + -- loop we are on; first iteration is 1 + -> CallEnv -- Seed calls + -- Two accumulating parameters: + -> ScUsage -- Usage from earlier specialisations + -> [SpecInfo] -- Details of specialisations so far + -> UniqSM (ScUsage, [SpecInfo]) go n_iter seed_calls usg_so_far spec_infos - = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) - -- , text "iteration" <+> int n_iter - -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) - -- ]) $ - do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos - ; let (extra_usg_s, all_spec_infos) = unzip specs_w_usg - extra_usg = combineUsages extra_usg_s - all_usg = usg_so_far `combineUsage` extra_usg - new_calls = scu_calls extra_usg - ; go_again n_iter new_calls all_usg all_spec_infos } - - -- go_again deals with termination - go_again n_iter seed_calls usg_so_far spec_infos | isEmptyVarEnv seed_calls - = return (usg_so_far, spec_infos) + = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) + -- , ppr seed_calls + -- , ppr body_usg ]) $ + return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1653,20 +1654,26 @@ specRec env body_calls rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- Give up on specialisation, but don't forget to include the rhs_usg - -- for the unspecialised function, since it may now be called - -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - let rhs_usgs = combineUsages (mapMaybe si_mb_unspec spec_infos) - in return (usg_so_far `combineUsage` rhs_usgs, spec_infos) + = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ + return (usg_so_far, spec_infos) | otherwise - = go (n_iter + 1) seed_calls usg_so_far spec_infos + = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) + -- , text "iteration" <+> int n_iter + -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) + -- ]) $ + do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos + ; let (extra_usg_s, new_spec_infos) = unzip specs_w_usg + extra_usg = combineUsages extra_usg_s + all_usg = usg_so_far `combineUsage` extra_usg + ; go (n_iter + 1) (scu_calls extra_usg) all_usg new_spec_infos } -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max + ---------------------- specialise :: ScEnv @@ -1689,12 +1696,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs spec_info@(SI { si_specs = specs, si_n_specs = spec_count , si_mb_unspec = mb_unspec }) | isDeadEndId fn -- Note [Do not specialise diverging functions] - -- /and/ do not generate specialisation seeds from its RHS + -- and do not generate specialisation seeds from its RHS = -- pprTrace "specialise bot" (ppr fn) $ return (nullUsage, spec_info) | not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation] + -- + -- -- Don't specialise OPAQUE things, see Note [OPAQUE pragma]. -- Since OPAQUE things are always never-active (see -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for @@ -1720,16 +1729,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs ; let spec_usg = combineUsages spec_usgs - unspec_rhs_needed = boring_call || isExportedId fn - -- If there were any boring calls among the seeds (= all_calls), then those -- calls will call the un-specialised function. So we should use the seeds -- from the _unspecialised_ function's RHS, which are in mb_unspec, by returning -- then in new_usg. - (new_usg, mb_unspec') = case mb_unspec of - Just rhs_usg | unspec_rhs_needed - -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') + = case mb_unspec of + Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1737,8 +1744,8 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs -- , text "new calls:" <+> ppr (scu_calls new_usg)]) $ -- return () - ; return (new_usg, SI { si_specs = new_specs ++ specs - , si_n_specs = spec_count + n_pats + ; return (new_usg, SI { si_specs = new_specs ++ specs + , si_n_specs = spec_count + n_pats , si_mb_unspec = mb_unspec' }) } | otherwise -- No calls, inactive, or not a function @@ -2020,8 +2027,7 @@ calcSpecInfo fn (CP { cp_qvars = qvars, cp_args = pats }) extra_bndrs Note [spec_usg includes rhs_usg] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In calls to 'specialise', the returned ScUsage must include the rhs_usg in -the passed-in SpecInfo in si_mb_unspec, unless there are no calls at all to -the function. +the passed-in SpecInfo, unless there are no calls at all to the function. The caller can, indeed must, assume this. They should not combine in rhs_usg themselves, or they'll get rhs_usg twice -- and that can lead to an exponential @@ -2239,11 +2245,9 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) --- Result has no duplicate patterns, --- nor ones mentioned in si_specs (hence "new" patterns) --- Bool indicates that there was at least one boring pattern --- The "New" in the name means "patterns that are not already covered --- by an existing specialisation" + -- Result has no duplicate patterns, + -- nor ones mentioned in done_pats + -- Bool indicates that there was at least one boring pattern callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -2153,7 +2153,9 @@ cpCloneBndr env bndr -- Drop (now-useless) rules/unfoldings -- See Note [Drop unfoldings and rules] -- and Note [Preserve evaluatedness] in GHC.Core.Tidy - ; let unfolding' = trimUnfolding (realIdUnfolding bndr) + -- And force it.. otherwise the old unfolding is just retained. + -- See #22071 + ; let !unfolding' = trimUnfolding (realIdUnfolding bndr) -- Simplifier will set the Id's unfolding bndr'' = bndr' `setIdUnfolding` unfolding' ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1292,12 +1292,14 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf --------- Unfolding ------------ unf_info = realUnfoldingInfo idinfo - unfold_info + -- Force this, otherwise the old unfolding is retained over code generation + -- See #22071 + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs | otherwise = minimal_unfold_info - minimal_unfold_info = trimUnfolding unf_info + !minimal_unfold_info = trimUnfolding unf_info unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -249,7 +249,7 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ haddocks + need $ srcs ++ (map snd haddocks) -- Build Haddock documentation -- TODO: Pass the correct way from Rules via Context. @@ -364,8 +364,8 @@ buildManPage = do copyFileUntracked (dir -/- "ghc.1") file -- | Find the Haddock files for the dependencies of the current library. -haddockDependencies :: Context -> Action [FilePath] +haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do depNames <- interpretInContext context (getContextData depNames) - sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg + sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext Stage1 depPkg) | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -43,9 +43,8 @@ haddockBuilderArgs = mconcat context <- getContext version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg - trans_deps <- expr $ contextDependencies context - pkgs <- expr $ mapM (pkgIdentifier . C.package) $ trans_deps haddocks <- expr $ haddockDependencies context + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) @@ -69,7 +68,7 @@ haddockBuilderArgs = mconcat , map ("--hide=" ++) <$> getContextData otherModules , pure [ "--read-interface=../" ++ p ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME}," - ++ haddock | (p, haddock) <- zip pkgs haddocks ] + ++ haddock | (p, haddock) <- haddocks_with_versions ] , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] , getInputs , arg "+RTS" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/021b1184857c8e68cc38d2d11ece0a6addf41b94...805462db2c104d3932190f7115e8ecfcacd8514b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/021b1184857c8e68cc38d2d11ece0a6addf41b94...805462db2c104d3932190f7115e8ecfcacd8514b You're receiving 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 Aug 19 04:09:28 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 00:09:28 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Make ru_fn field strict to avoid retaining Ids Message-ID: <62ff0cf8aea88_125b2b488501355b6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 4 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Tidy.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1151,7 +1151,7 @@ data CoreRule -- Rough-matching stuff -- see comments with InstEnv.ClsInst( is_cls, is_rough ) - ru_fn :: Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule + ru_fn :: !Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side -- Proper-matching stuff ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -634,7 +634,8 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) floats' = floats `extendFloats` NonRec bndr' triv_rhs ; return ( floats', setInScopeFromF env floats' ) } } where - occ_fs = getOccFS bndr + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr uf_opts = seUnfoldingOpts env work_ty = coercionLKind co info = idInfo bndr @@ -711,9 +712,11 @@ prepareBinding env top_lvl is_rec strict_bind bndr rhs_floats rhs -- rhs_env: add to in-scope set the binders from rhs_floats -- so that prepareRhs knows what is in scope in rhs ; let rhs_env = env `setInScopeFromF` rhs_floats1 + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr -- Now ANF-ise the remaining rhs - ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl (getOccFS bndr) rhs1 + ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl occ_fs rhs1 -- Finally, decide whether or not to float ; let all_floats = rhs_floats1 `addLetFloats` anf_floats @@ -4294,7 +4297,8 @@ simplRules env mb_new_id rules bind_cxt lhs_env = updMode updModeForRules env' rhs_env = updMode (updModeForStableUnfoldings act) env' -- See Note [Simplifying the RHS of a RULE] - fn_name' = case mb_new_id of + -- Force this to avoid retaining reference to old Id + !fn_name' = case mb_new_id of Just id -> idName id Nothing -> fn_name ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -2153,7 +2153,9 @@ cpCloneBndr env bndr -- Drop (now-useless) rules/unfoldings -- See Note [Drop unfoldings and rules] -- and Note [Preserve evaluatedness] in GHC.Core.Tidy - ; let unfolding' = trimUnfolding (realIdUnfolding bndr) + -- And force it.. otherwise the old unfolding is just retained. + -- See #22071 + ; let !unfolding' = trimUnfolding (realIdUnfolding bndr) -- Simplifier will set the Id's unfolding bndr'' = bndr' `setIdUnfolding` unfolding' ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1292,12 +1292,14 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf --------- Unfolding ------------ unf_info = realUnfoldingInfo idinfo - unfold_info + -- Force this, otherwise the old unfolding is retained over code generation + -- See #22071 + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs | otherwise = minimal_unfold_info - minimal_unfold_info = trimUnfolding unf_info + !minimal_unfold_info = trimUnfolding unf_info unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/989b844d7598fd71ffd76e00d8d1f5207d58fd61...4303acba89b26cc3ae05527d701cba7d84edafcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/989b844d7598fd71ffd76e00d8d1f5207d58fd61...4303acba89b26cc3ae05527d701cba7d84edafcb You're receiving 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 Aug 19 04:10:03 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 00:10:03 -0400 Subject: [Git][ghc/ghc][master] haddock docs: Fix links from identifiers to dependent packages Message-ID: <62ff0d1b27944_125b2b488001408c0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 2 changed files: - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -249,7 +249,7 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ haddocks + need $ srcs ++ (map snd haddocks) -- Build Haddock documentation -- TODO: Pass the correct way from Rules via Context. @@ -364,8 +364,8 @@ buildManPage = do copyFileUntracked (dir -/- "ghc.1") file -- | Find the Haddock files for the dependencies of the current library. -haddockDependencies :: Context -> Action [FilePath] +haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do depNames <- interpretInContext context (getContextData depNames) - sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg + sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext Stage1 depPkg) | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -43,9 +43,8 @@ haddockBuilderArgs = mconcat context <- getContext version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg - trans_deps <- expr $ contextDependencies context - pkgs <- expr $ mapM (pkgIdentifier . C.package) $ trans_deps haddocks <- expr $ haddockDependencies context + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) @@ -69,7 +68,7 @@ haddockBuilderArgs = mconcat , map ("--hide=" ++) <$> getContextData otherModules , pure [ "--read-interface=../" ++ p ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME}," - ++ haddock | (p, haddock) <- zip pkgs haddocks ] + ++ haddock | (p, haddock) <- haddocks_with_versions ] , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] , getInputs , arg "+RTS" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2361b3bc08811b0d2fb8f8fc5635b7c2fec157c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2361b3bc08811b0d2fb8f8fc5635b7c2fec157c6 You're receiving 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 Aug 19 04:10:39 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 00:10:39 -0400 Subject: [Git][ghc/ghc][master] Revert "Refactor SpecConstr to use treat bindings uniformly" Message-ID: <62ff0d3f4a37c_125b2b487ec144170@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 1 changed file: - compiler/GHC/Core/Opt/SpecConstr.hs Changes: ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,6 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) -import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) {- @@ -375,14 +374,11 @@ The recursive call ends up looking like So we want to spot the constructor application inside the cast. That's why we have the Cast case in argToPat -Note [Seeding recursive groups] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For a recursive group that is either - * nested, or - * top-level, but with no exported Ids -we can see all the calls to the function, so we seed the specialisation -loop from the calls in the body, and /not/ from the calls in the RHS. -Consider: +Note [Local recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a *local* recursive group, we can see all the calls to the +function, so we seed the specialisation loop from the calls in the +body, not from the calls in the RHS. Consider: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -405,42 +401,52 @@ a local function. In a case like the above we end up never calling the original un-specialised function. (Although we still leave its code around just in case.) -Wrinkles - -* Boring calls. If we find any boring calls in the body, including - *unsaturated* ones, such as +However, if we find any boring calls in the body, including *unsaturated* +ones, such as letrec foo x y = ....foo... in map foo xs - then we will end up calling the un-specialised function, so then we - *should* use the calls in the un-specialised RHS as seeds. We call - these "boring call patterns", and callsToNewPats reports if it finds - any of these. Then 'specialise' unleashes the usage info from the - un-specialised RHS. - -* Exported Ids. `specialise` /also/ unleashes `si_mb_unspec` - for exported Ids. That way we are sure to generate usage info from - the /un-specialised/ RHS of an exported function. - -More precisely: - -* Always start from the calls in the body of the let or (for top level) - calls in the rest of the module. See the body_calls in the call to - `specialise` in `specNonRec`, and to `go` in `specRec`. - -* si_mb_unspec holds the usage from the unspecialised RHS. - See `initSpecInfo`. - -* `specialise` will unleash si_mb_unspec, if - - `callsToNewPats` reports "boring calls found", or - - this is a top-level exported Id. - -Historical note. At an earlier point, if a top-level Id was exported, -we used only seeds from the RHS, and /not/from the body. But Dimitrios -had an example where using call patterns from the body (the other defns -in the module) was crucial. And doing so improved nofib allocation results: - multiplier: 4% better - minimax: 2.8% better -In any case, it is easier to do! +then we will end up calling the un-specialised function, so then we *should* +use the calls in the un-specialised RHS as seeds. We call these +"boring call patterns", and callsToPats reports if it finds any of these. + +Note [Seeding top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This seeding is done in the binding for seed_calls in specRec. + +1. If all the bindings in a top-level recursive group are local (not + exported), then all the calls are in the rest of the top-level + bindings. This means we can specialise with those call patterns + ONLY, and NOT with the RHSs of the recursive group (exactly like + Note [Local recursive groups]) + +2. But if any of the bindings are exported, the function may be called + with any old arguments, so (for lack of anything better) we specialise + based on + (a) the call patterns in the RHS + (b) the call patterns in the rest of the top-level bindings + NB: before Apr 15 we used (a) only, but Dimitrios had an example + where (b) was crucial, so I added that. + Adding (b) also improved nofib allocation results: + multiplier: 4% better + minimax: 2.8% better + +Actually in case (2), instead of using the calls from the RHS, it +would be better to specialise in the importing module. We'd need to +add an INLINABLE pragma to the function, and then it can be +specialised in the importing scope, just as is done for type classes +in GHC.Core.Opt.Specialise.specImports. This remains to be done (#10346). + +Note [Top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To get the call usage information from "the rest of the top level +bindings" (c.f. Note [Seeding top-level recursive groups]), we work +backwards through the top-level bindings so we see the usage before we +get to the binding of the function. Before we can collect the usage +though, we go through all the bindings and add them to the +environment. This is necessary because usage is only tracked for +functions in the environment. These two passes are called + 'go' and 'goEnv' +in specConstrProgram. (Looks a bit revolting to me.) Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -758,18 +764,35 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = do { env0 <- initScEnv guts - ; us <- getUniqueSupplyM - ; let (_usg, binds') = initUs_ us $ - scTopBinds env0 (mg_binds guts) - - ; return (guts { mg_binds = binds' }) } - -scTopBinds :: ScEnv -> [InBind] -> UniqSM (ScUsage, [OutBind]) -scTopBinds _env [] = return (nullUsage, []) -scTopBinds env (b:bs) = do { (usg, b', bs') <- scBind TopLevel env b $ - (\env -> scTopBinds env bs) - ; return (usg, b' ++ bs') } + = do + dflags <- getDynFlags + us <- getUniqueSupplyM + (_, annos) <- getFirstAnnotations deserializeWithData guts + this_mod <- getModule + -- pprTraceM "specConstrInput" (ppr $ mg_binds guts) + let binds' = reverse $ fst $ initUs us $ do + -- Note [Top-level recursive groups] + (env, binds) <- goEnv (initScEnv (initScOpts dflags this_mod) annos) + (mg_binds guts) + -- binds is identical to (mg_binds guts), except that the + -- binders on the LHS have been replaced by extendBndr + -- (SPJ this seems like overkill; I don't think the binders + -- will change at all; and we don't substitute in the RHSs anyway!!) + go env nullUsage (reverse binds) + + return (guts { mg_binds = binds' }) + where + -- See Note [Top-level recursive groups] + goEnv env [] = return (env, []) + goEnv env (bind:binds) = do (env', bind') <- scTopBindEnv env bind + (env'', binds') <- goEnv env' binds + return (env'', bind' : binds') + + -- Arg list of bindings is in reverse order + go _ _ [] = return [] + go env usg (bind:binds) = do (usg', bind') <- scTopBind env usg bind + binds' <- go env usg' binds + return (bind' : binds') {- ************************************************************************ @@ -933,24 +956,14 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -initScEnv :: ModGuts -> CoreM ScEnv -initScEnv guts - = do { dflags <- getDynFlags - ; (_, anns) <- getFirstAnnotations deserializeWithData guts - ; this_mod <- getModule - ; return (SCE { sc_opts = initScOpts dflags this_mod, - sc_force = False, - sc_subst = init_subst, - sc_how_bound = emptyVarEnv, - sc_vals = emptyVarEnv, - sc_annotations = anns }) } - where - init_subst = mkEmptySubst $ mkInScopeSet $ mkVarSet $ - bindersOfBinds (mg_binds guts) - -- Acccount for top-level bindings that are not in dependency order; - -- see Note [Glomming] in GHC.Core.Opt.OccurAnal - -- Easiest thing is to bring all the top level binders into scope at once, - -- as if at once, as if all the top-level decls were mutually recursive. +initScEnv :: SpecConstrOpts -> UniqFM Name SpecConstrAnnotation -> ScEnv +initScEnv opts anns + = SCE { sc_opts = opts, + sc_force = False, + sc_subst = emptySubst, + sc_how_bound = emptyVarEnv, + sc_vals = emptyVarEnv, + sc_annotations = anns } data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -1174,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -- Domain is OutIds -data Call = Call OutId [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] +data Call = Call Id [CoreArg] ValueEnv -- The arguments of the call, together with the -- env giving the constructor bindings at the call site -- We keep the function mainly for debug output @@ -1197,9 +1210,6 @@ nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv } combineCalls :: CallEnv -> CallEnv -> CallEnv combineCalls = plusVarEnv_C (++) -delCallsFor :: ScUsage -> [Var] -> ScUsage -delCallsFor env bndrs = env { scu_calls = scu_calls env `delVarEnvList` bndrs } - combineUsage :: ScUsage -> ScUsage -> ScUsage combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2), scu_occs = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) } @@ -1282,121 +1292,6 @@ The main recursive function gathers up usage information, and creates specialised versions of functions. -} -scBind :: TopLevelFlag -> ScEnv -> InBind - -> (ScEnv -> UniqSM (ScUsage, a)) -- Specialise the scope of the binding - -> UniqSM (ScUsage, [OutBind], a) -scBind top_lvl env (NonRec bndr rhs) do_body - | isTyVar bndr -- Type-lets may be created by doBeta - = do { (final_usage, body') <- do_body (extendScSubst env bndr rhs) - ; return (final_usage, [], body') } - - | not (isTopLevel top_lvl) -- Nested non-recursive value binding - -- See Note [Specialising local let bindings] - = do { let (body_env, bndr') = extendBndr env bndr - -- Not necessary at top level; but here we are nested - - ; rhs_info <- scRecRhs env (bndr',rhs) - - ; let body_env2 = extendHowBound body_env [bndr'] RecFun - rhs' = ri_new_rhs rhs_info - body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') - - ; (body_usg, body') <- do_body body_env3 - - -- Now make specialised copies of the binding, - -- based on calls in body_usg - ; (spec_usg, specs) <- specNonRec env (scu_calls body_usg) rhs_info - -- NB: For non-recursive bindings we inherit sc_force flag from - -- the parent function (see Note [Forcing specialisation]) - - -- Specialized + original binding - ; let spec_bnds = [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] - bind_usage = (body_usg `delCallsFor` [bndr']) - `combineUsage` spec_usg -- Note [spec_usg includes rhs_usg] - - ; return (bind_usage, spec_bnds, body') - } - - | otherwise -- Top-level, non-recursive value binding - -- At top level we do not specialise non-recursive bindings; that - -- is, we do not call specNonRec, passing the calls from the body. - -- The original paper only specialised /recursive/ bindings, but - -- we later started specialising nested non-recursive bindings: - -- see Note [Specialising local let bindings] - -- - -- I tried always specialising non-recursive top-level bindings too, - -- but found some regressions (see !8135). So I backed off. - = do { (rhs_usage, rhs') <- scExpr env rhs - - -- At top level, we've already put all binders into scope; see initScEnv - -- Hence no need to call `extendBndr`. But we still want to - -- extend the `ValueEnv` to record the value of this binder. - ; let body_env = extendValEnv env bndr (isValue (sc_vals env) rhs') - ; (body_usage, body') <- do_body body_env - - ; return (rhs_usage `combineUsage` body_usage, [NonRec bndr rhs'], body') } - -scBind top_lvl env (Rec prs) do_body - | isTopLevel top_lvl - , Just threshold <- sc_size (sc_opts env) - , not force_spec - , not (all (couldBeSmallEnoughToInline (sc_uf_opts (sc_opts env)) threshold) rhss) - = -- Do no specialisation if the RHSs are too big - -- ToDo: I'm honestly not sure of the rationale of this size-testing, nor - -- why it only applies at top level. But that's the way it has been - -- for a while. See #21456. - do { (body_usg, body') <- do_body rhs_env2 - ; (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss - ; let all_usg = (combineUsages rhs_usgs `combineUsage` body_usg) - `delCallsFor` bndrs' - bind' = Rec (bndrs' `zip` rhss') - ; return (all_usg, [bind'], body') } - - | otherwise - = do { rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) - ; (body_usg, body') <- do_body rhs_env2 - - ; (spec_usg, specs) <- specRec (scForce rhs_env2 force_spec) - (scu_calls body_usg) rhs_infos - -- Do not unconditionally generate specialisations from rhs_usgs - -- Instead use them only if we find an unspecialised call - -- See Note [Seeding recursive groups] - - ; let all_usg = (spec_usg `combineUsage` body_usg) -- Note [spec_usg includes rhs_usg] - `delCallsFor` bndrs' - bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) - -- zipWithEqual: length of returned [SpecInfo] - -- should be the same as incoming [RhsInfo] - - ; return (all_usg, [bind'], body') } - where - (bndrs,rhss) = unzip prs - force_spec = any (forceSpecBndr env) bndrs -- Note [Forcing specialisation] - - (rhs_env1,bndrs') | isTopLevel top_lvl = (env, bndrs) - | otherwise = extendRecBndrs env bndrs - -- At top level, we've already put all binders into scope; see initScEnv - - rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun - -{- Note [Specialising local let bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is not uncommon to find this - - let $j = \x. in ...$j True...$j True... - -Here $j is an arbitrary let-bound function, but it often comes up for -join points. We might like to specialise $j for its call patterns. -Notice the difference from a letrec, where we look for call patterns -in the *RHS* of the function. Here we look for call patterns in the -*body* of the let. - -At one point I predicated this on the RHS mentioning the outer -recursive function, but that's not essential and might even be -harmful. I'm not sure. --} - ------------------------- scExpr, scExpr' :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr) -- The unique supply is needed when we invent -- a new name for the specialised function and its args @@ -1421,11 +1316,6 @@ scExpr' env (Lam b e) = do let (env', b') = extendBndr env b (usg, e') <- scExpr env' e return (usg, Lam b' e') -scExpr' env (Let bind body) - = do { (final_usage, binds', body') <- scBind NotTopLevel env bind $ - (\env -> scExpr env body) - ; return (final_usage, mkLets binds' body') } - scExpr' env (Case scrut b ty alts) = do { (scrut_usg, scrut') <- scExpr env scrut ; case isValue (sc_vals env) scrut' of @@ -1465,7 +1355,79 @@ scExpr' env (Case scrut b ty alts) _ -> evalScrutOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } +scExpr' env (Let (NonRec bndr rhs) body) + | isTyVar bndr -- Type-lets may be created by doBeta + = scExpr' (extendScSubst env bndr rhs) body + + | otherwise + = do { let (body_env, bndr') = extendBndr env bndr + ; rhs_info <- scRecRhs env (bndr',rhs) + + ; let body_env2 = extendHowBound body_env [bndr'] RecFun + -- See Note [Local let bindings] + rhs' = ri_new_rhs rhs_info + body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') + + ; (body_usg, body') <- scExpr body_env3 body + + -- NB: For non-recursive bindings we inherit sc_force flag from + -- the parent function (see Note [Forcing specialisation]) + ; (spec_usg, specs) <- specNonRec env body_usg rhs_info + + -- Specialized + original binding + ; let spec_bnds = mkLets [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] body' + -- ; pprTraceM "spec_bnds" $ (ppr spec_bnds) + + ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' } + `combineUsage` spec_usg, -- Note [spec_usg includes rhs_usg] + spec_bnds + ) + } + + +-- A *local* recursive group: see Note [Local recursive groups] +scExpr' env (Let (Rec prs) body) + = do { let (bndrs,rhss) = unzip prs + (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun + force_spec = any (forceSpecBndr env) bndrs' + -- Note [Forcing specialisation] + + ; rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) + ; (body_usg, body') <- scExpr rhs_env2 body + + -- NB: start specLoop from body_usg + ; (spec_usg, specs) <- specRec NotTopLevel (scForce rhs_env2 force_spec) + body_usg rhs_infos + -- Do not unconditionally generate specialisations from rhs_usgs + -- Instead use them only if we find an unspecialised call + -- See Note [Local recursive groups] + + ; let all_usg = spec_usg `combineUsage` body_usg -- Note [spec_usg includes rhs_usg] + bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) + -- zipWithEqual: length of returned [SpecInfo] + -- should be the same as incoming [RhsInfo] + + ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' }, + Let bind' body') } + +{- +Note [Local let bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~ +It is not uncommon to find this + + let $j = \x. in ...$j True...$j True... +Here $j is an arbitrary let-bound function, but it often comes up for +join points. We might like to specialise $j for its call patterns. +Notice the difference from a letrec, where we look for call patterns +in the *RHS* of the function. Here we look for call patterns in the +*body* of the let. + +At one point I predicated this on the RHS mentioning the outer +recursive function, but that's not essential and might even be +harmful. I'm not sure. +-} scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) @@ -1520,6 +1482,51 @@ mkVarUsage env fn args arg_occ | null args = UnkOcc | otherwise = evalScrutOcc +---------------------- +scTopBindEnv :: ScEnv -> CoreBind -> UniqSM (ScEnv, CoreBind) +scTopBindEnv env (Rec prs) + = do { let (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs RecFun + + prs' = zip bndrs' rhss + ; return (rhs_env2, Rec prs') } + where + (bndrs,rhss) = unzip prs + +scTopBindEnv env (NonRec bndr rhs) + = do { let (env1, bndr') = extendBndr env bndr + env2 = extendValEnv env1 bndr' (isValue (sc_vals env) rhs) + ; return (env2, NonRec bndr' rhs) } + +---------------------- +scTopBind :: ScEnv -> ScUsage -> CoreBind -> UniqSM (ScUsage, CoreBind) + +scTopBind env body_usage (Rec prs) + | Just threshold <- sc_size $ sc_opts env + , not force_spec + , not (all (couldBeSmallEnoughToInline (sc_uf_opts $ sc_opts env) threshold) rhss) + -- No specialisation + = -- pprTrace "scTopBind: nospec" (ppr bndrs) $ + do { (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss + ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) } + + | otherwise -- Do specialisation + = do { rhs_infos <- mapM (scRecRhs env) prs + + ; (spec_usage, specs) <- specRec TopLevel (scForce env force_spec) + body_usage rhs_infos + + ; return (body_usage `combineUsage` spec_usage, + Rec (concat (zipWith ruleInfoBinds rhs_infos specs))) } + where + (bndrs,rhss) = unzip prs + force_spec = any (forceSpecBndr env) bndrs + -- Note [Forcing specialisation] + +scTopBind env usage (NonRec bndr rhs) -- Oddly, we don't seem to specialise top-level non-rec functions + = do { (rhs_usg', rhs') <- scExpr env rhs + ; return (usage `combineUsage` rhs_usg', NonRec bndr rhs') } + ---------------------- scRecRhs :: ScEnv -> (OutId, InExpr) -> UniqSM RhsInfo scRecRhs env (bndr,rhs) @@ -1567,8 +1574,7 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have - -- generated for this function + = SI { si_specs :: [OneSpec] -- The specialisations we have generated , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1579,7 +1585,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Seeding recursive groups] + -- See Note [Local recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1589,62 +1595,57 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -initSpecInfo :: RhsInfo -> SpecInfo -initSpecInfo (RI { ri_rhs_usg = rhs_usg }) - = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Just rhs_usg } - -- si_mb_unspec: add in rhs_usg if there are any boring calls, - -- or if the bndr is exported +noSpecInfo :: SpecInfo +noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } ---------------------- specNonRec :: ScEnv - -> CallEnv -- Calls in body + -> ScUsage -- Body usage -> RhsInfo -- Structure info usage info for un-specialised RHS -> UniqSM (ScUsage, SpecInfo) -- Usage from RHSs (specialised and not) -- plus details of specialisations -specNonRec env body_calls rhs_info - = specialise env body_calls rhs_info (initSpecInfo rhs_info) +specNonRec env body_usg rhs_info + = specialise env (scu_calls body_usg) rhs_info + (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) ---------------------- -specRec :: ScEnv - -> CallEnv -- Calls in body +specRec :: TopLevelFlag -> ScEnv + -> ScUsage -- Body usage -> [RhsInfo] -- Structure info and usage info for un-specialised RHSs -> UniqSM (ScUsage, [SpecInfo]) -- Usage from all RHSs (specialised and not) -- plus details of specialisations -specRec env body_calls rhs_infos - = go 1 body_calls nullUsage (map initSpecInfo rhs_infos) - -- body_calls: see Note [Seeding recursive groups] - -- NB: 'go' always calls 'specialise' once, which in turn unleashes - -- si_mb_unspec if there are any boring calls in body_calls, - -- or if any of the Id(s) are exported +specRec top_lvl env body_usg rhs_infos + = go 1 seed_calls nullUsage init_spec_infos where opts = sc_opts env + (seed_calls, init_spec_infos) -- Note [Seeding top-level recursive groups] + | isTopLevel top_lvl + , any (isExportedId . ri_fn) rhs_infos -- Seed from body and RHSs + = (all_calls, [noSpecInfo | _ <- rhs_infos]) + | otherwise -- Seed from body only + = (calls_in_body, [noSpecInfo { si_mb_unspec = Just (ri_rhs_usg ri) } + | ri <- rhs_infos]) + + calls_in_body = scu_calls body_usg + calls_in_rhss = foldr (combineCalls . scu_calls . ri_rhs_usg) emptyVarEnv rhs_infos + all_calls = calls_in_rhss `combineCalls` calls_in_body -- Loop, specialising, until you get no new specialisations - go, go_again :: Int -- Which iteration of the "until no new specialisations" - -- loop we are on; first iteration is 1 - -> CallEnv -- Seed calls - -- Two accumulating parameters: - -> ScUsage -- Usage from earlier specialisations - -> [SpecInfo] -- Details of specialisations so far - -> UniqSM (ScUsage, [SpecInfo]) + go :: Int -- Which iteration of the "until no new specialisations" + -- loop we are on; first iteration is 1 + -> CallEnv -- Seed calls + -- Two accumulating parameters: + -> ScUsage -- Usage from earlier specialisations + -> [SpecInfo] -- Details of specialisations so far + -> UniqSM (ScUsage, [SpecInfo]) go n_iter seed_calls usg_so_far spec_infos - = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) - -- , text "iteration" <+> int n_iter - -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) - -- ]) $ - do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos - ; let (extra_usg_s, all_spec_infos) = unzip specs_w_usg - extra_usg = combineUsages extra_usg_s - all_usg = usg_so_far `combineUsage` extra_usg - new_calls = scu_calls extra_usg - ; go_again n_iter new_calls all_usg all_spec_infos } - - -- go_again deals with termination - go_again n_iter seed_calls usg_so_far spec_infos | isEmptyVarEnv seed_calls - = return (usg_so_far, spec_infos) + = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) + -- , ppr seed_calls + -- , ppr body_usg ]) $ + return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1653,20 +1654,26 @@ specRec env body_calls rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- Give up on specialisation, but don't forget to include the rhs_usg - -- for the unspecialised function, since it may now be called - -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - let rhs_usgs = combineUsages (mapMaybe si_mb_unspec spec_infos) - in return (usg_so_far `combineUsage` rhs_usgs, spec_infos) + = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ + return (usg_so_far, spec_infos) | otherwise - = go (n_iter + 1) seed_calls usg_so_far spec_infos + = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) + -- , text "iteration" <+> int n_iter + -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) + -- ]) $ + do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos + ; let (extra_usg_s, new_spec_infos) = unzip specs_w_usg + extra_usg = combineUsages extra_usg_s + all_usg = usg_so_far `combineUsage` extra_usg + ; go (n_iter + 1) (scu_calls extra_usg) all_usg new_spec_infos } -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max + ---------------------- specialise :: ScEnv @@ -1689,12 +1696,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs spec_info@(SI { si_specs = specs, si_n_specs = spec_count , si_mb_unspec = mb_unspec }) | isDeadEndId fn -- Note [Do not specialise diverging functions] - -- /and/ do not generate specialisation seeds from its RHS + -- and do not generate specialisation seeds from its RHS = -- pprTrace "specialise bot" (ppr fn) $ return (nullUsage, spec_info) | not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation] + -- + -- -- Don't specialise OPAQUE things, see Note [OPAQUE pragma]. -- Since OPAQUE things are always never-active (see -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for @@ -1720,16 +1729,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs ; let spec_usg = combineUsages spec_usgs - unspec_rhs_needed = boring_call || isExportedId fn - -- If there were any boring calls among the seeds (= all_calls), then those -- calls will call the un-specialised function. So we should use the seeds -- from the _unspecialised_ function's RHS, which are in mb_unspec, by returning -- then in new_usg. - (new_usg, mb_unspec') = case mb_unspec of - Just rhs_usg | unspec_rhs_needed - -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') + = case mb_unspec of + Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1737,8 +1744,8 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs -- , text "new calls:" <+> ppr (scu_calls new_usg)]) $ -- return () - ; return (new_usg, SI { si_specs = new_specs ++ specs - , si_n_specs = spec_count + n_pats + ; return (new_usg, SI { si_specs = new_specs ++ specs + , si_n_specs = spec_count + n_pats , si_mb_unspec = mb_unspec' }) } | otherwise -- No calls, inactive, or not a function @@ -2020,8 +2027,7 @@ calcSpecInfo fn (CP { cp_qvars = qvars, cp_args = pats }) extra_bndrs Note [spec_usg includes rhs_usg] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In calls to 'specialise', the returned ScUsage must include the rhs_usg in -the passed-in SpecInfo in si_mb_unspec, unless there are no calls at all to -the function. +the passed-in SpecInfo, unless there are no calls at all to the function. The caller can, indeed must, assume this. They should not combine in rhs_usg themselves, or they'll get rhs_usg twice -- and that can lead to an exponential @@ -2239,11 +2245,9 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) --- Result has no duplicate patterns, --- nor ones mentioned in si_specs (hence "new" patterns) --- Bool indicates that there was at least one boring pattern --- The "New" in the name means "patterns that are not already covered --- by an existing specialisation" + -- Result has no duplicate patterns, + -- nor ones mentioned in done_pats + -- Bool indicates that there was at least one boring pattern callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a7e2ea1684c3a3ac91e4cdbb07b9d217f58dd4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a7e2ea1684c3a3ac91e4cdbb07b9d217f58dd4c You're receiving 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 Aug 19 04:14:54 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 00:14:54 -0400 Subject: [Git][ghc/ghc][ghc-9.4] 3 commits: gitlab-ci: Fix ARMv7 build Message-ID: <62ff0e3e171bf_125b2b48850147447@gitlab.mail> Ben Gamari pushed to branch ghc-9.4 at Glasgow Haskell Compiler / GHC Commits: aeb04c72 by Ben Gamari at 2022-08-18T15:59:46-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. (cherry picked from commit 5bc489cac104717f09be73f2b578719bcc1e3fcb) - - - - - c534eb5d by Ben Gamari at 2022-08-18T16:06:45-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used (cherry picked from commit 596db9a5f966643bcc9994d45f2f6ffb4037ad74) - - - - - ed84e10b by Matthew Pickering at 2022-08-18T16:06:45-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 (cherry picked from commit a740a4c56416c7c1bc914a7a9207207e17833573) - - - - - 7 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Monad.hs - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T22044.bazoo - testsuite/tests/driver/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -311,8 +311,15 @@ opsysVariables _ FreeBSD13 = mconcat ] opsysVariables ARMv7 (Linux distro) = distroVariables distro <> - mconcat [ -- ld.gold is affected by #16177 and therefore cannot be used. - "CONFIGURE_ARGS" =: "LD=ld.lld" + mconcat [ "CONFIGURE_ARGS" =: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" + -- N.B. We disable ld.lld explicitly here because it appears to fail + -- non-deterministically on ARMv7. See #18280. + , "LD" =: "ld.gold" + , "GccUseLdOpt" =: "-fuse-ld=gold" + -- Awkwardly, this appears to be necessary to work around a + -- live-lock exhibited by the CPython (at least in 3.9 and 3.8) + -- interpreter on ARMv7 + , "HADRIAN_ARGS" =: "--test-verbose=3" ] opsysVariables _ (Linux distro) = distroVariables distro opsysVariables AArch64 (Darwin {}) = @@ -480,6 +487,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" label is set. | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -500,6 +508,8 @@ ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" ruleString Off FreeBSDLabel = true +ruleString On ARMLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/" +ruleString Off ARMLabel = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" @@ -769,7 +779,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13)) , standardBuilds AArch64 Darwin , standardBuilds AArch64 (Linux Debian10) - , allowFailureGroup (disableValidate (standardBuilds ARMv7 (Linux Debian10))) + , allowFailureGroup (addValidateRule ARMLabel (standardBuilds ARMv7 (Linux Debian10))) , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) ===================================== .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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -174,7 +174,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate" } }, @@ -213,7 +216,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -271,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -334,7 +337,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -393,7 +396,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -412,7 +415,10 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-validate", "XZ_OPT": "-9" } @@ -452,7 +458,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -511,7 +517,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -576,7 +582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -637,7 +643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -699,7 +705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -761,7 +767,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -821,7 +827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -880,7 +886,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -939,7 +945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -999,7 +1005,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1058,7 +1064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1117,7 +1123,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1176,7 +1182,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1235,7 +1241,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1296,7 +1302,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1355,7 +1361,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1414,7 +1420,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1475,7 +1481,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1537,7 +1543,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1598,7 +1604,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1653,7 +1659,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1712,7 +1718,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"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\")", "when": "on_success" } ], @@ -1775,7 +1781,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1839,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1899,7 +1905,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -1918,8 +1924,11 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-armv7-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "LD=ld.lld ", + "CONFIGURE_ARGS": "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf ", + "GccUseLdOpt": "-fuse-ld=gold", + "HADRIAN_ARGS": "--test-verbose=3", "IGNORE_PERF_FAILURES": "all", + "LD": "ld.gold", "TEST_ENV": "armv7-linux-deb10-release", "XZ_OPT": "-9" } @@ -1959,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2019,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2085,7 +2094,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2147,7 +2156,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2210,7 +2219,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2273,7 +2282,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2334,7 +2343,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2394,7 +2403,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2454,7 +2463,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2514,7 +2523,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2574,7 +2583,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2636,7 +2645,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2698,7 +2707,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2761,7 +2770,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2817,7 +2826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2877,7 +2886,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -2941,7 +2950,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3005,7 +3014,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"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\")", "when": "on_success" } ], @@ -3065,7 +3074,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3126,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3187,7 +3196,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3246,7 +3255,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3305,7 +3314,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3363,7 +3372,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3431,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3480,7 +3489,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3538,7 +3547,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3596,7 +3605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"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\")", "when": "on_success" } ], @@ -3655,7 +3664,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "manual" } ], @@ -3715,7 +3724,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3773,7 +3782,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3831,7 +3840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"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\")", "when": "on_success" } ], @@ -3891,7 +3900,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3952,7 +3961,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4012,7 +4021,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4066,7 +4075,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4124,7 +4133,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -171,7 +171,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = -> Just (DriverPsHeaderMessage (PsHeaderMessage msg)) _ -> Nothing - pipe_env = mkPipeEnv StopPreprocess input_fn (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv StopPreprocess input_fn mb_phase (Temporary TFL_GhcSession) mkInputFn = case mb_input_buf of Just input_buf -> do @@ -238,7 +238,7 @@ compileOne' mHscMessage [ml_obj_file $ ms_location summary] plugin_hsc_env <- initializePlugins hsc_env - let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput + 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) @@ -513,7 +513,7 @@ oneShot hsc_env stop_phase srcs = do NoStop -> doLink hsc_env o_files compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath) -compileFile hsc_env stop_phase (src, _mb_phase) = do +compileFile hsc_env stop_phase (src, mb_phase) = do exists <- doesFileExist src when (not exists) $ throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src)) @@ -534,8 +534,8 @@ compileFile hsc_env stop_phase (src, _mb_phase) = do | isJust mb_o_file = SpecificFile -- -o foo applies to the file we are compiling now | otherwise = Persistent - pipe_env = mkPipeEnv stop_phase src output - pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src + pipe_env = mkPipeEnv stop_phase src mb_phase output + pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src mb_phase runPipeline (hsc_hooks hsc_env) pipeline @@ -584,7 +584,7 @@ compileForeign hsc_env lang stub_c = do #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif - pipe_env = mkPipeEnv NoStop stub_c (Temporary TFL_GhcSession) + pipe_env = mkPipeEnv NoStop stub_c Nothing (Temporary TFL_GhcSession) res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. @@ -608,7 +608,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode CStyle src)) - let pipe_env = (mkPipeEnv NoStop empty_stub Persistent) { src_basename = basename} + let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename} pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline return () @@ -618,15 +618,17 @@ compileEmptyStub dflags hsc_env basename location mod_name = do mkPipeEnv :: StopPhase -- End phase -> FilePath -- input fn + -> Maybe Phase -> PipelineOutput -- Output -> PipeEnv -mkPipeEnv stop_phase input_fn output = +mkPipeEnv stop_phase input_fn start_phase output = let (basename, suffix) = splitExtension input_fn suffix' = drop 1 suffix -- strip off the . env = PipeEnv{ stop_phase, src_filename = input_fn, src_basename = basename, src_suffix = suffix', + start_phase = fromMaybe (startPhase suffix') start_phase, output_spec = output } in env @@ -696,8 +698,7 @@ preprocessPipeline pipe_env hsc_env input_fn = do where platform = targetPlatform (hsc_dflags hsc_env) runAfter :: P p => Phase -> a -> p a -> p a - runAfter = phaseIfAfter platform start_phase - start_phase = startPhase (src_suffix pipe_env) + runAfter = phaseIfAfter platform (start_phase pipe_env) runAfterFlag :: P p => HscEnv -> Phase @@ -823,9 +824,9 @@ hscPostBackendPipeline pipe_env hsc_env _ bcknd ml input_fn = Interpreter -> return Nothing -- Pipeline from a given suffix -pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) -pipelineStart pipe_env hsc_env input_fn = - fromSuffix (src_suffix pipe_env) +pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> Maybe Phase -> m (Maybe FilePath) +pipelineStart pipe_env hsc_env input_fn mb_phase = + fromPhase (fromMaybe (startPhase $ src_suffix pipe_env) mb_phase) where stop_after = stop_phase pipe_env frontend :: P m => HscSource -> m (Maybe FilePath) @@ -857,33 +858,24 @@ pipelineStart pipe_env hsc_env input_fn = objFromLinkable _ = Nothing - fromSuffix :: P m => String -> m (Maybe FilePath) - fromSuffix "lhs" = frontend HsSrcFile - fromSuffix "lhs-boot" = frontend HsBootFile - fromSuffix "lhsig" = frontend HsigFile - fromSuffix "hs" = frontend HsSrcFile - fromSuffix "hs-boot" = frontend HsBootFile - fromSuffix "hsig" = frontend HsigFile - fromSuffix "hscpp" = frontend HsSrcFile - fromSuffix "hspp" = frontend HsSrcFile - fromSuffix "hc" = c HCc - fromSuffix "c" = c Cc - fromSuffix "cpp" = c Ccxx - fromSuffix "C" = c Cc - fromSuffix "m" = c Cobjc - fromSuffix "M" = c Cobjcxx - fromSuffix "mm" = c Cobjcxx - fromSuffix "cc" = c Ccxx - fromSuffix "cxx" = c Ccxx - fromSuffix "s" = as False - fromSuffix "S" = as True - fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn - fromSuffix "o" = return (Just input_fn) - fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn - fromSuffix _ = return (Just input_fn) + fromPhase :: P m => Phase -> m (Maybe FilePath) + fromPhase (Unlit p) = frontend p + fromPhase (Cpp p) = frontend p + fromPhase (HsPp p) = frontend p + fromPhase (Hsc p) = frontend p + fromPhase HCc = c HCc + fromPhase Cc = c Cc + fromPhase Ccxx = c Ccxx + fromPhase Cobjc = c Cobjc + fromPhase Cobjcxx = c Cobjcxx + fromPhase (As p) = as p + fromPhase LlvmOpt = llvmPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromPhase StopLn = return (Just input_fn) + fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase MergeForeign = panic "fromPhase: MergeForeign" {- Note [The Pipeline Monad] ===================================== compiler/GHC/Driver/Pipeline/Monad.hs ===================================== @@ -29,6 +29,7 @@ data PipeEnv = PipeEnv { src_filename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source src_suffix :: String, -- ^ its extension + start_phase :: Phase, output_spec :: PipelineOutput -- ^ says where to put the pipeline output } ===================================== testsuite/tests/driver/Makefile ===================================== @@ -750,3 +750,11 @@ T21869: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T21869.hs -S [ -f T21869.s ] || (echo "assembly file does not exist" && exit 2) [ ! -f T21869.o ] || (echo "object file exists" && exit 2) + +.PHONY: T22044 +T22044: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -E -cpp -x hs T22044.bazoo -o T22044.hs -DBAZOO=1 + # Test the file exists and is preprocessed + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T22044.hs + + ===================================== testsuite/tests/driver/T22044.bazoo ===================================== @@ -0,0 +1,3 @@ +module T22044 where + +bazoo = BAZOO ===================================== testsuite/tests/driver/all.T ===================================== @@ -308,3 +308,4 @@ test('patch-level2', normal, compile, ['-Wcpp-undef']) test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21869', normal, makefile_test, []) +test('T22044', normal, makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04c592df1643b1f3bdf1824a9c88887c054402e...ed84e10b0d2cf107a2858f1dfc0698d0e71bdd4f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d04c592df1643b1f3bdf1824a9c88887c054402e...ed84e10b0d2cf107a2858f1dfc0698d0e71bdd4f You're receiving 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 Aug 19 04:14:55 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 00:14:55 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.4 Message-ID: <62ff0e3f7db5a_125b2b4e4a81476fd@gitlab.mail> Ben Gamari deleted branch wip/backports-9.4 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 Aug 19 10:07:48 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 Aug 2022 06:07:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21608 Message-ID: <62ff60f4e6c2_125b2b487ec1994c5@gitlab.mail> Simon Peyton Jones pushed new branch wip/T21608 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21608 You're receiving 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 Aug 19 11:13:57 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 19 Aug 2022 07:13:57 -0400 Subject: [Git][ghc/ghc][wip/andreask/rules-omit-fix] Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Message-ID: <62ff707530a58_125b2b488282115f8@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/rules-omit-fix at Glasgow Haskell Compiler / GHC Commits: 411e8813 by Andreas Klebinger at 2022-08-19T13:12:18+02:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 3 changed files: - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1048,7 +1048,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} ===================================== testsuite/tests/driver/all.T ===================================== @@ -312,3 +312,4 @@ test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) test('T22044', normal, makefile_test, []) +test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/411e881309614e60459a078bdc16afbff094f316 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/411e881309614e60459a078bdc16afbff094f316 You're receiving 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 Aug 19 12:49:17 2022 From: gitlab at gitlab.haskell.org (Sasha Bogicevic (@Bogicevic)) Date: Fri, 19 Aug 2022 08:49:17 -0400 Subject: [Git][ghc/ghc][wip/19217] 133 commits: Make withDict opaque to the specialiser Message-ID: <62ff86cd60cb_125b2b502bc23086d@gitlab.mail> Sasha Bogicevic pushed to branch wip/19217 at Glasgow Haskell Compiler / GHC Commits: 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 4f5e999c by Sasha Bogicevic at 2022-08-19T14:48:49+02:00 19217 Implicitly quantify type variables in :kind command - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/upload_ghc_libs.py - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core.hs - + compiler/GHC/Core.hs-boot - compiler/GHC/Core/Coercion.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9e8190285de238f4d17a120251328b0a10b979ae...4f5e999c9b6e396f94d0889da6a17198c6238b8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9e8190285de238f4d17a120251328b0a10b979ae...4f5e999c9b6e396f94d0889da6a17198c6238b8a You're receiving 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 Aug 19 14:32:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 10:32:22 -0400 Subject: [Git][ghc/ghc][wip/T22077] Refactor IPE initialization Message-ID: <62ff9ef6248df_125b2b4885025118d@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 3b3e4230 by Ben Gamari at 2022-08-19T10:32:07-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 13 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/ghc.cabal.in - rts/IPE.c - rts/IPE.h - rts/Trace.c - rts/Trace.h - rts/include/rts/IPE.h - rts/include/stg/SMP.h Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -299,6 +299,7 @@ data ModuleLabelKind | MLK_InitializerArray | MLK_Finalizer String | MLK_FinalizerArray + | MLK_IPEBuffer deriving (Eq, Ord) instance Outputable ModuleLabelKind where @@ -306,6 +307,7 @@ instance Outputable ModuleLabelKind where ppr (MLK_Initializer s) = text ("init__" ++ s) ppr MLK_FinalizerArray = text "fini_arr" ppr (MLK_Finalizer s) = text ("fini__" ++ s) + ppr MLK_IPEBuffer = text "ipe_buf" isIdLabel :: CLabel -> Bool isIdLabel IdLabel{} = True @@ -830,10 +832,10 @@ instance OutputableP Platform InfoProvEnt where -- Constructing Cost Center Labels mkCCLabel :: CostCentre -> CLabel mkCCSLabel :: CostCentreStack -> CLabel -mkIPELabel :: InfoProvEnt -> CLabel +mkIPELabel :: Module -> CLabel mkCCLabel cc = CC_Label cc mkCCSLabel ccs = CCS_Label ccs -mkIPELabel ipe = IPE_Label ipe +mkIPELabel mod = ModuleLabel mod MLK_IPEBuffer mkRtsApFastLabel :: FastString -> CLabel mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str)) @@ -1011,6 +1013,7 @@ modLabelNeedsCDecl :: ModuleLabelKind -> Bool -- Code for finalizers and initializers are emitted in stub objects modLabelNeedsCDecl (MLK_Initializer _) = True modLabelNeedsCDecl (MLK_Finalizer _) = True +modLabelNeedsCDecl MLK_IPEBuffer = True -- The finalizer and initializer arrays are emitted in the code of the module modLabelNeedsCDecl MLK_InitializerArray = False modLabelNeedsCDecl MLK_FinalizerArray = False @@ -1208,6 +1211,7 @@ moduleLabelKindType kind = MLK_InitializerArray -> DataLabel MLK_Finalizer _ -> CodeLabel MLK_FinalizerArray -> DataLabel + MLK_IPEBuffer -> DataLabel idInfoLabelType :: IdLabelInfo -> CLabelType idInfoLabelType info = ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -224,6 +224,7 @@ import GHC.StgToCmm.Layout hiding (ArgRep(..)) import GHC.StgToCmm.Ticky import GHC.StgToCmm.Prof import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame ) +import GHC.StgToCmm.InfoTableProv import GHC.Cmm.Opt import GHC.Cmm.Graph @@ -1518,9 +1519,8 @@ parseCmmFile cmmpConfig this_mod home_unit filename = do let fcode = do ((), cmm) <- getCmm $ unEC code "global" (initEnv (pdProfile pdConfig)) [] >> return () -- See Note [Mapping Info Tables to Source Positions] (IPE Maps) - let used_info = map (cmmInfoTableToInfoProvEnt this_mod) - (mapMaybe topInfoTable cmm) - ((), cmm2) <- getCmm $ mapM_ emitInfoTableProv used_info + let used_info = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTable cmm) + ((), cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info return (cmm ++ cmm2, used_info) (cmm, _) = runC (cmmpStgToCmmConfig cmmpConfig) fstate st fcode (warnings,errors) = getPsMessages pst ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -368,24 +368,17 @@ ipInitCode :: Bool -- is Opt_InfoTableMap enabled or not -> Platform -> Module - -> [InfoProvEnt] -> CStub -ipInitCode do_info_table platform this_mod ents +ipInitCode do_info_table platform this_mod | not do_info_table = mempty - | otherwise = initializerCStub platform fn_nm decls body + | otherwise = initializerCStub platform fn_nm ipe_buffer_decl body where fn_nm = mkInitializerStubLabel this_mod "ip_init" - decls = vcat - $ map emit_ipe_decl ents - ++ [emit_ipe_list ents] - body = text "registerInfoProvList" <> parens local_ipe_list_label <> semi - emit_ipe_decl ipe = - text "extern InfoProvEnt" <+> ipe_lbl <> text "[];" - where ipe_lbl = pprCLabel platform CStyle (mkIPELabel ipe) - local_ipe_list_label = text "local_ipe_" <> ppr this_mod - emit_ipe_list ipes = - text "static InfoProvEnt *" <> local_ipe_list_label <> text "[] =" - <+> braces (vcat $ [ pprCLabel platform CStyle (mkIPELabel ipe) <> comma - | ipe <- ipes - ] ++ [text "NULL"]) - <> semi + + body = text "registerInfoProvList" <> parens (text "&" <> ipe_buffer_label) <> semi + + ipe_buffer_label = pprCLabel platform CStyle (mkIPELabel this_mod) + + ipe_buffer_decl = + text "extern IpeBufferListNode" <+> ipe_buffer_label <> text ";" + ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1830,7 +1830,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs mod_name = mkModuleName $ "Cmm$" ++ original_filename cmm_mod = mkHomeModule home_unit mod_name cmmpConfig = initCmmParserConfig dflags - (cmm, ents) <- ioMsgMaybe + (cmm, _ents) <- ioMsgMaybe $ do (warns,errs,cmm) <- withTiming logger (text "ParseCmm"<+>brackets (text filename)) (\_ -> ()) $ parseCmmFile cmmpConfig cmm_mod home_unit filename @@ -1857,7 +1857,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs Just h -> h dflags Nothing (Stream.yield cmmgroup) let foreign_stubs _ = - let ip_init = ipInitCode do_info_table platform cmm_mod ents + let ip_init = ipInitCode do_info_table platform cmm_mod in NoStubs `appendStubC` ip_init (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -0,0 +1,130 @@ +module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where + +import GHC.Prelude +import GHC.Platform +import GHC.Unit.Module +import GHC.Utils.Outputable + +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 Data.Bifunctor (first) +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 + +emitIpeBufferListNode :: Module + -> [InfoProvEnt] + -> FCode () +emitIpeBufferListNode this_mod ents = do + cfg <- getStgToCmmConfig + let ctx = stgToCmmContext cfg + platform = stgToCmmPlatform cfg + + 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 (ipeSrcLoc cg_ipe) + ] + + 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 + +toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt +toCgIPE platform ctx module_name ipe = do + table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (infoTablePtr ipe)) + closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe) + type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe + let (src_loc_str, label_str) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ipe) + label <- lookupStringTable $ ST.pack label_str + src_loc <- lookupStringTable $ ST.pack src_loc_str + return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe + , ipeTableName = table_name + , ipeClosureDesc = closure_desc + , ipeTypeDesc = type_desc + , ipeLabel = label + , ipeModuleName = module_name + , ipeSrcLoc = src_loc + } + +data CgInfoProvEnt = CgInfoProvEnt + { ipeInfoTablePtr :: !CLabel + , ipeTableName :: !StrTabOffset + , ipeClosureDesc :: !StrTabOffset + , ipeTypeDesc :: !StrTabOffset + , ipeLabel :: !StrTabOffset + , ipeModuleName :: !StrTabOffset + , ipeSrcLoc :: !StrTabOffset + } + +data StringTable = StringTable { stStrings :: DList ShortText + , stLength :: !Int + , stLookup :: !(M.Map ShortText StrTabOffset) + } + +newtype StrTabOffset = StrTabOffset Int + +emptyStringTable :: StringTable +emptyStringTable = + StringTable { stStrings = emptyDList + , stLength = 0 + , stLookup = M.empty + } + +getStringTableStrings :: StringTable -> BS.ByteString +getStringTableStrings st = + BSL.toStrict $ BSB.toLazyByteString + $ foldMap f $ dlistToList (stStrings st) + where + f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0 + +lookupStringTable :: ShortText -> State StringTable StrTabOffset +lookupStringTable str = state $ \st -> + case M.lookup str (stLookup st) of + Just off -> (off, st) + Nothing -> + let !st' = st { stStrings = stStrings st `snoc` str + , stLength = stLength st + ST.byteLength str + 1 + , stLookup = M.insert str res (stLookup st) + } + res = StrTabOffset (stLength st) + in (res, st') + +newtype DList a = DList ([a] -> [a]) + +emptyDList :: DList a +emptyDList = DList id + +snoc :: DList a -> a -> DList a +snoc (DList f) x = DList (f . (x:)) + +dlistToList :: DList a -> [a] +dlistToList (DList f) = f [] ===================================== compiler/GHC/StgToCmm/Prof.hs ===================================== @@ -11,7 +11,7 @@ module GHC.StgToCmm.Prof ( mkCCostCentre, mkCCostCentreStack, -- infoTablePRov - initInfoTableProv, emitInfoTableProv, + initInfoTableProv, -- Cost-centre Profiling dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf, @@ -32,6 +32,7 @@ import GHC.Platform import GHC.Platform.Profile import GHC.StgToCmm.Closure import GHC.StgToCmm.Config +import GHC.StgToCmm.InfoTableProv import GHC.StgToCmm.Utils import GHC.StgToCmm.Monad import GHC.StgToCmm.Lit @@ -55,7 +56,6 @@ import GHC.Utils.Encoding import Control.Monad import Data.Char (ord) -import Data.Bifunctor (first) import GHC.Utils.Monad (whenM) ----------------------------------------------------------------------------- @@ -274,9 +274,8 @@ sizeof_ccs_words platform where (ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform - +-- | Emit info-table provenance declarations initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode CStub --- Emit the declarations initInfoTableProv infos itmap = do cfg <- getStgToCmmConfig @@ -284,42 +283,16 @@ initInfoTableProv infos itmap info_table = stgToCmmInfoTableMap cfg platform = stgToCmmPlatform cfg this_mod = stgToCmmThisModule cfg - -- Output the actual IPE data - mapM_ emitInfoTableProv ents - -- Create the C stub which initialises the IPE map - return (ipInitCode info_table platform this_mod ents) - ---- Info Table Prov stuff -emitInfoTableProv :: InfoProvEnt -> FCode () -emitInfoTableProv ip = do - { cfg <- getStgToCmmConfig - ; let mod = infoProvModule ip - ctx = stgToCmmContext cfg - platform = stgToCmmPlatform cfg - ; let (src, label) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ip) - mk_string = newByteStringCLit . utf8EncodeByteString - ; label <- mk_string label - ; modl <- newByteStringCLit (bytesFS $ moduleNameFS - $ moduleName mod) - - ; ty_string <- mk_string (infoTableType ip) - ; loc <- mk_string src - ; table_name <- mk_string (renderWithContext ctx - (pprCLabel platform CStyle (infoTablePtr ip))) - ; closure_type <- mk_string (renderWithContext ctx - (text $ show $ infoProvEntClosureType ip)) - ; let - lits = [ CmmLabel (infoTablePtr ip), -- Info table pointer - table_name, -- char *table_name - closure_type, -- char *closure_desc -- Filled in from the InfoTable - ty_string, -- char *ty_string - label, -- char *label, - modl, -- char *module, - loc, -- char *srcloc, - zero platform -- struct _InfoProvEnt *link - ] - ; emitDataLits (mkIPELabel ip) lits - } + + case ents of + [] -> return mempty + _ -> do + -- Emit IPE buffer + emitIpeBufferListNode this_mod ents + + -- Create the C stub which initialises the IPE map + return (ipInitCode info_table platform this_mod) + -- --------------------------------------------------------------------------- -- Set the current cost centre stack ===================================== compiler/ghc.cabal.in ===================================== @@ -615,6 +615,7 @@ Library GHC.StgToCmm.Foreign GHC.StgToCmm.Heap GHC.StgToCmm.Hpc + GHC.StgToCmm.InfoTableProv GHC.StgToCmm.Layout GHC.StgToCmm.Lit GHC.StgToCmm.Monad ===================================== rts/IPE.c ===================================== @@ -34,17 +34,22 @@ Unfortunately, inserting into the hash map is relatively expensive. To keep startup times low, there's a temporary data structure that is optimized for collecting IPE lists on registration. -It's a singly linked list of IPE list buffers. Each buffer contains space for -126 IPE lists. This number is a bit arbitrary, but leaves a few bytes so that -the whole structure might fit into 1024 bytes. - -On registering a new IPE list, there are three cases: - -- It's the first entry at all: Allocate a new IpeBufferListNode and make it the - buffer's first entry. -- The current IpeBufferListNode has space in it's buffer: Add it to the buffer. -- The current IpeBufferListNode's buffer is full: Allocate a new one and link it -to the previous one, making this one the new current. +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. + +For reasons of space efficiency, IPE entries are represented slightly +differently in the object file than the InfoProvEnt which we ultimately expose +to the user. Specifically, the IPEs in IpeBufferListNode are represented by +IpeBufferEntrys, along with a corresponding string table. The string fields +of InfoProvEnt are represented in IpeBufferEntry as 32-bit offsets into the +string table. This allows us to halve the size of the buffer entries on +64-bit machines while significantly reducing the number of needed +relocations, reducing linking cost. Moreover, the code generator takes care +to deduplicate strings when generating the string table. When we inserting a +set of IpeBufferEntrys into the IPE hash-map we convert them to InfoProvEnts, +which contain proper string pointers. Building the hash map is done lazily, i.e. on first lookup or traversal. For this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. @@ -52,12 +57,12 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. After the content of a IpeBufferListNode has been inserted, it's freed. */ +static Mutex ipeMapLock; static HashTable *ipeMap = NULL; +// Accessed atomically static IpeBufferListNode *ipeBufferList = NULL; -static Mutex ipeMapLock; - void initIpeMapLock(void) { initMutex(&ipeMapLock); } void closeIpeMapLock(void) { closeMutex(&ipeMapLock); } @@ -66,25 +71,7 @@ void dumpIPEToEventLog(void) { #if defined(TRACING) ACQUIRE_LOCK(&ipeMapLock); - IpeBufferListNode *cursor = ipeBufferList; - while (cursor != NULL) { - for (int i = 0; i < cursor->count; i++) { - for (InfoProvEnt **ipeList = cursor->buffer[i]; *ipeList != NULL; - ipeList++) { - InfoProvEnt *ipe = *ipeList; - - traceIPE(ipe->info, ipe->prov.table_name, - ipe->prov.closure_desc, ipe->prov.ty_desc, - ipe->prov.label, ipe->prov.module, ipe->prov.srcloc); - } - } - - cursor = cursor->next; - } - - if (ipeMap != NULL) { - mapHashTable(ipeMap, NULL, &traceIPEFromHashTable); - } + // TODO RELEASE_LOCK(&ipeMapLock); #endif @@ -109,50 +96,20 @@ Note [The Info Table Provenance Entry (IPE) Map]. Statically initialized IPE lists are registered at startup by a C constructor function generated by the compiler (CodeOutput.hs) in a *.c file for each -module. +module. Since this is called in a static initializer we cannot rely on +ipeMapLock; we instead use atomic CAS operations to add to the list. A performance test for IPE registration and lookup can be found here: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806 */ -void registerInfoProvList(InfoProvEnt **ent_list) { - // The list must be dereferenceable. - ASSERT(ent_list[0] == NULL || ent_list[0] != NULL); - - // Ignore empty lists - if (ent_list[0] == NULL) { - return; - } - - ACQUIRE_LOCK(&ipeMapLock); - - if (ipeBufferList == NULL) { - ASSERT(ipeBufferList == NULL); - - ipeBufferList = stgMallocBytes(sizeof(IpeBufferListNode), - "registerInfoProvList-firstNode"); - ipeBufferList->buffer[0] = ent_list; - ipeBufferList->count = 1; - ipeBufferList->next = NULL; - } else { - if (ipeBufferList->count < IPE_LIST_NODE_BUFFER_SIZE) { - ipeBufferList->buffer[ipeBufferList->count] = ent_list; - ipeBufferList->count = ipeBufferList->count + 1; - - ASSERT(ipeBufferList->next == NULL || - ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); - } else { - IpeBufferListNode *newNode = stgMallocBytes( - sizeof(IpeBufferListNode), "registerInfoProvList-nextNode"); - newNode->buffer[0] = ent_list; - newNode->count = 1; - newNode->next = ipeBufferList; - ipeBufferList = newNode; - - ASSERT(ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); +void registerInfoProvList(IpeBufferListNode *node) { + while (true) { + IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList); + node->next = old; + if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) { + return; } } - - RELEASE_LOCK(&ipeMapLock); } InfoProvEnt *lookupIPE(const StgInfoTable *info) { @@ -163,7 +120,8 @@ InfoProvEnt *lookupIPE(const StgInfoTable *info) { void updateIpeMap() { // Check if there's any work at all. If not so, we can circumvent locking, // which decreases performance. - if (ipeMap != NULL && ipeBufferList == NULL) { + IpeBufferListNode *pending = xchg_ptr((void **) &ipeBufferList, NULL); + if (ipeMap != NULL && pending == NULL) { return; } @@ -173,23 +131,25 @@ void updateIpeMap() { ipeMap = allocHashTable(); } - while (ipeBufferList != NULL) { - ASSERT(ipeBufferList->next == NULL || - ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); - ASSERT(ipeBufferList->count > 0 && - ipeBufferList->count <= IPE_LIST_NODE_BUFFER_SIZE); - - IpeBufferListNode *currentNode = ipeBufferList; - - for (int i = 0; i < currentNode->count; i++) { - for (InfoProvEnt **ipeList = currentNode->buffer[i]; - *ipeList != NULL; ipeList++) { - insertHashTable(ipeMap, (StgWord)(*ipeList)->info, *ipeList); - } + while (pending != NULL) { + IpeBufferListNode *currentNode = pending; + InfoProvEnt *ip_ents = stgMallocBytes(sizeof(InfoProvEnt) * currentNode->count, "updateIpeMap"); + const char *strings = currentNode->string_table; + + for (uint32_t i = 0; i < currentNode->count; i++) { + const IpeBufferEntry *ent = ¤tNode->entries[i]; + ip_ents[i].info = ent->info; + ip_ents[i].prov.table_name = &strings[ent->table_name]; + ip_ents[i].prov.closure_desc = &strings[ent->closure_desc]; + ip_ents[i].prov.ty_desc = &strings[ent->ty_desc]; + ip_ents[i].prov.label = &strings[ent->label]; + ip_ents[i].prov.module = &strings[ent->module_name]; + ip_ents[i].prov.srcloc = &strings[ent->srcloc]; + + insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); } - ipeBufferList = currentNode->next; - stgFree(currentNode); + pending = currentNode->next; } RELEASE_LOCK(&ipeMapLock); ===================================== rts/IPE.h ===================================== @@ -13,14 +13,6 @@ #include "BeginPrivate.h" -#define IPE_LIST_NODE_BUFFER_SIZE 126 - -typedef struct IpeBufferListNode_ { - InfoProvEnt **buffer[IPE_LIST_NODE_BUFFER_SIZE]; - StgWord8 count; - struct IpeBufferListNode_ *next; -} IpeBufferListNode; - void dumpIPEToEventLog(void); void updateIpeMap(void); void initIpeMapLock(void); ===================================== rts/Trace.c ===================================== @@ -675,7 +675,7 @@ void traceHeapProfSampleString(StgWord8 profile_id, } } -void traceIPE(StgInfoTable * info, +void traceIPE(const StgInfoTable * info, const char *table_name, const char *closure_desc, const char *ty_desc, ===================================== rts/Trace.h ===================================== @@ -330,7 +330,7 @@ void traceConcUpdRemSetFlush(Capability *cap); void traceNonmovingHeapCensus(uint32_t log_blk_size, const struct NonmovingAllocCensus *census); -void traceIPE(StgInfoTable *info, +void traceIPE(const StgInfoTable *info, const char *table_name, const char *closure_desc, const char *ty_desc, ===================================== rts/include/rts/IPE.h ===================================== @@ -14,18 +14,53 @@ #pragma once typedef struct InfoProv_ { - char *table_name; - char *closure_desc; - char *ty_desc; - char *label; - char *module; - char *srcloc; + const char *table_name; + const char *closure_desc; + const char *ty_desc; + const char *label; + const char *module; + const char *srcloc; } InfoProv; typedef struct InfoProvEnt_ { - StgInfoTable *info; + const StgInfoTable *info; InfoProv prov; } InfoProvEnt; -void registerInfoProvList(InfoProvEnt **cc_list); + +/* + * On-disk representation + */ + +/* + * A byte offset into the string table. + * We use offsets rather than pointers as: + * + * a. they are smaller than pointers on 64-bit platforms + * b. they are easier on the linker since they do not need + * to be relocated + */ +typedef uint32_t StringIdx; + +// The size of this must be a multiple of the word size +// to ensure correct packing. +typedef struct { + const StgInfoTable *info; + StringIdx table_name; + StringIdx closure_desc; + StringIdx ty_desc; + StringIdx label; + StringIdx module_name; + StringIdx srcloc; +} IpeBufferEntry; + +typedef struct IpeBufferListNode_ { + struct IpeBufferListNode_ *next; + // Everything below is read-only and generated by the codegen + const char *string_table; + const StgWord count; + const IpeBufferEntry entries[]; +} IpeBufferListNode; + +void registerInfoProvList(IpeBufferListNode *node); InfoProvEnt *lookupIPE(const StgInfoTable *info); ===================================== rts/include/stg/SMP.h ===================================== @@ -568,3 +568,20 @@ atomic_dec(StgVolatilePtr p) #define VOLATILE_LOAD(p) ((StgWord)*((StgWord*)(p))) #endif /* !THREADED_RTS */ + +/* Helpers implemented in terms of the above */ +#if !IN_STG_CODE || IN_STGCRUN + +INLINE_HEADER void * +xchg_ptr(void **p, void *w) +{ + return (void *) xchg((StgPtr) p, (StgWord) w); +} + +INLINE_HEADER void * +cas_ptr(volatile void **p, void *o, void *n) +{ + return (void *) cas((StgVolatilePtr) p, (StgWord) o, (StgWord) n); +} + +#endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b3e42301b34cd12e511102a2e0a1e1545f36c78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b3e42301b34cd12e511102a2e0a1e1545f36c78 You're receiving 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 Aug 19 14:32:04 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 10:32:04 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22077 Message-ID: <62ff9ee43da0c_125b2b48850250917@gitlab.mail> Ben Gamari pushed new branch wip/T22077 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22077 You're receiving 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 Aug 19 14:53:10 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 10:53:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/exception-context Message-ID: <62ffa3d6ce984_125b2b488142551d6@gitlab.mail> Ben Gamari pushed new branch wip/exception-context at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/exception-context You're receiving 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 Aug 19 15:16:09 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 11:16:09 -0400 Subject: [Git][ghc/ghc][wip/T22077] 2 commits: base: Move IPE helpers to GHC.InfoProv Message-ID: <62ffa939e3489_125b2b488282640e0@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: a204fe0c by Ben Gamari at 2022-08-19T10:39:47-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 4d840d56 by Ben Gamari at 2022-08-19T11:15:14-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 13 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - + libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/base.cabal - rts/IPE.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/include/rts/IPE.h - testsuite/tests/profiling/should_run/staticcallstack001.hs - testsuite/tests/profiling/should_run/staticcallstack002.hs Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -4,6 +4,8 @@ import GHC.Prelude import GHC.Platform import GHC.Unit.Module import GHC.Utils.Outputable +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) +import GHC.Data.FastString (unpackFS) import GHC.Cmm.CLabel import GHC.Cmm.Expr @@ -44,7 +46,8 @@ emitIpeBufferListNode this_mod ents = do , strtab_offset (ipeTypeDesc cg_ipe) , strtab_offset (ipeLabel cg_ipe) , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcLoc cg_ipe) + , strtab_offset (ipeSrcFile cg_ipe) + , strtab_offset (ipeSrcSpan cg_ipe) ] int n = mkIntCLit platform n @@ -63,16 +66,26 @@ toCgIPE platform ctx module_name ipe = do table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (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 (src_loc_file, src_loc_span) = + case infoTableProv ipe of + Nothing -> ("", "") + Just (span, _) -> + let file = unpackFS $ srcSpanFile span + coords = renderWithContext ctx (pprUserRealSpan False span) + in (file, coords) let (src_loc_str, label_str) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ipe) label <- lookupStringTable $ ST.pack label_str - src_loc <- lookupStringTable $ ST.pack src_loc_str + src_file <- lookupStringTable $ ST.pack src_loc_file + src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name , ipeClosureDesc = closure_desc , ipeTypeDesc = type_desc , ipeLabel = label , ipeModuleName = module_name - , ipeSrcLoc = src_loc + , ipeSrcFile = src_file + , ipeSrcSpan = src_span } data CgInfoProvEnt = CgInfoProvEnt @@ -82,7 +95,8 @@ data CgInfoProvEnt = CgInfoProvEnt , ipeTypeDesc :: !StrTabOffset , ipeLabel :: !StrTabOffset , ipeModuleName :: !StrTabOffset - , ipeSrcLoc :: !StrTabOffset + , ipeSrcFile :: !StrTabOffset + , ipeSrcSpan :: !StrTabOffset } data StringTable = StringTable { stStrings :: DList ShortText ===================================== libraries/base/GHC/InfoProv.hsc ===================================== @@ -0,0 +1,113 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.InfoProv +-- Copyright : (c) The University of Glasgow 2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- Access to GHC's info-table provenance metadata. +-- +-- @since 4.18.0.0 +----------------------------------------------------------------------------- + +module GHC.InfoProv + ( InfoProv(..) + , ipLoc + , ipeProv + , whereFrom + -- * Internals + , InfoProvEnt + , peekInfoProv + ) where + +#include "Rts.h" + +import GHC.Base +import GHC.Show +import GHC.Ptr (Ptr(..), plusPtr, nullPtr) +import GHC.Foreign (CString, peekCString) +import GHC.IO.Encoding (utf8) +import Foreign.Storable (peekByteOff) + +data InfoProv = InfoProv { + ipName :: String, + ipDesc :: String, + ipTyDesc :: String, + ipLabel :: String, + ipMod :: String, + ipSrcFile :: String, + ipSrcSpan :: String +} deriving (Eq, Show) + +data InfoProvEnt + +ipLoc :: InfoProv -> String +ipLoc ip = ipSrcFile ip ++ ":" ++ ipSrcSpan ip + +getIPE :: a -> IO (Ptr InfoProvEnt) +getIPE obj = IO $ \s -> + case whereFrom## obj s of + (## s', addr ##) -> (## s', Ptr addr ##) + +ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv +ipeProv p = (#ptr InfoProvEnt, prov) p + +peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString +peekIpName p = (# peek InfoProv, table_name) p +peekIpDesc p = (# peek InfoProv, closure_desc) p +peekIpLabel p = (# peek InfoProv, label) p +peekIpModule p = (# peek InfoProv, module) p +peekIpSrcFile p = (# peek InfoProv, src_file) p +peekIpSrcSpan p = (# peek InfoProv, src_span) p +peekIpTyDesc p = (# peek InfoProv, ty_desc) p + +peekInfoProv :: Ptr InfoProv -> IO InfoProv +peekInfoProv infop = do + name <- peekCString utf8 =<< peekIpName infop + desc <- peekCString utf8 =<< peekIpDesc infop + tyDesc <- peekCString utf8 =<< peekIpTyDesc infop + label <- peekCString utf8 =<< peekIpLabel infop + mod <- peekCString utf8 =<< peekIpModule infop + file <- peekCString utf8 =<< peekIpSrcFile infop + span <- peekCString utf8 =<< peekIpSrcSpan infop + return InfoProv { + ipName = name, + ipDesc = desc, + ipTyDesc = tyDesc, + ipLabel = label, + ipMod = mod, + ipSrcFile = file, + ipSrcSpan = span + } + +-- | Get information about where a value originated from. +-- This information is stored statically in a binary when `-finfo-table-map` is +-- enabled. The source positions will be greatly improved by also enabled debug +-- information with `-g3`. Finally you can enable `-fdistinct-constructor-tables` to +-- get more precise information about data constructor allocations. +-- +-- The information is collect by looking at the info table address of a specific closure and +-- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think +-- the best source position to describe that info table arose from. +-- +-- @since 4.16.0.0 +whereFrom :: a -> IO (Maybe InfoProv) +whereFrom obj = do + ipe <- getIPE obj + -- The primop returns the null pointer in two situations at the moment + -- 1. The lookup fails for whatever reason + -- 2. -finfo-table-map is not enabled. + -- It would be good to distinguish between these two cases somehow. + if ipe == nullPtr + then return Nothing + else do + infoProv <- peekInfoProv (ipeProv ipe) + return $ Just infoProv ===================================== libraries/base/GHC/Stack/CCS.hsc ===================================== @@ -142,71 +142,3 @@ renderStack :: [String] -> String renderStack strs = "CallStack (from -prof):" ++ concatMap ("\n "++) (reverse strs) --- Static Closure Information - -data InfoProv = InfoProv { - ipName :: String, - ipDesc :: String, - ipTyDesc :: String, - ipLabel :: String, - ipMod :: String, - ipLoc :: String -} deriving (Eq, Show) -data InfoProvEnt - -getIPE :: a -> IO (Ptr InfoProvEnt) -getIPE obj = IO $ \s -> - case whereFrom## obj s of - (## s', addr ##) -> (## s', Ptr addr ##) - -ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv -ipeProv p = (#ptr InfoProvEnt, prov) p - -peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString -peekIpName p = (# peek InfoProv, table_name) p -peekIpDesc p = (# peek InfoProv, closure_desc) p -peekIpLabel p = (# peek InfoProv, label) p -peekIpModule p = (# peek InfoProv, module) p -peekIpSrcLoc p = (# peek InfoProv, srcloc) p -peekIpTyDesc p = (# peek InfoProv, ty_desc) p - -peekInfoProv :: Ptr InfoProv -> IO InfoProv -peekInfoProv infop = do - name <- GHC.peekCString utf8 =<< peekIpName infop - desc <- GHC.peekCString utf8 =<< peekIpDesc infop - tyDesc <- GHC.peekCString utf8 =<< peekIpTyDesc infop - label <- GHC.peekCString utf8 =<< peekIpLabel infop - mod <- GHC.peekCString utf8 =<< peekIpModule infop - loc <- GHC.peekCString utf8 =<< peekIpSrcLoc infop - return InfoProv { - ipName = name, - ipDesc = desc, - ipTyDesc = tyDesc, - ipLabel = label, - ipMod = mod, - ipLoc = loc - } - --- | Get information about where a value originated from. --- This information is stored statically in a binary when `-finfo-table-map` is --- enabled. The source positions will be greatly improved by also enabled debug --- information with `-g3`. Finally you can enable `-fdistinct-constructor-tables` to --- get more precise information about data constructor allocations. --- --- The information is collect by looking at the info table address of a specific closure and --- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think --- the best source position to describe that info table arose from. --- --- @since 4.16.0.0 -whereFrom :: a -> IO (Maybe InfoProv) -whereFrom obj = do - ipe <- getIPE obj - -- The primop returns the null pointer in two situations at the moment - -- 1. The lookup fails for whatever reason - -- 2. -finfo-table-map is not enabled. - -- It would be good to distinguish between these two cases somehow. - if ipe == nullPtr - then return Nothing - else do - infoProv <- peekInfoProv (ipeProv ipe) - return $ Just infoProv ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -28,7 +28,7 @@ import Foreign import GHC.Conc.Sync import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) import GHC.IO (IO (..)) -import GHC.Stack.CCS (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv) +import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv) import GHC.Stable -- | A frozen snapshot of the state of an execution stack. ===================================== libraries/base/base.cabal ===================================== @@ -222,6 +222,7 @@ Library GHC.GHCi GHC.GHCi.Helpers GHC.Generics + GHC.InfoProv GHC.IO GHC.IO.Buffer GHC.IO.BufferedIO ===================================== rts/IPE.c ===================================== @@ -85,7 +85,7 @@ void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module, - ipe->prov.srcloc); + ipe->prov.src_file, ipe->prov.src_span); } #endif @@ -144,7 +144,8 @@ void updateIpeMap() { ip_ents[i].prov.ty_desc = &strings[ent->ty_desc]; ip_ents[i].prov.label = &strings[ent->label]; ip_ents[i].prov.module = &strings[ent->module_name]; - ip_ents[i].prov.srcloc = &strings[ent->srcloc]; + ip_ents[i].prov.src_file = &strings[ent->src_file]; + ip_ents[i].prov.src_span = &strings[ent->src_span]; insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); } ===================================== rts/Trace.c ===================================== @@ -681,21 +681,22 @@ void traceIPE(const StgInfoTable * info, const char *ty_desc, const char *label, const char *module, - const char *srcloc ) + const char *src_file, + const char *src_span) { #if defined(DEBUG) if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { ACQUIRE_LOCK(&trace_utx); tracePreface(); - debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n", - table_name, closure_desc, ty_desc, label, module, srcloc); + debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n", + table_name, closure_desc, ty_desc, label, module, src_file, src_span); RELEASE_LOCK(&trace_utx); } else #endif if (eventlog_enabled) { - postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc); + postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, src_file, src_span); } } ===================================== rts/Trace.h ===================================== @@ -331,12 +331,13 @@ void traceNonmovingHeapCensus(uint32_t log_blk_size, const struct NonmovingAllocCensus *census); void traceIPE(const StgInfoTable *info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc ); + const char *table_name, + const char *closure_desc, + const char *ty_desc, + const char *label, + const char *module, + const char *src_file, + const char *src_span); void flushTrace(void); #else /* !TRACING */ @@ -373,7 +374,7 @@ void flushTrace(void); #define traceTaskDelete_(taskID) /* nothing */ #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ -#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, srcloc) /* nothing */ +#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, src_file, src_span) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ #define traceHeapBioProfSampleBegin(era, time) /* nothing */ #define traceHeapProfSampleEnd(era) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i) postWord32(eb, (StgWord32)i); } -static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size) +static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) { memcpy(eb->pos, buf, size); eb->pos += size; @@ -1417,7 +1417,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc) + const char *src_file, + const char *src_span) { ACQUIRE_LOCK(&eventBufMutex); StgWord table_name_len = strlen(table_name); @@ -1425,10 +1426,11 @@ void postIPE(StgWord64 info, StgWord ty_desc_len = strlen(ty_desc); StgWord label_len = strlen(label); StgWord module_len = strlen(module); - StgWord srcloc_len = strlen(srcloc); + StgWord src_file_len = strlen(src_file); + StgWord src_span_len = strlen(src_span); // 8 for the info word // 6 for the number of strings in the payload as postString adds 1 to the length - StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6; + StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+src_file_len+1+src_span_len+6; ensureRoomForVariableEvent(&eventBuf, len); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); @@ -1438,7 +1440,13 @@ void postIPE(StgWord64 info, postString(&eventBuf, ty_desc); postString(&eventBuf, label); postString(&eventBuf, module); - postString(&eventBuf, srcloc); + + // Manually construct the string ":\0" + postBuf(&eventBuf, (const StgWord8*) src_file, src_file_len); + StgWord8 colon = ':'; + postBuf(&eventBuf, &colon, 1); + postString(&eventBuf, src_span); + RELEASE_LOCK(&eventBufMutex); } ===================================== rts/eventlog/EventLog.h ===================================== @@ -196,7 +196,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc); + const char *src_file, + const char *src_span); void postConcUpdRemSetFlush(Capability *cap); void postConcMarkEnd(StgWord32 marked_obj_count); ===================================== rts/include/rts/IPE.h ===================================== @@ -19,7 +19,8 @@ typedef struct InfoProv_ { const char *ty_desc; const char *label; const char *module; - const char *srcloc; + const char *src_file; + const char *src_span; } InfoProv; typedef struct InfoProvEnt_ { @@ -51,7 +52,8 @@ typedef struct { StringIdx ty_desc; StringIdx label; StringIdx module_name; - StringIdx srcloc; + StringIdx src_file; + StringIdx src_span; } IpeBufferEntry; typedef struct IpeBufferListNode_ { ===================================== testsuite/tests/profiling/should_run/staticcallstack001.hs ===================================== @@ -1,6 +1,6 @@ module Main where -import GHC.Stack.CCS +import GHC.InfoProv data D = D Int deriving Show ===================================== testsuite/tests/profiling/should_run/staticcallstack002.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE UnboxedTuples #-} module Main where -import GHC.Stack.CCS +import GHC.InfoProv -- Unboxed data constructors don't have info tables so there is -- a special case to not generate distinct info tables for unboxed View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3b3e42301b34cd12e511102a2e0a1e1545f36c78...4d840d56a66365149d7ca2578b0dcd1232c8790e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3b3e42301b34cd12e511102a2e0a1e1545f36c78...4d840d56a66365149d7ca2578b0dcd1232c8790e You're receiving 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 Aug 19 15:20:00 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 11:20:00 -0400 Subject: [Git][ghc/ghc][wip/T22077] Separate IPE source file from span Message-ID: <62ffaa2098660_125b2b4e4bc2647c2@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 2f935f8d by Ben Gamari at 2022-08-19T11:19:44-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 8 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - libraries/base/GHC/InfoProv.hsc - rts/IPE.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/include/rts/IPE.h Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -4,6 +4,8 @@ import GHC.Prelude import GHC.Platform import GHC.Unit.Module import GHC.Utils.Outputable +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) +import GHC.Data.FastString (unpackFS) import GHC.Cmm.CLabel import GHC.Cmm.Expr @@ -44,7 +46,8 @@ emitIpeBufferListNode this_mod ents = do , strtab_offset (ipeTypeDesc cg_ipe) , strtab_offset (ipeLabel cg_ipe) , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcLoc cg_ipe) + , strtab_offset (ipeSrcFile cg_ipe) + , strtab_offset (ipeSrcSpan cg_ipe) ] int n = mkIntCLit platform n @@ -63,16 +66,26 @@ toCgIPE platform ctx module_name ipe = do table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (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 (src_loc_file, src_loc_span) = + case infoTableProv ipe of + Nothing -> ("", "") + Just (span, _) -> + let file = unpackFS $ srcSpanFile span + coords = renderWithContext ctx (pprUserRealSpan False span) + in (file, coords) let (src_loc_str, label_str) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ipe) label <- lookupStringTable $ ST.pack label_str - src_loc <- lookupStringTable $ ST.pack src_loc_str + src_file <- lookupStringTable $ ST.pack src_loc_file + src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name , ipeClosureDesc = closure_desc , ipeTypeDesc = type_desc , ipeLabel = label , ipeModuleName = module_name - , ipeSrcLoc = src_loc + , ipeSrcFile = src_file + , ipeSrcSpan = src_span } data CgInfoProvEnt = CgInfoProvEnt @@ -82,7 +95,8 @@ data CgInfoProvEnt = CgInfoProvEnt , ipeTypeDesc :: !StrTabOffset , ipeLabel :: !StrTabOffset , ipeModuleName :: !StrTabOffset - , ipeSrcLoc :: !StrTabOffset + , ipeSrcFile :: !StrTabOffset + , ipeSrcSpan :: !StrTabOffset } data StringTable = StringTable { stStrings :: DList ShortText ===================================== libraries/base/GHC/InfoProv.hsc ===================================== @@ -20,6 +20,7 @@ module GHC.InfoProv ( InfoProv(..) + , ipLoc , ipeProv , whereFrom -- * Internals @@ -42,10 +43,15 @@ data InfoProv = InfoProv { ipTyDesc :: String, ipLabel :: String, ipMod :: String, - ipLoc :: String + ipSrcFile :: String, + ipSrcSpan :: String } deriving (Eq, Show) + data InfoProvEnt +ipLoc :: InfoProv -> String +ipLoc ipe = ipSrcFile ipe ++ ":" ++ ipSrcSpan ipe + getIPE :: a -> IO (Ptr InfoProvEnt) getIPE obj = IO $ \s -> case whereFrom## obj s of @@ -54,13 +60,14 @@ getIPE obj = IO $ \s -> ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv ipeProv p = (#ptr InfoProvEnt, prov) p -peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString -peekIpName p = (# peek InfoProv, table_name) p -peekIpDesc p = (# peek InfoProv, closure_desc) p -peekIpLabel p = (# peek InfoProv, label) p -peekIpModule p = (# peek InfoProv, module) p -peekIpSrcLoc p = (# peek InfoProv, srcloc) p -peekIpTyDesc p = (# peek InfoProv, ty_desc) p +peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString +peekIpName p = (# peek InfoProv, table_name) p +peekIpDesc p = (# peek InfoProv, closure_desc) p +peekIpLabel p = (# peek InfoProv, label) p +peekIpModule p = (# peek InfoProv, module) p +peekIpSrcFile p = (# peek InfoProv, src_file) p +peekIpSrcSpan p = (# peek InfoProv, src_span) p +peekIpTyDesc p = (# peek InfoProv, ty_desc) p peekInfoProv :: Ptr InfoProv -> IO InfoProv peekInfoProv infop = do @@ -69,14 +76,16 @@ peekInfoProv infop = do tyDesc <- peekCString utf8 =<< peekIpTyDesc infop label <- peekCString utf8 =<< peekIpLabel infop mod <- peekCString utf8 =<< peekIpModule infop - loc <- peekCString utf8 =<< peekIpSrcLoc infop + file <- peekCString utf8 =<< peekIpSrcFile infop + span <- peekCString utf8 =<< peekIpSrcSpan infop return InfoProv { ipName = name, ipDesc = desc, ipTyDesc = tyDesc, ipLabel = label, ipMod = mod, - ipLoc = loc + ipSrcFile = file, + ipSrcSpan = span } -- | Get information about where a value originated from. ===================================== rts/IPE.c ===================================== @@ -85,7 +85,7 @@ void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module, - ipe->prov.srcloc); + ipe->prov.src_file, ipe->prov.src_span); } #endif @@ -144,7 +144,8 @@ void updateIpeMap() { ip_ents[i].prov.ty_desc = &strings[ent->ty_desc]; ip_ents[i].prov.label = &strings[ent->label]; ip_ents[i].prov.module = &strings[ent->module_name]; - ip_ents[i].prov.srcloc = &strings[ent->srcloc]; + ip_ents[i].prov.src_file = &strings[ent->src_file]; + ip_ents[i].prov.src_span = &strings[ent->src_span]; insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); } ===================================== rts/Trace.c ===================================== @@ -681,21 +681,22 @@ void traceIPE(const StgInfoTable * info, const char *ty_desc, const char *label, const char *module, - const char *srcloc ) + const char *src_file, + const char *src_span) { #if defined(DEBUG) if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { ACQUIRE_LOCK(&trace_utx); tracePreface(); - debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n", - table_name, closure_desc, ty_desc, label, module, srcloc); + debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n", + table_name, closure_desc, ty_desc, label, module, src_file, src_span); RELEASE_LOCK(&trace_utx); } else #endif if (eventlog_enabled) { - postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc); + postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, src_file, src_span); } } ===================================== rts/Trace.h ===================================== @@ -331,12 +331,13 @@ void traceNonmovingHeapCensus(uint32_t log_blk_size, const struct NonmovingAllocCensus *census); void traceIPE(const StgInfoTable *info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc ); + const char *table_name, + const char *closure_desc, + const char *ty_desc, + const char *label, + const char *module, + const char *src_file, + const char *src_span); void flushTrace(void); #else /* !TRACING */ @@ -373,7 +374,7 @@ void flushTrace(void); #define traceTaskDelete_(taskID) /* nothing */ #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ -#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, srcloc) /* nothing */ +#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, src_file, src_span) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ #define traceHeapBioProfSampleBegin(era, time) /* nothing */ #define traceHeapProfSampleEnd(era) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i) postWord32(eb, (StgWord32)i); } -static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size) +static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) { memcpy(eb->pos, buf, size); eb->pos += size; @@ -1417,7 +1417,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc) + const char *src_file, + const char *src_span) { ACQUIRE_LOCK(&eventBufMutex); StgWord table_name_len = strlen(table_name); @@ -1425,10 +1426,11 @@ void postIPE(StgWord64 info, StgWord ty_desc_len = strlen(ty_desc); StgWord label_len = strlen(label); StgWord module_len = strlen(module); - StgWord srcloc_len = strlen(srcloc); + StgWord src_file_len = strlen(src_file); + StgWord src_span_len = strlen(src_span); // 8 for the info word // 6 for the number of strings in the payload as postString adds 1 to the length - StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6; + StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+src_file_len+1+src_span_len+6; ensureRoomForVariableEvent(&eventBuf, len); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); @@ -1438,7 +1440,13 @@ void postIPE(StgWord64 info, postString(&eventBuf, ty_desc); postString(&eventBuf, label); postString(&eventBuf, module); - postString(&eventBuf, srcloc); + + // Manually construct the string ":\0" + postBuf(&eventBuf, (const StgWord8*) src_file, src_file_len); + StgWord8 colon = ':'; + postBuf(&eventBuf, &colon, 1); + postString(&eventBuf, src_span); + RELEASE_LOCK(&eventBufMutex); } ===================================== rts/eventlog/EventLog.h ===================================== @@ -196,7 +196,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc); + const char *src_file, + const char *src_span); void postConcUpdRemSetFlush(Capability *cap); void postConcMarkEnd(StgWord32 marked_obj_count); ===================================== rts/include/rts/IPE.h ===================================== @@ -19,7 +19,8 @@ typedef struct InfoProv_ { const char *ty_desc; const char *label; const char *module; - const char *srcloc; + const char *src_file; + const char *src_span; } InfoProv; typedef struct InfoProvEnt_ { @@ -51,7 +52,8 @@ typedef struct { StringIdx ty_desc; StringIdx label; StringIdx module_name; - StringIdx srcloc; + StringIdx src_file; + StringIdx src_span; } IpeBufferEntry; typedef struct IpeBufferListNode_ { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f935f8d52802a1331955a360bd58ec3d323e647 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f935f8d52802a1331955a360bd58ec3d323e647 You're receiving 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 Aug 19 15:20:35 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 11:20:35 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 12 commits: Separate IPE source file from span Message-ID: <62ffaa431022d_125b2b4881426544c@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 2f935f8d by Ben Gamari at 2022-08-19T11:19:44-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 6d1864b1 by Ben Gamari at 2022-08-19T11:20:09-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6b550ba by Ben Gamari at 2022-08-19T11:20:09-04:00 base: Move PrimMVar to GHC.MVar - - - - - ce764064 by Ben Gamari at 2022-08-19T11:20:09-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - d35787ee by Ben Gamari at 2022-08-19T11:20:10-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 1358b1cc by Ben Gamari at 2022-08-19T11:20:10-04:00 base: Introduce exception context - - - - - a7d2d12c by Ben Gamari at 2022-08-19T11:20:10-04:00 base: Collect backtraces in GHC.IO.throwIO - - - - - 24d22b6a by Ben Gamari at 2022-08-19T11:20:10-04:00 base: Collect backtraces in GHC.Exception.throw - - - - - b41ebaa3 by Ben Gamari at 2022-08-19T11:20:10-04:00 Pretty IPE - - - - - aa5462fe by Ben Gamari at 2022-08-19T11:20:10-04:00 base: Move prettyCallStack to GHC.Stack - - - - - 205bcf0e by Ben Gamari at 2022-08-19T11:20:10-04:00 Fix - - - - - b5d9acb1 by Ben Gamari at 2022-08-19T11:20:10-04:00 Formatting - - - - - 27 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - libraries/base/Foreign/C/String.hs - 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.hs-boot - libraries/base/GHC/ExecutionStack/Internal.hsc - libraries/base/GHC/Foreign.hs - libraries/base/GHC/IO.hs - libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/MVar.hs - libraries/base/GHC/Stack.hs - libraries/base/GHC/Stack/CCS.hs-boot - libraries/base/GHC/Stack/CloneStack.hs - + libraries/base/GHC/Stack/CloneStack.hs-boot - libraries/base/base.cabal - rts/IPE.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/include/rts/IPE.h Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -4,6 +4,8 @@ import GHC.Prelude import GHC.Platform import GHC.Unit.Module import GHC.Utils.Outputable +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) +import GHC.Data.FastString (unpackFS) import GHC.Cmm.CLabel import GHC.Cmm.Expr @@ -44,7 +46,8 @@ emitIpeBufferListNode this_mod ents = do , strtab_offset (ipeTypeDesc cg_ipe) , strtab_offset (ipeLabel cg_ipe) , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcLoc cg_ipe) + , strtab_offset (ipeSrcFile cg_ipe) + , strtab_offset (ipeSrcSpan cg_ipe) ] int n = mkIntCLit platform n @@ -63,16 +66,26 @@ toCgIPE platform ctx module_name ipe = do table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (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 (src_loc_file, src_loc_span) = + case infoTableProv ipe of + Nothing -> ("", "") + Just (span, _) -> + let file = unpackFS $ srcSpanFile span + coords = renderWithContext ctx (pprUserRealSpan False span) + in (file, coords) let (src_loc_str, label_str) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ipe) label <- lookupStringTable $ ST.pack label_str - src_loc <- lookupStringTable $ ST.pack src_loc_str + src_file <- lookupStringTable $ ST.pack src_loc_file + src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name , ipeClosureDesc = closure_desc , ipeTypeDesc = type_desc , ipeLabel = label , ipeModuleName = module_name - , ipeSrcLoc = src_loc + , ipeSrcFile = src_file + , ipeSrcSpan = src_span } data CgInfoProvEnt = CgInfoProvEnt @@ -82,7 +95,8 @@ data CgInfoProvEnt = CgInfoProvEnt , ipeTypeDesc :: !StrTabOffset , ipeLabel :: !StrTabOffset , ipeModuleName :: !StrTabOffset - , ipeSrcLoc :: !StrTabOffset + , ipeSrcFile :: !StrTabOffset + , ipeSrcSpan :: !StrTabOffset } data StringTable = StringTable { stStrings :: DList ShortText ===================================== libraries/base/Foreign/C/String.hs ===================================== @@ -110,20 +110,11 @@ import GHC.Base import {-# SOURCE #-} GHC.IO.Encoding import qualified GHC.Foreign as GHC +import GHC.Foreign (CString, CStringLen) ----------------------------------------------------------------------------- -- Strings --- representation of strings in C --- ------------------------------ - --- | 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 -- ------------------ -- ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -121,11 +121,8 @@ import GHC.IORef import GHC.MVar import GHC.Real ( fromIntegral ) import GHC.Show ( Show(..), showParen, showString ) -import GHC.Stable ( StablePtr(..) ) import GHC.Weak -import Unsafe.Coerce ( unsafeCoerce# ) - infixr 0 `par`, `pseq` ----------------------------------------------------------------------------- @@ -663,20 +660,6 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s -> (# s1, w #) -> (# s1, Weak w #) -data PrimMVar - --- | Make a 'StablePtr' that can be passed to the C function --- @hs_try_putmvar()@. The RTS wants a 'StablePtr' to the --- underlying 'MVar#', but a 'StablePtr#' can only refer to --- lifted types, so we have to cheat by coercing. -newStablePtrPrimMVar :: MVar a -> IO (StablePtr PrimMVar) -newStablePtrPrimMVar (MVar m) = IO $ \s0 -> - case makeStablePtr# (unsafeCoerce# m :: PrimMVar) s0 of - -- Coerce unlifted m :: MVar# RealWorld a - -- to lifted PrimMVar - -- apparently because mkStablePtr is not representation-polymorphic - (# s1, sp #) -> (# s1, StablePtr sp #) - ----------------------------------------------------------------------------- -- Transactional heap operations ----------------------------------------------------------------------------- ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -2,10 +2,12 @@ {-# LANGUAGE NoImplicitPrelude , ExistentialQuantification , MagicHash - , RecordWildCards , PatternSynonyms #-} -{-# LANGUAGE DataKinds, PolyKinds #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- @@ -28,7 +30,8 @@ module GHC.Exception , ErrorCall(..,ErrorCall) , errorCallException , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types + + -- * Re-exports from GHC.Types , CallStack, fromCallSiteList, getCallStack, prettyCallStack , prettyCallStackLines, showCCSStack , SrcLoc(..), prettySrcLoc @@ -40,6 +43,9 @@ import GHC.Stack.Types import GHC.OldList import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS +import {-# SOURCE #-} GHC.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc) +import GHC.Exception.Backtrace +import GHC.Exception.Context import GHC.Exception.Type -- | Throw an exception. Exceptions may be thrown from purely @@ -48,8 +54,10 @@ 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 !context = unsafePerformIO collectBacktraces + in raise# (toExceptionWithContext e context) -- | This is thrown when the user calls 'error'. The first @String@ is the -- argument given to 'error', second @String@ is the location. @@ -89,31 +97,3 @@ showCCSStack :: [String] -> [String] showCCSStack [] = [] showCCSStack stk = "CallStack (from -prof):" : map (" " ++) (reverse stk) --- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot --- files. See Note [Definition of CallStack] - --- | Pretty print a 'SrcLoc'. --- --- @since 4.9.0.0 -prettySrcLoc :: SrcLoc -> String -prettySrcLoc SrcLoc {..} - = foldr (++) "" - [ srcLocFile, ":" - , show srcLocStartLine, ":" - , show srcLocStartCol, " in " - , srcLocPackage, ":", srcLocModule - ] - --- | Pretty print a 'CallStack'. --- --- @since 4.9.0.0 -prettyCallStack :: CallStack -> String -prettyCallStack = intercalate "\n" . prettyCallStackLines - -prettyCallStackLines :: CallStack -> [String] -prettyCallStackLines cs = case getCallStack cs of - [] -> [] - stk -> "CallStack (from HasCallStack):" - : map ((" " ++) . prettyCallSite) stk - where - prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc ===================================== libraries/base/GHC/Exception/Backtrace.hs ===================================== @@ -0,0 +1,90 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE NamedFieldPuns #-} + +module GHC.Exception.Backtrace + ( BacktraceMechanism(..) + , collectBacktraces + , collectBacktrace + ) where + +import GHC.Base +import Data.OldList +import GHC.Show (Show) +import GHC.Exception.Context +import GHC.Stack.Types (HasCallStack, CallStack) +import {-# SOURCE #-} qualified GHC.Stack as CallStack +import {-# SOURCE #-} qualified GHC.ExecutionStack as ExecStack +import {-# SOURCE #-} qualified GHC.Stack.CloneStack as CloneStack +import {-# SOURCE #-} qualified GHC.Stack.CCS as CCS + +-- | How to collect a backtrace when an exception is thrown. +data BacktraceMechanism + = -- | collect a cost center stacktrace (only available when built with profiling) + CostCentreBacktraceMech + | -- | use execution stack unwinding with given limit + ExecutionStackBacktraceMech + | -- | collect backtraces from Info Table Provenance Entries + IPEBacktraceMech + | -- | use 'HasCallStack' + HasCallStackBacktraceMech + deriving (Eq, Show) + +collectBacktraces :: HasCallStack => IO ExceptionContext +collectBacktraces = do + mconcat `fmap` mapM collect + [ CostCentreBacktraceMech + , ExecutionStackBacktraceMech + , IPEBacktraceMech + , HasCallStackBacktraceMech + ] + where + collect mech + | True = collectBacktrace mech -- FIXME + -- | otherwise = return mempty + +data CostCentreBacktrace = CostCentreBacktrace [String] + +instance ExceptionAnnotation CostCentreBacktrace where + displayExceptionAnnotation (CostCentreBacktrace strs) = CCS.renderStack strs + +data ExecutionBacktrace = ExecutionBacktrace String + +instance ExceptionAnnotation ExecutionBacktrace where + displayExceptionAnnotation (ExecutionBacktrace str) = + "Native stack backtrace:\n" ++ str + +data HasCallStackBacktrace = HasCallStackBacktrace CallStack + +instance ExceptionAnnotation HasCallStackBacktrace where + displayExceptionAnnotation (HasCallStackBacktrace cs) = + "HasCallStack backtrace:\n" ++ CallStack.prettyCallStack cs + +data InfoProvBacktrace = InfoProvBacktrace [CloneStack.StackEntry] + +instance ExceptionAnnotation InfoProvBacktrace where + displayExceptionAnnotation (InfoProvBacktrace stack) = + "Info table provenance backtrace:\n" ++ + intercalate "\n" (map (" "++) $ map CloneStack.prettyStackEntry stack) + +collectBacktrace :: (?callStack :: CallStack) => BacktraceMechanism -> IO ExceptionContext +collectBacktrace CostCentreBacktraceMech = do + strs <- CCS.currentCallStack + case strs of + [] -> return emptyExceptionContext + _ -> pure $ mkExceptionContext (CostCentreBacktrace strs) + +collectBacktrace ExecutionStackBacktraceMech = do + mst <- ExecStack.showStackTrace + case mst of + Nothing -> return emptyExceptionContext + Just st -> return $ mkExceptionContext (ExecutionBacktrace st) + +collectBacktrace IPEBacktraceMech = do + stack <- CloneStack.cloneMyStack + stackEntries <- CloneStack.decode stack + return $ mkExceptionContext (InfoProvBacktrace stackEntries) + +collectBacktrace HasCallStackBacktraceMech = + return $ mkExceptionContext (HasCallStackBacktrace ?callStack) + ===================================== libraries/base/GHC/Exception/Backtrace.hs-boot ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Exception.Backtrace where + +import GHC.Base (IO) +import GHC.Exception.Context (ExceptionContext) +import GHC.Stack.Types (HasCallStack) + +data BacktraceMechanism + +collectBacktraces :: HasCallStack => IO ExceptionContext ===================================== libraries/base/GHC/Exception/Context.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# 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 + , mkExceptionContext + , mergeExceptionContexts + -- * Exception annotations + , SomeExceptionAnnotation(..) + , ExceptionAnnotation(..) + ) where + +import GHC.Base ((++), String, Semigroup(..), Monoid(..)) +import GHC.Show (Show(..)) +import Data.Typeable.Internal (Typeable) + +data ExceptionContext = ExceptionContext [SomeExceptionAnnotation] + +instance Semigroup ExceptionContext where + (<>) = mergeExceptionContexts + +instance Monoid ExceptionContext where + mempty = emptyExceptionContext + +emptyExceptionContext :: ExceptionContext +emptyExceptionContext = ExceptionContext [] + +mergeExceptionContexts :: ExceptionContext -> ExceptionContext -> ExceptionContext +mergeExceptionContexts (ExceptionContext a) (ExceptionContext b) = ExceptionContext (a ++ b) + +mkExceptionContext :: ExceptionAnnotation a => a -> ExceptionContext +mkExceptionContext x = ExceptionContext [SomeExceptionAnnotation x] + +data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a + +class Typeable a => ExceptionAnnotation a where + 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,6 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK not-home #-} @@ -20,7 +21,14 @@ module GHC.Exception.Type ( Exception(..) -- Class - , SomeException(..), ArithException(..) + , SomeException(..) + , exceptionContext + -- * Exception context + , ExceptionContext(..) + , emptyExceptionContext + , mergeExceptionContexts + -- * Arithmetic exceptions + , ArithException(..) , divZeroException, overflowException, ratioZeroDenomException , underflowException ) where @@ -30,13 +38,17 @@ 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, ?exc_context :: ExceptionContext) => SomeException e + +exceptionContext :: SomeException -> ExceptionContext +exceptionContext (SomeException _) = ?exc_context -- | @since 3.0 instance Show SomeException where @@ -129,10 +141,13 @@ Caught MismatchedParentheses -} class (Typeable e, Show e) => Exception e where - toException :: e -> SomeException + toException :: e -> SomeException + toExceptionWithContext :: e -> ExceptionContext -> SomeException fromException :: SomeException -> Maybe e - toException = SomeException + toException e = toExceptionWithContext e emptyExceptionContext + toExceptionWithContext e ctxt = SomeException e + where ?exc_context = ctxt fromException (SomeException e) = cast e -- | Render this exception value in a human-friendly manner. @@ -146,8 +161,18 @@ class (Typeable e, Show e) => Exception e where -- | @since 3.0 instance Exception SomeException where toException se = se + toExceptionWithContext se@(SomeException e) ctxt = + SomeException e + where ?exc_context = ctxt <> exceptionContext se fromException = Just - displayException (SomeException e) = displayException e + displayException (SomeException e) = + displayException e ++ "\n" ++ displayContext ?exc_context + +displayContext :: ExceptionContext -> String +displayContext (ExceptionContext anns0) = go anns0 + where + go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns + go [] = "\n" -- |Arithmetic exceptions. data ArithException ===================================== libraries/base/GHC/ExecutionStack.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.ExecutionStack @@ -36,7 +38,7 @@ module GHC.ExecutionStack ( , showStackTrace ) where -import Control.Monad (join) +import GHC.Base import GHC.ExecutionStack.Internal -- | Get a trace of the current execution stack state. ===================================== libraries/base/GHC/ExecutionStack.hs-boot ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.ExecutionStack where + +import GHC.Base + +showStackTrace :: IO (Maybe String) + ===================================== libraries/base/GHC/ExecutionStack/Internal.hsc ===================================== @@ -17,6 +17,7 @@ #include "HsBaseConfig.h" #include "rts/Libdw.h" +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MultiWayIf #-} module GHC.ExecutionStack.Internal ( @@ -31,7 +32,13 @@ module GHC.ExecutionStack.Internal ( , invalidateDebugCache ) where -import Control.Monad (join) +import GHC.Base +import GHC.Show +import GHC.List (reverse, null) +import GHC.Num ((-)) +import GHC.Real (fromIntegral) +import Data.Maybe +import Data.Functor ((<$>)) import Data.Word import Foreign.C.Types import Foreign.C.String (peekCString, CString) ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Foreign ( -- * C strings with a configurable encoding + CString, CStringLen, -- conversion of C strings into Haskell strings -- @@ -74,8 +75,11 @@ putDebugMsg | c_DEBUG_DUMP = debugLn | otherwise = const (return ()) --- These definitions are identical to those in Foreign.C.String, but copied in here to avoid a cycle: +-- | 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 ===================================== libraries/base/GHC/IO.hs ===================================== @@ -47,6 +47,8 @@ import GHC.ST import GHC.Exception import GHC.Show import GHC.IO.Unsafe +import GHC.Stack.Types ( HasCallStack ) +import GHC.Exception.Backtrace ( collectBacktraces ) import Unsafe.Coerce ( unsafeCoerce ) import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError ) @@ -235,8 +237,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 + ctxt <- collectBacktraces + IO (raiseIO# (toExceptionWithContext e ctxt)) -- ----------------------------------------------------------------------------- -- Controlling asynchronous exception delivery ===================================== libraries/base/GHC/InfoProv.hsc ===================================== @@ -20,6 +20,7 @@ module GHC.InfoProv ( InfoProv(..) + , ipLoc , ipeProv , whereFrom -- * Internals @@ -42,10 +43,15 @@ data InfoProv = InfoProv { ipTyDesc :: String, ipLabel :: String, ipMod :: String, - ipLoc :: String + ipSrcFile :: String, + ipSrcSpan :: String } deriving (Eq, Show) + data InfoProvEnt +ipLoc :: InfoProv -> String +ipLoc ipe = ipSrcFile ipe ++ ":" ++ ipSrcSpan ipe + getIPE :: a -> IO (Ptr InfoProvEnt) getIPE obj = IO $ \s -> case whereFrom## obj s of @@ -54,13 +60,14 @@ getIPE obj = IO $ \s -> ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv ipeProv p = (#ptr InfoProvEnt, prov) p -peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString -peekIpName p = (# peek InfoProv, table_name) p -peekIpDesc p = (# peek InfoProv, closure_desc) p -peekIpLabel p = (# peek InfoProv, label) p -peekIpModule p = (# peek InfoProv, module) p -peekIpSrcLoc p = (# peek InfoProv, srcloc) p -peekIpTyDesc p = (# peek InfoProv, ty_desc) p +peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString +peekIpName p = (# peek InfoProv, table_name) p +peekIpDesc p = (# peek InfoProv, closure_desc) p +peekIpLabel p = (# peek InfoProv, label) p +peekIpModule p = (# peek InfoProv, module) p +peekIpSrcFile p = (# peek InfoProv, src_file) p +peekIpSrcSpan p = (# peek InfoProv, src_span) p +peekIpTyDesc p = (# peek InfoProv, ty_desc) p peekInfoProv :: Ptr InfoProv -> IO InfoProv peekInfoProv infop = do @@ -69,14 +76,16 @@ peekInfoProv infop = do tyDesc <- peekCString utf8 =<< peekIpTyDesc infop label <- peekCString utf8 =<< peekIpLabel infop mod <- peekCString utf8 =<< peekIpModule infop - loc <- peekCString utf8 =<< peekIpSrcLoc infop + file <- peekCString utf8 =<< peekIpSrcFile infop + span <- peekCString utf8 =<< peekIpSrcSpan infop return InfoProv { ipName = name, ipDesc = desc, ipTyDesc = tyDesc, ipLabel = label, ipMod = mod, - ipLoc = loc + ipSrcFile = file, + ipSrcSpan = span } -- | Get information about where a value originated from. ===================================== libraries/base/GHC/MVar.hs ===================================== @@ -18,7 +18,7 @@ ----------------------------------------------------------------------------- module GHC.MVar ( - -- * MVars + -- * MVars MVar(..) , newMVar , newEmptyMVar @@ -30,9 +30,15 @@ module GHC.MVar ( , tryReadMVar , isEmptyMVar , addMVarFinalizer + + -- * PrimMVar + , PrimMVar + , newStablePtrPrimMVar ) where import GHC.Base +import GHC.Stable ( StablePtr(..) ) +import Unsafe.Coerce ( unsafeCoerce# ) data MVar a = MVar (MVar# RealWorld a) {- ^ @@ -180,3 +186,17 @@ addMVarFinalizer :: MVar a -> IO () -> IO () addMVarFinalizer (MVar m) (IO finalizer) = IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) } +data PrimMVar + +-- | Make a 'StablePtr' that can be passed to the C function +-- @hs_try_putmvar()@. The RTS wants a 'StablePtr' to the +-- underlying 'MVar#', but a 'StablePtr#' can only refer to +-- lifted types, so we have to cheat by coercing. +newStablePtrPrimMVar :: MVar a -> IO (StablePtr PrimMVar) +newStablePtrPrimMVar (MVar m) = IO $ \s0 -> + case makeStablePtr# (unsafeCoerce# m :: PrimMVar) s0 of + -- Coerce unlifted m :: MVar# RealWorld a + -- to lifted PrimMVar + -- apparently because mkStablePtr is not representation-polymorphic + (# s1, sp #) -> (# s1, StablePtr sp #) + ===================================== libraries/base/GHC/Stack.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} @@ -27,8 +28,9 @@ module GHC.Stack ( -- * HasCallStack call stacks CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack, - fromCallSiteList, getCallStack, popCallStack, prettyCallStack, + fromCallSiteList, getCallStack, popCallStack, pushCallStack, withFrozenCallStack, + prettyCallStackLines, prettyCallStack, -- * Source locations SrcLoc(..), prettySrcLoc, @@ -48,12 +50,14 @@ module GHC.Stack ( renderStack ) where +import GHC.Show import GHC.Stack.CCS import GHC.Stack.Types import GHC.IO import GHC.Base import GHC.List import GHC.Exception +import Data.OldList (intercalate) -- | Like the function 'error', but appends a stack trace to the error -- message if one is available. @@ -104,3 +108,32 @@ withFrozenCallStack do_this = -- withFrozenCallStack's call-site let ?callStack = freezeCallStack (popCallStack callStack) in do_this + +-- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot +-- files. See Note [Definition of CallStack] + +-- | Pretty print a 'SrcLoc'. +-- +-- @since 4.9.0.0 +prettySrcLoc :: SrcLoc -> String +prettySrcLoc SrcLoc {..} + = foldr (++) "" + [ srcLocFile, ":" + , show srcLocStartLine, ":" + , show srcLocStartCol, " in " + , srcLocPackage, ":", srcLocModule + ] + +-- | Pretty print a 'CallStack'. +-- +-- @since 4.9.0.0 +prettyCallStack :: CallStack -> String +prettyCallStack = intercalate "\n" . prettyCallStackLines + +prettyCallStackLines :: CallStack -> [String] +prettyCallStackLines cs = case getCallStack cs of + [] -> [] + stk -> "CallStack (from HasCallStack):" + : map ((" " ++) . prettyCallSite) stk + where + prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc ===================================== 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,17 +19,19 @@ module GHC.Stack.CloneStack ( StackEntry(..), cloneMyStack, cloneThreadStack, - decode + decode, + prettyStackEntry ) where -import Control.Concurrent.MVar +import GHC.MVar import Data.Maybe (catMaybes) -import Foreign -import GHC.Conc.Sync -import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) +import GHC.Conc.Sync (ThreadId(ThreadId)) +import GHC.Int (Int (I#)) +import GHC.Prim (RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) import GHC.IO (IO (..)) import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv) import GHC.Stable +import GHC.Ptr -- | A frozen snapshot of the state of an execution stack. -- @@ -262,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/GHC/Stack/CloneStack.hs-boot ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Stack.CloneStack where + +import GHC.Base + +data StackSnapshot +data StackEntry + +cloneMyStack :: IO StackSnapshot +decode :: StackSnapshot -> IO [StackEntry] +prettyStackEntry :: StackEntry -> String ===================================== libraries/base/base.cabal ===================================== @@ -208,6 +208,8 @@ Library GHC.Err GHC.Event.TimeOut GHC.Exception + GHC.Exception.Backtrace + GHC.Exception.Context GHC.Exception.Type GHC.ExecutionStack GHC.ExecutionStack.Internal ===================================== rts/IPE.c ===================================== @@ -85,7 +85,7 @@ void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module, - ipe->prov.srcloc); + ipe->prov.src_file, ipe->prov.src_span); } #endif @@ -144,7 +144,8 @@ void updateIpeMap() { ip_ents[i].prov.ty_desc = &strings[ent->ty_desc]; ip_ents[i].prov.label = &strings[ent->label]; ip_ents[i].prov.module = &strings[ent->module_name]; - ip_ents[i].prov.srcloc = &strings[ent->srcloc]; + ip_ents[i].prov.src_file = &strings[ent->src_file]; + ip_ents[i].prov.src_span = &strings[ent->src_span]; insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); } ===================================== rts/Trace.c ===================================== @@ -681,21 +681,22 @@ void traceIPE(const StgInfoTable * info, const char *ty_desc, const char *label, const char *module, - const char *srcloc ) + const char *src_file, + const char *src_span) { #if defined(DEBUG) if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { ACQUIRE_LOCK(&trace_utx); tracePreface(); - debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n", - table_name, closure_desc, ty_desc, label, module, srcloc); + debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n", + table_name, closure_desc, ty_desc, label, module, src_file, src_span); RELEASE_LOCK(&trace_utx); } else #endif if (eventlog_enabled) { - postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc); + postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, src_file, src_span); } } ===================================== rts/Trace.h ===================================== @@ -331,12 +331,13 @@ void traceNonmovingHeapCensus(uint32_t log_blk_size, const struct NonmovingAllocCensus *census); void traceIPE(const StgInfoTable *info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc ); + const char *table_name, + const char *closure_desc, + const char *ty_desc, + const char *label, + const char *module, + const char *src_file, + const char *src_span); void flushTrace(void); #else /* !TRACING */ @@ -373,7 +374,7 @@ void flushTrace(void); #define traceTaskDelete_(taskID) /* nothing */ #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ -#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, srcloc) /* nothing */ +#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, src_file, src_span) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ #define traceHeapBioProfSampleBegin(era, time) /* nothing */ #define traceHeapProfSampleEnd(era) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i) postWord32(eb, (StgWord32)i); } -static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size) +static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) { memcpy(eb->pos, buf, size); eb->pos += size; @@ -1417,7 +1417,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc) + const char *src_file, + const char *src_span) { ACQUIRE_LOCK(&eventBufMutex); StgWord table_name_len = strlen(table_name); @@ -1425,10 +1426,11 @@ void postIPE(StgWord64 info, StgWord ty_desc_len = strlen(ty_desc); StgWord label_len = strlen(label); StgWord module_len = strlen(module); - StgWord srcloc_len = strlen(srcloc); + StgWord src_file_len = strlen(src_file); + StgWord src_span_len = strlen(src_span); // 8 for the info word // 6 for the number of strings in the payload as postString adds 1 to the length - StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6; + StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+src_file_len+1+src_span_len+6; ensureRoomForVariableEvent(&eventBuf, len); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); @@ -1438,7 +1440,13 @@ void postIPE(StgWord64 info, postString(&eventBuf, ty_desc); postString(&eventBuf, label); postString(&eventBuf, module); - postString(&eventBuf, srcloc); + + // Manually construct the string ":\0" + postBuf(&eventBuf, (const StgWord8*) src_file, src_file_len); + StgWord8 colon = ':'; + postBuf(&eventBuf, &colon, 1); + postString(&eventBuf, src_span); + RELEASE_LOCK(&eventBufMutex); } ===================================== rts/eventlog/EventLog.h ===================================== @@ -196,7 +196,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc); + const char *src_file, + const char *src_span); void postConcUpdRemSetFlush(Capability *cap); void postConcMarkEnd(StgWord32 marked_obj_count); ===================================== rts/include/rts/IPE.h ===================================== @@ -19,7 +19,8 @@ typedef struct InfoProv_ { const char *ty_desc; const char *label; const char *module; - const char *srcloc; + const char *src_file; + const char *src_span; } InfoProv; typedef struct InfoProvEnt_ { @@ -51,7 +52,8 @@ typedef struct { StringIdx ty_desc; StringIdx label; StringIdx module_name; - StringIdx srcloc; + StringIdx src_file; + StringIdx src_span; } IpeBufferEntry; typedef struct IpeBufferListNode_ { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5a3d3587b22da3928396d4698c28eaf2cee6c1a2...b5d9acb1e7a5cba4a510eae4fe9ee7ad22439b46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5a3d3587b22da3928396d4698c28eaf2cee6c1a2...b5d9acb1e7a5cba4a510eae4fe9ee7ad22439b46 You're receiving 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 Aug 19 15:25:57 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 Aug 2022 11:25:57 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Efficency improvements Message-ID: <62ffab85d34f6_125b2b4885026602@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: 233089bd by Simon Peyton Jones at 2022-08-19T16:26:46+01:00 Efficency improvements Don't call full arityType for non-rec join points (must document this). Refactoring - - - - - 5 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Iface/Tidy.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Core.Opt.Arity ( -- Finding arity manifestArity, joinRhsArity, exprArity - , findRhsArity, exprBotStrictness_maybe + , findRhsArity, cheapArityType , ArityOpts(..) -- ** Eta expansion @@ -24,7 +24,10 @@ module GHC.Core.Opt.Arity -- ** ArityType , ArityType, mkBotArityType - , arityTypeArity, idArityType, getBotArity + , arityTypeArity, idArityType + + -- ** Bottoming things + , exprBotStrictness_maybe, arityTypeBotSigs_maybe -- ** typeArity and the state hack , typeArity, typeOneShots, typeOneShot @@ -63,6 +66,7 @@ import GHC.Core.Type as Type import GHC.Core.Coercion as Type import GHC.Types.Demand +import GHC.Types.Cpr( CprSig, mkCprSig, botCpr ) import GHC.Types.Id import GHC.Types.Var.Env import GHC.Types.Var.Set @@ -156,14 +160,22 @@ exprArity e = go e go _ = 0 --------------- -exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, DmdSig) +exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, DmdSig, CprSig) -- A cheap and cheerful function that identifies bottoming functions --- and gives them a suitable strictness signatures. It's used during --- float-out -exprBotStrictness_maybe e - = case getBotArity (arityType botStrictnessArityEnv e) of - Nothing -> Nothing - Just ar -> Just (ar, mkVanillaDmdSig ar botDiv) +-- and gives them a suitable strictness and CPR signatures. +-- It's used during float-out +exprBotStrictness_maybe e = arityTypeBotSigs_maybe (cheapArityType e) + +arityTypeBotSigs_maybe :: ArityType -> Maybe (Arity, DmdSig, CprSig) +-- Arity of a divergent function +arityTypeBotSigs_maybe (AT lams div) + | isDeadEndDiv div = Just ( arity + , mkVanillaDmdSig arity botDiv + , mkCprSig arity botCpr) + | otherwise = Nothing + where + arity = length lams + {- Note [exprArity for applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -467,7 +479,14 @@ We want this to have arity 1 if the \y-abstraction is a 1-shot lambda. Note [Dealing with bottom] ~~~~~~~~~~~~~~~~~~~~~~~~~~ -A Big Deal with computing arities is expressions like +GHC does some transformations that are technically unsound wrt +bottom, because doing so improves arities... a lot! We describe +them in this Note. + +The flag -fpedantic-bottoms (off by default) restore technically +correct behaviour at the cots of efficiency. + +It's mostly to do with eta-expansion. Consider f = \x -> case x of True -> \s -> e1 @@ -487,7 +506,7 @@ would lose an important transformation for many programs. (See Consider also f = \x -> error "foo" -Here, arity 1 is fine. But if it is +Here, arity 1 is fine. But if it looks like this (see #22068) f = \x -> case x of True -> error "foo" False -> \y -> x+y @@ -869,12 +888,6 @@ exprEtaExpandArity opts e where arity_type = safeArityType (arityType (findRhsArityEnv opts False) e) -getBotArity :: ArityType -> Maybe Arity --- Arity of a divergent function -getBotArity (AT oss div) - | isDeadEndDiv div = Just $ length oss - | otherwise = Nothing - {- ********************************************************************* * * @@ -923,13 +936,13 @@ findRhsArity opts is_rec bndr rhs old_arity go !n cur_at@(AT lams div) | not (isDeadEndDiv div) -- the "stop right away" case , length lams <= old_arity = cur_at -- from above - | next_at == cur_at = cur_at - | otherwise = + | next_at == cur_at = cur_at + | otherwise -- Warn if more than 2 iterations. Why 2? See Note [Exciting arity] - warnPprTrace (debugIsOn && n > 2) + = warnPprTrace (debugIsOn && n > 2) "Exciting arity" (nest 2 (ppr bndr <+> ppr cur_at <+> ppr next_at $$ ppr rhs)) $ - go (n+1) next_at + go (n+1) next_at where next_at = step (extendSigEnv init_env bndr cur_at) @@ -1294,8 +1307,8 @@ instance Outputable AnalysisMode where -- | The @ArityEnv@ used by 'exprBotStrictness_maybe'. Pedantic about bottoms -- and no application is ever considered cheap. -botStrictnessArityEnv :: ArityEnv -botStrictnessArityEnv = AE { ae_mode = BotStrictness } +_botStrictnessArityEnv :: ArityEnv +_botStrictnessArityEnv = AE { ae_mode = BotStrictness } -- | The @ArityEnv@ used by 'findRhsArity'. findRhsArityEnv :: ArityOpts -> Bool -> ArityEnv @@ -1482,6 +1495,20 @@ arityType env (Tick t e) arityType _ _ = topArityType +-------------------- +cheapArityType :: HasDebugCallStack => CoreExpr -> ArityType + +cheapArityType (Lam var body) + | isTyVar var = body_at + | otherwise = AT ((IsCheap, idOneShotInfo var) : lams) div + where + !body_at@(AT lams div) = cheapArityType body + +cheapArityType e + | exprIsDeadEnd e = botArityType + | otherwise = AT lams topDiv + where + lams = replicate (exprArity e) (IsCheap, NoOneShotInfo) {- Note [No free join points in arityType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1579,7 +1606,8 @@ Obviously `f` should get arity 4. But it's a bit tricky: Note [Do not eta-expand join points]. 2. But even though we aren't going to eta-expand it, we still want `j` to get - idArity=4, via findRhsArity, so that in arityType, + idArity=4, via the findRhsArity fixpoint. Then when we are doing findRhsArity + for `f`, we'll call arityType on f's RHS: - At the letrec-binding for `j` we'll whiz up an arity-4 ArityType for `j` (Note [arityType for let-bindings]) - At the occurrence (j 20) that arity-4 ArityType will leave an arity-3 ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -104,7 +104,7 @@ import GHC.Types.Unique.DSet ( getUniqDSet ) import GHC.Types.Var.Env import GHC.Types.Literal ( litIsTrivial ) import GHC.Types.Demand ( DmdSig, prependArgsDmdSig ) -import GHC.Types.Cpr ( mkCprSig, botCpr ) +import GHC.Types.Cpr ( CprSig, prependArgsCprSig ) import GHC.Types.Name ( getOccName, mkSystemVarName ) import GHC.Types.Name.Occurrence ( occNameString ) import GHC.Types.Unique ( hasKey ) @@ -659,9 +659,7 @@ lvlMFE env strict_ctxt ann_expr -- No wrapping needed if the type is lifted, or is a literal string -- or if we are wrapping it in one or more value lambdas = do { expr1 <- lvlFloatRhs abs_vars dest_lvl rhs_env NonRecursive - (isJust mb_bot_str) - join_arity_maybe - ann_expr + is_bot_lam join_arity_maybe ann_expr -- Treat the expr just like a right-hand side ; var <- newLvlVar expr1 join_arity_maybe is_mk_static ; let var2 = annotateBotStr var float_n_lams mb_bot_str @@ -702,6 +700,7 @@ lvlMFE env strict_ctxt ann_expr fvs = freeVarsOf ann_expr fvs_ty = tyCoVarsOfType expr_ty is_bot = isBottomThunk mb_bot_str + is_bot_lam = isJust mb_bot_str is_function = isFunction ann_expr mb_bot_str = exprBotStrictness_maybe expr -- See Note [Bottoming floats] @@ -750,10 +749,10 @@ hasFreeJoin :: LevelEnv -> DVarSet -> Bool hasFreeJoin env fvs = not (maxFvLevel isJoinId env fvs == tOP_LEVEL) -isBottomThunk :: Maybe (Arity, s) -> Bool +isBottomThunk :: Maybe (Arity, DmdSig, CprSig) -> Bool -- See Note [Bottoming floats] (2) -isBottomThunk (Just (0, _)) = True -- Zero arity -isBottomThunk _ = False +isBottomThunk (Just (0, _, _)) = True -- Zero arity +isBottomThunk _ = False {- Note [Floating to the top] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1008,17 +1007,18 @@ answer. -} -annotateBotStr :: Id -> Arity -> Maybe (Arity, DmdSig) -> Id +annotateBotStr :: Id -> Arity -> Maybe (Arity, DmdSig, CprSig) -> Id -- See Note [Bottoming floats] for why we want to add -- bottoming information right now -- -- n_extra are the number of extra value arguments added during floating -annotateBotStr id n_extra mb_str - = case mb_str of - Nothing -> id - Just (arity, sig) -> id `setIdArity` (arity + n_extra) - `setIdDmdSig` prependArgsDmdSig n_extra sig - `setIdCprSig` mkCprSig (arity + n_extra) botCpr +annotateBotStr id n_extra mb_bot_str + | Just (arity, str_sig, cpr_sig) <- mb_bot_str + = id `setIdArity` (arity + n_extra) + `setIdDmdSig` prependArgsDmdSig n_extra str_sig + `setIdCprSig` prependArgsCprSig n_extra cpr_sig + | otherwise + = id notWorthFloating :: CoreExpr -> [Var] -> Bool -- Returns True if the expression would be replaced by @@ -1127,7 +1127,7 @@ lvlBind env (AnnNonRec bndr rhs) -- bit brutal, but unlifted bindings aren't expensive either = -- No float - do { rhs' <- lvlRhs env NonRecursive is_bot mb_join_arity rhs + do { rhs' <- lvlRhs env NonRecursive is_bot_lam mb_join_arity rhs ; let bind_lvl = incMinorLvl (le_ctxt_lvl env) (env', [bndr']) = substAndLvlBndrs NonRecursive env bind_lvl [bndr] ; return (NonRec bndr' rhs', env') } @@ -1136,7 +1136,7 @@ lvlBind env (AnnNonRec bndr rhs) | null abs_vars = do { -- No type abstraction; clone existing binder rhs' <- lvlFloatRhs [] dest_lvl env NonRecursive - is_bot mb_join_arity rhs + is_bot_lam mb_join_arity rhs ; (env', [bndr']) <- cloneLetVars NonRecursive env dest_lvl [bndr] ; let bndr2 = annotateBotStr bndr' 0 mb_bot_str ; return (NonRec (TB bndr2 (FloatMe dest_lvl)) rhs', env') } @@ -1144,7 +1144,7 @@ lvlBind env (AnnNonRec bndr rhs) | otherwise = do { -- Yes, type abstraction; create a new binder, extend substitution, etc rhs' <- lvlFloatRhs abs_vars dest_lvl env NonRecursive - is_bot mb_join_arity rhs + is_bot_lam mb_join_arity rhs ; (env', [bndr']) <- newPolyBndrs dest_lvl env abs_vars [bndr] ; let bndr2 = annotateBotStr bndr' n_extra mb_bot_str ; return (NonRec (TB bndr2 (FloatMe dest_lvl)) rhs', env') } @@ -1155,11 +1155,12 @@ lvlBind env (AnnNonRec bndr rhs) rhs_fvs = freeVarsOf rhs bind_fvs = rhs_fvs `unionDVarSet` dIdFreeVars bndr abs_vars = abstractVars dest_lvl env bind_fvs - dest_lvl = destLevel env bind_fvs ty_fvs (isFunction rhs) is_bot is_join + dest_lvl = destLevel env bind_fvs ty_fvs (isFunction rhs) is_bot_lam is_join deann_rhs = deAnnotate rhs mb_bot_str = exprBotStrictness_maybe deann_rhs - is_bot = isJust mb_bot_str + is_bot_lam = isJust mb_bot_str + -- is_bot_lam: looks like (\xy. bot), maybe zero lams -- NB: not isBottomThunk! See Note [Bottoming floats] point (3) n_extra = count isId abs_vars ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Core.Ppr ( pprCoreExpr ) import GHC.Core.Unfold import GHC.Core.Unfold.Make import GHC.Core.Utils -import GHC.Core.Opt.Arity ( ArityType, exprArity, getBotArity +import GHC.Core.Opt.Arity ( ArityType, exprArity, arityTypeBotSigs_maybe , pushCoTyArg, pushCoValArg , typeArity, arityTypeArity, etaExpandAT ) import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe ) @@ -53,7 +53,6 @@ import GHC.Types.Id.Make ( seqId ) import GHC.Types.Id.Info import GHC.Types.Name ( mkSystemVarName, isExternalName, getOccFS ) import GHC.Types.Demand -import GHC.Types.Cpr ( mkCprSig, botCpr ) import GHC.Types.Unique ( hasKey ) import GHC.Types.Basic import GHC.Types.Tickish @@ -980,11 +979,11 @@ addLetBndrInfo new_bndr new_arity_type new_unf = info2 -- Bottoming bindings: see Note [Bottoming bindings] - info4 = case getBotArity new_arity_type of + info4 = case arityTypeBotSigs_maybe new_arity_type of Nothing -> info3 - Just ar -> assert (ar == new_arity) $ - info3 `setDmdSigInfo` mkVanillaDmdSig new_arity botDiv - `setCprSigInfo` mkCprSig new_arity botCpr + Just (ar, str_sig, cpr_sig) -> assert (ar == new_arity) $ + info3 `setDmdSigInfo` str_sig + `setCprSigInfo` cpr_sig -- Zap call arity info. We have used it by now (via -- `tryEtaExpandRhs`), and the simplifier can invalidate this ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1780,19 +1780,17 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -- (a) rhs' has manifest arity n -- (b) if is_bot is True then rhs' applied to n args is guaranteed bottom tryEtaExpandRhs env (BC_Join is_rec _) bndr rhs - | isJoinId bndr - = return (arity_type, rhs) + = assertPpr (isJoinId bndr) (ppr bndr) $ + return (arity_type, rhs) -- Note [Do not eta-expand join points] -- But do return the correct arity and bottom-ness, because -- these are used to set the bndr's IdInfo (#15517) -- Note [Invariants on join points] invariant 2b, in GHC.Core - - | otherwise - = pprPanic "tryEtaExpandRhs" (ppr bndr) where - old_arity = exprArity rhs - arity_type = findRhsArity arity_opts is_rec bndr rhs old_arity - arity_opts = seArityOpts env + arity_type = case is_rec of + NonRecursive -> cheapArityType rhs + Recursive -> findRhsArity (seArityOpts env) Recursive + bndr rhs (exprArity rhs) tryEtaExpandRhs env (BC_Let _ is_rec) bndr rhs | seEtaExpand env -- Provided eta-expansion is on @@ -1805,8 +1803,8 @@ tryEtaExpandRhs env (BC_Let _ is_rec) bndr rhs = return (arity_type, rhs) where in_scope = getInScope env - arity_opts = seArityOpts env old_arity = exprArity rhs + arity_opts = seArityOpts env arity_type = findRhsArity arity_opts is_rec bndr rhs old_arity new_arity = arityTypeArity arity_type ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1274,21 +1274,22 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf -- No demand signature, so try a -- cheap-and-cheerful bottom analyser - | Just (_, nsig) <- mb_bot_str - = nsig + | Just (_, bot_str_sig, _) <- mb_bot_str + = bot_str_sig -- No stricness info | otherwise = nopSig cpr = cprSigInfo idinfo - final_cpr | Just _ <- mb_bot_str - = mkCprSig arity botCpr + final_cpr | Just (_, _, bot_cpr_sig) <- mb_bot_str + = bot_cpr_sig | otherwise = cpr - _bottom_hidden id_sig = case mb_bot_str of - Nothing -> False - Just (arity, _) -> not (isDeadEndAppSig id_sig arity) + _bottom_hidden id_sig + = case mb_bot_str of + Nothing -> False + Just (arity, _, _) -> not (isDeadEndAppSig id_sig arity) --------- Unfolding ------------ unf_info = realUnfoldingInfo idinfo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/233089bd7623d80ad43154c9bed71f1cd86dc184 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/233089bd7623d80ad43154c9bed71f1cd86dc184 You're receiving 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 Aug 19 15:31:22 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 Aug 2022 11:31:22 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Improve exprIsDeadEnd Message-ID: <62ffacca21ff4_125b2b502bc266353@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: d22bec7c by Simon Peyton Jones at 2022-08-19T16:32:44+01:00 Improve exprIsDeadEnd - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1083,21 +1083,25 @@ expensive. exprIsDeadEnd :: CoreExpr -> Bool -- See Note [Bottoming expressions] exprIsDeadEnd e - | isEmptyTy (exprType e) - = True - | otherwise = go 0 e where - go n (Var v) = isDeadEndAppSig (idDmdSig v) n + go _ (Lit {}) = False + go _ (Type {}) = False + go _ (Coercion {}) = False go n (App e a) | isTypeArg a = go n e | otherwise = go (n+1) e go n (Tick _ e) = go n e go n (Cast e _) = go n e go n (Let _ e) = go n e go n (Lam v e) | isTyVar v = go n e + | otherwise = False + go _ (Case _ _ _ alts) = null alts -- See Note [Empty case alternatives] in GHC.Core - go _ _ = False + + go n (Var v) | isDeadEndAppSig (idDmdSig v) n = True + | isEmptyTy (idType v) = True + | otherwise = False {- Note [Bottoming expressions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d22bec7cdb9ff5ac9d9a496954a09f084aaa12a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d22bec7cdb9ff5ac9d9a496954a09f084aaa12a6 You're receiving 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 Aug 19 15:47:39 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 11:47:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Make ru_fn field strict to avoid retaining Ids Message-ID: <62ffb09bf24e3_125b2b48814270177@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 29ca2b0c by Zachary Wood at 2022-08-19T11:47:17-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - 6d53fa9e by Andreas Klebinger at 2022-08-19T11:47:17-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 17 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Builders/Haddock.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T - + testsuite/tests/typecheck/should_compile/T21951a.hs - + testsuite/tests/typecheck/should_compile/T21951a.stderr - + testsuite/tests/typecheck/should_compile/T21951b.hs - + testsuite/tests/typecheck/should_compile/T21951b.stderr - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -1151,7 +1151,7 @@ data CoreRule -- Rough-matching stuff -- see comments with InstEnv.ClsInst( is_cls, is_rough ) - ru_fn :: Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule + ru_fn :: !Name, -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side -- Proper-matching stuff ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -634,7 +634,8 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) floats' = floats `extendFloats` NonRec bndr' triv_rhs ; return ( floats', setInScopeFromF env floats' ) } } where - occ_fs = getOccFS bndr + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr uf_opts = seUnfoldingOpts env work_ty = coercionLKind co info = idInfo bndr @@ -711,9 +712,11 @@ prepareBinding env top_lvl is_rec strict_bind bndr rhs_floats rhs -- rhs_env: add to in-scope set the binders from rhs_floats -- so that prepareRhs knows what is in scope in rhs ; let rhs_env = env `setInScopeFromF` rhs_floats1 + -- Force the occ_fs so that the old Id is not retained in the new Id. + !occ_fs = getOccFS bndr -- Now ANF-ise the remaining rhs - ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl (getOccFS bndr) rhs1 + ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl occ_fs rhs1 -- Finally, decide whether or not to float ; let all_floats = rhs_floats1 `addLetFloats` anf_floats @@ -4294,7 +4297,8 @@ simplRules env mb_new_id rules bind_cxt lhs_env = updMode updModeForRules env' rhs_env = updMode (updModeForStableUnfoldings act) env' -- See Note [Simplifying the RHS of a RULE] - fn_name' = case mb_new_id of + -- Force this to avoid retaining reference to old Id + !fn_name' = case mb_new_id of Just id -> idName id Nothing -> fn_name ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,6 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) -import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) {- @@ -375,14 +374,11 @@ The recursive call ends up looking like So we want to spot the constructor application inside the cast. That's why we have the Cast case in argToPat -Note [Seeding recursive groups] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For a recursive group that is either - * nested, or - * top-level, but with no exported Ids -we can see all the calls to the function, so we seed the specialisation -loop from the calls in the body, and /not/ from the calls in the RHS. -Consider: +Note [Local recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a *local* recursive group, we can see all the calls to the +function, so we seed the specialisation loop from the calls in the +body, not from the calls in the RHS. Consider: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -405,42 +401,52 @@ a local function. In a case like the above we end up never calling the original un-specialised function. (Although we still leave its code around just in case.) -Wrinkles - -* Boring calls. If we find any boring calls in the body, including - *unsaturated* ones, such as +However, if we find any boring calls in the body, including *unsaturated* +ones, such as letrec foo x y = ....foo... in map foo xs - then we will end up calling the un-specialised function, so then we - *should* use the calls in the un-specialised RHS as seeds. We call - these "boring call patterns", and callsToNewPats reports if it finds - any of these. Then 'specialise' unleashes the usage info from the - un-specialised RHS. - -* Exported Ids. `specialise` /also/ unleashes `si_mb_unspec` - for exported Ids. That way we are sure to generate usage info from - the /un-specialised/ RHS of an exported function. - -More precisely: - -* Always start from the calls in the body of the let or (for top level) - calls in the rest of the module. See the body_calls in the call to - `specialise` in `specNonRec`, and to `go` in `specRec`. - -* si_mb_unspec holds the usage from the unspecialised RHS. - See `initSpecInfo`. - -* `specialise` will unleash si_mb_unspec, if - - `callsToNewPats` reports "boring calls found", or - - this is a top-level exported Id. - -Historical note. At an earlier point, if a top-level Id was exported, -we used only seeds from the RHS, and /not/from the body. But Dimitrios -had an example where using call patterns from the body (the other defns -in the module) was crucial. And doing so improved nofib allocation results: - multiplier: 4% better - minimax: 2.8% better -In any case, it is easier to do! +then we will end up calling the un-specialised function, so then we *should* +use the calls in the un-specialised RHS as seeds. We call these +"boring call patterns", and callsToPats reports if it finds any of these. + +Note [Seeding top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This seeding is done in the binding for seed_calls in specRec. + +1. If all the bindings in a top-level recursive group are local (not + exported), then all the calls are in the rest of the top-level + bindings. This means we can specialise with those call patterns + ONLY, and NOT with the RHSs of the recursive group (exactly like + Note [Local recursive groups]) + +2. But if any of the bindings are exported, the function may be called + with any old arguments, so (for lack of anything better) we specialise + based on + (a) the call patterns in the RHS + (b) the call patterns in the rest of the top-level bindings + NB: before Apr 15 we used (a) only, but Dimitrios had an example + where (b) was crucial, so I added that. + Adding (b) also improved nofib allocation results: + multiplier: 4% better + minimax: 2.8% better + +Actually in case (2), instead of using the calls from the RHS, it +would be better to specialise in the importing module. We'd need to +add an INLINABLE pragma to the function, and then it can be +specialised in the importing scope, just as is done for type classes +in GHC.Core.Opt.Specialise.specImports. This remains to be done (#10346). + +Note [Top-level recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To get the call usage information from "the rest of the top level +bindings" (c.f. Note [Seeding top-level recursive groups]), we work +backwards through the top-level bindings so we see the usage before we +get to the binding of the function. Before we can collect the usage +though, we go through all the bindings and add them to the +environment. This is necessary because usage is only tracked for +functions in the environment. These two passes are called + 'go' and 'goEnv' +in specConstrProgram. (Looks a bit revolting to me.) Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -758,18 +764,35 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = do { env0 <- initScEnv guts - ; us <- getUniqueSupplyM - ; let (_usg, binds') = initUs_ us $ - scTopBinds env0 (mg_binds guts) - - ; return (guts { mg_binds = binds' }) } - -scTopBinds :: ScEnv -> [InBind] -> UniqSM (ScUsage, [OutBind]) -scTopBinds _env [] = return (nullUsage, []) -scTopBinds env (b:bs) = do { (usg, b', bs') <- scBind TopLevel env b $ - (\env -> scTopBinds env bs) - ; return (usg, b' ++ bs') } + = do + dflags <- getDynFlags + us <- getUniqueSupplyM + (_, annos) <- getFirstAnnotations deserializeWithData guts + this_mod <- getModule + -- pprTraceM "specConstrInput" (ppr $ mg_binds guts) + let binds' = reverse $ fst $ initUs us $ do + -- Note [Top-level recursive groups] + (env, binds) <- goEnv (initScEnv (initScOpts dflags this_mod) annos) + (mg_binds guts) + -- binds is identical to (mg_binds guts), except that the + -- binders on the LHS have been replaced by extendBndr + -- (SPJ this seems like overkill; I don't think the binders + -- will change at all; and we don't substitute in the RHSs anyway!!) + go env nullUsage (reverse binds) + + return (guts { mg_binds = binds' }) + where + -- See Note [Top-level recursive groups] + goEnv env [] = return (env, []) + goEnv env (bind:binds) = do (env', bind') <- scTopBindEnv env bind + (env'', binds') <- goEnv env' binds + return (env'', bind' : binds') + + -- Arg list of bindings is in reverse order + go _ _ [] = return [] + go env usg (bind:binds) = do (usg', bind') <- scTopBind env usg bind + binds' <- go env usg' binds + return (bind' : binds') {- ************************************************************************ @@ -933,24 +956,14 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -initScEnv :: ModGuts -> CoreM ScEnv -initScEnv guts - = do { dflags <- getDynFlags - ; (_, anns) <- getFirstAnnotations deserializeWithData guts - ; this_mod <- getModule - ; return (SCE { sc_opts = initScOpts dflags this_mod, - sc_force = False, - sc_subst = init_subst, - sc_how_bound = emptyVarEnv, - sc_vals = emptyVarEnv, - sc_annotations = anns }) } - where - init_subst = mkEmptySubst $ mkInScopeSet $ mkVarSet $ - bindersOfBinds (mg_binds guts) - -- Acccount for top-level bindings that are not in dependency order; - -- see Note [Glomming] in GHC.Core.Opt.OccurAnal - -- Easiest thing is to bring all the top level binders into scope at once, - -- as if at once, as if all the top-level decls were mutually recursive. +initScEnv :: SpecConstrOpts -> UniqFM Name SpecConstrAnnotation -> ScEnv +initScEnv opts anns + = SCE { sc_opts = opts, + sc_force = False, + sc_subst = emptySubst, + sc_how_bound = emptyVarEnv, + sc_vals = emptyVarEnv, + sc_annotations = anns } data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -1174,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -- Domain is OutIds -data Call = Call OutId [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] +data Call = Call Id [CoreArg] ValueEnv -- The arguments of the call, together with the -- env giving the constructor bindings at the call site -- We keep the function mainly for debug output @@ -1197,9 +1210,6 @@ nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv } combineCalls :: CallEnv -> CallEnv -> CallEnv combineCalls = plusVarEnv_C (++) -delCallsFor :: ScUsage -> [Var] -> ScUsage -delCallsFor env bndrs = env { scu_calls = scu_calls env `delVarEnvList` bndrs } - combineUsage :: ScUsage -> ScUsage -> ScUsage combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2), scu_occs = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) } @@ -1282,121 +1292,6 @@ The main recursive function gathers up usage information, and creates specialised versions of functions. -} -scBind :: TopLevelFlag -> ScEnv -> InBind - -> (ScEnv -> UniqSM (ScUsage, a)) -- Specialise the scope of the binding - -> UniqSM (ScUsage, [OutBind], a) -scBind top_lvl env (NonRec bndr rhs) do_body - | isTyVar bndr -- Type-lets may be created by doBeta - = do { (final_usage, body') <- do_body (extendScSubst env bndr rhs) - ; return (final_usage, [], body') } - - | not (isTopLevel top_lvl) -- Nested non-recursive value binding - -- See Note [Specialising local let bindings] - = do { let (body_env, bndr') = extendBndr env bndr - -- Not necessary at top level; but here we are nested - - ; rhs_info <- scRecRhs env (bndr',rhs) - - ; let body_env2 = extendHowBound body_env [bndr'] RecFun - rhs' = ri_new_rhs rhs_info - body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') - - ; (body_usg, body') <- do_body body_env3 - - -- Now make specialised copies of the binding, - -- based on calls in body_usg - ; (spec_usg, specs) <- specNonRec env (scu_calls body_usg) rhs_info - -- NB: For non-recursive bindings we inherit sc_force flag from - -- the parent function (see Note [Forcing specialisation]) - - -- Specialized + original binding - ; let spec_bnds = [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] - bind_usage = (body_usg `delCallsFor` [bndr']) - `combineUsage` spec_usg -- Note [spec_usg includes rhs_usg] - - ; return (bind_usage, spec_bnds, body') - } - - | otherwise -- Top-level, non-recursive value binding - -- At top level we do not specialise non-recursive bindings; that - -- is, we do not call specNonRec, passing the calls from the body. - -- The original paper only specialised /recursive/ bindings, but - -- we later started specialising nested non-recursive bindings: - -- see Note [Specialising local let bindings] - -- - -- I tried always specialising non-recursive top-level bindings too, - -- but found some regressions (see !8135). So I backed off. - = do { (rhs_usage, rhs') <- scExpr env rhs - - -- At top level, we've already put all binders into scope; see initScEnv - -- Hence no need to call `extendBndr`. But we still want to - -- extend the `ValueEnv` to record the value of this binder. - ; let body_env = extendValEnv env bndr (isValue (sc_vals env) rhs') - ; (body_usage, body') <- do_body body_env - - ; return (rhs_usage `combineUsage` body_usage, [NonRec bndr rhs'], body') } - -scBind top_lvl env (Rec prs) do_body - | isTopLevel top_lvl - , Just threshold <- sc_size (sc_opts env) - , not force_spec - , not (all (couldBeSmallEnoughToInline (sc_uf_opts (sc_opts env)) threshold) rhss) - = -- Do no specialisation if the RHSs are too big - -- ToDo: I'm honestly not sure of the rationale of this size-testing, nor - -- why it only applies at top level. But that's the way it has been - -- for a while. See #21456. - do { (body_usg, body') <- do_body rhs_env2 - ; (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss - ; let all_usg = (combineUsages rhs_usgs `combineUsage` body_usg) - `delCallsFor` bndrs' - bind' = Rec (bndrs' `zip` rhss') - ; return (all_usg, [bind'], body') } - - | otherwise - = do { rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) - ; (body_usg, body') <- do_body rhs_env2 - - ; (spec_usg, specs) <- specRec (scForce rhs_env2 force_spec) - (scu_calls body_usg) rhs_infos - -- Do not unconditionally generate specialisations from rhs_usgs - -- Instead use them only if we find an unspecialised call - -- See Note [Seeding recursive groups] - - ; let all_usg = (spec_usg `combineUsage` body_usg) -- Note [spec_usg includes rhs_usg] - `delCallsFor` bndrs' - bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) - -- zipWithEqual: length of returned [SpecInfo] - -- should be the same as incoming [RhsInfo] - - ; return (all_usg, [bind'], body') } - where - (bndrs,rhss) = unzip prs - force_spec = any (forceSpecBndr env) bndrs -- Note [Forcing specialisation] - - (rhs_env1,bndrs') | isTopLevel top_lvl = (env, bndrs) - | otherwise = extendRecBndrs env bndrs - -- At top level, we've already put all binders into scope; see initScEnv - - rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun - -{- Note [Specialising local let bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is not uncommon to find this - - let $j = \x. in ...$j True...$j True... - -Here $j is an arbitrary let-bound function, but it often comes up for -join points. We might like to specialise $j for its call patterns. -Notice the difference from a letrec, where we look for call patterns -in the *RHS* of the function. Here we look for call patterns in the -*body* of the let. - -At one point I predicated this on the RHS mentioning the outer -recursive function, but that's not essential and might even be -harmful. I'm not sure. --} - ------------------------- scExpr, scExpr' :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr) -- The unique supply is needed when we invent -- a new name for the specialised function and its args @@ -1421,11 +1316,6 @@ scExpr' env (Lam b e) = do let (env', b') = extendBndr env b (usg, e') <- scExpr env' e return (usg, Lam b' e') -scExpr' env (Let bind body) - = do { (final_usage, binds', body') <- scBind NotTopLevel env bind $ - (\env -> scExpr env body) - ; return (final_usage, mkLets binds' body') } - scExpr' env (Case scrut b ty alts) = do { (scrut_usg, scrut') <- scExpr env scrut ; case isValue (sc_vals env) scrut' of @@ -1465,7 +1355,79 @@ scExpr' env (Case scrut b ty alts) _ -> evalScrutOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } +scExpr' env (Let (NonRec bndr rhs) body) + | isTyVar bndr -- Type-lets may be created by doBeta + = scExpr' (extendScSubst env bndr rhs) body + + | otherwise + = do { let (body_env, bndr') = extendBndr env bndr + ; rhs_info <- scRecRhs env (bndr',rhs) + + ; let body_env2 = extendHowBound body_env [bndr'] RecFun + -- See Note [Local let bindings] + rhs' = ri_new_rhs rhs_info + body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs') + + ; (body_usg, body') <- scExpr body_env3 body + + -- NB: For non-recursive bindings we inherit sc_force flag from + -- the parent function (see Note [Forcing specialisation]) + ; (spec_usg, specs) <- specNonRec env body_usg rhs_info + + -- Specialized + original binding + ; let spec_bnds = mkLets [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] body' + -- ; pprTraceM "spec_bnds" $ (ppr spec_bnds) + + ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' } + `combineUsage` spec_usg, -- Note [spec_usg includes rhs_usg] + spec_bnds + ) + } + + +-- A *local* recursive group: see Note [Local recursive groups] +scExpr' env (Let (Rec prs) body) + = do { let (bndrs,rhss) = unzip prs + (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun + force_spec = any (forceSpecBndr env) bndrs' + -- Note [Forcing specialisation] + + ; rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss) + ; (body_usg, body') <- scExpr rhs_env2 body + + -- NB: start specLoop from body_usg + ; (spec_usg, specs) <- specRec NotTopLevel (scForce rhs_env2 force_spec) + body_usg rhs_infos + -- Do not unconditionally generate specialisations from rhs_usgs + -- Instead use them only if we find an unspecialised call + -- See Note [Local recursive groups] + + ; let all_usg = spec_usg `combineUsage` body_usg -- Note [spec_usg includes rhs_usg] + bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) + -- zipWithEqual: length of returned [SpecInfo] + -- should be the same as incoming [RhsInfo] + + ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' }, + Let bind' body') } + +{- +Note [Local let bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~ +It is not uncommon to find this + + let $j = \x. in ...$j True...$j True... +Here $j is an arbitrary let-bound function, but it often comes up for +join points. We might like to specialise $j for its call patterns. +Notice the difference from a letrec, where we look for call patterns +in the *RHS* of the function. Here we look for call patterns in the +*body* of the let. + +At one point I predicated this on the RHS mentioning the outer +recursive function, but that's not essential and might even be +harmful. I'm not sure. +-} scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) @@ -1520,6 +1482,51 @@ mkVarUsage env fn args arg_occ | null args = UnkOcc | otherwise = evalScrutOcc +---------------------- +scTopBindEnv :: ScEnv -> CoreBind -> UniqSM (ScEnv, CoreBind) +scTopBindEnv env (Rec prs) + = do { let (rhs_env1,bndrs') = extendRecBndrs env bndrs + rhs_env2 = extendHowBound rhs_env1 bndrs RecFun + + prs' = zip bndrs' rhss + ; return (rhs_env2, Rec prs') } + where + (bndrs,rhss) = unzip prs + +scTopBindEnv env (NonRec bndr rhs) + = do { let (env1, bndr') = extendBndr env bndr + env2 = extendValEnv env1 bndr' (isValue (sc_vals env) rhs) + ; return (env2, NonRec bndr' rhs) } + +---------------------- +scTopBind :: ScEnv -> ScUsage -> CoreBind -> UniqSM (ScUsage, CoreBind) + +scTopBind env body_usage (Rec prs) + | Just threshold <- sc_size $ sc_opts env + , not force_spec + , not (all (couldBeSmallEnoughToInline (sc_uf_opts $ sc_opts env) threshold) rhss) + -- No specialisation + = -- pprTrace "scTopBind: nospec" (ppr bndrs) $ + do { (rhs_usgs, rhss') <- mapAndUnzipM (scExpr env) rhss + ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) } + + | otherwise -- Do specialisation + = do { rhs_infos <- mapM (scRecRhs env) prs + + ; (spec_usage, specs) <- specRec TopLevel (scForce env force_spec) + body_usage rhs_infos + + ; return (body_usage `combineUsage` spec_usage, + Rec (concat (zipWith ruleInfoBinds rhs_infos specs))) } + where + (bndrs,rhss) = unzip prs + force_spec = any (forceSpecBndr env) bndrs + -- Note [Forcing specialisation] + +scTopBind env usage (NonRec bndr rhs) -- Oddly, we don't seem to specialise top-level non-rec functions + = do { (rhs_usg', rhs') <- scExpr env rhs + ; return (usage `combineUsage` rhs_usg', NonRec bndr rhs') } + ---------------------- scRecRhs :: ScEnv -> (OutId, InExpr) -> UniqSM RhsInfo scRecRhs env (bndr,rhs) @@ -1567,8 +1574,7 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have - -- generated for this function + = SI { si_specs :: [OneSpec] -- The specialisations we have generated , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1579,7 +1585,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Seeding recursive groups] + -- See Note [Local recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1589,62 +1595,57 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -initSpecInfo :: RhsInfo -> SpecInfo -initSpecInfo (RI { ri_rhs_usg = rhs_usg }) - = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Just rhs_usg } - -- si_mb_unspec: add in rhs_usg if there are any boring calls, - -- or if the bndr is exported +noSpecInfo :: SpecInfo +noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } ---------------------- specNonRec :: ScEnv - -> CallEnv -- Calls in body + -> ScUsage -- Body usage -> RhsInfo -- Structure info usage info for un-specialised RHS -> UniqSM (ScUsage, SpecInfo) -- Usage from RHSs (specialised and not) -- plus details of specialisations -specNonRec env body_calls rhs_info - = specialise env body_calls rhs_info (initSpecInfo rhs_info) +specNonRec env body_usg rhs_info + = specialise env (scu_calls body_usg) rhs_info + (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) ---------------------- -specRec :: ScEnv - -> CallEnv -- Calls in body +specRec :: TopLevelFlag -> ScEnv + -> ScUsage -- Body usage -> [RhsInfo] -- Structure info and usage info for un-specialised RHSs -> UniqSM (ScUsage, [SpecInfo]) -- Usage from all RHSs (specialised and not) -- plus details of specialisations -specRec env body_calls rhs_infos - = go 1 body_calls nullUsage (map initSpecInfo rhs_infos) - -- body_calls: see Note [Seeding recursive groups] - -- NB: 'go' always calls 'specialise' once, which in turn unleashes - -- si_mb_unspec if there are any boring calls in body_calls, - -- or if any of the Id(s) are exported +specRec top_lvl env body_usg rhs_infos + = go 1 seed_calls nullUsage init_spec_infos where opts = sc_opts env + (seed_calls, init_spec_infos) -- Note [Seeding top-level recursive groups] + | isTopLevel top_lvl + , any (isExportedId . ri_fn) rhs_infos -- Seed from body and RHSs + = (all_calls, [noSpecInfo | _ <- rhs_infos]) + | otherwise -- Seed from body only + = (calls_in_body, [noSpecInfo { si_mb_unspec = Just (ri_rhs_usg ri) } + | ri <- rhs_infos]) + + calls_in_body = scu_calls body_usg + calls_in_rhss = foldr (combineCalls . scu_calls . ri_rhs_usg) emptyVarEnv rhs_infos + all_calls = calls_in_rhss `combineCalls` calls_in_body -- Loop, specialising, until you get no new specialisations - go, go_again :: Int -- Which iteration of the "until no new specialisations" - -- loop we are on; first iteration is 1 - -> CallEnv -- Seed calls - -- Two accumulating parameters: - -> ScUsage -- Usage from earlier specialisations - -> [SpecInfo] -- Details of specialisations so far - -> UniqSM (ScUsage, [SpecInfo]) + go :: Int -- Which iteration of the "until no new specialisations" + -- loop we are on; first iteration is 1 + -> CallEnv -- Seed calls + -- Two accumulating parameters: + -> ScUsage -- Usage from earlier specialisations + -> [SpecInfo] -- Details of specialisations so far + -> UniqSM (ScUsage, [SpecInfo]) go n_iter seed_calls usg_so_far spec_infos - = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) - -- , text "iteration" <+> int n_iter - -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) - -- ]) $ - do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos - ; let (extra_usg_s, all_spec_infos) = unzip specs_w_usg - extra_usg = combineUsages extra_usg_s - all_usg = usg_so_far `combineUsage` extra_usg - new_calls = scu_calls extra_usg - ; go_again n_iter new_calls all_usg all_spec_infos } - - -- go_again deals with termination - go_again n_iter seed_calls usg_so_far spec_infos | isEmptyVarEnv seed_calls - = return (usg_so_far, spec_infos) + = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) + -- , ppr seed_calls + -- , ppr body_usg ]) $ + return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1653,20 +1654,26 @@ specRec env body_calls rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- Give up on specialisation, but don't forget to include the rhs_usg - -- for the unspecialised function, since it may now be called - -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - let rhs_usgs = combineUsages (mapMaybe si_mb_unspec spec_infos) - in return (usg_so_far `combineUsage` rhs_usgs, spec_infos) + = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ + return (usg_so_far, spec_infos) | otherwise - = go (n_iter + 1) seed_calls usg_so_far spec_infos + = -- pprTrace "specRec3" (vcat [ text "bndrs" <+> ppr (map ri_fn rhs_infos) + -- , text "iteration" <+> int n_iter + -- , text "spec_infos" <+> ppr (map (map os_pat . si_specs) spec_infos) + -- ]) $ + do { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos + ; let (extra_usg_s, new_spec_infos) = unzip specs_w_usg + extra_usg = combineUsages extra_usg_s + all_usg = usg_so_far `combineUsage` extra_usg + ; go (n_iter + 1) (scu_calls extra_usg) all_usg new_spec_infos } -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max + ---------------------- specialise :: ScEnv @@ -1689,12 +1696,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs spec_info@(SI { si_specs = specs, si_n_specs = spec_count , si_mb_unspec = mb_unspec }) | isDeadEndId fn -- Note [Do not specialise diverging functions] - -- /and/ do not generate specialisation seeds from its RHS + -- and do not generate specialisation seeds from its RHS = -- pprTrace "specialise bot" (ppr fn) $ return (nullUsage, spec_info) | not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation] + -- + -- -- Don't specialise OPAQUE things, see Note [OPAQUE pragma]. -- Since OPAQUE things are always never-active (see -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for @@ -1720,16 +1729,14 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs ; let spec_usg = combineUsages spec_usgs - unspec_rhs_needed = boring_call || isExportedId fn - -- If there were any boring calls among the seeds (= all_calls), then those -- calls will call the un-specialised function. So we should use the seeds -- from the _unspecialised_ function's RHS, which are in mb_unspec, by returning -- then in new_usg. - (new_usg, mb_unspec') = case mb_unspec of - Just rhs_usg | unspec_rhs_needed - -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') + = case mb_unspec of + Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1737,8 +1744,8 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs -- , text "new calls:" <+> ppr (scu_calls new_usg)]) $ -- return () - ; return (new_usg, SI { si_specs = new_specs ++ specs - , si_n_specs = spec_count + n_pats + ; return (new_usg, SI { si_specs = new_specs ++ specs + , si_n_specs = spec_count + n_pats , si_mb_unspec = mb_unspec' }) } | otherwise -- No calls, inactive, or not a function @@ -2020,8 +2027,7 @@ calcSpecInfo fn (CP { cp_qvars = qvars, cp_args = pats }) extra_bndrs Note [spec_usg includes rhs_usg] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In calls to 'specialise', the returned ScUsage must include the rhs_usg in -the passed-in SpecInfo in si_mb_unspec, unless there are no calls at all to -the function. +the passed-in SpecInfo, unless there are no calls at all to the function. The caller can, indeed must, assume this. They should not combine in rhs_usg themselves, or they'll get rhs_usg twice -- and that can lead to an exponential @@ -2239,11 +2245,9 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) --- Result has no duplicate patterns, --- nor ones mentioned in si_specs (hence "new" patterns) --- Bool indicates that there was at least one boring pattern --- The "New" in the name means "patterns that are not already covered --- by an existing specialisation" + -- Result has no duplicate patterns, + -- nor ones mentioned in done_pats + -- Bool indicates that there was at least one boring pattern callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -2153,7 +2153,9 @@ cpCloneBndr env bndr -- Drop (now-useless) rules/unfoldings -- See Note [Drop unfoldings and rules] -- and Note [Preserve evaluatedness] in GHC.Core.Tidy - ; let unfolding' = trimUnfolding (realIdUnfolding bndr) + -- And force it.. otherwise the old unfolding is just retained. + -- See #22071 + ; let !unfolding' = trimUnfolding (realIdUnfolding bndr) -- Simplifier will set the Id's unfolding bndr'' = bndr' `setIdUnfolding` unfolding' ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1048,7 +1048,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client @@ -1292,12 +1293,14 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf --------- Unfolding ------------ unf_info = realUnfoldingInfo idinfo - unfold_info + -- Force this, otherwise the old unfolding is retained over code generation + -- See #22071 + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs | otherwise = minimal_unfold_info - minimal_unfold_info = trimUnfolding unf_info + !minimal_unfold_info = trimUnfolding unf_info unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -445,6 +445,9 @@ instance Diagnostic TcRnMessage where TcRnBangOnUnliftedType ty -> mkSimpleDecorated $ text "Strictness flag has no effect on unlifted type" <+> quotes (ppr ty) + TcRnLazyBangOnUnliftedType ty + -> mkSimpleDecorated $ + text "Lazy flag has no effect on unlifted type" <+> quotes (ppr ty) TcRnMultipleDefaultDeclarations dup_things -> mkSimpleDecorated $ hang (text "Multiple default declarations") @@ -1094,6 +1097,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnBangOnUnliftedType{} -> WarningWithFlag Opt_WarnRedundantStrictnessFlags + TcRnLazyBangOnUnliftedType{} + -> WarningWithFlag Opt_WarnRedundantStrictnessFlags TcRnMultipleDefaultDeclarations{} -> ErrorWithoutFlag TcRnBadDefaultType{} @@ -1424,6 +1429,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnBangOnUnliftedType{} -> noHints + TcRnLazyBangOnUnliftedType{} + -> noHints TcRnMultipleDefaultDeclarations{} -> noHints TcRnBadDefaultType{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1133,6 +1133,17 @@ data TcRnMessage where -} TcRnBangOnUnliftedType :: !Type -> TcRnMessage + {-| TcRnLazyBangOnUnliftedType is a warning (controlled by -Wredundant-strictness-flags) that + occurs when a lazy annotation is applied to an unlifted type. + + Example(s): + data T = MkT ~Int# -- Lazy flag has no effect on unlifted types + + Test cases: typecheck/should_compile/T21951a + typecheck/should_compile/T21951b + -} + TcRnLazyBangOnUnliftedType :: !Type -> TcRnMessage + {-| TcRnMultipleDefaultDeclarations is an error that occurs when a module has more than one default declaration. ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -4441,6 +4441,12 @@ checkValidDataCon dflags existential_ok tc con , isUnliftedType orig_arg_ty = addDiagnosticTc $ TcRnBangOnUnliftedType orig_arg_ty + -- Warn about a ~ on an unlifted type (#21951) + -- e.g. data T = MkT ~Int# + | HsSrcBang _ _ SrcLazy <- bang + , isUnliftedType orig_arg_ty + = addDiagnosticTc $ TcRnLazyBangOnUnliftedType orig_arg_ty + | HsSrcBang _ want_unpack _ <- bang , isSrcUnpacked want_unpack , case rep_bang of { HsUnpack {} -> False; _ -> True } ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -249,7 +249,7 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ haddocks + need $ srcs ++ (map snd haddocks) -- Build Haddock documentation -- TODO: Pass the correct way from Rules via Context. @@ -364,8 +364,8 @@ buildManPage = do copyFileUntracked (dir -/- "ghc.1") file -- | Find the Haddock files for the dependencies of the current library. -haddockDependencies :: Context -> Action [FilePath] +haddockDependencies :: Context -> Action [(Package, FilePath)] haddockDependencies context = do depNames <- interpretInContext context (getContextData depNames) - sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg + sequence [ (,) <$> pure depPkg <*> (pkgHaddockFile $ vanillaContext Stage1 depPkg) | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -43,9 +43,8 @@ haddockBuilderArgs = mconcat context <- getContext version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg - trans_deps <- expr $ contextDependencies context - pkgs <- expr $ mapM (pkgIdentifier . C.package) $ trans_deps haddocks <- expr $ haddockDependencies context + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) @@ -69,7 +68,7 @@ haddockBuilderArgs = mconcat , map ("--hide=" ++) <$> getContextData otherModules , pure [ "--read-interface=../" ++ p ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME}," - ++ haddock | (p, haddock) <- zip pkgs haddocks ] + ++ haddock | (p, haddock) <- haddocks_with_versions ] , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] , getInputs , arg "+RTS" ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} ===================================== testsuite/tests/driver/all.T ===================================== @@ -312,3 +312,4 @@ test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) test('T22044', normal, makefile_test, []) +test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) ===================================== testsuite/tests/typecheck/should_compile/T21951a.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE UnliftedDatatypes #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE MagicHash #-} + +module Wibble where + +import Data.Kind +import GHC.Exts + +data UA = UA ~(Array# Int) ===================================== testsuite/tests/typecheck/should_compile/T21951a.stderr ===================================== @@ -0,0 +1,4 @@ +T21951a.hs:10:11: warning: [-Wredundant-strictness-flags] + Lazy flag has no effect on unlifted type ‘Array# Int’ + In the definition of data constructor ‘UA’ + In the data type declaration for ‘UA’ ===================================== testsuite/tests/typecheck/should_compile/T21951b.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE UnliftedDatatypes #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE MagicHash #-} + +module Wibble where + +import Data.Kind +import GHC.Exts + +type U :: UnliftedType +data U = MkU Int + +data T = T ~U ===================================== testsuite/tests/typecheck/should_compile/T21951b.stderr ===================================== @@ -0,0 +1,4 @@ +T21951b.hs:13:10: warning: [-Wredundant-strictness-flags] + Lazy flag has no effect on unlifted type ‘U’ + In the definition of data constructor ‘T’ + In the data type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -853,3 +853,5 @@ test('DeepSubsumption06', normal, compile, ['-XHaskell98']) test('DeepSubsumption07', normal, compile, ['-XHaskell2010']) test('DeepSubsumption08', normal, compile, ['']) test('DeepSubsumption09', normal, compile, ['']) +test('T21951a', normal, compile, ['-Wredundant-strictness-flags']) +test('T21951b', normal, compile, ['-Wredundant-strictness-flags']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/805462db2c104d3932190f7115e8ecfcacd8514b...6d53fa9e4b363d835550f2eab8a919f50bb9c0f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/805462db2c104d3932190f7115e8ecfcacd8514b...6d53fa9e4b363d835550f2eab8a919f50bb9c0f7 You're receiving 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 Aug 19 16:21:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 12:21:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.4 Message-ID: <62ffb882b3368_125b2b502bc27973c@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.4 You're receiving 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 Aug 19 18:14:05 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 Aug 2022 14:14:05 -0400 Subject: [Git][ghc/ghc][wip/T21694a] 18 commits: Implement Response File support for HPC Message-ID: <62ffd2edc70f1_125b2b488282890ed@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 69dc6973 by Simon Peyton Jones at 2022-08-19T19:13:21+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694 and #21755 * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * I realised that, now we have ae_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. And finally, it was the strange treatment of join-point Ids (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring * Rewrote Note [Combining case branches: optimistic one-shot-ness] Compile time improves slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- CoOpt_Read(normal) ghc/alloc 803,788,056 747,832,680 -7.1% GOOD T18223(normal) ghc/alloc 928,207,320 959,424,016 +3.1% BAD geo. mean -0.3% minimum -7.1% maximum +3.1% On Windows it's a bit better: geo mean is -0.6%, and three more benchmarks trip their compile-time bytes-allocated threshold (they were all close on the other build): T18698b(normal) ghc/alloc 235,619,776 233,219,008 -1.0% GOOD T6048(optasm) ghc/alloc 112,208,192 109,704,936 -2.2% GOOD T18140(normal) ghc/alloc 85,064,192 83,168,360 -2.2% GOOD I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3.4% increase in exchange for goodness elsewhere. Metric Decrease: CoOpt_Read T18140 T18698b T6048 Metric Increase: T18223 - - - - - 4dbcdf8d by Simon Peyton Jones at 2022-08-19T19:13:21+01:00 Try giving join points proper ArityInfo work in progress - - - - - 0d080b71 by Simon Peyton Jones at 2022-08-19T19:13:21+01:00 Further wibbles - - - - - 54cb64ca by Simon Peyton Jones at 2022-08-19T19:13:21+01:00 Wibble worker/wrapper for join points Need to add docs - - - - - 439dc397 by Simon Peyton Jones at 2022-08-19T19:13:21+01:00 Efficency improvements Don't call full arityType for non-rec join points (must document this). Refactoring - - - - - 50ca5069 by Simon Peyton Jones at 2022-08-19T19:13:21+01:00 Improve exprIsDeadEnd - - - - - b65e1d6c by Simon Peyton Jones at 2022-08-19T19:13:56+01:00 Remove unused import - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Types/Var.hs - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Haddock.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/hpc - − m4/fp_prog_ld_build_id.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d22bec7cdb9ff5ac9d9a496954a09f084aaa12a6...b65e1d6c237e4399b618c8087d7df043acd57826 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d22bec7cdb9ff5ac9d9a496954a09f084aaa12a6...b65e1d6c237e4399b618c8087d7df043acd57826 You're receiving 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 Aug 19 18:17:49 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 14:17:49 -0400 Subject: [Git][ghc/ghc][master] tc: warn about lazy annotations on unlifted arguments (fixes #21951) Message-ID: <62ffd3cda0b7e_125b2b487ec29485a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - 8 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - + testsuite/tests/typecheck/should_compile/T21951a.hs - + testsuite/tests/typecheck/should_compile/T21951a.stderr - + testsuite/tests/typecheck/should_compile/T21951b.hs - + testsuite/tests/typecheck/should_compile/T21951b.stderr - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -445,6 +445,9 @@ instance Diagnostic TcRnMessage where TcRnBangOnUnliftedType ty -> mkSimpleDecorated $ text "Strictness flag has no effect on unlifted type" <+> quotes (ppr ty) + TcRnLazyBangOnUnliftedType ty + -> mkSimpleDecorated $ + text "Lazy flag has no effect on unlifted type" <+> quotes (ppr ty) TcRnMultipleDefaultDeclarations dup_things -> mkSimpleDecorated $ hang (text "Multiple default declarations") @@ -1094,6 +1097,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnBangOnUnliftedType{} -> WarningWithFlag Opt_WarnRedundantStrictnessFlags + TcRnLazyBangOnUnliftedType{} + -> WarningWithFlag Opt_WarnRedundantStrictnessFlags TcRnMultipleDefaultDeclarations{} -> ErrorWithoutFlag TcRnBadDefaultType{} @@ -1424,6 +1429,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnBangOnUnliftedType{} -> noHints + TcRnLazyBangOnUnliftedType{} + -> noHints TcRnMultipleDefaultDeclarations{} -> noHints TcRnBadDefaultType{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1133,6 +1133,17 @@ data TcRnMessage where -} TcRnBangOnUnliftedType :: !Type -> TcRnMessage + {-| TcRnLazyBangOnUnliftedType is a warning (controlled by -Wredundant-strictness-flags) that + occurs when a lazy annotation is applied to an unlifted type. + + Example(s): + data T = MkT ~Int# -- Lazy flag has no effect on unlifted types + + Test cases: typecheck/should_compile/T21951a + typecheck/should_compile/T21951b + -} + TcRnLazyBangOnUnliftedType :: !Type -> TcRnMessage + {-| TcRnMultipleDefaultDeclarations is an error that occurs when a module has more than one default declaration. ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -4441,6 +4441,12 @@ checkValidDataCon dflags existential_ok tc con , isUnliftedType orig_arg_ty = addDiagnosticTc $ TcRnBangOnUnliftedType orig_arg_ty + -- Warn about a ~ on an unlifted type (#21951) + -- e.g. data T = MkT ~Int# + | HsSrcBang _ _ SrcLazy <- bang + , isUnliftedType orig_arg_ty + = addDiagnosticTc $ TcRnLazyBangOnUnliftedType orig_arg_ty + | HsSrcBang _ want_unpack _ <- bang , isSrcUnpacked want_unpack , case rep_bang of { HsUnpack {} -> False; _ -> True } ===================================== testsuite/tests/typecheck/should_compile/T21951a.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE UnliftedDatatypes #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE MagicHash #-} + +module Wibble where + +import Data.Kind +import GHC.Exts + +data UA = UA ~(Array# Int) ===================================== testsuite/tests/typecheck/should_compile/T21951a.stderr ===================================== @@ -0,0 +1,4 @@ +T21951a.hs:10:11: warning: [-Wredundant-strictness-flags] + Lazy flag has no effect on unlifted type ‘Array# Int’ + In the definition of data constructor ‘UA’ + In the data type declaration for ‘UA’ ===================================== testsuite/tests/typecheck/should_compile/T21951b.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE UnliftedDatatypes #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE MagicHash #-} + +module Wibble where + +import Data.Kind +import GHC.Exts + +type U :: UnliftedType +data U = MkU Int + +data T = T ~U ===================================== testsuite/tests/typecheck/should_compile/T21951b.stderr ===================================== @@ -0,0 +1,4 @@ +T21951b.hs:13:10: warning: [-Wredundant-strictness-flags] + Lazy flag has no effect on unlifted type ‘U’ + In the definition of data constructor ‘T’ + In the data type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -853,3 +853,5 @@ test('DeepSubsumption06', normal, compile, ['-XHaskell98']) test('DeepSubsumption07', normal, compile, ['-XHaskell2010']) test('DeepSubsumption08', normal, compile, ['']) test('DeepSubsumption09', normal, compile, ['']) +test('T21951a', normal, compile, ['-Wredundant-strictness-flags']) +test('T21951b', normal, compile, ['-Wredundant-strictness-flags']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9789e8454ad9f315169063b344a56c4216c12711 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9789e8454ad9f315169063b344a56c4216c12711 You're receiving 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 Aug 19 18:18:18 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 14:18:18 -0400 Subject: [Git][ghc/ghc][master] Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Message-ID: <62ffd3ea94145_125b2b5025830002e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 3 changed files: - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/driver/T22048.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1048,7 +1048,8 @@ findExternalRules opts binds imp_id_rules unfold_env -- In needed_fvs', we don't bother to delete binders from the fv set local_rules = [ rule - | id <- bndrs + | (opt_expose_rules opts) + , id <- bndrs , is_external_id id -- Only collect rules for external Ids , rule <- idCoreRules id , expose_rule rule ] -- and ones that can fire in a client ===================================== testsuite/tests/driver/T22048.hs ===================================== @@ -0,0 +1,11 @@ +module T22048 where + +{-# NOINLINE g #-} +g :: Bool -> Bool +g = not + +-- With -fomit-interface-pragmas these rules should not make it into interface files. +{-# RULES +"imported_rule" [~1] forall xs. map g xs = [] +"local_rule" [~1] forall . g True = False +#-} ===================================== testsuite/tests/driver/all.T ===================================== @@ -312,3 +312,4 @@ test('T21866', normal, multimod_compile, ['T21866','-no-link']) test('T21349', extra_files(['T21349']), makefile_test, []) test('T21869', [normal, when(unregisterised(), skip)], makefile_test, []) test('T22044', normal, makefile_test, []) +test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5567289c576a76f62bd78bd823a824c7ca83de6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5567289c576a76f62bd78bd823a824c7ca83de6 You're receiving 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 Aug 19 19:01:45 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 15:01:45 -0400 Subject: [Git][ghc/ghc][wip/T22077] Separate IPE source file from span Message-ID: <62ffde19d33a8_125b2b4e4a831293f@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 8f4087e3 by Ben Gamari at 2022-08-19T15:01:36-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 9 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/Stack/CloneStack.hs - rts/IPE.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/include/rts/IPE.h Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -4,6 +4,8 @@ import GHC.Prelude import GHC.Platform import GHC.Unit.Module import GHC.Utils.Outputable +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) +import GHC.Data.FastString (unpackFS) import GHC.Cmm.CLabel import GHC.Cmm.Expr @@ -16,7 +18,6 @@ import GHC.StgToCmm.Utils import GHC.Data.ShortText (ShortText) import qualified GHC.Data.ShortText as ST -import Data.Bifunctor (first) import qualified Data.Map.Strict as M import Control.Monad.Trans.State.Strict import qualified Data.ByteString as BS @@ -44,7 +45,8 @@ emitIpeBufferListNode this_mod ents = do , strtab_offset (ipeTypeDesc cg_ipe) , strtab_offset (ipeLabel cg_ipe) , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcLoc cg_ipe) + , strtab_offset (ipeSrcFile cg_ipe) + , strtab_offset (ipeSrcSpan cg_ipe) ] int n = mkIntCLit platform n @@ -63,16 +65,25 @@ toCgIPE platform ctx module_name ipe = do table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (infoTablePtr ipe)) closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe) type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe - let (src_loc_str, label_str) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ipe) + let label_str = maybe "" snd (infoTableProv ipe) + let (src_loc_file, src_loc_span) = + case infoTableProv ipe of + Nothing -> ("", "") + Just (span, _) -> + let file = unpackFS $ srcSpanFile span + coords = renderWithContext ctx (pprUserRealSpan False span) + in (file, coords) label <- lookupStringTable $ ST.pack label_str - src_loc <- lookupStringTable $ ST.pack src_loc_str + src_file <- lookupStringTable $ ST.pack src_loc_file + src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name , ipeClosureDesc = closure_desc , ipeTypeDesc = type_desc , ipeLabel = label , ipeModuleName = module_name - , ipeSrcLoc = src_loc + , ipeSrcFile = src_file + , ipeSrcSpan = src_span } data CgInfoProvEnt = CgInfoProvEnt @@ -82,7 +93,8 @@ data CgInfoProvEnt = CgInfoProvEnt , ipeTypeDesc :: !StrTabOffset , ipeLabel :: !StrTabOffset , ipeModuleName :: !StrTabOffset - , ipeSrcLoc :: !StrTabOffset + , ipeSrcFile :: !StrTabOffset + , ipeSrcSpan :: !StrTabOffset } data StringTable = StringTable { stStrings :: DList ShortText ===================================== libraries/base/GHC/InfoProv.hsc ===================================== @@ -20,6 +20,7 @@ module GHC.InfoProv ( InfoProv(..) + , ipLoc , ipeProv , whereFrom -- * Internals @@ -42,10 +43,15 @@ data InfoProv = InfoProv { ipTyDesc :: String, ipLabel :: String, ipMod :: String, - ipLoc :: String + ipSrcFile :: String, + ipSrcSpan :: String } deriving (Eq, Show) + data InfoProvEnt +ipLoc :: InfoProv -> String +ipLoc ipe = ipSrcFile ipe ++ ":" ++ ipSrcSpan ipe + getIPE :: a -> IO (Ptr InfoProvEnt) getIPE obj = IO $ \s -> case whereFrom## obj s of @@ -54,13 +60,14 @@ getIPE obj = IO $ \s -> ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv ipeProv p = (#ptr InfoProvEnt, prov) p -peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString -peekIpName p = (# peek InfoProv, table_name) p -peekIpDesc p = (# peek InfoProv, closure_desc) p -peekIpLabel p = (# peek InfoProv, label) p -peekIpModule p = (# peek InfoProv, module) p -peekIpSrcLoc p = (# peek InfoProv, srcloc) p -peekIpTyDesc p = (# peek InfoProv, ty_desc) p +peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString +peekIpName p = (# peek InfoProv, table_name) p +peekIpDesc p = (# peek InfoProv, closure_desc) p +peekIpLabel p = (# peek InfoProv, label) p +peekIpModule p = (# peek InfoProv, module) p +peekIpSrcFile p = (# peek InfoProv, src_file) p +peekIpSrcSpan p = (# peek InfoProv, src_span) p +peekIpTyDesc p = (# peek InfoProv, ty_desc) p peekInfoProv :: Ptr InfoProv -> IO InfoProv peekInfoProv infop = do @@ -69,14 +76,16 @@ peekInfoProv infop = do tyDesc <- peekCString utf8 =<< peekIpTyDesc infop label <- peekCString utf8 =<< peekIpLabel infop mod <- peekCString utf8 =<< peekIpModule infop - loc <- peekCString utf8 =<< peekIpSrcLoc infop + file <- peekCString utf8 =<< peekIpSrcFile infop + span <- peekCString utf8 =<< peekIpSrcSpan infop return InfoProv { ipName = name, ipDesc = desc, ipTyDesc = tyDesc, ipLabel = label, ipMod = mod, - ipLoc = loc + ipSrcFile = file, + ipSrcSpan = span } -- | Get information about where a value originated from. ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -28,7 +28,7 @@ import Foreign import GHC.Conc.Sync import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) import GHC.IO (IO (..)) -import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv) +import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable -- | A frozen snapshot of the state of an execution stack. ===================================== rts/IPE.c ===================================== @@ -85,7 +85,7 @@ void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module, - ipe->prov.srcloc); + ipe->prov.src_file, ipe->prov.src_span); } #endif @@ -144,7 +144,8 @@ void updateIpeMap() { ip_ents[i].prov.ty_desc = &strings[ent->ty_desc]; ip_ents[i].prov.label = &strings[ent->label]; ip_ents[i].prov.module = &strings[ent->module_name]; - ip_ents[i].prov.srcloc = &strings[ent->srcloc]; + ip_ents[i].prov.src_file = &strings[ent->src_file]; + ip_ents[i].prov.src_span = &strings[ent->src_span]; insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); } ===================================== rts/Trace.c ===================================== @@ -681,21 +681,22 @@ void traceIPE(const StgInfoTable * info, const char *ty_desc, const char *label, const char *module, - const char *srcloc ) + const char *src_file, + const char *src_span) { #if defined(DEBUG) if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { ACQUIRE_LOCK(&trace_utx); tracePreface(); - debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n", - table_name, closure_desc, ty_desc, label, module, srcloc); + debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n", + table_name, closure_desc, ty_desc, label, module, src_file, src_span); RELEASE_LOCK(&trace_utx); } else #endif if (eventlog_enabled) { - postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc); + postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, src_file, src_span); } } ===================================== rts/Trace.h ===================================== @@ -331,12 +331,13 @@ void traceNonmovingHeapCensus(uint32_t log_blk_size, const struct NonmovingAllocCensus *census); void traceIPE(const StgInfoTable *info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc ); + const char *table_name, + const char *closure_desc, + const char *ty_desc, + const char *label, + const char *module, + const char *src_file, + const char *src_span); void flushTrace(void); #else /* !TRACING */ @@ -373,7 +374,7 @@ void flushTrace(void); #define traceTaskDelete_(taskID) /* nothing */ #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ -#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, srcloc) /* nothing */ +#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, src_file, src_span) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ #define traceHeapBioProfSampleBegin(era, time) /* nothing */ #define traceHeapProfSampleEnd(era) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i) postWord32(eb, (StgWord32)i); } -static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size) +static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) { memcpy(eb->pos, buf, size); eb->pos += size; @@ -1417,7 +1417,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc) + const char *src_file, + const char *src_span) { ACQUIRE_LOCK(&eventBufMutex); StgWord table_name_len = strlen(table_name); @@ -1425,10 +1426,11 @@ void postIPE(StgWord64 info, StgWord ty_desc_len = strlen(ty_desc); StgWord label_len = strlen(label); StgWord module_len = strlen(module); - StgWord srcloc_len = strlen(srcloc); + StgWord src_file_len = strlen(src_file); + StgWord src_span_len = strlen(src_span); // 8 for the info word // 6 for the number of strings in the payload as postString adds 1 to the length - StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6; + StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+src_file_len+1+src_span_len+6; ensureRoomForVariableEvent(&eventBuf, len); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); @@ -1438,7 +1440,13 @@ void postIPE(StgWord64 info, postString(&eventBuf, ty_desc); postString(&eventBuf, label); postString(&eventBuf, module); - postString(&eventBuf, srcloc); + + // Manually construct the location field: ":\0" + postBuf(&eventBuf, (const StgWord8*) src_file, src_file_len); + StgWord8 colon = ':'; + postBuf(&eventBuf, &colon, 1); + postString(&eventBuf, src_span); + RELEASE_LOCK(&eventBufMutex); } ===================================== rts/eventlog/EventLog.h ===================================== @@ -196,7 +196,8 @@ void postIPE(StgWord64 info, const char *ty_desc, const char *label, const char *module, - const char *srcloc); + const char *src_file, + const char *src_span); void postConcUpdRemSetFlush(Capability *cap); void postConcMarkEnd(StgWord32 marked_obj_count); ===================================== rts/include/rts/IPE.h ===================================== @@ -19,7 +19,8 @@ typedef struct InfoProv_ { const char *ty_desc; const char *label; const char *module; - const char *srcloc; + const char *src_file; + const char *src_span; } InfoProv; typedef struct InfoProvEnt_ { @@ -51,7 +52,8 @@ typedef struct { StringIdx ty_desc; StringIdx label; StringIdx module_name; - StringIdx srcloc; + StringIdx src_file; + StringIdx src_span; } IpeBufferEntry; typedef struct IpeBufferListNode_ { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f4087e3cfe515b0222269e01e3cd74162970327 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f4087e3cfe515b0222269e01e3cd74162970327 You're receiving 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 Aug 19 19:19:26 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 15:19:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: tc: warn about lazy annotations on unlifted arguments (fixes #21951) Message-ID: <62ffe23e345b4_125b2b502bc326952@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 58ff4f34 by Swann Moreau at 2022-08-19T15:19:09-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - fdbeded4 by Sasha Bogicevic at 2022-08-19T15:19:10-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 30 changed files: - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - docs/users_guide/ghci.rst - libraries/base/tests/T9681.stderr - testsuite/tests/ado/T16628.stderr - testsuite/tests/ado/ado005.stderr - testsuite/tests/annotations/should_fail/annfail05.stderr - testsuite/tests/annotations/should_fail/annfail08.stderr - testsuite/tests/arrows/should_fail/T20768_arrow_fail.stderr - testsuite/tests/backpack/cabal/bkpcabal05/bkpcabal05.stderr - testsuite/tests/backpack/should_fail/bkpfail11.stderr - testsuite/tests/backpack/should_fail/bkpfail24.stderr - testsuite/tests/backpack/should_fail/bkpfail43.stderr - testsuite/tests/backpack/should_fail/bkpfail44.stderr - testsuite/tests/dependent/should_fail/T13135.stderr - testsuite/tests/dependent/should_fail/T15308.stderr - testsuite/tests/deriving/should_fail/T21302.stderr - testsuite/tests/deriving/should_fail/T2851.stderr - testsuite/tests/deriving/should_fail/T5287.stderr - testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr - testsuite/tests/deriving/should_fail/drvfail-functor2.stderr - testsuite/tests/deriving/should_fail/drvfail001.stderr - testsuite/tests/deriving/should_fail/drvfail002.stderr - testsuite/tests/deriving/should_fail/drvfail003.stderr - testsuite/tests/deriving/should_fail/drvfail004.stderr - testsuite/tests/deriving/should_fail/drvfail007.stderr - testsuite/tests/deriving/should_fail/drvfail011.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d53fa9e4b363d835550f2eab8a919f50bb9c0f7...fdbeded4c87de29f5dbbc1107e0c29d8b47d172e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d53fa9e4b363d835550f2eab8a919f50bb9c0f7...fdbeded4c87de29f5dbbc1107e0c29d8b47d172e You're receiving 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 Aug 19 20:31:39 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 16:31:39 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] Update haddock submodule to revert quickjump breakage Message-ID: <62fff32baf3b4_125b2b502bc351135@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: b9ed1a48 by Matthew Pickering at 2022-08-19T16:31:33-04:00 Update haddock submodule to revert quickjump breakage Fixes #21984 - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit f07a4059efcde05fd26b33a8c902930d3ad90379 +Subproject commit 421e4c36e58cae686d55a99946d5fa54abaa6000 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9ed1a481f6163f46e902c71e58f2e3143bf8914 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9ed1a481f6163f46e902c71e58f2e3143bf8914 You're receiving 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 Aug 19 21:08:02 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 17:08:02 -0400 Subject: [Git][ghc/ghc][wip/T22077] 5 commits: base: Move CString, CStringLen to GHC.Foreign Message-ID: <62fffbb2c03b8_125b2b150df6f0356328@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: c3697c5b by Ben Gamari at 2022-08-19T15:52:58-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - 25a231bf by Ben Gamari at 2022-08-19T15:52:58-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - eb7b8dab by Ben Gamari at 2022-08-19T15:52:58-04:00 rts: Refactor IPE tracing support - - - - - 111b8492 by Ben Gamari at 2022-08-19T15:52:58-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - dafb357b by Ben Gamari at 2022-08-19T17:03:24-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 24 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/ghc.cabal.in - libraries/base/Foreign/C/String.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/base.cabal - rts/IPE.c - rts/IPE.h - rts/RtsStartup.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/include/rts/IPE.h - rts/include/stg/SMP.h - testsuite/tests/profiling/should_run/staticcallstack001.hs - testsuite/tests/profiling/should_run/staticcallstack002.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -299,6 +299,7 @@ data ModuleLabelKind | MLK_InitializerArray | MLK_Finalizer String | MLK_FinalizerArray + | MLK_IPEBuffer deriving (Eq, Ord) instance Outputable ModuleLabelKind where @@ -306,6 +307,7 @@ instance Outputable ModuleLabelKind where ppr (MLK_Initializer s) = text ("init__" ++ s) ppr MLK_FinalizerArray = text "fini_arr" ppr (MLK_Finalizer s) = text ("fini__" ++ s) + ppr MLK_IPEBuffer = text "ipe_buf" isIdLabel :: CLabel -> Bool isIdLabel IdLabel{} = True @@ -830,10 +832,10 @@ instance OutputableP Platform InfoProvEnt where -- Constructing Cost Center Labels mkCCLabel :: CostCentre -> CLabel mkCCSLabel :: CostCentreStack -> CLabel -mkIPELabel :: InfoProvEnt -> CLabel +mkIPELabel :: Module -> CLabel mkCCLabel cc = CC_Label cc mkCCSLabel ccs = CCS_Label ccs -mkIPELabel ipe = IPE_Label ipe +mkIPELabel mod = ModuleLabel mod MLK_IPEBuffer mkRtsApFastLabel :: FastString -> CLabel mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str)) @@ -1011,6 +1013,7 @@ modLabelNeedsCDecl :: ModuleLabelKind -> Bool -- Code for finalizers and initializers are emitted in stub objects modLabelNeedsCDecl (MLK_Initializer _) = True modLabelNeedsCDecl (MLK_Finalizer _) = True +modLabelNeedsCDecl MLK_IPEBuffer = True -- The finalizer and initializer arrays are emitted in the code of the module modLabelNeedsCDecl MLK_InitializerArray = False modLabelNeedsCDecl MLK_FinalizerArray = False @@ -1208,6 +1211,7 @@ moduleLabelKindType kind = MLK_InitializerArray -> DataLabel MLK_Finalizer _ -> CodeLabel MLK_FinalizerArray -> DataLabel + MLK_IPEBuffer -> DataLabel idInfoLabelType :: IdLabelInfo -> CLabelType idInfoLabelType info = ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -224,6 +224,7 @@ import GHC.StgToCmm.Layout hiding (ArgRep(..)) import GHC.StgToCmm.Ticky import GHC.StgToCmm.Prof import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame ) +import GHC.StgToCmm.InfoTableProv import GHC.Cmm.Opt import GHC.Cmm.Graph @@ -1518,9 +1519,8 @@ parseCmmFile cmmpConfig this_mod home_unit filename = do let fcode = do ((), cmm) <- getCmm $ unEC code "global" (initEnv (pdProfile pdConfig)) [] >> return () -- See Note [Mapping Info Tables to Source Positions] (IPE Maps) - let used_info = map (cmmInfoTableToInfoProvEnt this_mod) - (mapMaybe topInfoTable cmm) - ((), cmm2) <- getCmm $ mapM_ emitInfoTableProv used_info + let used_info = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTable cmm) + ((), cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info return (cmm ++ cmm2, used_info) (cmm, _) = runC (cmmpStgToCmmConfig cmmpConfig) fstate st fcode (warnings,errors) = getPsMessages pst ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -368,24 +368,17 @@ ipInitCode :: Bool -- is Opt_InfoTableMap enabled or not -> Platform -> Module - -> [InfoProvEnt] -> CStub -ipInitCode do_info_table platform this_mod ents +ipInitCode do_info_table platform this_mod | not do_info_table = mempty - | otherwise = initializerCStub platform fn_nm decls body + | otherwise = initializerCStub platform fn_nm ipe_buffer_decl body where fn_nm = mkInitializerStubLabel this_mod "ip_init" - decls = vcat - $ map emit_ipe_decl ents - ++ [emit_ipe_list ents] - body = text "registerInfoProvList" <> parens local_ipe_list_label <> semi - emit_ipe_decl ipe = - text "extern InfoProvEnt" <+> ipe_lbl <> text "[];" - where ipe_lbl = pprCLabel platform CStyle (mkIPELabel ipe) - local_ipe_list_label = text "local_ipe_" <> ppr this_mod - emit_ipe_list ipes = - text "static InfoProvEnt *" <> local_ipe_list_label <> text "[] =" - <+> braces (vcat $ [ pprCLabel platform CStyle (mkIPELabel ipe) <> comma - | ipe <- ipes - ] ++ [text "NULL"]) - <> semi + + body = text "registerInfoProvList" <> parens (text "&" <> ipe_buffer_label) <> semi + + ipe_buffer_label = pprCLabel platform CStyle (mkIPELabel this_mod) + + ipe_buffer_decl = + text "extern IpeBufferListNode" <+> ipe_buffer_label <> text ";" + ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1830,7 +1830,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs mod_name = mkModuleName $ "Cmm$" ++ original_filename cmm_mod = mkHomeModule home_unit mod_name cmmpConfig = initCmmParserConfig dflags - (cmm, ents) <- ioMsgMaybe + (cmm, _ents) <- ioMsgMaybe $ do (warns,errs,cmm) <- withTiming logger (text "ParseCmm"<+>brackets (text filename)) (\_ -> ()) $ parseCmmFile cmmpConfig cmm_mod home_unit filename @@ -1857,7 +1857,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs Just h -> h dflags Nothing (Stream.yield cmmgroup) let foreign_stubs _ = - let ip_init = ipInitCode do_info_table platform cmm_mod ents + let ip_init = ipInitCode do_info_table platform cmm_mod in NoStubs `appendStubC` ip_init (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -0,0 +1,143 @@ +module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where + +import GHC.Prelude +import GHC.Platform +import GHC.Unit.Module +import GHC.Utils.Outputable +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) +import GHC.Data.FastString (unpackFS) + +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 + +emitIpeBufferListNode :: Module + -> [InfoProvEnt] + -> FCode () +emitIpeBufferListNode this_mod ents = do + cfg <- getStgToCmmConfig + let ctx = stgToCmmContext cfg + platform = stgToCmmPlatform cfg + + 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 + +toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt +toCgIPE platform ctx module_name ipe = do + table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (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 (src_loc_file, src_loc_span) = + case infoTableProv ipe of + Nothing -> ("", "") + Just (span, _) -> + let file = unpackFS $ srcSpanFile span + coords = renderWithContext ctx (pprUserRealSpan False span) + in (file, coords) + label <- lookupStringTable $ ST.pack label_str + src_file <- lookupStringTable $ ST.pack src_loc_file + src_span <- lookupStringTable $ ST.pack src_loc_span + return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe + , ipeTableName = table_name + , ipeClosureDesc = closure_desc + , ipeTypeDesc = type_desc + , ipeLabel = label + , ipeModuleName = module_name + , ipeSrcFile = src_file + , ipeSrcSpan = src_span + } + +data CgInfoProvEnt = CgInfoProvEnt + { ipeInfoTablePtr :: !CLabel + , ipeTableName :: !StrTabOffset + , ipeClosureDesc :: !StrTabOffset + , ipeTypeDesc :: !StrTabOffset + , ipeLabel :: !StrTabOffset + , ipeModuleName :: !StrTabOffset + , ipeSrcFile :: !StrTabOffset + , ipeSrcSpan :: !StrTabOffset + } + +data StringTable = StringTable { stStrings :: DList ShortText + , stLength :: !Int + , stLookup :: !(M.Map ShortText StrTabOffset) + } + +newtype StrTabOffset = StrTabOffset Int + +emptyStringTable :: StringTable +emptyStringTable = + StringTable { stStrings = emptyDList + , stLength = 0 + , stLookup = M.empty + } + +getStringTableStrings :: StringTable -> BS.ByteString +getStringTableStrings st = + BSL.toStrict $ BSB.toLazyByteString + $ foldMap f $ dlistToList (stStrings st) + where + f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0 + +lookupStringTable :: ShortText -> State StringTable StrTabOffset +lookupStringTable str = state $ \st -> + case M.lookup str (stLookup st) of + Just off -> (off, st) + Nothing -> + let !st' = st { stStrings = stStrings st `snoc` str + , stLength = stLength st + ST.byteLength str + 1 + , stLookup = M.insert str res (stLookup st) + } + res = StrTabOffset (stLength st) + in (res, st') + +newtype DList a = DList ([a] -> [a]) + +emptyDList :: DList a +emptyDList = DList id + +snoc :: DList a -> a -> DList a +snoc (DList f) x = DList (f . (x:)) + +dlistToList :: DList a -> [a] +dlistToList (DList f) = f [] ===================================== compiler/GHC/StgToCmm/Prof.hs ===================================== @@ -11,7 +11,7 @@ module GHC.StgToCmm.Prof ( mkCCostCentre, mkCCostCentreStack, -- infoTablePRov - initInfoTableProv, emitInfoTableProv, + initInfoTableProv, -- Cost-centre Profiling dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf, @@ -32,6 +32,7 @@ import GHC.Platform import GHC.Platform.Profile import GHC.StgToCmm.Closure import GHC.StgToCmm.Config +import GHC.StgToCmm.InfoTableProv import GHC.StgToCmm.Utils import GHC.StgToCmm.Monad import GHC.StgToCmm.Lit @@ -55,7 +56,6 @@ import GHC.Utils.Encoding import Control.Monad import Data.Char (ord) -import Data.Bifunctor (first) import GHC.Utils.Monad (whenM) ----------------------------------------------------------------------------- @@ -274,9 +274,8 @@ sizeof_ccs_words platform where (ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform - +-- | Emit info-table provenance declarations initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode CStub --- Emit the declarations initInfoTableProv infos itmap = do cfg <- getStgToCmmConfig @@ -284,42 +283,16 @@ initInfoTableProv infos itmap info_table = stgToCmmInfoTableMap cfg platform = stgToCmmPlatform cfg this_mod = stgToCmmThisModule cfg - -- Output the actual IPE data - mapM_ emitInfoTableProv ents - -- Create the C stub which initialises the IPE map - return (ipInitCode info_table platform this_mod ents) - ---- Info Table Prov stuff -emitInfoTableProv :: InfoProvEnt -> FCode () -emitInfoTableProv ip = do - { cfg <- getStgToCmmConfig - ; let mod = infoProvModule ip - ctx = stgToCmmContext cfg - platform = stgToCmmPlatform cfg - ; let (src, label) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ip) - mk_string = newByteStringCLit . utf8EncodeByteString - ; label <- mk_string label - ; modl <- newByteStringCLit (bytesFS $ moduleNameFS - $ moduleName mod) - - ; ty_string <- mk_string (infoTableType ip) - ; loc <- mk_string src - ; table_name <- mk_string (renderWithContext ctx - (pprCLabel platform CStyle (infoTablePtr ip))) - ; closure_type <- mk_string (renderWithContext ctx - (text $ show $ infoProvEntClosureType ip)) - ; let - lits = [ CmmLabel (infoTablePtr ip), -- Info table pointer - table_name, -- char *table_name - closure_type, -- char *closure_desc -- Filled in from the InfoTable - ty_string, -- char *ty_string - label, -- char *label, - modl, -- char *module, - loc, -- char *srcloc, - zero platform -- struct _InfoProvEnt *link - ] - ; emitDataLits (mkIPELabel ip) lits - } + + case ents of + [] -> return mempty + _ -> do + -- Emit IPE buffer + emitIpeBufferListNode this_mod ents + + -- Create the C stub which initialises the IPE map + return (ipInitCode info_table platform this_mod) + -- --------------------------------------------------------------------------- -- Set the current cost centre stack ===================================== compiler/ghc.cabal.in ===================================== @@ -615,6 +615,7 @@ Library GHC.StgToCmm.Foreign GHC.StgToCmm.Heap GHC.StgToCmm.Hpc + GHC.StgToCmm.InfoTableProv GHC.StgToCmm.Layout GHC.StgToCmm.Lit GHC.StgToCmm.Monad ===================================== libraries/base/Foreign/C/String.hs ===================================== @@ -110,20 +110,11 @@ import GHC.Base import {-# SOURCE #-} GHC.IO.Encoding import qualified GHC.Foreign as GHC +import GHC.Foreign (CString, CStringLen) ----------------------------------------------------------------------------- -- Strings --- representation of strings in C --- ------------------------------ - --- | 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 -- ------------------ -- ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Foreign ( -- * C strings with a configurable encoding + CString, CStringLen, -- conversion of C strings into Haskell strings -- @@ -74,8 +75,11 @@ putDebugMsg | c_DEBUG_DUMP = debugLn | otherwise = const (return ()) --- These definitions are identical to those in Foreign.C.String, but copied in here to avoid a cycle: +-- | 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 ===================================== libraries/base/GHC/InfoProv.hsc ===================================== @@ -0,0 +1,113 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.InfoProv +-- Copyright : (c) The University of Glasgow 2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- Access to GHC's info-table provenance metadata. +-- +-- @since 4.18.0.0 +----------------------------------------------------------------------------- + +module GHC.InfoProv + ( InfoProv(..) + , ipLoc + , ipeProv + , whereFrom + -- * Internals + , InfoProvEnt + , peekInfoProv + ) where + +#include "Rts.h" + +import GHC.Base +import GHC.Show +import GHC.Ptr (Ptr(..), plusPtr, nullPtr) +import GHC.Foreign (CString, peekCString) +import GHC.IO.Encoding (utf8) +import Foreign.Storable (peekByteOff) + +data InfoProv = InfoProv { + ipName :: String, + ipDesc :: String, + ipTyDesc :: String, + ipLabel :: String, + ipMod :: String, + ipSrcFile :: String, + ipSrcSpan :: String +} deriving (Eq, Show) + +data InfoProvEnt + +ipLoc :: InfoProv -> String +ipLoc ipe = ipSrcFile ipe ++ ":" ++ ipSrcSpan ipe + +getIPE :: a -> IO (Ptr InfoProvEnt) +getIPE obj = IO $ \s -> + case whereFrom## obj s of + (## s', addr ##) -> (## s', Ptr addr ##) + +ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv +ipeProv p = (#ptr InfoProvEnt, prov) p + +peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString +peekIpName p = (# peek InfoProv, table_name) p +peekIpDesc p = (# peek InfoProv, closure_desc) p +peekIpLabel p = (# peek InfoProv, label) p +peekIpModule p = (# peek InfoProv, module) p +peekIpSrcFile p = (# peek InfoProv, src_file) p +peekIpSrcSpan p = (# peek InfoProv, src_span) p +peekIpTyDesc p = (# peek InfoProv, ty_desc) p + +peekInfoProv :: Ptr InfoProv -> IO InfoProv +peekInfoProv infop = do + name <- peekCString utf8 =<< peekIpName infop + desc <- peekCString utf8 =<< peekIpDesc infop + tyDesc <- peekCString utf8 =<< peekIpTyDesc infop + label <- peekCString utf8 =<< peekIpLabel infop + mod <- peekCString utf8 =<< peekIpModule infop + file <- peekCString utf8 =<< peekIpSrcFile infop + span <- peekCString utf8 =<< peekIpSrcSpan infop + return InfoProv { + ipName = name, + ipDesc = desc, + ipTyDesc = tyDesc, + ipLabel = label, + ipMod = mod, + ipSrcFile = file, + ipSrcSpan = span + } + +-- | Get information about where a value originated from. +-- This information is stored statically in a binary when `-finfo-table-map` is +-- enabled. The source positions will be greatly improved by also enabled debug +-- information with `-g3`. Finally you can enable `-fdistinct-constructor-tables` to +-- get more precise information about data constructor allocations. +-- +-- The information is collect by looking at the info table address of a specific closure and +-- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think +-- the best source position to describe that info table arose from. +-- +-- @since 4.16.0.0 +whereFrom :: a -> IO (Maybe InfoProv) +whereFrom obj = do + ipe <- getIPE obj + -- The primop returns the null pointer in two situations at the moment + -- 1. The lookup fails for whatever reason + -- 2. -finfo-table-map is not enabled. + -- It would be good to distinguish between these two cases somehow. + if ipe == nullPtr + then return Nothing + else do + infoProv <- peekInfoProv (ipeProv ipe) + return $ Just infoProv ===================================== libraries/base/GHC/Stack/CCS.hsc ===================================== @@ -20,7 +20,6 @@ module GHC.Stack.CCS ( -- * Call stacks currentCallStack, whoCreated, - whereFrom, -- * Internals CostCentreStack, @@ -35,10 +34,6 @@ module GHC.Stack.CCS ( ccSrcSpan, ccsToStrings, renderStack, - ipeProv, - peekInfoProv, - InfoProv(..), - InfoProvEnt, ) where import Foreign @@ -49,7 +44,6 @@ import GHC.Ptr import GHC.Foreign as GHC import GHC.IO.Encoding import GHC.List ( concatMap, reverse ) -import GHC.Show (Show) #define PROFILING #include "Rts.h" @@ -142,71 +136,3 @@ renderStack :: [String] -> String renderStack strs = "CallStack (from -prof):" ++ concatMap ("\n "++) (reverse strs) --- Static Closure Information - -data InfoProv = InfoProv { - ipName :: String, - ipDesc :: String, - ipTyDesc :: String, - ipLabel :: String, - ipMod :: String, - ipLoc :: String -} deriving (Eq, Show) -data InfoProvEnt - -getIPE :: a -> IO (Ptr InfoProvEnt) -getIPE obj = IO $ \s -> - case whereFrom## obj s of - (## s', addr ##) -> (## s', Ptr addr ##) - -ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv -ipeProv p = (#ptr InfoProvEnt, prov) p - -peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString -peekIpName p = (# peek InfoProv, table_name) p -peekIpDesc p = (# peek InfoProv, closure_desc) p -peekIpLabel p = (# peek InfoProv, label) p -peekIpModule p = (# peek InfoProv, module) p -peekIpSrcLoc p = (# peek InfoProv, srcloc) p -peekIpTyDesc p = (# peek InfoProv, ty_desc) p - -peekInfoProv :: Ptr InfoProv -> IO InfoProv -peekInfoProv infop = do - name <- GHC.peekCString utf8 =<< peekIpName infop - desc <- GHC.peekCString utf8 =<< peekIpDesc infop - tyDesc <- GHC.peekCString utf8 =<< peekIpTyDesc infop - label <- GHC.peekCString utf8 =<< peekIpLabel infop - mod <- GHC.peekCString utf8 =<< peekIpModule infop - loc <- GHC.peekCString utf8 =<< peekIpSrcLoc infop - return InfoProv { - ipName = name, - ipDesc = desc, - ipTyDesc = tyDesc, - ipLabel = label, - ipMod = mod, - ipLoc = loc - } - --- | Get information about where a value originated from. --- This information is stored statically in a binary when `-finfo-table-map` is --- enabled. The source positions will be greatly improved by also enabled debug --- information with `-g3`. Finally you can enable `-fdistinct-constructor-tables` to --- get more precise information about data constructor allocations. --- --- The information is collect by looking at the info table address of a specific closure and --- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think --- the best source position to describe that info table arose from. --- --- @since 4.16.0.0 -whereFrom :: a -> IO (Maybe InfoProv) -whereFrom obj = do - ipe <- getIPE obj - -- The primop returns the null pointer in two situations at the moment - -- 1. The lookup fails for whatever reason - -- 2. -finfo-table-map is not enabled. - -- It would be good to distinguish between these two cases somehow. - if ipe == nullPtr - then return Nothing - else do - infoProv <- peekInfoProv (ipeProv ipe) - return $ Just infoProv ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -28,7 +28,7 @@ import Foreign import GHC.Conc.Sync import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) import GHC.IO (IO (..)) -import GHC.Stack.CCS (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv) +import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable -- | A frozen snapshot of the state of an execution stack. ===================================== libraries/base/base.cabal ===================================== @@ -222,6 +222,7 @@ Library GHC.GHCi GHC.GHCi.Helpers GHC.Generics + GHC.InfoProv GHC.IO GHC.IO.Buffer GHC.IO.BufferedIO ===================================== rts/IPE.c ===================================== @@ -34,17 +34,22 @@ Unfortunately, inserting into the hash map is relatively expensive. To keep startup times low, there's a temporary data structure that is optimized for collecting IPE lists on registration. -It's a singly linked list of IPE list buffers. Each buffer contains space for -126 IPE lists. This number is a bit arbitrary, but leaves a few bytes so that -the whole structure might fit into 1024 bytes. - -On registering a new IPE list, there are three cases: - -- It's the first entry at all: Allocate a new IpeBufferListNode and make it the - buffer's first entry. -- The current IpeBufferListNode has space in it's buffer: Add it to the buffer. -- The current IpeBufferListNode's buffer is full: Allocate a new one and link it -to the previous one, making this one the new current. +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. + +For reasons of space efficiency, IPE entries are represented slightly +differently in the object file than the InfoProvEnt which we ultimately expose +to the user. Specifically, the IPEs in IpeBufferListNode are represented by +IpeBufferEntrys, along with a corresponding string table. The string fields +of InfoProvEnt are represented in IpeBufferEntry as 32-bit offsets into the +string table. This allows us to halve the size of the buffer entries on +64-bit machines while significantly reducing the number of needed +relocations, reducing linking cost. Moreover, the code generator takes care +to deduplicate strings when generating the string table. When we inserting a +set of IpeBufferEntrys into the IPE hash-map we convert them to InfoProvEnts, +which contain proper string pointers. Building the hash map is done lazily, i.e. on first lookup or traversal. For this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. @@ -52,54 +57,63 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. After the content of a IpeBufferListNode has been inserted, it's freed. */ +static Mutex ipeMapLock; static HashTable *ipeMap = NULL; +// Accessed atomically static IpeBufferListNode *ipeBufferList = NULL; -static Mutex ipeMapLock; - -void initIpeMapLock(void) { initMutex(&ipeMapLock); } - -void closeIpeMapLock(void) { closeMutex(&ipeMapLock); } +void initIpe(void) { initMutex(&ipeMapLock); } + +void exitIpe(void) { closeMutex(&ipeMapLock); } + +static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) +{ + const char *strings = node->string_table; + return (InfoProvEnt) { + .info = ent->info, + .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] + } + }; +} -void dumpIPEToEventLog(void) { #if defined(TRACING) - ACQUIRE_LOCK(&ipeMapLock); +static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, + const void *value) { + InfoProvEnt *ipe = (InfoProvEnt *)value; + traceIPE(ipe); +} - IpeBufferListNode *cursor = ipeBufferList; +void dumpIPEToEventLog(void) { + // Dump pending entries + IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList); while (cursor != NULL) { - for (int i = 0; i < cursor->count; i++) { - for (InfoProvEnt **ipeList = cursor->buffer[i]; *ipeList != NULL; - ipeList++) { - InfoProvEnt *ipe = *ipeList; - - traceIPE(ipe->info, ipe->prov.table_name, - ipe->prov.closure_desc, ipe->prov.ty_desc, - ipe->prov.label, ipe->prov.module, ipe->prov.srcloc); - } + for (uint32_t i = 0; i < cursor->count; i++) { + const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); + traceIPE(&ent); } - cursor = cursor->next; } + // Dump entries already in hashmap + ACQUIRE_LOCK(&ipeMapLock); if (ipeMap != NULL) { mapHashTable(ipeMap, NULL, &traceIPEFromHashTable); } - RELEASE_LOCK(&ipeMapLock); -#endif - return; } -#if defined(TRACING) -void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, - const void *value) { - InfoProvEnt *ipe = (InfoProvEnt *)value; +#else + +void dumpIPEToEventLog(void) { } - traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc, - ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module, - ipe->prov.srcloc); -} #endif /* Registering IPEs @@ -109,50 +123,20 @@ Note [The Info Table Provenance Entry (IPE) Map]. Statically initialized IPE lists are registered at startup by a C constructor function generated by the compiler (CodeOutput.hs) in a *.c file for each -module. +module. Since this is called in a static initializer we cannot rely on +ipeMapLock; we instead use atomic CAS operations to add to the list. A performance test for IPE registration and lookup can be found here: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806 */ -void registerInfoProvList(InfoProvEnt **ent_list) { - // The list must be dereferenceable. - ASSERT(ent_list[0] == NULL || ent_list[0] != NULL); - - // Ignore empty lists - if (ent_list[0] == NULL) { - return; - } - - ACQUIRE_LOCK(&ipeMapLock); - - if (ipeBufferList == NULL) { - ASSERT(ipeBufferList == NULL); - - ipeBufferList = stgMallocBytes(sizeof(IpeBufferListNode), - "registerInfoProvList-firstNode"); - ipeBufferList->buffer[0] = ent_list; - ipeBufferList->count = 1; - ipeBufferList->next = NULL; - } else { - if (ipeBufferList->count < IPE_LIST_NODE_BUFFER_SIZE) { - ipeBufferList->buffer[ipeBufferList->count] = ent_list; - ipeBufferList->count = ipeBufferList->count + 1; - - ASSERT(ipeBufferList->next == NULL || - ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); - } else { - IpeBufferListNode *newNode = stgMallocBytes( - sizeof(IpeBufferListNode), "registerInfoProvList-nextNode"); - newNode->buffer[0] = ent_list; - newNode->count = 1; - newNode->next = ipeBufferList; - ipeBufferList = newNode; - - ASSERT(ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); +void registerInfoProvList(IpeBufferListNode *node) { + while (true) { + IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList); + node->next = old; + if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) { + return; } } - - RELEASE_LOCK(&ipeMapLock); } InfoProvEnt *lookupIPE(const StgInfoTable *info) { @@ -163,7 +147,8 @@ InfoProvEnt *lookupIPE(const StgInfoTable *info) { void updateIpeMap() { // Check if there's any work at all. If not so, we can circumvent locking, // which decreases performance. - if (ipeMap != NULL && ipeBufferList == NULL) { + IpeBufferListNode *pending = xchg_ptr((void **) &ipeBufferList, NULL); + if (ipeMap != NULL && pending == NULL) { return; } @@ -173,23 +158,16 @@ void updateIpeMap() { ipeMap = allocHashTable(); } - while (ipeBufferList != NULL) { - ASSERT(ipeBufferList->next == NULL || - ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); - ASSERT(ipeBufferList->count > 0 && - ipeBufferList->count <= IPE_LIST_NODE_BUFFER_SIZE); - - IpeBufferListNode *currentNode = ipeBufferList; - - for (int i = 0; i < currentNode->count; i++) { - for (InfoProvEnt **ipeList = currentNode->buffer[i]; - *ipeList != NULL; ipeList++) { - insertHashTable(ipeMap, (StgWord)(*ipeList)->info, *ipeList); - } + 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]); } - ipeBufferList = currentNode->next; - stgFree(currentNode); + pending = currentNode->next; } RELEASE_LOCK(&ipeMapLock); ===================================== rts/IPE.h ===================================== @@ -13,22 +13,9 @@ #include "BeginPrivate.h" -#define IPE_LIST_NODE_BUFFER_SIZE 126 - -typedef struct IpeBufferListNode_ { - InfoProvEnt **buffer[IPE_LIST_NODE_BUFFER_SIZE]; - StgWord8 count; - struct IpeBufferListNode_ *next; -} IpeBufferListNode; - void dumpIPEToEventLog(void); void updateIpeMap(void); -void initIpeMapLock(void); -void closeIpeMapLock(void); - -#if defined(TRACING) -void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, - const void *value); -#endif +void initIpe(void); +void exitIpe(void); #include "EndPrivate.h" ===================================== rts/RtsStartup.c ===================================== @@ -386,7 +386,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) #if defined(PROFILING) initProfiling(); #endif - initIpeMapLock(); + initIpe(); traceInitEvent(dumpIPEToEventLog); initHeapProfiling(); @@ -611,7 +611,7 @@ hs_exit_(bool wait_foreign) // Free threading resources freeThreadingResources(); - closeIpeMapLock(); + exitIpe(); } // Flush stdout and stderr. We do this during shutdown so that it ===================================== rts/Trace.c ===================================== @@ -675,27 +675,22 @@ void traceHeapProfSampleString(StgWord8 profile_id, } } -void traceIPE(StgInfoTable * info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc ) +void traceIPE(const InfoProvEnt *ipe) { #if defined(DEBUG) if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) { ACQUIRE_LOCK(&trace_utx); tracePreface(); - debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n", - table_name, closure_desc, ty_desc, label, module, srcloc); + debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n", + ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc, + ipe->prov.label, ipe->prov.module, ipe->prov.src_file, ipe->prov.src_span); RELEASE_LOCK(&trace_utx); } else #endif if (eventlog_enabled) { - postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc); + postIPE(ipe); } } ===================================== rts/Trace.h ===================================== @@ -330,13 +330,7 @@ void traceConcUpdRemSetFlush(Capability *cap); void traceNonmovingHeapCensus(uint32_t log_blk_size, const struct NonmovingAllocCensus *census); -void traceIPE(StgInfoTable *info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc ); +void traceIPE(const InfoProvEnt *ipe); void flushTrace(void); #else /* !TRACING */ @@ -373,7 +367,7 @@ void flushTrace(void); #define traceTaskDelete_(taskID) /* nothing */ #define traceHeapProfBegin(profile_id) /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ -#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, srcloc) /* nothing */ +#define traceIPE(ipe) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ #define traceHeapBioProfSampleBegin(era, time) /* nothing */ #define traceHeapProfSampleEnd(era) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i) postWord32(eb, (StgWord32)i); } -static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size) +static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) { memcpy(eb->pos, buf, size); eb->pos += size; @@ -1411,34 +1411,37 @@ void postTickyCounterSamples(StgEntCounter *counters) RELEASE_LOCK(&eventBufMutex); } #endif /* TICKY_TICKY */ -void postIPE(StgWord64 info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc) +void postIPE(const InfoProvEnt *ipe) { ACQUIRE_LOCK(&eventBufMutex); - StgWord table_name_len = strlen(table_name); - StgWord closure_desc_len = strlen(closure_desc); - StgWord ty_desc_len = strlen(ty_desc); - StgWord label_len = strlen(label); - StgWord module_len = strlen(module); - StgWord srcloc_len = strlen(srcloc); + StgWord table_name_len = strlen(ipe->prov.table_name); + StgWord closure_desc_len = strlen(ipe->prov.closure_desc); + StgWord ty_desc_len = strlen(ipe->prov.ty_desc); + StgWord label_len = strlen(ipe->prov.label); + StgWord module_len = strlen(ipe->prov.module); + StgWord src_file_len = strlen(ipe->prov.src_file); + StgWord src_span_len = strlen(ipe->prov.src_span); + // 8 for the info word - // 6 for the number of strings in the payload as postString adds 1 to the length - StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6; + // 1 null after each string + // 1 colon between src_file and src_span + StgWord len = 8+table_name_len+1+closure_desc_len+1+ty_desc_len+1+label_len+1+module_len+1+src_file_len+1+src_span_len+1; ensureRoomForVariableEvent(&eventBuf, len); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); - postWord64(&eventBuf, info); - postString(&eventBuf, table_name); - postString(&eventBuf, closure_desc); - postString(&eventBuf, ty_desc); - postString(&eventBuf, label); - postString(&eventBuf, module); - postString(&eventBuf, srcloc); + postWord64(&eventBuf, (StgWord) ipe->info); + postString(&eventBuf, ipe->prov.table_name); + postString(&eventBuf, ipe->prov.closure_desc); + postString(&eventBuf, ipe->prov.ty_desc); + postString(&eventBuf, ipe->prov.label); + postString(&eventBuf, ipe->prov.module); + + // Manually construct the location field: ":\0" + postBuf(&eventBuf, (const StgWord8*) ipe->prov.src_file, src_file_len); + StgWord8 colon = ':'; + postBuf(&eventBuf, &colon, 1); + postString(&eventBuf, ipe->prov.src_span); + RELEASE_LOCK(&eventBufMutex); } ===================================== rts/eventlog/EventLog.h ===================================== @@ -190,13 +190,7 @@ void postProfSampleCostCentre(Capability *cap, void postProfBegin(void); #endif /* PROFILING */ -void postIPE(StgWord64 info, - const char *table_name, - const char *closure_desc, - const char *ty_desc, - const char *label, - const char *module, - const char *srcloc); +void postIPE(const InfoProvEnt *ipe); void postConcUpdRemSetFlush(Capability *cap); void postConcMarkEnd(StgWord32 marked_obj_count); ===================================== rts/include/rts/IPE.h ===================================== @@ -14,18 +14,56 @@ #pragma once typedef struct InfoProv_ { - char *table_name; - char *closure_desc; - char *ty_desc; - char *label; - char *module; - char *srcloc; + const char *table_name; + const char *closure_desc; + const char *ty_desc; + const char *label; + const char *module; + const char *src_file; + const char *src_span; } InfoProv; typedef struct InfoProvEnt_ { - StgInfoTable *info; + const StgInfoTable *info; InfoProv prov; } InfoProvEnt; -void registerInfoProvList(InfoProvEnt **cc_list); + +/* + * On-disk representation + */ + +/* + * A byte offset into the string table. + * We use offsets rather than pointers as: + * + * a. they are smaller than pointers on 64-bit platforms + * b. they are easier on the linker since they do not need + * to be relocated + */ +typedef uint32_t StringIdx; + +// The size of this must be a multiple of the word size +// to ensure correct packing. +typedef struct { + const StgInfoTable *info; + StringIdx table_name; + StringIdx closure_desc; + StringIdx ty_desc; + StringIdx label; + StringIdx module_name; + StringIdx src_file; + StringIdx src_span; + uint32_t _padding; +} IpeBufferEntry; + +typedef struct IpeBufferListNode_ { + struct IpeBufferListNode_ *next; + // Everything below is read-only and generated by the codegen + const char *string_table; + const StgWord count; + const IpeBufferEntry entries[]; +} IpeBufferListNode; + +void registerInfoProvList(IpeBufferListNode *node); InfoProvEnt *lookupIPE(const StgInfoTable *info); ===================================== rts/include/stg/SMP.h ===================================== @@ -568,3 +568,20 @@ atomic_dec(StgVolatilePtr p) #define VOLATILE_LOAD(p) ((StgWord)*((StgWord*)(p))) #endif /* !THREADED_RTS */ + +/* Helpers implemented in terms of the above */ +#if !IN_STG_CODE || IN_STGCRUN + +INLINE_HEADER void * +xchg_ptr(void **p, void *w) +{ + return (void *) xchg((StgPtr) p, (StgWord) w); +} + +INLINE_HEADER void * +cas_ptr(volatile void **p, void *o, void *n) +{ + return (void *) cas((StgVolatilePtr) p, (StgWord) o, (StgWord) n); +} + +#endif ===================================== testsuite/tests/profiling/should_run/staticcallstack001.hs ===================================== @@ -1,6 +1,6 @@ module Main where -import GHC.Stack.CCS +import GHC.InfoProv data D = D Int deriving Show ===================================== testsuite/tests/profiling/should_run/staticcallstack002.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE UnboxedTuples #-} module Main where -import GHC.Stack.CCS +import GHC.InfoProv -- Unboxed data constructors don't have info tables so there is -- a special case to not generate distinct info tables for unboxed View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f4087e3cfe515b0222269e01e3cd74162970327...dafb357befbd39f54b2d16cff89e32845fc187ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f4087e3cfe515b0222269e01e3cd74162970327...dafb357befbd39f54b2d16cff89e32845fc187ff You're receiving 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 Aug 19 21:08:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 17:08:22 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 15 commits: base: Move CString, CStringLen to GHC.Foreign Message-ID: <62fffbc63aa0_125b2b150df6f0356883@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: c3697c5b by Ben Gamari at 2022-08-19T15:52:58-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - 25a231bf by Ben Gamari at 2022-08-19T15:52:58-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - eb7b8dab by Ben Gamari at 2022-08-19T15:52:58-04:00 rts: Refactor IPE tracing support - - - - - 111b8492 by Ben Gamari at 2022-08-19T15:52:58-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - dafb357b by Ben Gamari at 2022-08-19T17:03:24-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 2fcdff17 by Ben Gamari at 2022-08-19T17:08:12-04:00 base: Move PrimMVar to GHC.MVar - - - - - cb4726df by Ben Gamari at 2022-08-19T17:08:12-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - 44f3c041 by Ben Gamari at 2022-08-19T17:08:12-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 0171e8cd by Ben Gamari at 2022-08-19T17:08:12-04:00 base: Introduce exception context - - - - - c895735d by Ben Gamari at 2022-08-19T17:08:12-04:00 base: Collect backtraces in GHC.IO.throwIO - - - - - f1016ce4 by Ben Gamari at 2022-08-19T17:08:13-04:00 base: Collect backtraces in GHC.Exception.throw - - - - - 62d59127 by Ben Gamari at 2022-08-19T17:08:13-04:00 Pretty IPE - - - - - 3c942439 by Ben Gamari at 2022-08-19T17:08:13-04:00 base: Move prettyCallStack to GHC.Stack - - - - - e40913c0 by Ben Gamari at 2022-08-19T17:08:13-04:00 Fix - - - - - 53f5367e by Ben Gamari at 2022-08-19T17:08:13-04:00 Formatting - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/ghc.cabal.in - libraries/base/Foreign/C/String.hs - 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.hs-boot - libraries/base/GHC/ExecutionStack/Internal.hsc - libraries/base/GHC/Foreign.hs - libraries/base/GHC/IO.hs - + libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/MVar.hs - libraries/base/GHC/Stack.hs - libraries/base/GHC/Stack/CCS.hs-boot - libraries/base/GHC/Stack/CCS.hsc - libraries/base/GHC/Stack/CloneStack.hs - + libraries/base/GHC/Stack/CloneStack.hs-boot - libraries/base/base.cabal - rts/IPE.c - rts/IPE.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5d9acb1e7a5cba4a510eae4fe9ee7ad22439b46...53f5367e9f221be99a6c7b81ff60171bcbc59a82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5d9acb1e7a5cba4a510eae4fe9ee7ad22439b46...53f5367e9f221be99a6c7b81ff60171bcbc59a82 You're receiving 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 Aug 19 21:10:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 17:10:22 -0400 Subject: [Git][ghc/ghc][wip/T22038] compiler: Rework handling of mutator aborting Message-ID: <62fffc3e18608_125b2b488143572e8@gitlab.mail> Ben Gamari pushed to branch wip/T22038 at Glasgow Haskell Compiler / GHC Commits: 6d9802a6 by Ben Gamari at 2022-08-19T17:09:44-04:00 compiler: Rework handling of mutator aborting Previously `-dtag-inference-checks`, `-dcheck-prim-bounds`, and `-falignment-sanitization` all aborted by calling `barf` from the mutator. However, this can lead to deadlocks in the threaded RTS. For instance, in the case of `-dcheck-prim-bounds` the following can happen 1. the mutator takes a capability and begins execution 2. the bounds check fails, calling `barf` 3. `barf` calls `rtsFatalInternalErrorFn`, which in turn calls `endEventLogging` 4. `endEventLogging` calls `flushEventLog`, which it turn initiates a sync to request that all capabilities flush their local event logs 5. we deadlock as the the capability held by the crashing mutator can never join the sync To avoid this we now have a more principled means of aborting: we return to the scheduler setting the thread's return value to ThreadAborting. The scheduler will see this and call `barf`. Fixes #22038. - - - - - 9 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/TagCheck.hs - compiler/GHC/StgToCmm/Utils.hs - rts/PrimOps.cmm - rts/RtsMessages.c - rts/Schedule.c - rts/StgMiscClosures.cmm - rts/include/rts/Constants.h Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -64,6 +64,7 @@ module GHC.Cmm.CLabel ( mkSMAP_FROZEN_DIRTY_infoLabel, mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel, + mkTagInferenceCheckFailureLabel, mkOutOfBoundsAccessLabel, mkArrWords_infoLabel, mkSRTInfoLabel, @@ -637,8 +638,9 @@ mkDirty_MUT_VAR_Label, mkTopTickyCtrLabel, mkCAFBlackHoleInfoTableLabel, mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel, - mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel, - mkOutOfBoundsAccessLabel, mkMUT_VAR_CLEAN_infoLabel :: CLabel + mkSMAP_DIRTY_infoLabel, mkMUT_VAR_CLEAN_infoLabel, + mkBadAlignmentLabel, mkTagInferenceCheckFailureLabel, mkOutOfBoundsAccessLabel + :: CLabel mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData @@ -655,9 +657,10 @@ mkArrWords_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsL mkSMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo mkSMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo -mkBadAlignmentLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment") CmmEntry -mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") Nothing ForeignLabelInExternalPackage IsFunction -mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +mkBadAlignmentLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment") CmmPrimCall +mkOutOfBoundsAccessLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_outOfBoundsAccess") CmmPrimCall +mkTagInferenceCheckFailureLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_tagInferenceCheckFailure") CmmPrimCall mkSRTInfoLabel :: Int -> CLabel mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -3211,7 +3211,7 @@ doBoundsCheck idx sz = do when do_bounds_check (doCheck platform) where doCheck platform = do - boundsCheckFailed <- getCode $ emitCCall [] (mkLblExpr mkOutOfBoundsAccessLabel) [] + boundsCheckFailed <- getCode $ emitCall (NativeNodeCall, NativeReturn) (mkLblExpr mkOutOfBoundsAccessLabel) [idx, sz] emit =<< mkCmmIfThen' isOutOfBounds boundsCheckFailed (Just False) where uGE = cmmUGeWord platform ===================================== compiler/GHC/StgToCmm/TagCheck.hs ===================================== @@ -19,9 +19,13 @@ import GHC.Prelude import GHC.StgToCmm.Env import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils +import GHC.StgToCmm.Layout (emitCall) +import GHC.StgToCmm.Lit (newStringCLit) import GHC.Cmm import GHC.Cmm.BlockId +import GHC.Cmm.CLabel (mkTagInferenceCheckFailureLabel) import GHC.Cmm.Graph as CmmGraph +import GHC.Cmm.Utils import GHC.Core.Type import GHC.Types.Id @@ -95,7 +99,8 @@ emitTagAssertion onWhat fun = do ; needsArgTag fun lbarf lret ; emitLabel lbarf - ; emitBarf ("Tag inference failed on:" ++ onWhat) + ; onWhat_str <- newStringCLit onWhat + ; _ <- emitCall (NativeNodeCall, NativeReturn) (mkLblExpr mkTagInferenceCheckFailureLabel) [CmmLit onWhat_str] ; emitLabel lret } ===================================== compiler/GHC/StgToCmm/Utils.hs ===================================== @@ -12,7 +12,6 @@ module GHC.StgToCmm.Utils ( emitDataLits, emitRODataLits, emitDataCon, emitRtsCall, emitRtsCallWithResult, emitRtsCallGen, - emitBarf, assignTemp, newTemp, newUnboxedTupleRegs, @@ -158,11 +157,6 @@ tagToClosure platform tycon tag -- ------------------------------------------------------------------------- -emitBarf :: String -> FCode () -emitBarf msg = do - strLbl <- newStringCLit msg - emitRtsCall rtsUnitId (fsLit "barf") [(CmmLit strLbl,AddrHint)] False - emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCall pkg fun = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) ===================================== rts/PrimOps.cmm ===================================== @@ -42,7 +42,7 @@ import CLOSURE CCS_MAIN; #if defined(DEBUG) #define ASSERT_IN_BOUNDS(ind, sz) \ - if (ind >= sz) { ccall rtsOutOfBoundsAccess(); } + if (ind >= sz) { ccall stg_outOfBoundsAccess(ind, sz); } #else #define ASSERT_IN_BOUNDS(ind, sz) #endif @@ -1150,7 +1150,7 @@ stg_threadStatuszh ( gcptr tso ) * TVar primitives * -------------------------------------------------------------------------- */ -stg_abort /* no arg list: explicit stack layout */ +stg_abort_tx /* no arg list: explicit stack layout */ { W_ frame_type; W_ frame; @@ -1159,7 +1159,7 @@ stg_abort /* no arg list: explicit stack layout */ W_ r; // STM operations may allocate - MAYBE_GC_ (stg_abort); // NB. not MAYBE_GC(), we cannot make a + MAYBE_GC_ (stg_abort_tx); // NB. not MAYBE_GC(), we cannot make a // function call in an explicit-stack proc // Find the enclosing ATOMICALLY_FRAME @@ -1217,7 +1217,7 @@ INFO_TABLE_RET(stg_catch_retry_frame, CATCH_RETRY_FRAME, } else { // Did not commit: abort and restart. StgTSO_trec(CurrentTSO) = outer; - jump stg_abort(); + jump stg_abort_tx(); } } ===================================== rts/RtsMessages.c ===================================== @@ -320,21 +320,3 @@ rtsDebugMsgFn(const char *s, va_list ap) return r; } - -// Used in stg_badAlignment_entry defined in StgStartup.cmm. -void rtsBadAlignmentBarf(void) GNUC3_ATTRIBUTE(__noreturn__); - -void -rtsBadAlignmentBarf() -{ - barf("Encountered incorrectly aligned pointer. This can't be good."); -} - -// Used by code generator -void rtsOutOfBoundsAccess(void) GNUC3_ATTRIBUTE(__noreturn__); - -void -rtsOutOfBoundsAccess() -{ - barf("Encountered out of bounds array access."); -} ===================================== rts/Schedule.c ===================================== @@ -571,6 +571,9 @@ run_thread: ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task); break; + case ThreadAborted: + barf("internal error"); + default: barf("schedule: invalid thread return code %d", (int)ret); } @@ -3090,7 +3093,7 @@ findRetryFrameHelper (Capability *cap, StgTSO *tso) /* ----------------------------------------------------------------------------- findAtomicallyFrameHelper - This function is called by stg_abort via catch_retry_frame primitive. It is + This function is called by stg_abort_tx via catch_retry_frame primitive. It is like findRetryFrameHelper but it will only stop at ATOMICALLY_FRAME. -------------------------------------------------------------------------- */ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -1486,3 +1486,49 @@ section "data" { } #endif + +/* Note [Aborting from the mutator] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * GHC supports a number of runtime checking modes (largely for debugging + * purposes) which may need to abort execution at runtime. This include + * -dtag-inference-check, -dcheck-prim-bounds, and -falignment-sanitisation. + * To abort execution one might think that we could just call `barf`; however + * this is not ideal since it doesn't allow the RTS to gracefully shutdown. + * + * In #22038 we saw this manifest as a deadlock when -dcheck-prim-bounds + * failed. In particular, we saw the following: + * + * 1. the mutator takes a capability and begins execution + * 2. the bounds check fails, calling `barf` + * 3. `barf` calls `rtsFatalInternalErrorFn`, which in turn calls `endEventLogging` + * 4. `endEventLogging` calls `flushEventLog`, which it turn initiates a + * sync to request that all capabilities flush their local event logs + * 5. we deadlock as the the capability held by the crashing mutator can + * never yields to the sync + * + * Consequently, we instead crash in a more principled manner by yielding back + * to the scheduler, indicating that we should abort by setting the thread's + * return value to ThreadAborted. This is done by stg_abort(). + */ + +stg_tagInferenceCheckFailure(W_ what) { + ccall debugBelch("Tag inference failed on: %s\n", what); + jump stg_abort(); +} + +stg_outOfBoundsAccess(W_ ind, W_ sz) { + ccall debugBelch("Encountered out of bounds array access (index=%d, size=%d)", ind, sz); + jump stg_abort(); +} + +stg_badAlignment() { + ccall debugBelch("Encountered incorrectly aligned pointer. This can't be good."); + jump stg_abort(); +} + +stg_abort() { + StgTSO_what_next(CurrentTSO) = ThreadKilled :: I16; + StgRegTable_rRet(BaseReg) = ThreadAborted :: W_; + R1 = BaseReg; + jump stg_returnToSched [R1]; +} ===================================== rts/include/rts/Constants.h ===================================== @@ -268,6 +268,7 @@ #define ThreadYielding 3 #define ThreadBlocked 4 #define ThreadFinished 5 +#define ThreadAborted 6 /* See Note [Aborting from the mutator] */ /* * Flags for the tso->flags field. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d9802a6e19b0873f58c85ccf61a3f219bac32c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d9802a6e19b0873f58c85ccf61a3f219bac32c1 You're receiving 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 Aug 19 22:08:00 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 18:08:00 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 7 commits: base: Clean up imports of GHC.ExecutionStack Message-ID: <630009c09223e_125b2b48828366280@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: d29caa82 by Ben Gamari at 2022-08-19T18:02:03-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - 7392c518 by Ben Gamari at 2022-08-19T18:02:03-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - c5d3efb1 by Ben Gamari at 2022-08-19T18:04:18-04:00 base: Move prettyCallStack to GHC.Stack - - - - - 89373322 by Ben Gamari at 2022-08-19T18:07:09-04:00 base: Introduce exception context - - - - - bc5ed676 by Ben Gamari at 2022-08-19T18:07:40-04:00 base: Backtraces - - - - - e69b0c7d by Ben Gamari at 2022-08-19T18:07:53-04:00 base: Collect backtraces in GHC.IO.throwIO - - - - - e0998cce by Ben Gamari at 2022-08-19T18:07:53-04:00 base: Collect backtraces in GHC.Exception.throw - - - - - 16 changed files: - 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.hs-boot - libraries/base/GHC/ExecutionStack/Internal.hsc - libraries/base/GHC/IO.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/Stack/CloneStack.hs-boot - libraries/base/base.cabal Changes: ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -2,10 +2,12 @@ {-# LANGUAGE NoImplicitPrelude , ExistentialQuantification , MagicHash - , RecordWildCards , PatternSynonyms #-} -{-# LANGUAGE DataKinds, PolyKinds #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- @@ -28,7 +30,8 @@ module GHC.Exception , ErrorCall(..,ErrorCall) , errorCallException , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types + + -- * Re-exports from GHC.Types , CallStack, fromCallSiteList, getCallStack, prettyCallStack , prettyCallStackLines, showCCSStack , SrcLoc(..), prettySrcLoc @@ -40,6 +43,9 @@ import GHC.Stack.Types import GHC.OldList import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS +import {-# SOURCE #-} GHC.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc) +import GHC.Exception.Backtrace +import GHC.Exception.Context import GHC.Exception.Type -- | Throw an exception. Exceptions may be thrown from purely @@ -48,8 +54,10 @@ 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 !context = unsafePerformIO collectBacktraces + in raise# (toExceptionWithContext e context) -- | This is thrown when the user calls 'error'. The first @String@ is the -- argument given to 'error', second @String@ is the location. @@ -89,31 +97,3 @@ showCCSStack :: [String] -> [String] showCCSStack [] = [] showCCSStack stk = "CallStack (from -prof):" : map (" " ++) (reverse stk) --- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot --- files. See Note [Definition of CallStack] - --- | Pretty print a 'SrcLoc'. --- --- @since 4.9.0.0 -prettySrcLoc :: SrcLoc -> String -prettySrcLoc SrcLoc {..} - = foldr (++) "" - [ srcLocFile, ":" - , show srcLocStartLine, ":" - , show srcLocStartCol, " in " - , srcLocPackage, ":", srcLocModule - ] - --- | Pretty print a 'CallStack'. --- --- @since 4.9.0.0 -prettyCallStack :: CallStack -> String -prettyCallStack = intercalate "\n" . prettyCallStackLines - -prettyCallStackLines :: CallStack -> [String] -prettyCallStackLines cs = case getCallStack cs of - [] -> [] - stk -> "CallStack (from HasCallStack):" - : map ((" " ++) . prettyCallSite) stk - where - prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc ===================================== libraries/base/GHC/Exception/Backtrace.hs ===================================== @@ -0,0 +1,90 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE NamedFieldPuns #-} + +module GHC.Exception.Backtrace + ( BacktraceMechanism(..) + , collectBacktraces + , collectBacktrace + ) where + +import GHC.Base +import Data.OldList +import GHC.Show (Show) +import GHC.Exception.Context +import GHC.Stack.Types (HasCallStack, CallStack) +import {-# SOURCE #-} qualified GHC.Stack as CallStack +import {-# SOURCE #-} qualified GHC.ExecutionStack as ExecStack +import {-# SOURCE #-} qualified GHC.Stack.CloneStack as CloneStack +import {-# SOURCE #-} qualified GHC.Stack.CCS as CCS + +-- | How to collect a backtrace when an exception is thrown. +data BacktraceMechanism + = -- | collect a cost center stacktrace (only available when built with profiling) + CostCentreBacktraceMech + | -- | use execution stack unwinding with given limit + ExecutionStackBacktraceMech + | -- | collect backtraces from Info Table Provenance Entries + IPEBacktraceMech + | -- | use 'HasCallStack' + HasCallStackBacktraceMech + deriving (Eq, Show) + +collectBacktraces :: HasCallStack => IO ExceptionContext +collectBacktraces = do + mconcat `fmap` mapM collect + [ CostCentreBacktraceMech + , ExecutionStackBacktraceMech + , IPEBacktraceMech + , HasCallStackBacktraceMech + ] + where + collect mech + | True = collectBacktrace mech -- FIXME + -- | otherwise = return mempty + +data CostCentreBacktrace = CostCentreBacktrace [String] + +instance ExceptionAnnotation CostCentreBacktrace where + displayExceptionAnnotation (CostCentreBacktrace strs) = CCS.renderStack strs + +data ExecutionBacktrace = ExecutionBacktrace String + +instance ExceptionAnnotation ExecutionBacktrace where + displayExceptionAnnotation (ExecutionBacktrace str) = + "Native stack backtrace:\n" ++ str + +data HasCallStackBacktrace = HasCallStackBacktrace CallStack + +instance ExceptionAnnotation HasCallStackBacktrace where + displayExceptionAnnotation (HasCallStackBacktrace cs) = + "HasCallStack backtrace:\n" ++ CallStack.prettyCallStack cs + +data InfoProvBacktrace = InfoProvBacktrace [CloneStack.StackEntry] + +instance ExceptionAnnotation InfoProvBacktrace where + displayExceptionAnnotation (InfoProvBacktrace stack) = + "Info table provenance backtrace:\n" ++ + intercalate "\n" (map (" "++) $ map CloneStack.prettyStackEntry stack) + +collectBacktrace :: (?callStack :: CallStack) => BacktraceMechanism -> IO ExceptionContext +collectBacktrace CostCentreBacktraceMech = do + strs <- CCS.currentCallStack + case strs of + [] -> return emptyExceptionContext + _ -> pure $ mkExceptionContext (CostCentreBacktrace strs) + +collectBacktrace ExecutionStackBacktraceMech = do + mst <- ExecStack.showStackTrace + case mst of + Nothing -> return emptyExceptionContext + Just st -> return $ mkExceptionContext (ExecutionBacktrace st) + +collectBacktrace IPEBacktraceMech = do + stack <- CloneStack.cloneMyStack + stackEntries <- CloneStack.decode stack + return $ mkExceptionContext (InfoProvBacktrace stackEntries) + +collectBacktrace HasCallStackBacktraceMech = + return $ mkExceptionContext (HasCallStackBacktrace ?callStack) + ===================================== libraries/base/GHC/Exception/Backtrace.hs-boot ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Exception.Backtrace where + +import GHC.Base (IO) +import GHC.Exception.Context (ExceptionContext) +import GHC.Stack.Types (HasCallStack) + +data BacktraceMechanism + +collectBacktraces :: HasCallStack => IO ExceptionContext ===================================== libraries/base/GHC/Exception/Context.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# 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 + , mkExceptionContext + , mergeExceptionContexts + -- * Exception annotations + , SomeExceptionAnnotation(..) + , ExceptionAnnotation(..) + ) where + +import GHC.Base ((++), String, Semigroup(..), Monoid(..)) +import GHC.Show (Show(..)) +import Data.Typeable.Internal (Typeable) + +data ExceptionContext = ExceptionContext [SomeExceptionAnnotation] + +instance Semigroup ExceptionContext where + (<>) = mergeExceptionContexts + +instance Monoid ExceptionContext where + mempty = emptyExceptionContext + +emptyExceptionContext :: ExceptionContext +emptyExceptionContext = ExceptionContext [] + +mergeExceptionContexts :: ExceptionContext -> ExceptionContext -> ExceptionContext +mergeExceptionContexts (ExceptionContext a) (ExceptionContext b) = ExceptionContext (a ++ b) + +mkExceptionContext :: ExceptionAnnotation a => a -> ExceptionContext +mkExceptionContext x = ExceptionContext [SomeExceptionAnnotation x] + +data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a + +class Typeable a => ExceptionAnnotation a where + 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,6 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK not-home #-} @@ -20,7 +21,14 @@ module GHC.Exception.Type ( Exception(..) -- Class - , SomeException(..), ArithException(..) + , SomeException(..) + , exceptionContext + -- * Exception context + , ExceptionContext(..) + , emptyExceptionContext + , mergeExceptionContexts + -- * Arithmetic exceptions + , ArithException(..) , divZeroException, overflowException, ratioZeroDenomException , underflowException ) where @@ -30,13 +38,17 @@ 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, ?exc_context :: ExceptionContext) => SomeException e + +exceptionContext :: SomeException -> ExceptionContext +exceptionContext (SomeException _) = ?exc_context -- | @since 3.0 instance Show SomeException where @@ -129,10 +141,13 @@ Caught MismatchedParentheses -} class (Typeable e, Show e) => Exception e where - toException :: e -> SomeException + toException :: e -> SomeException + toExceptionWithContext :: e -> ExceptionContext -> SomeException fromException :: SomeException -> Maybe e - toException = SomeException + toException e = toExceptionWithContext e emptyExceptionContext + toExceptionWithContext e ctxt = SomeException e + where ?exc_context = ctxt fromException (SomeException e) = cast e -- | Render this exception value in a human-friendly manner. @@ -146,8 +161,18 @@ class (Typeable e, Show e) => Exception e where -- | @since 3.0 instance Exception SomeException where toException se = se + toExceptionWithContext se@(SomeException e) ctxt = + SomeException e + where ?exc_context = ctxt <> exceptionContext se fromException = Just - displayException (SomeException e) = displayException e + displayException (SomeException e) = + displayException e ++ "\n" ++ displayContext ?exc_context + +displayContext :: ExceptionContext -> String +displayContext (ExceptionContext anns0) = go anns0 + where + go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns + go [] = "\n" -- |Arithmetic exceptions. data ArithException ===================================== libraries/base/GHC/ExecutionStack.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.ExecutionStack @@ -36,7 +38,7 @@ module GHC.ExecutionStack ( , showStackTrace ) where -import Control.Monad (join) +import GHC.Base import GHC.ExecutionStack.Internal -- | Get a trace of the current execution stack state. ===================================== libraries/base/GHC/ExecutionStack.hs-boot ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.ExecutionStack where + +import GHC.Base + +showStackTrace :: IO (Maybe String) + ===================================== libraries/base/GHC/ExecutionStack/Internal.hsc ===================================== @@ -17,6 +17,7 @@ #include "HsBaseConfig.h" #include "rts/Libdw.h" +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MultiWayIf #-} module GHC.ExecutionStack.Internal ( @@ -31,7 +32,13 @@ module GHC.ExecutionStack.Internal ( , invalidateDebugCache ) where -import Control.Monad (join) +import GHC.Base +import GHC.Show +import GHC.List (reverse, null) +import GHC.Num ((-)) +import GHC.Real (fromIntegral) +import Data.Maybe +import Data.Functor ((<$>)) import Data.Word import Foreign.C.Types import Foreign.C.String (peekCString, CString) ===================================== libraries/base/GHC/IO.hs ===================================== @@ -47,6 +47,8 @@ import GHC.ST import GHC.Exception import GHC.Show import GHC.IO.Unsafe +import GHC.Stack.Types ( HasCallStack ) +import GHC.Exception.Backtrace ( collectBacktraces ) import Unsafe.Coerce ( unsafeCoerce ) import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError ) @@ -235,8 +237,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 + ctxt <- collectBacktraces + IO (raiseIO# (toExceptionWithContext e ctxt)) -- ----------------------------------------------------------------------------- -- Controlling asynchronous exception delivery ===================================== libraries/base/GHC/Stack.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} @@ -27,8 +28,9 @@ module GHC.Stack ( -- * HasCallStack call stacks CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack, - fromCallSiteList, getCallStack, popCallStack, prettyCallStack, + fromCallSiteList, getCallStack, popCallStack, pushCallStack, withFrozenCallStack, + prettyCallStackLines, prettyCallStack, -- * Source locations SrcLoc(..), prettySrcLoc, @@ -48,12 +50,14 @@ module GHC.Stack ( renderStack ) where +import GHC.Show import GHC.Stack.CCS import GHC.Stack.Types import GHC.IO import GHC.Base import GHC.List import GHC.Exception +import Data.OldList (intercalate) -- | Like the function 'error', but appends a stack trace to the error -- message if one is available. @@ -104,3 +108,32 @@ withFrozenCallStack do_this = -- withFrozenCallStack's call-site let ?callStack = freezeCallStack (popCallStack callStack) in do_this + +-- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot +-- files. See Note [Definition of CallStack] + +-- | Pretty print a 'SrcLoc'. +-- +-- @since 4.9.0.0 +prettySrcLoc :: SrcLoc -> String +prettySrcLoc SrcLoc {..} + = foldr (++) "" + [ srcLocFile, ":" + , show srcLocStartLine, ":" + , show srcLocStartCol, " in " + , srcLocPackage, ":", srcLocModule + ] + +-- | Pretty print a 'CallStack'. +-- +-- @since 4.9.0.0 +prettyCallStack :: CallStack -> String +prettyCallStack = intercalate "\n" . prettyCallStackLines + +prettyCallStackLines :: CallStack -> [String] +prettyCallStackLines cs = case getCallStack cs of + [] -> [] + stk -> "CallStack (from HasCallStack):" + : map ((" " ++) . prettyCallSite) stk + where + prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc ===================================== libraries/base/GHC/Stack.hs-boot ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Stack where + +import GHC.Base +import GHC.Stack.Types (CallStack, SrcLoc) + +prettyCallStackLines :: CallStack -> [String] +prettyCallStack :: CallStack -> String +prettySrcLoc :: SrcLoc -> String ===================================== 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,17 +19,19 @@ module GHC.Stack.CloneStack ( StackEntry(..), cloneMyStack, cloneThreadStack, - decode + decode, + prettyStackEntry ) where -import Control.Concurrent.MVar +import GHC.MVar import Data.Maybe (catMaybes) -import Foreign -import GHC.Conc.Sync -import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) +import GHC.Conc.Sync (ThreadId(ThreadId)) +import GHC.Int (Int (I#)) +import GHC.Prim (RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) import GHC.IO (IO (..)) import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable +import GHC.Ptr -- | A frozen snapshot of the state of an execution stack. -- @@ -262,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/GHC/Stack/CloneStack.hs-boot ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Stack.CloneStack where + +import GHC.Base + +data StackSnapshot +data StackEntry + +cloneMyStack :: IO StackSnapshot +decode :: StackSnapshot -> IO [StackEntry] +prettyStackEntry :: StackEntry -> String ===================================== libraries/base/base.cabal ===================================== @@ -208,6 +208,8 @@ Library GHC.Err GHC.Event.TimeOut GHC.Exception + GHC.Exception.Backtrace + GHC.Exception.Context GHC.Exception.Type GHC.ExecutionStack GHC.ExecutionStack.Internal View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53f5367e9f221be99a6c7b81ff60171bcbc59a82...e0998ccec48d57951228581c6090dbfb8ab5796f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53f5367e9f221be99a6c7b81ff60171bcbc59a82...e0998ccec48d57951228581c6090dbfb8ab5796f You're receiving 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 Aug 19 22:29:37 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 18:29:37 -0400 Subject: [Git][ghc/ghc][master] Print constraints in quotes (#21167) Message-ID: <63000ed12a3f6_125b2b150e1540372358@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 51ffd009 by Swann Moreau at 2022-08-19T18:29:21-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - 30 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - libraries/base/tests/T9681.stderr - testsuite/tests/ado/T16628.stderr - testsuite/tests/ado/ado005.stderr - testsuite/tests/annotations/should_fail/annfail05.stderr - testsuite/tests/annotations/should_fail/annfail08.stderr - testsuite/tests/arrows/should_fail/T20768_arrow_fail.stderr - testsuite/tests/backpack/cabal/bkpcabal05/bkpcabal05.stderr - testsuite/tests/backpack/should_fail/bkpfail11.stderr - testsuite/tests/backpack/should_fail/bkpfail24.stderr - testsuite/tests/backpack/should_fail/bkpfail43.stderr - testsuite/tests/backpack/should_fail/bkpfail44.stderr - testsuite/tests/dependent/should_fail/T13135.stderr - testsuite/tests/dependent/should_fail/T15308.stderr - testsuite/tests/deriving/should_fail/T21302.stderr - testsuite/tests/deriving/should_fail/T2851.stderr - testsuite/tests/deriving/should_fail/T5287.stderr - testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr - testsuite/tests/deriving/should_fail/drvfail-functor2.stderr - testsuite/tests/deriving/should_fail/drvfail001.stderr - testsuite/tests/deriving/should_fail/drvfail002.stderr - testsuite/tests/deriving/should_fail/drvfail003.stderr - testsuite/tests/deriving/should_fail/drvfail004.stderr - testsuite/tests/deriving/should_fail/drvfail007.stderr - testsuite/tests/deriving/should_fail/drvfail011.stderr - testsuite/tests/deriving/should_fail/drvfail012.stderr - testsuite/tests/deriving/should_fail/drvfail013.stderr - testsuite/tests/deriving/should_run/T9576.stderr - testsuite/tests/driver/T2182.stderr - testsuite/tests/driver/T5147/T5147.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51ffd00906d1c75dc72c71ba4216b480996c8ce2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51ffd00906d1c75dc72c71ba4216b480996c8ce2 You're receiving 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 Aug 19 22:30:10 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 Aug 2022 18:30:10 -0400 Subject: [Git][ghc/ghc][master] 19217 Implicitly quantify type variables in :kind command Message-ID: <63000ef28a381_125b2b150f9d7037636a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 5 changed files: - compiler/GHC/Tc/Module.hs - docs/users_guide/ghci.rst - + testsuite/tests/ghci/should_run/T19217.script - + testsuite/tests/ghci/should_run/T19217.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2668,8 +2668,15 @@ tcRnType :: HscEnv tcRnType hsc_env flexi normalise rdr_type = runTcInteractive hsc_env $ setXOptM LangExt.PolyKinds $ -- See Note [Kind-generalise in tcRnType] - do { (HsWC { hswc_ext = wcs, hswc_body = rn_type }, _fvs) - <- rnHsWcType GHCiCtx (mkHsWildCardBndrs rdr_type) + do { (HsWC { hswc_ext = wcs, hswc_body = rn_sig_type@(L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body })) }, _fvs) + -- we are using 'rnHsSigWcType' to bind the unbound type variables + -- and in combination with 'tcOuterTKBndrs' we are able to + -- implicitly quantify them as if the user wrote 'forall' by + -- hand (see #19217). This allows kind check to work in presence + -- of free type variables : + -- ghci> :k [a] + -- [a] :: * + <- rnHsSigWcType GHCiCtx (mkHsWildCardBndrs $ noLocA (mkHsImplicitSigType rdr_type)) -- The type can have wild cards, but no implicit -- generalisation; e.g. :kind (T _) ; failIfErrsM @@ -2679,14 +2686,14 @@ tcRnType hsc_env flexi normalise rdr_type -- Now kind-check the type -- It can have any rank or kind -- First bring into scope any wildcards - ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type]) - ; ((ty, kind), wanted) + ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_sig_type]) + ; si <- mkSkolemInfo $ SigTypeSkol (GhciCtxt True) + ; ((_, (ty, kind)), wanted) <- captureTopConstraints $ pushTcLevelM_ $ bindNamedWildCardBinders wcs $ \ wcs' -> do { mapM_ emitNamedTypeHole wcs' - ; tcInferLHsTypeUnsaturated rn_type } - + ; tcOuterTKBndrs si outer_bndrs $ tcInferLHsTypeUnsaturated body } -- Since all the wanteds are equalities, the returned bindings will be empty ; empty_binds <- simplifyTop wanted ; massertPpr (isEmptyBag empty_binds) (ppr empty_binds) ===================================== docs/users_guide/ghci.rst ===================================== @@ -2615,6 +2615,14 @@ commonly used commands. ghci> :k T Int T Int :: * -> * + Free type variables are also implicitly quantified, same as if you wrote + ``:k forall a. [a]`` so this also works: + + .. code-block:: none + + ghci> :k [a] + [a] :: * + If you specify the optional "``!``", GHC will in addition normalise the type by expanding out type synonyms and evaluating type-function applications, and display the normalised result. ===================================== testsuite/tests/ghci/should_run/T19217.script ===================================== @@ -0,0 +1 @@ +:kind [a] ===================================== testsuite/tests/ghci/should_run/T19217.stdout ===================================== @@ -0,0 +1 @@ +[a] :: * ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -77,6 +77,7 @@ test('T18064', ['T18064.script']) test('T18594', just_ghci, ghci_script, ['T18594.script']) test('T18562', just_ghci, ghci_script, ['T18562.script']) +test('T19217', just_ghci, ghci_script, ['T19217.script']) test('T19460', just_ghci, ghci_script, ['T19460.script']) test('T19733', just_ghci, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab3e0f5a02f6a1b63407e08bb97a228a76c27abd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab3e0f5a02f6a1b63407e08bb97a228a76c27abd You're receiving 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 Aug 19 22:33:00 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 18:33:00 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 3 commits: Mechanisms Message-ID: <63000f9cab876_125b2b150f9d7037657d@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 696d35f8 by Ben Gamari at 2022-08-19T18:27:09-04:00 Mechanisms - - - - - 293e0772 by Ben Gamari at 2022-08-19T18:29:51-04:00 base: Move PrimMVar to GHC.MVar - - - - - 2d00c7af by Ben Gamari at 2022-08-19T18:32:06-04:00 Drop redundant boot files - - - - - 7 changed files: - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Exception/Backtrace.hs - − libraries/base/GHC/ExecutionStack.hs-boot - libraries/base/GHC/IO.hs - libraries/base/GHC/MVar.hs - − libraries/base/GHC/Stack/CloneStack.hs-boot Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -121,11 +121,8 @@ import GHC.IORef import GHC.MVar import GHC.Real ( fromIntegral ) import GHC.Show ( Show(..), showParen, showString ) -import GHC.Stable ( StablePtr(..) ) import GHC.Weak -import Unsafe.Coerce ( unsafeCoerce# ) - infixr 0 `par`, `pseq` ----------------------------------------------------------------------------- @@ -663,20 +660,6 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s -> (# s1, w #) -> (# s1, Weak w #) -data PrimMVar - --- | Make a 'StablePtr' that can be passed to the C function --- @hs_try_putmvar()@. The RTS wants a 'StablePtr' to the --- underlying 'MVar#', but a 'StablePtr#' can only refer to --- lifted types, so we have to cheat by coercing. -newStablePtrPrimMVar :: MVar a -> IO (StablePtr PrimMVar) -newStablePtrPrimMVar (MVar m) = IO $ \s0 -> - case makeStablePtr# (unsafeCoerce# m :: PrimMVar) s0 of - -- Coerce unlifted m :: MVar# RealWorld a - -- to lifted PrimMVar - -- apparently because mkStablePtr is not representation-polymorphic - (# s1, sp #) -> (# s1, StablePtr sp #) - ----------------------------------------------------------------------------- -- Transactional heap operations ----------------------------------------------------------------------------- ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -44,7 +44,7 @@ import GHC.OldList import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS import {-# SOURCE #-} GHC.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc) -import GHC.Exception.Backtrace +import {-# SOURCE #-} GHC.Exception.Backtrace (collectBacktraces) import GHC.Exception.Context import GHC.Exception.Type ===================================== libraries/base/GHC/Exception/Backtrace.hs ===================================== @@ -3,45 +3,55 @@ {-# LANGUAGE NamedFieldPuns #-} module GHC.Exception.Backtrace - ( BacktraceMechanism(..) + ( -- * Backtrace mechanisms + BacktraceMechanism(..) + , setEnabledBacktraceMechanisms + , getEnabledBacktraceMechanisms + -- * Collecting backtraces , collectBacktraces , collectBacktrace ) where import GHC.Base import Data.OldList +import GHC.IORef +import GHC.IO.Unsafe (unsafePerformIO) import GHC.Show (Show) import GHC.Exception.Context import GHC.Stack.Types (HasCallStack, CallStack) -import {-# SOURCE #-} qualified GHC.Stack as CallStack -import {-# SOURCE #-} qualified GHC.ExecutionStack as ExecStack -import {-# SOURCE #-} qualified GHC.Stack.CloneStack as CloneStack -import {-# SOURCE #-} qualified GHC.Stack.CCS as CCS +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 - = -- | collect a cost center stacktrace (only available when built with profiling) + = -- | collect cost-centre stack backtraces (only available when built with profiling) CostCentreBacktraceMech - | -- | use execution stack unwinding with given limit - ExecutionStackBacktraceMech + | -- | collect backtraces from native execution stack unwinding + ExecutionStackBacktraceMech -- TODO: unwind limit? | -- | collect backtraces from Info Table Provenance Entries IPEBacktraceMech - | -- | use 'HasCallStack' + | -- | collect 'HasCallStack' backtraces HasCallStackBacktraceMech deriving (Eq, Show) +enabledBacktraceMechanisms :: IORef [BacktraceMechanism] +enabledBacktraceMechanisms = unsafePerformIO $ newIORef [HasCallStackBacktraceMech] +{-# NOINLINE enabledBacktraceMechanisms #-} + +-- | Set how 'Control.Exception.throwIO', et al. collect backtraces. +setEnabledBacktraceMechanisms :: [BacktraceMechanism] -> IO () +setEnabledBacktraceMechanisms = writeIORef enabledBacktraceMechanisms + +-- | Returns the currently enabled 'BacktraceMechanism's. +getEnabledBacktraceMechanisms :: IO [BacktraceMechanism] +getEnabledBacktraceMechanisms = readIORef enabledBacktraceMechanisms + collectBacktraces :: HasCallStack => IO ExceptionContext collectBacktraces = do - mconcat `fmap` mapM collect - [ CostCentreBacktraceMech - , ExecutionStackBacktraceMech - , IPEBacktraceMech - , HasCallStackBacktraceMech - ] - where - collect mech - | True = collectBacktrace mech -- FIXME - -- | otherwise = return mempty + mechs <- getEnabledBacktraceMechanisms + mconcat `fmap` mapM collectBacktrace mechs data CostCentreBacktrace = CostCentreBacktrace [String] ===================================== libraries/base/GHC/ExecutionStack.hs-boot deleted ===================================== @@ -1,8 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module GHC.ExecutionStack where - -import GHC.Base - -showStackTrace :: IO (Maybe String) - ===================================== libraries/base/GHC/IO.hs ===================================== @@ -48,9 +48,9 @@ import GHC.Exception import GHC.Show import GHC.IO.Unsafe import GHC.Stack.Types ( HasCallStack ) -import GHC.Exception.Backtrace ( collectBacktraces ) import Unsafe.Coerce ( unsafeCoerce ) +import {-# SOURCE #-} GHC.Exception.Backtrace ( collectBacktraces ) import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError ) -- --------------------------------------------------------------------------- ===================================== libraries/base/GHC/MVar.hs ===================================== @@ -18,7 +18,7 @@ ----------------------------------------------------------------------------- module GHC.MVar ( - -- * MVars + -- * MVars MVar(..) , newMVar , newEmptyMVar @@ -30,9 +30,15 @@ module GHC.MVar ( , tryReadMVar , isEmptyMVar , addMVarFinalizer + + -- * PrimMVar + , PrimMVar + , newStablePtrPrimMVar ) where import GHC.Base +import GHC.Stable ( StablePtr(..) ) +import Unsafe.Coerce ( unsafeCoerce# ) data MVar a = MVar (MVar# RealWorld a) {- ^ @@ -180,3 +186,17 @@ addMVarFinalizer :: MVar a -> IO () -> IO () addMVarFinalizer (MVar m) (IO finalizer) = IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) } +data PrimMVar + +-- | Make a 'StablePtr' that can be passed to the C function +-- @hs_try_putmvar()@. The RTS wants a 'StablePtr' to the +-- underlying 'MVar#', but a 'StablePtr#' can only refer to +-- lifted types, so we have to cheat by coercing. +newStablePtrPrimMVar :: MVar a -> IO (StablePtr PrimMVar) +newStablePtrPrimMVar (MVar m) = IO $ \s0 -> + case makeStablePtr# (unsafeCoerce# m :: PrimMVar) s0 of + -- Coerce unlifted m :: MVar# RealWorld a + -- to lifted PrimMVar + -- apparently because mkStablePtr is not representation-polymorphic + (# s1, sp #) -> (# s1, StablePtr sp #) + ===================================== libraries/base/GHC/Stack/CloneStack.hs-boot deleted ===================================== @@ -1,12 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module GHC.Stack.CloneStack where - -import GHC.Base - -data StackSnapshot -data StackEntry - -cloneMyStack :: IO StackSnapshot -decode :: StackSnapshot -> IO [StackEntry] -prettyStackEntry :: StackEntry -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0998ccec48d57951228581c6090dbfb8ab5796f...2d00c7af4a4ac3251ccf1bdf2b2fa808b0de5255 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0998ccec48d57951228581c6090dbfb8ab5796f...2d00c7af4a4ac3251ccf1bdf2b2fa808b0de5255 You're receiving 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 Aug 19 22:50:20 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 Aug 2022 18:50:20 -0400 Subject: [Git][ghc/ghc][wip/T21694a] More improvements Message-ID: <630013ac82253_125b2b150df6dc3771ae@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: 1f142834 by Simon Peyton Jones at 2022-08-19T23:49:51+01:00 More improvements Get rid of the AnalysisMode from ArityEnv; not needed any more. Enhance cheapArityType. - - - - - 3 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -137,28 +137,6 @@ joinRhsArity (Lam _ e) = 1 + joinRhsArity e joinRhsArity _ = 0 ---------------- -exprArity :: CoreExpr -> Arity --- ^ An approximate, fast, version of 'exprEtaExpandArity' --- We do /not/ guarantee that exprArity e <= typeArity e --- You may need to do arity trimming after calling exprArity --- See Note [Arity trimming] --- Reason: if we do arity trimming here we have take exprType --- and that can be expensive if there is a large cast -exprArity e = go e - where - go (Var v) = idArity v - go (Lam x e) | isId x = go e + 1 - | otherwise = go e - go (Tick t e) | not (tickishIsCode t) = go e - go (Cast e _) = go e - go (App e (Type _)) = go e - go (App f a) | exprIsTrivial a = (go f - 1) `max` 0 - -- See Note [exprArity for applications] - -- NB: coercions count as a value argument - - go _ = 0 - --------------- exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, DmdSig, CprSig) -- A cheap and cheerful function that identifies bottoming functions @@ -1264,71 +1242,35 @@ dictionary-typed expression, but that's more work. --------------------------- --- | Each of the entry-points of the analyser ('arityType') has different --- requirements. The entry-points are --- --- 1. 'exprBotStrictness_maybe' --- 2. 'exprEtaExpandArity' --- 3. 'findRhsArity' --- --- For each of the entry-points, there is a separate mode that governs --- --- 1. How pedantic we are wrt. ⊥, in 'pedanticBottoms'. --- 2. Whether we store arity signatures for non-recursive let-bindings, --- accessed in 'extendSigEnv'/'lookupSigEnv'. --- See Note [Arity analysis] why that's important. --- 3. Which expressions we consider cheap to float inside a lambda, --- in 'myExprIsCheap'. -data AnalysisMode - = BotStrictness - -- ^ Used during 'exprBotStrictness_maybe'. - - | FindRhsArity { am_opts :: !ArityOpts - , am_no_eta :: !Bool - , am_sigs :: !(IdEnv SafeArityType) } - -- ^ Used for regular, fixed-point arity analysis ('findRhsArity'). - -- See Note [Arity analysis] for details about fixed-point iteration. +data ArityEnv + = AE { am_opts :: !ArityOpts + , am_no_eta :: !Bool + , am_sigs :: !(IdEnv SafeArityType) } + -- ^ See Note [Arity analysis] for details about fixed-point iteration. -- am_sigs: NB `SafeArityType` so we can use this in myIsCheapApp -- am_no_eta: see Note [Arity type for recursive join bindings] -- point 5 -data ArityEnv - = AE - { ae_mode :: !AnalysisMode - -- ^ The analysis mode. See 'AnalysisMode'. - } - instance Outputable ArityEnv where - ppr (AE mode) = ppr mode - -instance Outputable AnalysisMode where - ppr BotStrictness = text "BotStrictness" - ppr (FindRhsArity { am_sigs = sigs }) = text "FindRhsArity" <+> ppr sigs - --- | The @ArityEnv@ used by 'exprBotStrictness_maybe'. Pedantic about bottoms --- and no application is ever considered cheap. -_botStrictnessArityEnv :: ArityEnv -_botStrictnessArityEnv = AE { ae_mode = BotStrictness } + ppr (AE { am_sigs = sigs, am_no_eta = no_eta }) + = text "AE" <+> braces (sep [ text "no-eta" <+> ppr no_eta + , text "sigs" <+> ppr sigs ]) -- | The @ArityEnv@ used by 'findRhsArity'. findRhsArityEnv :: ArityOpts -> Bool -> ArityEnv findRhsArityEnv opts no_eta - = AE { ae_mode = FindRhsArity { am_opts = opts - , am_no_eta = no_eta - , am_sigs = emptyVarEnv } } + = AE { am_opts = opts + , am_no_eta = no_eta + , am_sigs = emptyVarEnv } isNoEtaEnv :: ArityEnv -> Bool -isNoEtaEnv ae = case ae_mode ae of - FindRhsArity { am_no_eta = no_eta } -> no_eta - BotStrictness -> True +isNoEtaEnv (AE { am_no_eta = no_eta }) = no_eta -- First some internal functions in snake_case for deleting in certain VarEnvs -- of the ArityType. Don't call these; call delInScope* instead! modifySigEnv :: (IdEnv ArityType -> IdEnv ArityType) -> ArityEnv -> ArityEnv -modifySigEnv f env at AE { ae_mode = am at FindRhsArity{am_sigs = sigs} } - = env { ae_mode = am { am_sigs = f sigs } } -modifySigEnv _ env = env +modifySigEnv f env@(AE { am_sigs = sigs }) = env { am_sigs = f sigs } {-# INLINE modifySigEnv #-} del_sig_env :: Id -> ArityEnv -> ArityEnv -- internal! @@ -1353,16 +1295,12 @@ delInScopeList :: ArityEnv -> [Id] -> ArityEnv delInScopeList env ids = del_sig_env_list ids env lookupSigEnv :: ArityEnv -> Id -> Maybe SafeArityType -lookupSigEnv AE{ ae_mode = mode } id = case mode of - BotStrictness -> Nothing - FindRhsArity{ am_sigs = sigs } -> lookupVarEnv sigs id +lookupSigEnv (AE { am_sigs = sigs }) id = lookupVarEnv sigs id -- | Whether the analysis should be pedantic about bottoms. -- 'exprBotStrictness_maybe' always is. pedanticBottoms :: ArityEnv -> Bool -pedanticBottoms AE{ ae_mode = mode } = case mode of - BotStrictness -> True - FindRhsArity{ am_opts = ArityOpts{ ao_ped_bot = ped_bot } } -> ped_bot +pedanticBottoms (AE { am_opts = ArityOpts{ ao_ped_bot = ped_bot }}) = ped_bot exprCost :: ArityEnv -> CoreExpr -> Maybe Type -> Cost exprCost env e mb_ty @@ -1373,22 +1311,17 @@ exprCost env e mb_ty -- and optionally the expression's type. -- Under 'exprBotStrictness_maybe', no expressions are cheap. myExprIsCheap :: ArityEnv -> CoreExpr -> Maybe Type -> Bool -myExprIsCheap AE{ae_mode = mode} e mb_ty = case mode of - BotStrictness -> False - _ -> cheap_dict || cheap_fun e - where - cheap_dict = case mb_ty of +myExprIsCheap (AE { am_opts = opts, am_sigs = sigs }) e mb_ty + = cheap_dict || cheap_fun e + where + cheap_dict = case mb_ty of Nothing -> False - Just ty -> (ao_dicts_cheap (am_opts mode) && isDictTy ty) + Just ty -> (ao_dicts_cheap opts && isDictTy ty) || isCallStackPredTy ty -- See Note [Eta expanding through dictionaries] -- See Note [Eta expanding through CallStacks] - cheap_fun e = case mode of -#if __GLASGOW_HASKELL__ <= 900 - BotStrictness -> panic "impossible" -#endif - FindRhsArity{am_sigs = sigs} -> exprIsCheapX (myIsCheapApp sigs) e + cheap_fun e = exprIsCheapX (myIsCheapApp sigs) e -- | A version of 'isCheapApp' that considers results from arity analysis. -- See Note [Arity analysis] for what's in the signature environment and why @@ -1495,20 +1428,76 @@ arityType env (Tick t e) arityType _ _ = topArityType +-------------------- +idArityType :: Id -> ArityType +idArityType v + | strict_sig <- idDmdSig v + , (ds, div) <- splitDmdSig strict_sig + , isDeadEndDiv div + = AT (takeList ds one_shots) div + + | isEmptyTy id_ty + = botArityType + + | otherwise + = AT (take (idArity v) one_shots) topDiv + where + id_ty = idType v + + one_shots :: [(Cost,OneShotInfo)] -- One-shot-ness derived from the type + one_shots = repeat IsCheap `zip` typeOneShots id_ty + -------------------- cheapArityType :: HasDebugCallStack => CoreExpr -> ArityType -cheapArityType (Lam var body) - | isTyVar var = body_at - | otherwise = AT ((IsCheap, idOneShotInfo var) : lams) div +-- Returns ArityType with IsCheap everywhere +cheapArityType e = go e where - !body_at@(AT lams div) = cheapArityType body + go (Var v) = idArityType v + go (Cast e _) = go e + go (Lam x e) | isId x = arityLam x (go e) + | otherwise = go e + go (App f a) | isTypeArg a = go f + | otherwise = arity_app a (go e) -cheapArityType e - | exprIsDeadEnd e = botArityType - | otherwise = AT lams topDiv + go (Tick t e) | not (tickishIsCode t) = go e + + -- Null alts: see Note [Empty case alternatives] in GHC.Core + go (Case _ _ _ alts) | null alts = botArityType + + -- Give up on let, case + go _ = topArityType + + -- Specialised version of arityApp; all costs in ArityType are IsCheap + -- See Note [exprArity for applications] + -- NB: coercions count as a value argument + arity_app _ at@(AT [] _) = at + arity_app arg (AT (_:lams) div) + | isDeadEndDiv div = AT lams div + | exprIsTrivial arg = AT lams topDiv + | otherwise = topArityType + +--------------- +exprArity :: CoreExpr -> Arity +-- ^ An approximate, fast, version of 'exprEtaExpandArity' +-- We do /not/ guarantee that exprArity e <= typeArity e +-- You may need to do arity trimming after calling exprArity +-- See Note [Arity trimming] +-- Reason: if we do arity trimming here we have take exprType +-- and that can be expensive if there is a large cast +exprArity e = go e where - lams = replicate (exprArity e) (IsCheap, NoOneShotInfo) + go (Var v) = idArity v + go (Lam x e) | isId x = go e + 1 + | otherwise = go e + go (Tick t e) | not (tickishIsCode t) = go e + go (Cast e _) = go e + go (App e (Type _)) = go e + go (App f a) | exprIsTrivial a = (go f - 1) `max` 0 + -- See Note [exprArity for applications] + -- NB: coercions count as a value argument + + go _ = 0 {- Note [No free join points in arityType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1646,20 +1635,6 @@ Obviously `f` should get arity 4. But it's a bit tricky: the flag is on, we allow free join points, but not otherwise. -} -idArityType :: Id -> ArityType -idArityType v - | strict_sig <- idDmdSig v - , (ds, div) <- splitDmdSig strict_sig - , isDeadEndDiv div - , let arity = length ds - = AT (take arity one_shots) div - - | otherwise - = AT (take (idArity v) one_shots) topDiv - where - one_shots :: [(Cost,OneShotInfo)] -- One-shot-ness derived from the type - one_shots = repeat IsCheap `zip` typeOneShots (idType v) - {- %************************************************************************ %* * ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -117,8 +117,7 @@ tidyCbvInfoTop boot_exports id rhs -- See Note [CBV Function Ids] tidyCbvInfoLocal :: HasDebugCallStack => Id -> CoreExpr -> Id -tidyCbvInfoLocal id rhs - | otherwise = computeCbvInfo id rhs +tidyCbvInfoLocal id rhs = computeCbvInfo id rhs -- | For a binding we: -- * Look at the args @@ -135,9 +134,9 @@ computeCbvInfo :: HasCallStack -> Id -- computeCbvInfo fun_id rhs = fun_id computeCbvInfo fun_id rhs - | (isWorkerLike || isJoinId fun_id) && (valid_unlifted_worker val_args) - = - -- pprTrace "computeCbvInfo" + | is_wkr_like || isJust mb_join_id + , valid_unlifted_worker val_args + = -- pprTrace "computeCbvInfo" -- (text "fun" <+> ppr fun_id $$ -- text "arg_tys" <+> ppr (map idType val_args) $$ @@ -146,31 +145,48 @@ computeCbvInfo fun_id rhs -- text "cbv_marks" <+> ppr cbv_marks $$ -- text "out_id" <+> ppr cbv_bndr $$ -- ppr rhs) - cbv_bndr + cbv_bndr + | otherwise = fun_id where - val_args = filter isId . fst $ collectBinders rhs - cbv_marks = - -- CBV marks are only set during tidy so none should be present already. - assertPpr (maybe True null $ idCbvMarks_maybe fun_id) (ppr fun_id <+> (ppr $ idCbvMarks_maybe fun_id) $$ ppr rhs) $ - map mkMark val_args - cbv_bndr - | valid_unlifted_worker val_args - , any isMarkedCbv cbv_marks - -- seqList to avoid retaining the original rhs - = cbv_marks `seqList` setIdCbvMarks fun_id cbv_marks - | otherwise = - -- pprTraceDebug "tidyCbvInfo: Worker seems to take unboxed tuple/sum types!" (ppr fun_id <+> ppr rhs) - asNonWorkerLikeId fun_id - -- We don't set CBV marks on functions which take unboxed tuples or sums as arguments. - -- Doing so would require us to compute the result of unarise here in order to properly determine - -- argument positions at runtime. - -- In practice this doesn't matter much. Most "interesting" functions will get a W/W split which will eliminate - -- unboxed tuple arguments, and unboxed sums are rarely used. But we could change this in the future and support + mb_join_id = isJoinId_maybe fun_id + is_wkr_like = isWorkerLikeId fun_id + + val_args = filter isId lam_bndrs + -- When computing CbvMarks, we limit the arity of join points to + -- the JoinArity, because that's the arity we are going to use + -- when calling it. There may be more lambdas than that on the RHS. + lam_bndrs | Just join_arity <- mb_join_id + = fst $ collectNBinders join_arity rhs + | otherwise + = fst $ collectBinders rhs + + cbv_marks = -- assert: CBV marks are only set during tidy so none should be present already. + assertPpr (maybe True null $ idCbvMarks_maybe fun_id) + (ppr fun_id <+> (ppr $ idCbvMarks_maybe fun_id) $$ ppr rhs) $ + map mkMark val_args + + cbv_bndr | any isMarkedCbv cbv_marks + = cbv_marks `seqList` setIdCbvMarks fun_id cbv_marks + -- seqList: avoid retaining the original rhs + + | otherwise + = -- pprTraceDebug "tidyCbvInfo: Worker seems to take unboxed tuple/sum types!" + -- (ppr fun_id <+> ppr rhs) + asNonWorkerLikeId fun_id + + -- We don't set CBV marks on functions which take unboxed tuples or sums as + -- arguments. Doing so would require us to compute the result of unarise + -- here in order to properly determine argument positions at runtime. + -- + -- In practice this doesn't matter much. Most "interesting" functions will + -- get a W/W split which will eliminate unboxed tuple arguments, and unboxed + -- sums are rarely used. But we could change this in the future and support -- unboxed sums/tuples as well. valid_unlifted_worker args = -- pprTrace "valid_unlifted" (ppr fun_id $$ ppr args) $ all isSingleUnarisedArg args + isSingleUnarisedArg v | isUnboxedSumType ty = False | isUnboxedTupleType ty = isSimplePrimRep (typePrimRep ty) @@ -188,7 +204,6 @@ computeCbvInfo fun_id rhs , not (isDeadEndId fun_id) = MarkedCbv | otherwise = NotMarkedCbv - isWorkerLike = isWorkerLikeId fun_id ------------ Expressions -------------- tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr @@ -339,7 +354,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setDmdSigInfo` zapDmdEnvSig (dmdSigInfo old_info) + `setDmdSigInfo` zapDmdEnvSig (dmdSigInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1085,6 +1085,8 @@ exprIsDeadEnd :: CoreExpr -> Bool exprIsDeadEnd e = go 0 e where + go :: Arity -> CoreExpr -> Bool + -- (go n e) = True <=> expr applied to n value args is bottom go _ (Lit {}) = False go _ (Type {}) = False go _ (Coercion {}) = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f142834b9c06636d08749bf74f4f45e60c5c057 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f142834b9c06636d08749bf74f4f45e60c5c057 You're receiving 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 Aug 19 23:10:35 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 19:10:35 -0400 Subject: [Git][ghc/ghc][wip/T22038] compiler: Rework handling of mutator aborting Message-ID: <6300186bc9968_125b2b48828379075@gitlab.mail> Ben Gamari pushed to branch wip/T22038 at Glasgow Haskell Compiler / GHC Commits: c895c449 by Ben Gamari at 2022-08-19T19:10:26-04:00 compiler: Rework handling of mutator aborting Previously `-dtag-inference-checks`, `-dcheck-prim-bounds`, and `-falignment-sanitization` all aborted by calling `barf` from the mutator. However, this can lead to deadlocks in the threaded RTS. For instance, in the case of `-dcheck-prim-bounds` the following can happen 1. the mutator takes a capability and begins execution 2. the bounds check fails, calling `barf` 3. `barf` calls `rtsFatalInternalErrorFn`, which in turn calls `endEventLogging` 4. `endEventLogging` calls `flushEventLog`, which it turn initiates a sync to request that all capabilities flush their local event logs 5. we deadlock as the the capability held by the crashing mutator can never join the sync To avoid this we now have a more principled means of aborting: we return to the scheduler setting the thread's return value to ThreadAborting. The scheduler will see this and call `barf`. Fixes #22038. - - - - - 9 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/TagCheck.hs - compiler/GHC/StgToCmm/Utils.hs - rts/PrimOps.cmm - rts/RtsMessages.c - rts/Schedule.c - rts/StgMiscClosures.cmm - rts/include/rts/Constants.h Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -64,6 +64,7 @@ module GHC.Cmm.CLabel ( mkSMAP_FROZEN_DIRTY_infoLabel, mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel, + mkTagInferenceCheckFailureLabel, mkOutOfBoundsAccessLabel, mkArrWords_infoLabel, mkSRTInfoLabel, @@ -637,8 +638,9 @@ mkDirty_MUT_VAR_Label, mkTopTickyCtrLabel, mkCAFBlackHoleInfoTableLabel, mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel, - mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel, - mkOutOfBoundsAccessLabel, mkMUT_VAR_CLEAN_infoLabel :: CLabel + mkSMAP_DIRTY_infoLabel, mkMUT_VAR_CLEAN_infoLabel, + mkBadAlignmentLabel, mkTagInferenceCheckFailureLabel, mkOutOfBoundsAccessLabel + :: CLabel mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData @@ -655,9 +657,10 @@ mkArrWords_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsL mkSMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo mkSMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo -mkBadAlignmentLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment") CmmEntry -mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") Nothing ForeignLabelInExternalPackage IsFunction -mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +mkBadAlignmentLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment") CmmPrimCall +mkOutOfBoundsAccessLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_outOfBoundsAccess") CmmPrimCall +mkTagInferenceCheckFailureLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_tagInferenceCheckFailure") CmmPrimCall mkSRTInfoLabel :: Int -> CLabel mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -3211,7 +3211,7 @@ doBoundsCheck idx sz = do when do_bounds_check (doCheck platform) where doCheck platform = do - boundsCheckFailed <- getCode $ emitCCall [] (mkLblExpr mkOutOfBoundsAccessLabel) [] + boundsCheckFailed <- getCode $ emitCall (NativeNodeCall, NativeReturn) (mkLblExpr mkOutOfBoundsAccessLabel) [idx, sz] emit =<< mkCmmIfThen' isOutOfBounds boundsCheckFailed (Just False) where uGE = cmmUGeWord platform ===================================== compiler/GHC/StgToCmm/TagCheck.hs ===================================== @@ -19,9 +19,13 @@ import GHC.Prelude import GHC.StgToCmm.Env import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils +import GHC.StgToCmm.Layout (emitCall) +import GHC.StgToCmm.Lit (newStringCLit) import GHC.Cmm import GHC.Cmm.BlockId +import GHC.Cmm.CLabel (mkTagInferenceCheckFailureLabel) import GHC.Cmm.Graph as CmmGraph +import GHC.Cmm.Utils import GHC.Core.Type import GHC.Types.Id @@ -95,7 +99,8 @@ emitTagAssertion onWhat fun = do ; needsArgTag fun lbarf lret ; emitLabel lbarf - ; emitBarf ("Tag inference failed on:" ++ onWhat) + ; onWhat_str <- newStringCLit onWhat + ; _ <- emitCall (NativeNodeCall, NativeReturn) (mkLblExpr mkTagInferenceCheckFailureLabel) [CmmLit onWhat_str] ; emitLabel lret } ===================================== compiler/GHC/StgToCmm/Utils.hs ===================================== @@ -12,7 +12,6 @@ module GHC.StgToCmm.Utils ( emitDataLits, emitRODataLits, emitDataCon, emitRtsCall, emitRtsCallWithResult, emitRtsCallGen, - emitBarf, assignTemp, newTemp, newUnboxedTupleRegs, @@ -158,11 +157,6 @@ tagToClosure platform tycon tag -- ------------------------------------------------------------------------- -emitBarf :: String -> FCode () -emitBarf msg = do - strLbl <- newStringCLit msg - emitRtsCall rtsUnitId (fsLit "barf") [(CmmLit strLbl,AddrHint)] False - emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCall pkg fun = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) ===================================== rts/PrimOps.cmm ===================================== @@ -42,7 +42,7 @@ import CLOSURE CCS_MAIN; #if defined(DEBUG) #define ASSERT_IN_BOUNDS(ind, sz) \ - if (ind >= sz) { ccall rtsOutOfBoundsAccess(); } + if (ind >= sz) { ccall stg_outOfBoundsAccess(ind, sz); } #else #define ASSERT_IN_BOUNDS(ind, sz) #endif @@ -1150,7 +1150,7 @@ stg_threadStatuszh ( gcptr tso ) * TVar primitives * -------------------------------------------------------------------------- */ -stg_abort /* no arg list: explicit stack layout */ +stg_abort_tx /* no arg list: explicit stack layout */ { W_ frame_type; W_ frame; @@ -1159,7 +1159,7 @@ stg_abort /* no arg list: explicit stack layout */ W_ r; // STM operations may allocate - MAYBE_GC_ (stg_abort); // NB. not MAYBE_GC(), we cannot make a + MAYBE_GC_ (stg_abort_tx); // NB. not MAYBE_GC(), we cannot make a // function call in an explicit-stack proc // Find the enclosing ATOMICALLY_FRAME @@ -1217,7 +1217,7 @@ INFO_TABLE_RET(stg_catch_retry_frame, CATCH_RETRY_FRAME, } else { // Did not commit: abort and restart. StgTSO_trec(CurrentTSO) = outer; - jump stg_abort(); + jump stg_abort_tx(); } } ===================================== rts/RtsMessages.c ===================================== @@ -320,21 +320,3 @@ rtsDebugMsgFn(const char *s, va_list ap) return r; } - -// Used in stg_badAlignment_entry defined in StgStartup.cmm. -void rtsBadAlignmentBarf(void) GNUC3_ATTRIBUTE(__noreturn__); - -void -rtsBadAlignmentBarf() -{ - barf("Encountered incorrectly aligned pointer. This can't be good."); -} - -// Used by code generator -void rtsOutOfBoundsAccess(void) GNUC3_ATTRIBUTE(__noreturn__); - -void -rtsOutOfBoundsAccess() -{ - barf("Encountered out of bounds array access."); -} ===================================== rts/Schedule.c ===================================== @@ -571,8 +571,12 @@ run_thread: ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task); break; + case ThreadAborted: + interruptStgRts(); + break; + default: - barf("schedule: invalid thread return code %d", (int)ret); + barf("schedule: invalid thread return code %d", (int)ret); } if (ready_to_gc || scheduleNeedHeapProfile(ready_to_gc)) { @@ -3090,7 +3094,7 @@ findRetryFrameHelper (Capability *cap, StgTSO *tso) /* ----------------------------------------------------------------------------- findAtomicallyFrameHelper - This function is called by stg_abort via catch_retry_frame primitive. It is + This function is called by stg_abort_tx via catch_retry_frame primitive. It is like findRetryFrameHelper but it will only stop at ATOMICALLY_FRAME. -------------------------------------------------------------------------- */ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -1486,3 +1486,49 @@ section "data" { } #endif + +/* Note [Aborting from the mutator] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * GHC supports a number of runtime checking modes (largely for debugging + * purposes) which may need to abort execution at runtime. This include + * -dtag-inference-check, -dcheck-prim-bounds, and -falignment-sanitisation. + * To abort execution one might think that we could just call `barf`; however + * this is not ideal since it doesn't allow the RTS to gracefully shutdown. + * + * In #22038 we saw this manifest as a deadlock when -dcheck-prim-bounds + * failed. In particular, we saw the following: + * + * 1. the mutator takes a capability and begins execution + * 2. the bounds check fails, calling `barf` + * 3. `barf` calls `rtsFatalInternalErrorFn`, which in turn calls `endEventLogging` + * 4. `endEventLogging` calls `flushEventLog`, which it turn initiates a + * sync to request that all capabilities flush their local event logs + * 5. we deadlock as the the capability held by the crashing mutator can + * never yields to the sync + * + * Consequently, we instead crash in a more principled manner by yielding back + * to the scheduler, indicating that we should abort by setting the thread's + * return value to ThreadAborted. This is done by stg_abort(). + */ + +stg_tagInferenceCheckFailure(W_ what) { + ccall debugBelch("Tag inference failed on: %s\n", what); + jump stg_abort(); +} + +stg_outOfBoundsAccess(W_ ind, W_ sz) { + ccall debugBelch("Encountered out of bounds array access (index=%d, size=%d)", ind, sz); + jump stg_abort(); +} + +stg_badAlignment() { + ccall debugBelch("Encountered incorrectly aligned pointer. This can't be good."); + jump stg_abort(); +} + +stg_abort() { + StgTSO_what_next(CurrentTSO) = ThreadKilled :: I16; + StgRegTable_rRet(BaseReg) = ThreadAborted :: W_; + R1 = BaseReg; + jump stg_returnToSched [R1]; +} ===================================== rts/include/rts/Constants.h ===================================== @@ -268,6 +268,7 @@ #define ThreadYielding 3 #define ThreadBlocked 4 #define ThreadFinished 5 +#define ThreadAborted 6 /* See Note [Aborting from the mutator] */ /* * Flags for the tso->flags field. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c895c44911ec44b9506cbe97555753ac402d6acf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c895c44911ec44b9506cbe97555753ac402d6acf You're receiving 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 Aug 19 23:33:32 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 Aug 2022 19:33:32 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Documentation Message-ID: <63001dccc2c56_125b2b502bc37989c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: aa3ea6af by Simon Peyton Jones at 2022-08-20T00:33:45+01:00 Documentation - - - - - 3 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -1582,8 +1582,8 @@ function, via idArityType. But see Note [Arity type for recursive join bindings] for dark corners. -See Note [Arity type for recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Arity type for recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider f x = joinrec j 0 = \ a b c -> (a,x,b) j n = j (n-1) ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1005,8 +1005,7 @@ dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs !(!lazy_fv, !sig_fv) = partitionVarEnv isWeakDmd rhs_fv2 thresholdArity :: Id -> CoreExpr -> Arity --- **** TODO *** --- See Note [Demand signatures are computed for a threshold demand based on idArity] +-- See Note [Demand signatures are computed for a threshold arity based on idArity] thresholdArity fn rhs = case isJoinId_maybe fn of Just join_arity -> count isId $ fst $ collectNBinders join_arity rhs @@ -1144,28 +1143,40 @@ meaning one absent argument, returns bottom. That seems odd because there's a \y inside. But it's right because when consumed in a C1(L) context the RHS of the join point is indeed bottom. -Note [Demand signatures are computed for a threshold demand based on idArity] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We compute demand signatures assuming idArity incoming arguments to approximate -behavior for when we have a call site with at least that many arguments. idArity -is /at least/ the number of manifest lambdas, but might be higher for PAPs and -trivial RHS (see Note [Demand analysis for trivial right-hand sides]). +Note [Demand signatures are computed for a threshold arity based on idArity] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Given a binding { f = rhs }, we compute a "theshold arity", and do demand +analysis based on a call with that many value arguments. -Because idArity of a function varies independently of its cardinality -properties (cf. Note [idArity varies independently of dmdTypeDepth]), we -implicitly encode the arity for when a demand signature is sound to unleash -in its 'dmdTypeDepth' (cf. Note [Understanding DmdType and DmdSig] in -GHC.Types.Demand). It is unsound to unleash a demand signature when the -incoming number of arguments is less than that. -See Note [What are demand signatures?] in GHC.Types.Demand for more details -on soundness. +The threshold we use is + +* Ordinary bindings: idArity f. + Why idArity arguments? Because that's a conservative estimate of how many + arguments we must feed a function before it does anything interesting with + them. Also it elegantly subsumes the trivial RHS and PAP case. + + idArity is /at least/ the number of manifest lambdas, but might be higher for + PAPs and trivial RHS (see Note [Demand analysis for trivial right-hand sides]). -Why idArity arguments? Because that's a conservative estimate of how many -arguments we must feed a function before it does anything interesting with them. -Also it elegantly subsumes the trivial RHS and PAP case. +* Join points: the value-binder subset of the JoinArity. This can + be less than the number of visible lambdas; e.g. + join j x = \y. blah + in ...(jump j 2)....(jump j 3).... + We know that j will never be applied to more than 1 arg (its join + arity, and we don't eta-expand join points, so here a threshold + of 1 is the best we can do. -There might be functions for which we might want to analyse for more incoming -arguments than idArity. Example: +Note that the idArity of a function varies independently of its cardinality +properties (cf. Note [idArity varies independently of dmdTypeDepth]), so we +implicitly encode the arity for when a demand signature is sound to unleash +in its 'dmdTypeDepth', not in its idArity (cf. Note [Understanding DmdType +and DmdSig] in GHC.Types.Demand). It is unsound to unleash a demand +signature when the incoming number of arguments is less than that. See +GHC.Types.Demand Note [What are demand signatures?] for more details on +soundness. + +Note that there might, in principle, be functions for which we might want to +analyse for more incoming arguments than idArity. Example: f x = if expensive @@ -1182,6 +1193,7 @@ strictness info for `y` (and more precise info on `x`) and possibly CPR information, but * We would no longer be able to unleash the signature at unary call sites + * Performing the worker/wrapper split based on this information would be implicitly eta-expanding `f`, playing fast and loose with divergence and even being unsound in the presence of newtypes, so we refrain from doing so. ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1787,6 +1787,7 @@ tryEtaExpandRhs env (BC_Join is_rec _) bndr rhs -- these are used to set the bndr's IdInfo (#15517) -- Note [Invariants on join points] invariant 2b, in GHC.Core where + -- See Note [Arity computation for join points] arity_type = case is_rec of NonRecursive -> cheapArityType rhs Recursive -> findRhsArity (seArityOpts env) Recursive @@ -1931,6 +1932,24 @@ CorePrep comes around, the code is very likely to look more like this: $j2 = if n > 0 then $j1 else (...) eta +Note [Arity computation for join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For /recursive/ join points we want the full glory of findRhsArity, +with its fixpont computation. Why? See GHC.Core.Opt.Arity +Note [Arity type for recursive join bindings]. + +But for /non-recursive/ join points, findRhsArity will call arityType. +And that can be expensive when we have deeply nested join points: + join j1 x1 = join j2 x2 = join j3 x3 = blah3 + in blah2 + in blah1 +(e.g. test T18698b). + +So we call cheapArityType instead. It's good enough for practical +purposes. + +(Side note: maybe we should use cheapArity for the RHS of let bindings +in the main arityType function.) ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa3ea6af2a48994875d0dd2d7b5933475dc5f455 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa3ea6af2a48994875d0dd2d7b5933475dc5f455 You're receiving 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 Aug 19 23:36:21 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 Aug 2022 19:36:21 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Crucial wibble Message-ID: <63001e757073_125b2b150e154038030@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: ecd80bb3 by Simon Peyton Jones at 2022-08-20T00:36:43+01:00 Crucial wibble - - - - - 1 changed file: - compiler/GHC/Core/Opt/Arity.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -1457,7 +1457,7 @@ cheapArityType e = go e go (Cast e _) = go e go (Lam x e) | isId x = arityLam x (go e) | otherwise = go e - go (App f a) | isTypeArg a = go f + go (App e a) | isTypeArg a = go e | otherwise = arity_app a (go e) go (Tick t e) | not (tickishIsCode t) = go e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecd80bb34aeb7fa15cd7892aae69a7a374005302 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecd80bb34aeb7fa15cd7892aae69a7a374005302 You're receiving 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 Aug 20 01:56:27 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 21:56:27 -0400 Subject: [Git][ghc/ghc][ghc-9.4] 2 commits: Fix GHCis interaction with tag inference. Message-ID: <63003f4bd1c43_125b2b488143876c7@gitlab.mail> Ben Gamari pushed to branch ghc-9.4 at Glasgow Haskell Compiler / GHC Commits: 0868c8a5 by Andreas Klebinger at 2022-08-19T10:21:04-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - b9ed1a48 by Matthew Pickering at 2022-08-19T16:31:33-04:00 Update haddock submodule to revert quickjump breakage Fixes #21984 - - - - - 20 changed files: - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/InferTags/TagSig.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Name/Set.hs - testsuite/tests/ghci.debugger/scripts/T12458.stdout - testsuite/tests/ghci.debugger/scripts/print018.stdout - testsuite/tests/simplStg/should_run/Makefile - + testsuite/tests/simplStg/should_run/T22042.hs - + testsuite/tests/simplStg/should_run/T22042.stdout - + testsuite/tests/simplStg/should_run/T22042a.hs - testsuite/tests/simplStg/should_run/all.T - utils/haddock Changes: ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -26,11 +26,9 @@ import GHC.Runtime.Heap.Layout (isStackRep) import GHC.Settings (Platform, platformUnregisterised) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) -import GHC.Stg.InferTags.TagSig (TagSig) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) -import GHC.Types.Name.Env (NameEnv) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module) import GHC.Utils.Misc @@ -180,8 +178,8 @@ The find the tick: remembered in a `Maybe`. -} -generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> NameEnv TagSig -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CgInfos -generateCgIPEStub hsc_env this_mod denv tag_sigs s = do +generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CmmCgInfos +generateCgIPEStub hsc_env this_mod denv s = do let dflags = hsc_dflags hsc_env platform = targetPlatform dflags fstate = initFCodeState platform @@ -198,7 +196,7 @@ generateCgIPEStub hsc_env this_mod denv tag_sigs s = do (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline hsc_env (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - return CgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub, cgTagSigs = tag_sigs} + return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub} where collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) collect platform acc cmmGroupSRTs = do ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -172,15 +172,14 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Stg.Syntax -import GHC.Stg.Pipeline ( stg2stg ) -import GHC.Stg.InferTags +import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) import GHC.Builtin.Utils import GHC.Builtin.Names import GHC.Builtin.Uniques ( mkPseudoUniqueE ) import qualified GHC.StgToCmm as StgToCmm ( codeGen ) -import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) import GHC.Cmm import GHC.Cmm.Parser ( parseCmmFile ) @@ -253,6 +252,8 @@ import GHC.Driver.Env.KnotVars import GHC.Types.Name.Set (NonCaffySet) import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub) import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Types.Unique.FM {- ********************************************************************** @@ -1613,7 +1614,7 @@ hscSimpleIface' tc_result summary = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe CgInfos) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe StgCgInfos, Maybe CmmCgInfos ) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1658,11 +1659,16 @@ hscGenHardCode hsc_env cgguts location output_filename = do late_cc_binds data_tycons ----------------- Convert to STG ------------------ - (stg_binds, denv, (caf_ccs, caf_cc_stacks)) + (stg_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) - (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ()) + (\(a, b, (c,d), tag_env) -> + a `seqList` + b `seq` + c `seqList` + d `seqList` + (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) let cost_centre_info = @@ -1701,11 +1707,12 @@ hscGenHardCode hsc_env cgguts location output_filename = do let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init `appendStubC` cgIPEStub st - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cg_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos) <- {-# SCC "codeOutput" #-} codeOutput logger tmpfs dflags (hsc_units hsc_env) this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, Just cg_infos) + return ( output_filename, stub_c_exists, foreign_fps + , Just stg_cg_infos, Just cmm_cg_infos) hscInteractive :: HscEnv @@ -1735,7 +1742,9 @@ hscInteractive hsc_env cgguts location = do prepd_binds <- {-# SCC "CorePrep" #-} corePrepPgm hsc_env this_mod location core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + -- 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) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds ----------------- Generate byte code ------------------ @@ -1826,7 +1835,7 @@ doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -> HpcInfo - -> IO (Stream IO CmmGroupSRTs CgInfos) + -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1837,13 +1846,10 @@ doCodeGen hsc_env this_mod denv data_tycons hooks = hsc_hooks hsc_env tmpfs = hsc_tmpfs hsc_env platform = targetPlatform dflags - - -- Do tag inference on optimized STG - (!stg_post_infer,export_tag_info) <- - {-# SCC "StgTagFields" #-} inferTags dflags logger this_mod stg_binds_w_fvs + stg_ppr_opts = (initStgPprOpts dflags) putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_post_infer) + (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs) let stg_to_cmm dflags mod = case stgToCmmHook hooks of Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) @@ -1851,8 +1857,8 @@ doCodeGen hsc_env this_mod denv data_tycons let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] - cmm_stream = stg_post_infer `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_post_infer hpc_info + cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} + stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -1881,7 +1887,7 @@ doCodeGen hsc_env this_mod denv data_tycons putDumpFileMaybe logger Opt_D_dump_cmm "Output Cmm" FormatCMM (pdoc platform a) return a - return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv export_tag_info pipeline_stream + return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv pipeline_stream myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> Bool @@ -1889,7 +1895,8 @@ myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext -> IO ( Id , [CgStgTopBinding] , InfoTableProvMap - , CollectedCCs ) + , CollectedCCs + , StgCgInfos ) myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} @@ -1897,7 +1904,7 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do (mkPseudoUniqueE 0) Many (exprType prepd_expr) - (stg_binds, prov_map, collected_ccs) <- + (stg_binds, prov_map, collected_ccs, stg_cg_infos) <- myCoreToStg logger dflags ictxt @@ -1905,20 +1912,21 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do this_mod ml [NonRec bco_tmp_id prepd_expr] - return (bco_tmp_id, stg_binds, prov_map, collected_ccs) + return (bco_tmp_id, stg_binds, prov_map, collected_ccs, stg_cg_infos) myCoreToStg :: Logger -> DynFlags -> InteractiveContext -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap - , CollectedCCs ) -- CAF cost centre info (declared and used) + , CollectedCCs -- CAF cost centre info (declared and used) + , StgCgInfos ) myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds - stg_binds_with_fvs + (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} stg2stg logger ictxt (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds @@ -1926,7 +1934,7 @@ myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) - return (stg_binds_with_fvs, denv, cost_centre_info) + return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) {- ********************************************************************** %* * @@ -2072,7 +2080,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do prepd_binds <- {-# SCC "CorePrep" #-} liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks) + (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2298,7 +2306,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } ; let ictxt = hsc_IC hsc_env - ; (binding_id, stg_expr, _, _) <- + ; (binding_id, stg_expr, _, _, _stg_cg_info) <- myCoreToStgExpr (hsc_logger hsc_env) (hsc_dflags hsc_env) ictxt ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -735,7 +735,7 @@ hscBackendPipeline pipe_env hsc_env mod_sum result = NoBackend -> case result of HscUpdate iface -> return (iface, Nothing) - HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing + HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing) <*> pure Nothing -- TODO: Why is there not a linkable? -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing _ -> do ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -503,7 +503,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do Interpreter -> do -- In interpreted mode the regular codeGen backend is not run so we -- generate a interface without codeGen info. - final_iface <- mkFullIface hsc_env partial_iface Nothing + final_iface <- mkFullIface hsc_env partial_iface Nothing Nothing hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location @@ -521,9 +521,9 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do return ([], final_iface, Just linkable, panic "interpreter") _ -> do output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location) - (outputFilename, mStub, foreign_files, mb_cg_infos) <- + (outputFilename, mStub, foreign_files, mb_stg_infos, mb_cg_infos) <- hscGenHardCode hsc_env cgguts mod_location output_fn - final_iface <- mkFullIface hsc_env partial_iface mb_cg_infos + final_iface <- mkFullIface hsc_env partial_iface mb_stg_infos mb_cg_infos -- See Note [Writing interface files] hscMaybeWriteIface logger dflags False final_iface mb_old_iface_hash mod_location ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Prelude import GHC.Hs -import GHC.StgToCmm.Types (CgInfos (..)) +import GHC.StgToCmm.Types (CmmCgInfos (..)) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad @@ -98,6 +98,7 @@ import Data.Function import Data.List ( findIndex, mapAccumL, sortBy ) import Data.Ord import Data.IORef +import GHC.Stg.Pipeline (StgCgInfos) {- @@ -133,16 +134,16 @@ mkPartialIface hsc_env mod_details mod_summary -- | Fully instantiate an interface. Adds fingerprints and potentially code -- generator produced information. -- --- CgInfos is not available when not generating code (-fno-code), or when not +-- CmmCgInfos is not available when not generating code (-fno-code), or when not -- generating interface pragmas (-fomit-interface-pragmas). See also -- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types. -mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface -mkFullIface hsc_env partial_iface mb_cg_infos = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface +mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDecl (mi_decls partial_iface) mb_cg_infos + = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -155,11 +156,16 @@ mkFullIface hsc_env partial_iface mb_cg_infos = do return full_iface -updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl] -updateDecl decls Nothing = decls -updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos, cgTagSigs = tag_sigs }) +updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl] +updateDecl decls Nothing Nothing = decls +updateDecl decls m_stg_infos m_cmm_infos = map update_decl decls where + (non_cafs,lf_infos) = maybe (mempty, mempty) + (\cmm_info -> (ncs_nameSet (cgNonCafs cmm_info), cgLFInfos cmm_info)) + m_cmm_infos + tag_sigs = fromMaybe mempty m_stg_infos + update_decl (IfaceId nm ty details infos) | let not_caffy = elemNameSet nm non_cafs , let mb_lf_info = lookupNameEnv lf_infos nm @@ -177,6 +183,9 @@ updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf update_decl decl = decl + + + -- | Make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any -- object code at all ('NoBackend'). @@ -230,7 +239,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary docs mod_summary mod_details - mkFullIface hsc_env partial_iface Nothing + mkFullIface hsc_env partial_iface Nothing Nothing mkIface_ :: HscEnv -> Module -> HscSource -> Bool -> Dependencies -> GlobalRdrEnv ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Stg.InferTags.Types import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) import Data.Maybe import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.Config.Stg.Ppr import GHC.Driver.Session import GHC.Utils.Logger import qualified GHC.Unit.Types @@ -217,17 +216,17 @@ the output of itself. -- -> CollectedCCs -- -> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs -- -> HpcInfo --- -> IO (Stream IO CmmGroupSRTs CgInfos) +-- -> IO (Stream IO CmmGroupSRTs CmmCgInfos) -- -- Note we produce a 'Stream' of CmmGroups, so that the -- -- backend can be run incrementally. Otherwise it generates all -- -- the C-- up front, which has a significant space cost. -inferTags :: DynFlags -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags dflags logger this_mod stg_binds = do +inferTags :: StgPprOpts -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +inferTags ppr_opts logger this_mod stg_binds = do -- Annotate binders with tag information. let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} inferTagsAnal stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_w_tags) + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) let export_tag_info = collectExportInfo stg_binds_w_tags ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, isInteractiveModule) import GHC.Core.DataCon import GHC.Core (AltCon(..) ) @@ -212,16 +212,55 @@ withLcl fv act = do setFVs old_fvs return r +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When compiling bytecode we call myCoreToStg to get STG code first. +myCoreToStg in turn calls out to stg2stg which runs the STG to STG +passes followed by free variables analysis and tag inference at the end. +Running tag inference is important as it upholds Note [Strict Field Invariant]. +While code executed by GHCi doesn't take advantage of the SFI it can call into +compiled code which does. So it must still make sure that the SFI is upheld. +See also #21083 and #22042. + +However there one important difference in code generation for GHCi and regular +compilation. When compiling an entire module (not a GHCi expression), we call +`stg2stg` on the entire module which allows us to build up a map which is guaranteed +to have an entry for every binder in the current module. +For non-interactive compilation the tag inference rewrite pass takes advantage +of this by building up a map from binders to their tag signatures. + +When compiling a GHCi expression on the other hand we invoke stg2stg separately +for each expression on the prompt. This means in GHCi for a sequence of: + > let x = True + > let y = StrictJust x +We first run stg2stg for `[x = True]`. And then again for [y = StrictJust x]`. + +While computing the tag signature for `y` during tag inference inferConTag will check +if `x` is already tagged by looking up the tagsig of `x` in the binder->signature mapping. +However since this mapping isn't persistent between stg2stg +invocations the lookup will fail. This isn't a correctness issue since it's always +safe to assume a binding isn't tagged and that's what we do in such cases. + +However for non-interactive mode we *don't* want to do this. Since in non-interactive mode +we have all binders of the module available for each invocation we can expect the binder->signature +mapping to be complete and all lookups to succeed. This means in non-interactive contexts a failed lookup +indicates a bug in the tag inference implementation. +For this reason we assert that we are running in interactive mode if a lookup fails. +-} isTagged :: Id -> RM Bool isTagged v = do this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) case nameIsLocalOrFrom this_mod (idName v) of True | isUnliftedType (idType v) -> return True | otherwise -> do -- Local binding !s <- getMap - let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v + let !sig = lookupWithDefaultUFM s (lookupDefault v) v return $ case sig of TagSig info -> case info of ===================================== compiler/GHC/Stg/InferTags/TagSig.hs ===================================== @@ -16,6 +16,7 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +65,12 @@ isTaggedSig :: TagSig -> Bool isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis \ No newline at end of file ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Stg.Pipeline ( StgPipelineOpts (..) , StgToDo (..) , stg2stg + , StgCgInfos ) where import GHC.Prelude @@ -38,6 +39,9 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) +import GHC.Stg.InferTags (inferTags) +import GHC.Types.Name.Env (NameEnv) +import GHC.Stg.InferTags.TagSig (TagSig) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -51,6 +55,10 @@ data StgPipelineOpts = StgPipelineOpts newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Information to be exposed in interface files which is produced +-- by the stg2stg passes. +type StgCgInfos = NameEnv TagSig + instance MonadUnique StgM where getUniqueSupplyM = StgM $ do { mask <- ask ; liftIO $! mkSplitUniqSupply mask} @@ -65,7 +73,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- module being compiled -> [StgTopBinding] -- input program - -> IO [CgStgTopBinding] -- output program + -> IO ([CgStgTopBinding], StgCgInfos) -- output program stg2stg logger ictxt opts this_mod binds = do { dump_when Opt_D_dump_stg_from_core "Initial STG:" binds ; showPass logger "Stg2Stg" @@ -84,7 +92,8 @@ stg2stg logger ictxt opts this_mod binds -- 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' - ; return binds_sorted_with_fvs + -- See Note [Tag inference for interactive contexts] + ; inferTags (stgPipeline_pprOpts opts) logger this_mod binds_sorted_with_fvs } where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1669,10 +1669,21 @@ pushAtom d p (StgVarArg var) case lookupVarEnv topStrings var of Just ptr -> pushAtom d p $ StgLitArg $ mkLitWord platform $ fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr - Nothing -> do - let sz = idSizeCon platform var - massert (sz == wordSize platform) - return (unitOL (PUSH_G (getName var)), sz) + Nothing + -- PUSH_G doesn't tag constructors. So we use PACK here + -- if we are dealing with nullary constructor. + | Just con <- isDataConWorkId_maybe var + -> do + massert (sz == wordSize platform) + massert (isNullaryRepDataCon con) + return (unitOL (PACK con 0), sz) + | otherwise + -> do + let + massert (sz == wordSize platform) + return (unitOL (PUSH_G (getName var)), sz) + where + !sz = idSizeCon platform var pushAtom _ _ (StgLitArg lit) = pushLiteral True lit ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -1,7 +1,7 @@ module GHC.StgToCmm.Types - ( CgInfos (..) + ( CmmCgInfos (..) , LambdaFormInfo (..) , ModuleLFInfos , StandardFormInfo (..) @@ -13,8 +13,6 @@ import GHC.Prelude import GHC.Core.DataCon -import GHC.Stg.InferTags.TagSig - import GHC.Runtime.Heap.Layout import GHC.Types.Basic @@ -85,7 +83,7 @@ moving parts are: -- -- See also Note [Conveying CAF-info and LFInfo between modules] above. -- -data CgInfos = CgInfos +data CmmCgInfos = CmmCgInfos { cgNonCafs :: !NonCaffySet -- ^ Exported Non-CAFFY closures in the current module. Everything else is -- either not exported of CAFFY. @@ -93,7 +91,6 @@ data CgInfos = CgInfos -- ^ LambdaFormInfos of exported closures in the current module. , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information - , cgTagSigs :: !(NameEnv TagSig) } -------------------------------------------------------------------------------- ===================================== compiler/GHC/Types/Name/Set.hs ===================================== @@ -220,5 +220,5 @@ findUses dus uses -- | 'Id's which have no CAF references. This is a result of analysis of C--. -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note. -newtype NonCaffySet = NonCaffySet NameSet +newtype NonCaffySet = NonCaffySet { ncs_nameSet :: NameSet } deriving (Semigroup, Monoid) ===================================== testsuite/tests/ghci.debugger/scripts/T12458.stdout ===================================== @@ -1,2 +1,2 @@ -d = (_t1::forall {k} {a :: k}. D a) +d = () ===================================== testsuite/tests/ghci.debugger/scripts/print018.stdout ===================================== @@ -1,9 +1,9 @@ Breakpoint 0 activated at Test.hs:40:10-17 Stopped in Test.Test2.poly, Test.hs:40:10-17 _result :: () = _ -x :: a = _ -x = (_t1::a) -x :: a +x :: Unary = Unary +x = Unary +x :: Unary () x = Unary x :: Unary ===================================== testsuite/tests/simplStg/should_run/Makefile ===================================== @@ -1,3 +1,12 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T22042: T22042_clean + "$(TEST_HC)" $(TEST_HC_OPTS) -O T22042a.hs -dynamic -c + "$(TEST_HC)" $(TEST_HC_OPTS) -e ":main" T22042.hs T22042a.o + +T22042_clean: + rm -f T22042a.o T22042a.hi + +.PHONY: T22042 T22042_clean ===================================== testsuite/tests/simplStg/should_run/T22042.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import T22042a + +main = do + putStrLn (foo $ SC A B C) ===================================== testsuite/tests/simplStg/should_run/T22042.stdout ===================================== @@ -0,0 +1 @@ +ABC ===================================== testsuite/tests/simplStg/should_run/T22042a.hs ===================================== @@ -0,0 +1,10 @@ +module T22042a where + +data A = A | AA deriving Show +data B = B | AB deriving Show +data C = C | AC deriving Show + +data SC = SC !A !B !C + +foo :: SC -> String +foo (SC a b c) = show a ++ show b ++ show c ===================================== testsuite/tests/simplStg/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('T13536a', ['']) test('inferTags001', normal, multimod_compile_and_run, ['inferTags001', 'inferTags001_a']) +test('T22042', [extra_files(['T22042a.hs']),only_ways('normal'),unless(have_dynamic(), skip)], makefile_test, ['T22042']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit f07a4059efcde05fd26b33a8c902930d3ad90379 +Subproject commit 421e4c36e58cae686d55a99946d5fa54abaa6000 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed84e10b0d2cf107a2858f1dfc0698d0e71bdd4f...b9ed1a481f6163f46e902c71e58f2e3143bf8914 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed84e10b0d2cf107a2858f1dfc0698d0e71bdd4f...b9ed1a481f6163f46e902c71e58f2e3143bf8914 You're receiving 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 Aug 20 01:56:25 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 21:56:25 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.4 Message-ID: <63003f498d96_125b2b5025838757b@gitlab.mail> Ben Gamari deleted branch wip/backports-9.4 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 Sat Aug 20 01:57:17 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 21:57:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.4 Message-ID: <63003f7dd635e_125b2b150df6f03878b7@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.4 You're receiving 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 Aug 20 03:21:03 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 23:21:03 -0400 Subject: [Git][ghc/ghc][wip/T22077] 2 commits: Refactor IPE initialization Message-ID: <6300531fcd936_125b2b150df6dc390591@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: c0d18614 by Ben Gamari at 2022-08-19T23:19:29-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - ebc644c1 by Ben Gamari at 2022-08-19T23:19:29-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 23 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/ghc.cabal.in - libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/Stack/CloneStack.hs - rts/IPE.c - rts/IPE.h - rts/RtsStartup.c - rts/Trace.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - rts/include/stg/SMP.h - testsuite/tests/rts/all.T - testsuite/tests/rts/ipeEventLog.c - testsuite/tests/rts/ipeEventLog.stderr - testsuite/tests/rts/ipeEventLog_fromMap.c - testsuite/tests/rts/ipeEventLog_fromMap.stderr - testsuite/tests/rts/ipeEventLog_lib.c - + testsuite/tests/rts/ipeEventLog_lib.h Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -299,6 +299,7 @@ data ModuleLabelKind | MLK_InitializerArray | MLK_Finalizer String | MLK_FinalizerArray + | MLK_IPEBuffer deriving (Eq, Ord) instance Outputable ModuleLabelKind where @@ -306,6 +307,7 @@ instance Outputable ModuleLabelKind where ppr (MLK_Initializer s) = text ("init__" ++ s) ppr MLK_FinalizerArray = text "fini_arr" ppr (MLK_Finalizer s) = text ("fini__" ++ s) + ppr MLK_IPEBuffer = text "ipe_buf" isIdLabel :: CLabel -> Bool isIdLabel IdLabel{} = True @@ -830,10 +832,10 @@ instance OutputableP Platform InfoProvEnt where -- Constructing Cost Center Labels mkCCLabel :: CostCentre -> CLabel mkCCSLabel :: CostCentreStack -> CLabel -mkIPELabel :: InfoProvEnt -> CLabel +mkIPELabel :: Module -> CLabel mkCCLabel cc = CC_Label cc mkCCSLabel ccs = CCS_Label ccs -mkIPELabel ipe = IPE_Label ipe +mkIPELabel mod = ModuleLabel mod MLK_IPEBuffer mkRtsApFastLabel :: FastString -> CLabel mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str)) @@ -1011,6 +1013,7 @@ modLabelNeedsCDecl :: ModuleLabelKind -> Bool -- Code for finalizers and initializers are emitted in stub objects modLabelNeedsCDecl (MLK_Initializer _) = True modLabelNeedsCDecl (MLK_Finalizer _) = True +modLabelNeedsCDecl MLK_IPEBuffer = True -- The finalizer and initializer arrays are emitted in the code of the module modLabelNeedsCDecl MLK_InitializerArray = False modLabelNeedsCDecl MLK_FinalizerArray = False @@ -1208,6 +1211,7 @@ moduleLabelKindType kind = MLK_InitializerArray -> DataLabel MLK_Finalizer _ -> CodeLabel MLK_FinalizerArray -> DataLabel + MLK_IPEBuffer -> DataLabel idInfoLabelType :: IdLabelInfo -> CLabelType idInfoLabelType info = ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -224,6 +224,7 @@ import GHC.StgToCmm.Layout hiding (ArgRep(..)) import GHC.StgToCmm.Ticky import GHC.StgToCmm.Prof import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame ) +import GHC.StgToCmm.InfoTableProv import GHC.Cmm.Opt import GHC.Cmm.Graph @@ -1518,9 +1519,8 @@ parseCmmFile cmmpConfig this_mod home_unit filename = do let fcode = do ((), cmm) <- getCmm $ unEC code "global" (initEnv (pdProfile pdConfig)) [] >> return () -- See Note [Mapping Info Tables to Source Positions] (IPE Maps) - let used_info = map (cmmInfoTableToInfoProvEnt this_mod) - (mapMaybe topInfoTable cmm) - ((), cmm2) <- getCmm $ mapM_ emitInfoTableProv used_info + let used_info = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTable cmm) + ((), cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info return (cmm ++ cmm2, used_info) (cmm, _) = runC (cmmpStgToCmmConfig cmmpConfig) fstate st fcode (warnings,errors) = getPsMessages pst ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -368,24 +368,17 @@ ipInitCode :: Bool -- is Opt_InfoTableMap enabled or not -> Platform -> Module - -> [InfoProvEnt] -> CStub -ipInitCode do_info_table platform this_mod ents +ipInitCode do_info_table platform this_mod | not do_info_table = mempty - | otherwise = initializerCStub platform fn_nm decls body + | otherwise = initializerCStub platform fn_nm ipe_buffer_decl body where fn_nm = mkInitializerStubLabel this_mod "ip_init" - decls = vcat - $ map emit_ipe_decl ents - ++ [emit_ipe_list ents] - body = text "registerInfoProvList" <> parens local_ipe_list_label <> semi - emit_ipe_decl ipe = - text "extern InfoProvEnt" <+> ipe_lbl <> text "[];" - where ipe_lbl = pprCLabel platform CStyle (mkIPELabel ipe) - local_ipe_list_label = text "local_ipe_" <> ppr this_mod - emit_ipe_list ipes = - text "static InfoProvEnt *" <> local_ipe_list_label <> text "[] =" - <+> braces (vcat $ [ pprCLabel platform CStyle (mkIPELabel ipe) <> comma - | ipe <- ipes - ] ++ [text "NULL"]) - <> semi + + body = text "registerInfoProvList" <> parens (text "&" <> ipe_buffer_label) <> semi + + ipe_buffer_label = pprCLabel platform CStyle (mkIPELabel this_mod) + + ipe_buffer_decl = + text "extern IpeBufferListNode" <+> ipe_buffer_label <> text ";" + ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1830,7 +1830,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs mod_name = mkModuleName $ "Cmm$" ++ original_filename cmm_mod = mkHomeModule home_unit mod_name cmmpConfig = initCmmParserConfig dflags - (cmm, ents) <- ioMsgMaybe + (cmm, _ents) <- ioMsgMaybe $ do (warns,errs,cmm) <- withTiming logger (text "ParseCmm"<+>brackets (text filename)) (\_ -> ()) $ parseCmmFile cmmpConfig cmm_mod home_unit filename @@ -1857,7 +1857,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs Just h -> h dflags Nothing (Stream.yield cmmgroup) let foreign_stubs _ = - let ip_init = ipInitCode do_info_table platform cmm_mod ents + let ip_init = ipInitCode do_info_table platform cmm_mod in NoStubs `appendStubC` ip_init (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -0,0 +1,143 @@ +module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where + +import GHC.Prelude +import GHC.Platform +import GHC.Unit.Module +import GHC.Utils.Outputable +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) +import GHC.Data.FastString (unpackFS) + +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 + +emitIpeBufferListNode :: Module + -> [InfoProvEnt] + -> FCode () +emitIpeBufferListNode this_mod ents = do + cfg <- getStgToCmmConfig + let ctx = stgToCmmContext cfg + platform = stgToCmmPlatform cfg + + 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 + +toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt +toCgIPE platform ctx module_name ipe = do + table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (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 (src_loc_file, src_loc_span) = + case infoTableProv ipe of + Nothing -> ("", "") + Just (span, _) -> + let file = unpackFS $ srcSpanFile span + coords = renderWithContext ctx (pprUserRealSpan False span) + in (file, coords) + label <- lookupStringTable $ ST.pack label_str + src_file <- lookupStringTable $ ST.pack src_loc_file + src_span <- lookupStringTable $ ST.pack src_loc_span + return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe + , ipeTableName = table_name + , ipeClosureDesc = closure_desc + , ipeTypeDesc = type_desc + , ipeLabel = label + , ipeModuleName = module_name + , ipeSrcFile = src_file + , ipeSrcSpan = src_span + } + +data CgInfoProvEnt = CgInfoProvEnt + { ipeInfoTablePtr :: !CLabel + , ipeTableName :: !StrTabOffset + , ipeClosureDesc :: !StrTabOffset + , ipeTypeDesc :: !StrTabOffset + , ipeLabel :: !StrTabOffset + , ipeModuleName :: !StrTabOffset + , ipeSrcFile :: !StrTabOffset + , ipeSrcSpan :: !StrTabOffset + } + +data StringTable = StringTable { stStrings :: DList ShortText + , stLength :: !Int + , stLookup :: !(M.Map ShortText StrTabOffset) + } + +newtype StrTabOffset = StrTabOffset Int + +emptyStringTable :: StringTable +emptyStringTable = + StringTable { stStrings = emptyDList + , stLength = 0 + , stLookup = M.empty + } + +getStringTableStrings :: StringTable -> BS.ByteString +getStringTableStrings st = + BSL.toStrict $ BSB.toLazyByteString + $ foldMap f $ dlistToList (stStrings st) + where + f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0 + +lookupStringTable :: ShortText -> State StringTable StrTabOffset +lookupStringTable str = state $ \st -> + case M.lookup str (stLookup st) of + Just off -> (off, st) + Nothing -> + let !st' = st { stStrings = stStrings st `snoc` str + , stLength = stLength st + ST.byteLength str + 1 + , stLookup = M.insert str res (stLookup st) + } + res = StrTabOffset (stLength st) + in (res, st') + +newtype DList a = DList ([a] -> [a]) + +emptyDList :: DList a +emptyDList = DList id + +snoc :: DList a -> a -> DList a +snoc (DList f) x = DList (f . (x:)) + +dlistToList :: DList a -> [a] +dlistToList (DList f) = f [] ===================================== compiler/GHC/StgToCmm/Prof.hs ===================================== @@ -11,7 +11,7 @@ module GHC.StgToCmm.Prof ( mkCCostCentre, mkCCostCentreStack, -- infoTablePRov - initInfoTableProv, emitInfoTableProv, + initInfoTableProv, -- Cost-centre Profiling dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf, @@ -32,6 +32,7 @@ import GHC.Platform import GHC.Platform.Profile import GHC.StgToCmm.Closure import GHC.StgToCmm.Config +import GHC.StgToCmm.InfoTableProv import GHC.StgToCmm.Utils import GHC.StgToCmm.Monad import GHC.StgToCmm.Lit @@ -55,7 +56,6 @@ import GHC.Utils.Encoding import Control.Monad import Data.Char (ord) -import Data.Bifunctor (first) import GHC.Utils.Monad (whenM) ----------------------------------------------------------------------------- @@ -274,9 +274,8 @@ sizeof_ccs_words platform where (ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform - +-- | Emit info-table provenance declarations initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode CStub --- Emit the declarations initInfoTableProv infos itmap = do cfg <- getStgToCmmConfig @@ -284,42 +283,16 @@ initInfoTableProv infos itmap info_table = stgToCmmInfoTableMap cfg platform = stgToCmmPlatform cfg this_mod = stgToCmmThisModule cfg - -- Output the actual IPE data - mapM_ emitInfoTableProv ents - -- Create the C stub which initialises the IPE map - return (ipInitCode info_table platform this_mod ents) - ---- Info Table Prov stuff -emitInfoTableProv :: InfoProvEnt -> FCode () -emitInfoTableProv ip = do - { cfg <- getStgToCmmConfig - ; let mod = infoProvModule ip - ctx = stgToCmmContext cfg - platform = stgToCmmPlatform cfg - ; let (src, label) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ip) - mk_string = newByteStringCLit . utf8EncodeByteString - ; label <- mk_string label - ; modl <- newByteStringCLit (bytesFS $ moduleNameFS - $ moduleName mod) - - ; ty_string <- mk_string (infoTableType ip) - ; loc <- mk_string src - ; table_name <- mk_string (renderWithContext ctx - (pprCLabel platform CStyle (infoTablePtr ip))) - ; closure_type <- mk_string (renderWithContext ctx - (text $ show $ infoProvEntClosureType ip)) - ; let - lits = [ CmmLabel (infoTablePtr ip), -- Info table pointer - table_name, -- char *table_name - closure_type, -- char *closure_desc -- Filled in from the InfoTable - ty_string, -- char *ty_string - label, -- char *label, - modl, -- char *module, - loc, -- char *srcloc, - zero platform -- struct _InfoProvEnt *link - ] - ; emitDataLits (mkIPELabel ip) lits - } + + case ents of + [] -> return mempty + _ -> do + -- Emit IPE buffer + emitIpeBufferListNode this_mod ents + + -- Create the C stub which initialises the IPE map + return (ipInitCode info_table platform this_mod) + -- --------------------------------------------------------------------------- -- Set the current cost centre stack ===================================== compiler/ghc.cabal.in ===================================== @@ -615,6 +615,7 @@ Library GHC.StgToCmm.Foreign GHC.StgToCmm.Heap GHC.StgToCmm.Hpc + GHC.StgToCmm.InfoTableProv GHC.StgToCmm.Layout GHC.StgToCmm.Lit GHC.StgToCmm.Monad ===================================== libraries/base/GHC/InfoProv.hsc ===================================== @@ -20,6 +20,7 @@ module GHC.InfoProv ( InfoProv(..) + , ipLoc , ipeProv , whereFrom -- * Internals @@ -42,10 +43,15 @@ data InfoProv = InfoProv { ipTyDesc :: String, ipLabel :: String, ipMod :: String, - ipLoc :: String + ipSrcFile :: String, + ipSrcSpan :: String } deriving (Eq, Show) + data InfoProvEnt +ipLoc :: InfoProv -> String +ipLoc ipe = ipSrcFile ipe ++ ":" ++ ipSrcSpan ipe + getIPE :: a -> IO (Ptr InfoProvEnt) getIPE obj = IO $ \s -> case whereFrom## obj s of @@ -54,13 +60,14 @@ getIPE obj = IO $ \s -> ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv ipeProv p = (#ptr InfoProvEnt, prov) p -peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString -peekIpName p = (# peek InfoProv, table_name) p -peekIpDesc p = (# peek InfoProv, closure_desc) p -peekIpLabel p = (# peek InfoProv, label) p -peekIpModule p = (# peek InfoProv, module) p -peekIpSrcLoc p = (# peek InfoProv, srcloc) p -peekIpTyDesc p = (# peek InfoProv, ty_desc) p +peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString +peekIpName p = (# peek InfoProv, table_name) p +peekIpDesc p = (# peek InfoProv, closure_desc) p +peekIpLabel p = (# peek InfoProv, label) p +peekIpModule p = (# peek InfoProv, module) p +peekIpSrcFile p = (# peek InfoProv, src_file) p +peekIpSrcSpan p = (# peek InfoProv, src_span) p +peekIpTyDesc p = (# peek InfoProv, ty_desc) p peekInfoProv :: Ptr InfoProv -> IO InfoProv peekInfoProv infop = do @@ -69,14 +76,16 @@ peekInfoProv infop = do tyDesc <- peekCString utf8 =<< peekIpTyDesc infop label <- peekCString utf8 =<< peekIpLabel infop mod <- peekCString utf8 =<< peekIpModule infop - loc <- peekCString utf8 =<< peekIpSrcLoc infop + file <- peekCString utf8 =<< peekIpSrcFile infop + span <- peekCString utf8 =<< peekIpSrcSpan infop return InfoProv { ipName = name, ipDesc = desc, ipTyDesc = tyDesc, ipLabel = label, ipMod = mod, - ipLoc = loc + ipSrcFile = file, + ipSrcSpan = span } -- | Get information about where a value originated from. ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -28,7 +28,7 @@ import Foreign import GHC.Conc.Sync import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) import GHC.IO (IO (..)) -import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv) +import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable -- | A frozen snapshot of the state of an execution stack. ===================================== rts/IPE.c ===================================== @@ -34,17 +34,22 @@ Unfortunately, inserting into the hash map is relatively expensive. To keep startup times low, there's a temporary data structure that is optimized for collecting IPE lists on registration. -It's a singly linked list of IPE list buffers. Each buffer contains space for -126 IPE lists. This number is a bit arbitrary, but leaves a few bytes so that -the whole structure might fit into 1024 bytes. - -On registering a new IPE list, there are three cases: - -- It's the first entry at all: Allocate a new IpeBufferListNode and make it the - buffer's first entry. -- The current IpeBufferListNode has space in it's buffer: Add it to the buffer. -- The current IpeBufferListNode's buffer is full: Allocate a new one and link it -to the previous one, making this one the new current. +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. + +For reasons of space efficiency, IPE entries are represented slightly +differently in the object file than the InfoProvEnt which we ultimately expose +to the user. Specifically, the IPEs in IpeBufferListNode are represented by +IpeBufferEntrys, along with a corresponding string table. The string fields +of InfoProvEnt are represented in IpeBufferEntry as 32-bit offsets into the +string table. This allows us to halve the size of the buffer entries on +64-bit machines while significantly reducing the number of needed +relocations, reducing linking cost. Moreover, the code generator takes care +to deduplicate strings when generating the string table. When we inserting a +set of IpeBufferEntrys into the IPE hash-map we convert them to InfoProvEnts, +which contain proper string pointers. Building the hash map is done lazily, i.e. on first lookup or traversal. For this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. @@ -52,43 +57,56 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. After the content of a IpeBufferListNode has been inserted, it's freed. */ +static Mutex ipeMapLock; static HashTable *ipeMap = NULL; +// Accessed atomically static IpeBufferListNode *ipeBufferList = NULL; -static Mutex ipeMapLock; - -void initIpeMapLock(void) { initMutex(&ipeMapLock); } - -void closeIpeMapLock(void) { closeMutex(&ipeMapLock); } +void initIpe(void) { initMutex(&ipeMapLock); } + +void exitIpe(void) { closeMutex(&ipeMapLock); } + +static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) +{ + const char *strings = node->string_table; + return (InfoProvEnt) { + .info = ent->info, + .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] + } + }; +} #if defined(TRACING) -static void traceIPEFromHashTable(void *data STG_UNUSED, - StgWord key STG_UNUSED, +static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, const void *value) { InfoProvEnt *ipe = (InfoProvEnt *)value; traceIPE(ipe); } void dumpIPEToEventLog(void) { - ACQUIRE_LOCK(&ipeMapLock); - - IpeBufferListNode *cursor = ipeBufferList; + // Dump pending entries + IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList); while (cursor != NULL) { - for (int i = 0; i < cursor->count; i++) { - for (InfoProvEnt **ipeList = cursor->buffer[i]; *ipeList != NULL; ipeList++) { - InfoProvEnt *ipe = *ipeList; - traceIPE(ipe); - } + for (uint32_t i = 0; i < cursor->count; i++) { + const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); + traceIPE(&ent); } - cursor = cursor->next; } + // Dump entries already in hashmap + ACQUIRE_LOCK(&ipeMapLock); if (ipeMap != NULL) { mapHashTable(ipeMap, NULL, &traceIPEFromHashTable); } - RELEASE_LOCK(&ipeMapLock); } @@ -105,50 +123,20 @@ Note [The Info Table Provenance Entry (IPE) Map]. Statically initialized IPE lists are registered at startup by a C constructor function generated by the compiler (CodeOutput.hs) in a *.c file for each -module. +module. Since this is called in a static initializer we cannot rely on +ipeMapLock; we instead use atomic CAS operations to add to the list. A performance test for IPE registration and lookup can be found here: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806 */ -void registerInfoProvList(InfoProvEnt **ent_list) { - // The list must be dereferenceable. - ASSERT(ent_list[0] == NULL || ent_list[0] != NULL); - - // Ignore empty lists - if (ent_list[0] == NULL) { - return; - } - - ACQUIRE_LOCK(&ipeMapLock); - - if (ipeBufferList == NULL) { - ASSERT(ipeBufferList == NULL); - - ipeBufferList = stgMallocBytes(sizeof(IpeBufferListNode), - "registerInfoProvList-firstNode"); - ipeBufferList->buffer[0] = ent_list; - ipeBufferList->count = 1; - ipeBufferList->next = NULL; - } else { - if (ipeBufferList->count < IPE_LIST_NODE_BUFFER_SIZE) { - ipeBufferList->buffer[ipeBufferList->count] = ent_list; - ipeBufferList->count = ipeBufferList->count + 1; - - ASSERT(ipeBufferList->next == NULL || - ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); - } else { - IpeBufferListNode *newNode = stgMallocBytes( - sizeof(IpeBufferListNode), "registerInfoProvList-nextNode"); - newNode->buffer[0] = ent_list; - newNode->count = 1; - newNode->next = ipeBufferList; - ipeBufferList = newNode; - - ASSERT(ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); +void registerInfoProvList(IpeBufferListNode *node) { + while (true) { + IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList); + node->next = old; + if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) { + return; } } - - RELEASE_LOCK(&ipeMapLock); } InfoProvEnt *lookupIPE(const StgInfoTable *info) { @@ -159,7 +147,8 @@ InfoProvEnt *lookupIPE(const StgInfoTable *info) { void updateIpeMap() { // Check if there's any work at all. If not so, we can circumvent locking, // which decreases performance. - if (ipeMap != NULL && ipeBufferList == NULL) { + IpeBufferListNode *pending = xchg_ptr((void **) &ipeBufferList, NULL); + if (ipeMap != NULL && pending == NULL) { return; } @@ -169,23 +158,16 @@ void updateIpeMap() { ipeMap = allocHashTable(); } - while (ipeBufferList != NULL) { - ASSERT(ipeBufferList->next == NULL || - ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE); - ASSERT(ipeBufferList->count > 0 && - ipeBufferList->count <= IPE_LIST_NODE_BUFFER_SIZE); - - IpeBufferListNode *currentNode = ipeBufferList; - - for (int i = 0; i < currentNode->count; i++) { - for (InfoProvEnt **ipeList = currentNode->buffer[i]; - *ipeList != NULL; ipeList++) { - insertHashTable(ipeMap, (StgWord)(*ipeList)->info, *ipeList); - } + 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]); } - ipeBufferList = currentNode->next; - stgFree(currentNode); + pending = currentNode->next; } RELEASE_LOCK(&ipeMapLock); ===================================== rts/IPE.h ===================================== @@ -13,17 +13,9 @@ #include "BeginPrivate.h" -#define IPE_LIST_NODE_BUFFER_SIZE 126 - -typedef struct IpeBufferListNode_ { - InfoProvEnt **buffer[IPE_LIST_NODE_BUFFER_SIZE]; - StgWord8 count; - struct IpeBufferListNode_ *next; -} IpeBufferListNode; - void dumpIPEToEventLog(void); void updateIpeMap(void); -void initIpeMapLock(void); -void closeIpeMapLock(void); +void initIpe(void); +void exitIpe(void); #include "EndPrivate.h" ===================================== rts/RtsStartup.c ===================================== @@ -386,7 +386,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) #if defined(PROFILING) initProfiling(); #endif - initIpeMapLock(); + initIpe(); traceInitEvent(dumpIPEToEventLog); initHeapProfiling(); @@ -611,7 +611,7 @@ hs_exit_(bool wait_foreign) // Free threading resources freeThreadingResources(); - closeIpeMapLock(); + exitIpe(); } // Flush stdout and stderr. We do this during shutdown so that it ===================================== rts/Trace.c ===================================== @@ -682,9 +682,9 @@ void traceIPE(const InfoProvEnt *ipe) ACQUIRE_LOCK(&trace_utx); tracePreface(); - debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n", + debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n", ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc, - ipe->prov.label, ipe->prov.module, ipe->prov.srcloc); + ipe->prov.label, ipe->prov.module, ipe->prov.src_file, ipe->prov.src_span); RELEASE_LOCK(&trace_utx); } else ===================================== rts/eventlog/EventLog.c ===================================== @@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i) postWord32(eb, (StgWord32)i); } -static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size) +static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) { memcpy(eb->pos, buf, size); eb->pos += size; @@ -1419,10 +1419,13 @@ void postIPE(const InfoProvEnt *ipe) StgWord ty_desc_len = strlen(ipe->prov.ty_desc); StgWord label_len = strlen(ipe->prov.label); StgWord module_len = strlen(ipe->prov.module); - StgWord srcloc_len = strlen(ipe->prov.srcloc); + StgWord src_file_len = strlen(ipe->prov.src_file); + StgWord src_span_len = strlen(ipe->prov.src_span); + // 8 for the info word - // 6 for the number of strings in the payload as postString adds 1 to the length - StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6; + // 1 null after each string + // 1 colon between src_file and src_span + StgWord len = 8+table_name_len+1+closure_desc_len+1+ty_desc_len+1+label_len+1+module_len+1+src_file_len+1+src_span_len+1; ensureRoomForVariableEvent(&eventBuf, len); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); @@ -1432,7 +1435,13 @@ void postIPE(const InfoProvEnt *ipe) postString(&eventBuf, ipe->prov.ty_desc); postString(&eventBuf, ipe->prov.label); postString(&eventBuf, ipe->prov.module); - postString(&eventBuf, ipe->prov.srcloc); + + // Manually construct the location field: ":\0" + postBuf(&eventBuf, (const StgWord8*) ipe->prov.src_file, src_file_len); + StgWord8 colon = ':'; + postBuf(&eventBuf, &colon, 1); + postString(&eventBuf, ipe->prov.src_span); + RELEASE_LOCK(&eventBufMutex); } ===================================== rts/include/rts/IPE.h ===================================== @@ -14,18 +14,56 @@ #pragma once typedef struct InfoProv_ { - char *table_name; - char *closure_desc; - char *ty_desc; - char *label; - char *module; - char *srcloc; + const char *table_name; + const char *closure_desc; + const char *ty_desc; + const char *label; + const char *module; + const char *src_file; + const char *src_span; } InfoProv; typedef struct InfoProvEnt_ { - StgInfoTable *info; + const StgInfoTable *info; InfoProv prov; } InfoProvEnt; -void registerInfoProvList(InfoProvEnt **cc_list); + +/* + * On-disk representation + */ + +/* + * A byte offset into the string table. + * We use offsets rather than pointers as: + * + * a. they are smaller than pointers on 64-bit platforms + * b. they are easier on the linker since they do not need + * to be relocated + */ +typedef uint32_t StringIdx; + +// The size of this must be a multiple of the word size +// to ensure correct packing. +typedef struct { + const StgInfoTable *info; + StringIdx table_name; + StringIdx closure_desc; + StringIdx ty_desc; + StringIdx label; + StringIdx module_name; + StringIdx src_file; + StringIdx src_span; + uint32_t _padding; +} IpeBufferEntry; + +typedef struct IpeBufferListNode_ { + struct IpeBufferListNode_ *next; + // Everything below is read-only and generated by the codegen + const char *string_table; + StgWord count; + IpeBufferEntry entries[]; +} IpeBufferListNode; + +void registerInfoProvList(IpeBufferListNode *node); InfoProvEnt *lookupIPE(const StgInfoTable *info); ===================================== rts/include/stg/SMP.h ===================================== @@ -568,3 +568,20 @@ atomic_dec(StgVolatilePtr p) #define VOLATILE_LOAD(p) ((StgWord)*((StgWord*)(p))) #endif /* !THREADED_RTS */ + +/* Helpers implemented in terms of the above */ +#if !IN_STG_CODE || IN_STGCRUN + +INLINE_HEADER void * +xchg_ptr(void **p, void *w) +{ + return (void *) xchg((StgPtr) p, (StgWord) w); +} + +INLINE_HEADER void * +cas_ptr(volatile void **p, void *o, void *n) +{ + return (void *) cas((StgVolatilePtr) p, (StgWord) o, (StgWord) n); +} + +#endif ===================================== testsuite/tests/rts/all.T ===================================== @@ -199,9 +199,9 @@ def noCapabilityOutputFilter(s): # Manually create IPE entries and dump them to event log (stderr). test('ipeEventLog', [ c_src, - extra_files(['ipeEventLog_lib.c']), + extra_files(['ipeEventLog_lib.c', 'ipeEventLog_lib.h']), extra_run_opts('+RTS -va -RTS'), - grep_errmsg('IPE:'), + grep_errmsg('table_name_'), only_ways(debug_ways), normalise_errmsg_fun(noCapabilityOutputFilter), ignore_stdout, @@ -215,9 +215,9 @@ test('ipeEventLog', # and dump them to event log (stderr). test('ipeEventLog_fromMap', [ c_src, - extra_files(['ipeEventLog_lib.c']), + extra_files(['ipeEventLog_lib.c', 'ipeEventLog_lib.h']), extra_run_opts('+RTS -va -RTS'), - grep_errmsg('IPE:'), + grep_errmsg('table_name_'), only_ways(debug_ways), normalise_errmsg_fun(noCapabilityOutputFilter), ignore_stdout, ===================================== testsuite/tests/rts/ipeEventLog.c ===================================== @@ -4,53 +4,17 @@ #include #include #include - -extern void dumpIPEToEventLog(void); -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i); +#include "ipeEventLog_lib.h" int main(int argc, char *argv[]) { hs_init(&argc, &argv); Capability *cap = rts_lock(); - // Force the creation of 4 IpeBufferListNodes (381 IPEs) - for (int i = 0; i < 381; i++) { - - InfoProvEnt **ipeList_1 = malloc(sizeof(InfoProvEnt *) * 2); - ipeList_1[0] = makeAnyProvEntry(cap, i); - ipeList_1[1] = NULL; - - registerInfoProvList(ipeList_1); - } - - // Register an IPE list with two elements - HaskellObj one = rts_mkInt(cap, 1); - - InfoProvEnt *provEntA = malloc(sizeof(InfoProvEnt)); - provEntA->info = (StgInfoTable *)one->header.info; - provEntA->prov.table_name = "table_name_a"; - provEntA->prov.closure_desc = "closure_desc_a"; - provEntA->prov.ty_desc = "ty_desc_a"; - provEntA->prov.label = "label_a"; - provEntA->prov.module = "module_a"; - provEntA->prov.srcloc = "srcloc_a"; - - HaskellObj two = rts_mkInt(cap, 2); - - InfoProvEnt *provEntB = malloc(sizeof(InfoProvEnt)); - provEntB->info = (StgInfoTable *)two->header.info; - provEntB->prov.table_name = "table_name_b"; - provEntB->prov.closure_desc = "closure_desc_b"; - provEntB->prov.ty_desc = "ty_desc_b"; - provEntB->prov.label = "label_b"; - provEntB->prov.module = "module_b"; - provEntB->prov.srcloc = "srcloc_b"; - - InfoProvEnt **ipeList_2 = malloc(sizeof(InfoProvEnt *) * 3); - ipeList_2[0] = provEntA; - ipeList_2[1] = provEntB; - ipeList_2[2] = NULL; + IpeBufferListNode *list1 = makeAnyProvEntries(cap, 10); + IpeBufferListNode *list2 = makeAnyProvEntries(cap, 10); - registerInfoProvList(ipeList_2); + registerInfoProvList(list1); + registerInfoProvList(list2); // Trace all IPE events. Expected count (see Makefile): 381 + 2 = 383 dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipeEventLog.stderr ===================================== @@ -1,383 +1,20 @@ -IPE: table_name table_name_378, closure_desc closure_desc_378, ty_desc ty_desc_378, label label_378, module module_378, srcloc srcloc_378 -IPE: table_name table_name_379, closure_desc closure_desc_379, ty_desc ty_desc_379, label label_379, module module_379, srcloc srcloc_379 -IPE: table_name table_name_380, closure_desc closure_desc_380, ty_desc ty_desc_380, label label_380, module module_380, srcloc srcloc_380 -IPE: table_name table_name_a, closure_desc closure_desc_a, ty_desc ty_desc_a, label label_a, module module_a, srcloc srcloc_a -IPE: table_name table_name_b, closure_desc closure_desc_b, ty_desc ty_desc_b, label label_b, module module_b, srcloc srcloc_b -IPE: table_name table_name_252, closure_desc closure_desc_252, ty_desc ty_desc_252, label label_252, module module_252, srcloc srcloc_252 -IPE: table_name table_name_253, closure_desc closure_desc_253, ty_desc ty_desc_253, label label_253, module module_253, srcloc srcloc_253 -IPE: table_name table_name_254, closure_desc closure_desc_254, ty_desc ty_desc_254, label label_254, module module_254, srcloc srcloc_254 -IPE: table_name table_name_255, closure_desc closure_desc_255, ty_desc ty_desc_255, label label_255, module module_255, srcloc srcloc_255 -IPE: table_name table_name_256, closure_desc closure_desc_256, ty_desc ty_desc_256, label label_256, module module_256, srcloc srcloc_256 -IPE: table_name table_name_257, closure_desc closure_desc_257, ty_desc ty_desc_257, label label_257, module module_257, srcloc srcloc_257 -IPE: table_name table_name_258, closure_desc closure_desc_258, ty_desc ty_desc_258, label label_258, module module_258, srcloc srcloc_258 -IPE: table_name table_name_259, closure_desc closure_desc_259, ty_desc ty_desc_259, label label_259, module module_259, srcloc srcloc_259 -IPE: table_name table_name_260, closure_desc closure_desc_260, ty_desc ty_desc_260, label label_260, module module_260, srcloc srcloc_260 -IPE: table_name table_name_261, closure_desc closure_desc_261, ty_desc ty_desc_261, label label_261, module module_261, srcloc srcloc_261 -IPE: table_name table_name_262, closure_desc closure_desc_262, ty_desc ty_desc_262, label label_262, module module_262, srcloc srcloc_262 -IPE: table_name table_name_263, closure_desc closure_desc_263, ty_desc ty_desc_263, label label_263, module module_263, srcloc srcloc_263 -IPE: table_name table_name_264, closure_desc closure_desc_264, ty_desc ty_desc_264, label label_264, module module_264, srcloc srcloc_264 -IPE: table_name table_name_265, closure_desc closure_desc_265, ty_desc ty_desc_265, label label_265, module module_265, srcloc srcloc_265 -IPE: table_name table_name_266, closure_desc closure_desc_266, ty_desc ty_desc_266, label label_266, module module_266, srcloc srcloc_266 -IPE: table_name table_name_267, closure_desc closure_desc_267, ty_desc ty_desc_267, label label_267, module module_267, srcloc srcloc_267 -IPE: table_name table_name_268, closure_desc closure_desc_268, ty_desc ty_desc_268, label label_268, module module_268, srcloc srcloc_268 -IPE: table_name table_name_269, closure_desc closure_desc_269, ty_desc ty_desc_269, label label_269, module module_269, srcloc srcloc_269 -IPE: table_name table_name_270, closure_desc closure_desc_270, ty_desc ty_desc_270, label label_270, module module_270, srcloc srcloc_270 -IPE: table_name table_name_271, closure_desc closure_desc_271, ty_desc ty_desc_271, label label_271, module module_271, srcloc srcloc_271 -IPE: table_name table_name_272, closure_desc closure_desc_272, ty_desc ty_desc_272, label label_272, module module_272, srcloc srcloc_272 -IPE: table_name table_name_273, closure_desc closure_desc_273, ty_desc ty_desc_273, label label_273, module module_273, srcloc srcloc_273 -IPE: table_name table_name_274, closure_desc closure_desc_274, ty_desc ty_desc_274, label label_274, module module_274, srcloc srcloc_274 -IPE: table_name table_name_275, closure_desc closure_desc_275, ty_desc ty_desc_275, label label_275, module module_275, srcloc srcloc_275 -IPE: table_name table_name_276, closure_desc closure_desc_276, ty_desc ty_desc_276, label label_276, module module_276, srcloc srcloc_276 -IPE: table_name table_name_277, closure_desc closure_desc_277, ty_desc ty_desc_277, label label_277, module module_277, srcloc srcloc_277 -IPE: table_name table_name_278, closure_desc closure_desc_278, ty_desc ty_desc_278, label label_278, module module_278, srcloc srcloc_278 -IPE: table_name table_name_279, closure_desc closure_desc_279, ty_desc ty_desc_279, label label_279, module module_279, srcloc srcloc_279 -IPE: table_name table_name_280, closure_desc closure_desc_280, ty_desc ty_desc_280, label label_280, module module_280, srcloc srcloc_280 -IPE: table_name table_name_281, closure_desc closure_desc_281, ty_desc ty_desc_281, label label_281, module module_281, srcloc srcloc_281 -IPE: table_name table_name_282, closure_desc closure_desc_282, ty_desc ty_desc_282, label label_282, module module_282, srcloc srcloc_282 -IPE: table_name table_name_283, closure_desc closure_desc_283, ty_desc ty_desc_283, label label_283, module module_283, srcloc srcloc_283 -IPE: table_name table_name_284, closure_desc closure_desc_284, ty_desc ty_desc_284, label label_284, module module_284, srcloc srcloc_284 -IPE: table_name table_name_285, closure_desc closure_desc_285, ty_desc ty_desc_285, label label_285, module module_285, srcloc srcloc_285 -IPE: table_name table_name_286, closure_desc closure_desc_286, ty_desc ty_desc_286, label label_286, module module_286, srcloc srcloc_286 -IPE: table_name table_name_287, closure_desc closure_desc_287, ty_desc ty_desc_287, label label_287, module module_287, srcloc srcloc_287 -IPE: table_name table_name_288, closure_desc closure_desc_288, ty_desc ty_desc_288, label label_288, module module_288, srcloc srcloc_288 -IPE: table_name table_name_289, closure_desc closure_desc_289, ty_desc ty_desc_289, label label_289, module module_289, srcloc srcloc_289 -IPE: table_name table_name_290, closure_desc closure_desc_290, ty_desc ty_desc_290, label label_290, module module_290, srcloc srcloc_290 -IPE: table_name table_name_291, closure_desc closure_desc_291, ty_desc ty_desc_291, label label_291, module module_291, srcloc srcloc_291 -IPE: table_name table_name_292, closure_desc closure_desc_292, ty_desc ty_desc_292, label label_292, module module_292, srcloc srcloc_292 -IPE: table_name table_name_293, closure_desc closure_desc_293, ty_desc ty_desc_293, label label_293, module module_293, srcloc srcloc_293 -IPE: table_name table_name_294, closure_desc closure_desc_294, ty_desc ty_desc_294, label label_294, module module_294, srcloc srcloc_294 -IPE: table_name table_name_295, closure_desc closure_desc_295, ty_desc ty_desc_295, label label_295, module module_295, srcloc srcloc_295 -IPE: table_name table_name_296, closure_desc closure_desc_296, ty_desc ty_desc_296, label label_296, module module_296, srcloc srcloc_296 -IPE: table_name table_name_297, closure_desc closure_desc_297, ty_desc ty_desc_297, label label_297, module module_297, srcloc srcloc_297 -IPE: table_name table_name_298, closure_desc closure_desc_298, ty_desc ty_desc_298, label label_298, module module_298, srcloc srcloc_298 -IPE: table_name table_name_299, closure_desc closure_desc_299, ty_desc ty_desc_299, label label_299, module module_299, srcloc srcloc_299 -IPE: table_name table_name_300, closure_desc closure_desc_300, ty_desc ty_desc_300, label label_300, module module_300, srcloc srcloc_300 -IPE: table_name table_name_301, closure_desc closure_desc_301, ty_desc ty_desc_301, label label_301, module module_301, srcloc srcloc_301 -IPE: table_name table_name_302, closure_desc closure_desc_302, ty_desc ty_desc_302, label label_302, module module_302, srcloc srcloc_302 -IPE: table_name table_name_303, closure_desc closure_desc_303, ty_desc ty_desc_303, label label_303, module module_303, srcloc srcloc_303 -IPE: table_name table_name_304, closure_desc closure_desc_304, ty_desc ty_desc_304, label label_304, module module_304, srcloc srcloc_304 -IPE: table_name table_name_305, closure_desc closure_desc_305, ty_desc ty_desc_305, label label_305, module module_305, srcloc srcloc_305 -IPE: table_name table_name_306, closure_desc closure_desc_306, ty_desc ty_desc_306, label label_306, module module_306, srcloc srcloc_306 -IPE: table_name table_name_307, closure_desc closure_desc_307, ty_desc ty_desc_307, label label_307, module module_307, srcloc srcloc_307 -IPE: table_name table_name_308, closure_desc closure_desc_308, ty_desc ty_desc_308, label label_308, module module_308, srcloc srcloc_308 -IPE: table_name table_name_309, closure_desc closure_desc_309, ty_desc ty_desc_309, label label_309, module module_309, srcloc srcloc_309 -IPE: table_name table_name_310, closure_desc closure_desc_310, ty_desc ty_desc_310, label label_310, module module_310, srcloc srcloc_310 -IPE: table_name table_name_311, closure_desc closure_desc_311, ty_desc ty_desc_311, label label_311, module module_311, srcloc srcloc_311 -IPE: table_name table_name_312, closure_desc closure_desc_312, ty_desc ty_desc_312, label label_312, module module_312, srcloc srcloc_312 -IPE: table_name table_name_313, closure_desc closure_desc_313, ty_desc ty_desc_313, label label_313, module module_313, srcloc srcloc_313 -IPE: table_name table_name_314, closure_desc closure_desc_314, ty_desc ty_desc_314, label label_314, module module_314, srcloc srcloc_314 -IPE: table_name table_name_315, closure_desc closure_desc_315, ty_desc ty_desc_315, label label_315, module module_315, srcloc srcloc_315 -IPE: table_name table_name_316, closure_desc closure_desc_316, ty_desc ty_desc_316, label label_316, module module_316, srcloc srcloc_316 -IPE: table_name table_name_317, closure_desc closure_desc_317, ty_desc ty_desc_317, label label_317, module module_317, srcloc srcloc_317 -IPE: table_name table_name_318, closure_desc closure_desc_318, ty_desc ty_desc_318, label label_318, module module_318, srcloc srcloc_318 -IPE: table_name table_name_319, closure_desc closure_desc_319, ty_desc ty_desc_319, label label_319, module module_319, srcloc srcloc_319 -IPE: table_name table_name_320, closure_desc closure_desc_320, ty_desc ty_desc_320, label label_320, module module_320, srcloc srcloc_320 -IPE: table_name table_name_321, closure_desc closure_desc_321, ty_desc ty_desc_321, label label_321, module module_321, srcloc srcloc_321 -IPE: table_name table_name_322, closure_desc closure_desc_322, ty_desc ty_desc_322, label label_322, module module_322, srcloc srcloc_322 -IPE: table_name table_name_323, closure_desc closure_desc_323, ty_desc ty_desc_323, label label_323, module module_323, srcloc srcloc_323 -IPE: table_name table_name_324, closure_desc closure_desc_324, ty_desc ty_desc_324, label label_324, module module_324, srcloc srcloc_324 -IPE: table_name table_name_325, closure_desc closure_desc_325, ty_desc ty_desc_325, label label_325, module module_325, srcloc srcloc_325 -IPE: table_name table_name_326, closure_desc closure_desc_326, ty_desc ty_desc_326, label label_326, module module_326, srcloc srcloc_326 -IPE: table_name table_name_327, closure_desc closure_desc_327, ty_desc ty_desc_327, label label_327, module module_327, srcloc srcloc_327 -IPE: table_name table_name_328, closure_desc closure_desc_328, ty_desc ty_desc_328, label label_328, module module_328, srcloc srcloc_328 -IPE: table_name table_name_329, closure_desc closure_desc_329, ty_desc ty_desc_329, label label_329, module module_329, srcloc srcloc_329 -IPE: table_name table_name_330, closure_desc closure_desc_330, ty_desc ty_desc_330, label label_330, module module_330, srcloc srcloc_330 -IPE: table_name table_name_331, closure_desc closure_desc_331, ty_desc ty_desc_331, label label_331, module module_331, srcloc srcloc_331 -IPE: table_name table_name_332, closure_desc closure_desc_332, ty_desc ty_desc_332, label label_332, module module_332, srcloc srcloc_332 -IPE: table_name table_name_333, closure_desc closure_desc_333, ty_desc ty_desc_333, label label_333, module module_333, srcloc srcloc_333 -IPE: table_name table_name_334, closure_desc closure_desc_334, ty_desc ty_desc_334, label label_334, module module_334, srcloc srcloc_334 -IPE: table_name table_name_335, closure_desc closure_desc_335, ty_desc ty_desc_335, label label_335, module module_335, srcloc srcloc_335 -IPE: table_name table_name_336, closure_desc closure_desc_336, ty_desc ty_desc_336, label label_336, module module_336, srcloc srcloc_336 -IPE: table_name table_name_337, closure_desc closure_desc_337, ty_desc ty_desc_337, label label_337, module module_337, srcloc srcloc_337 -IPE: table_name table_name_338, closure_desc closure_desc_338, ty_desc ty_desc_338, label label_338, module module_338, srcloc srcloc_338 -IPE: table_name table_name_339, closure_desc closure_desc_339, ty_desc ty_desc_339, label label_339, module module_339, srcloc srcloc_339 -IPE: table_name table_name_340, closure_desc closure_desc_340, ty_desc ty_desc_340, label label_340, module module_340, srcloc srcloc_340 -IPE: table_name table_name_341, closure_desc closure_desc_341, ty_desc ty_desc_341, label label_341, module module_341, srcloc srcloc_341 -IPE: table_name table_name_342, closure_desc closure_desc_342, ty_desc ty_desc_342, label label_342, module module_342, srcloc srcloc_342 -IPE: table_name table_name_343, closure_desc closure_desc_343, ty_desc ty_desc_343, label label_343, module module_343, srcloc srcloc_343 -IPE: table_name table_name_344, closure_desc closure_desc_344, ty_desc ty_desc_344, label label_344, module module_344, srcloc srcloc_344 -IPE: table_name table_name_345, closure_desc closure_desc_345, ty_desc ty_desc_345, label label_345, module module_345, srcloc srcloc_345 -IPE: table_name table_name_346, closure_desc closure_desc_346, ty_desc ty_desc_346, label label_346, module module_346, srcloc srcloc_346 -IPE: table_name table_name_347, closure_desc closure_desc_347, ty_desc ty_desc_347, label label_347, module module_347, srcloc srcloc_347 -IPE: table_name table_name_348, closure_desc closure_desc_348, ty_desc ty_desc_348, label label_348, module module_348, srcloc srcloc_348 -IPE: table_name table_name_349, closure_desc closure_desc_349, ty_desc ty_desc_349, label label_349, module module_349, srcloc srcloc_349 -IPE: table_name table_name_350, closure_desc closure_desc_350, ty_desc ty_desc_350, label label_350, module module_350, srcloc srcloc_350 -IPE: table_name table_name_351, closure_desc closure_desc_351, ty_desc ty_desc_351, label label_351, module module_351, srcloc srcloc_351 -IPE: table_name table_name_352, closure_desc closure_desc_352, ty_desc ty_desc_352, label label_352, module module_352, srcloc srcloc_352 -IPE: table_name table_name_353, closure_desc closure_desc_353, ty_desc ty_desc_353, label label_353, module module_353, srcloc srcloc_353 -IPE: table_name table_name_354, closure_desc closure_desc_354, ty_desc ty_desc_354, label label_354, module module_354, srcloc srcloc_354 -IPE: table_name table_name_355, closure_desc closure_desc_355, ty_desc ty_desc_355, label label_355, module module_355, srcloc srcloc_355 -IPE: table_name table_name_356, closure_desc closure_desc_356, ty_desc ty_desc_356, label label_356, module module_356, srcloc srcloc_356 -IPE: table_name table_name_357, closure_desc closure_desc_357, ty_desc ty_desc_357, label label_357, module module_357, srcloc srcloc_357 -IPE: table_name table_name_358, closure_desc closure_desc_358, ty_desc ty_desc_358, label label_358, module module_358, srcloc srcloc_358 -IPE: table_name table_name_359, closure_desc closure_desc_359, ty_desc ty_desc_359, label label_359, module module_359, srcloc srcloc_359 -IPE: table_name table_name_360, closure_desc closure_desc_360, ty_desc ty_desc_360, label label_360, module module_360, srcloc srcloc_360 -IPE: table_name table_name_361, closure_desc closure_desc_361, ty_desc ty_desc_361, label label_361, module module_361, srcloc srcloc_361 -IPE: table_name table_name_362, closure_desc closure_desc_362, ty_desc ty_desc_362, label label_362, module module_362, srcloc srcloc_362 -IPE: table_name table_name_363, closure_desc closure_desc_363, ty_desc ty_desc_363, label label_363, module module_363, srcloc srcloc_363 -IPE: table_name table_name_364, closure_desc closure_desc_364, ty_desc ty_desc_364, label label_364, module module_364, srcloc srcloc_364 -IPE: table_name table_name_365, closure_desc closure_desc_365, ty_desc ty_desc_365, label label_365, module module_365, srcloc srcloc_365 -IPE: table_name table_name_366, closure_desc closure_desc_366, ty_desc ty_desc_366, label label_366, module module_366, srcloc srcloc_366 -IPE: table_name table_name_367, closure_desc closure_desc_367, ty_desc ty_desc_367, label label_367, module module_367, srcloc srcloc_367 -IPE: table_name table_name_368, closure_desc closure_desc_368, ty_desc ty_desc_368, label label_368, module module_368, srcloc srcloc_368 -IPE: table_name table_name_369, closure_desc closure_desc_369, ty_desc ty_desc_369, label label_369, module module_369, srcloc srcloc_369 -IPE: table_name table_name_370, closure_desc closure_desc_370, ty_desc ty_desc_370, label label_370, module module_370, srcloc srcloc_370 -IPE: table_name table_name_371, closure_desc closure_desc_371, ty_desc ty_desc_371, label label_371, module module_371, srcloc srcloc_371 -IPE: table_name table_name_372, closure_desc closure_desc_372, ty_desc ty_desc_372, label label_372, module module_372, srcloc srcloc_372 -IPE: table_name table_name_373, closure_desc closure_desc_373, ty_desc ty_desc_373, label label_373, module module_373, srcloc srcloc_373 -IPE: table_name table_name_374, closure_desc closure_desc_374, ty_desc ty_desc_374, label label_374, module module_374, srcloc srcloc_374 -IPE: table_name table_name_375, closure_desc closure_desc_375, ty_desc ty_desc_375, label label_375, module module_375, srcloc srcloc_375 -IPE: table_name table_name_376, closure_desc closure_desc_376, ty_desc ty_desc_376, label label_376, module module_376, srcloc srcloc_376 -IPE: table_name table_name_377, closure_desc closure_desc_377, ty_desc ty_desc_377, label label_377, module module_377, srcloc srcloc_377 -IPE: table_name table_name_126, closure_desc closure_desc_126, ty_desc ty_desc_126, label label_126, module module_126, srcloc srcloc_126 -IPE: table_name table_name_127, closure_desc closure_desc_127, ty_desc ty_desc_127, label label_127, module module_127, srcloc srcloc_127 -IPE: table_name table_name_128, closure_desc closure_desc_128, ty_desc ty_desc_128, label label_128, module module_128, srcloc srcloc_128 -IPE: table_name table_name_129, closure_desc closure_desc_129, ty_desc ty_desc_129, label label_129, module module_129, srcloc srcloc_129 -IPE: table_name table_name_130, closure_desc closure_desc_130, ty_desc ty_desc_130, label label_130, module module_130, srcloc srcloc_130 -IPE: table_name table_name_131, closure_desc closure_desc_131, ty_desc ty_desc_131, label label_131, module module_131, srcloc srcloc_131 -IPE: table_name table_name_132, closure_desc closure_desc_132, ty_desc ty_desc_132, label label_132, module module_132, srcloc srcloc_132 -IPE: table_name table_name_133, closure_desc closure_desc_133, ty_desc ty_desc_133, label label_133, module module_133, srcloc srcloc_133 -IPE: table_name table_name_134, closure_desc closure_desc_134, ty_desc ty_desc_134, label label_134, module module_134, srcloc srcloc_134 -IPE: table_name table_name_135, closure_desc closure_desc_135, ty_desc ty_desc_135, label label_135, module module_135, srcloc srcloc_135 -IPE: table_name table_name_136, closure_desc closure_desc_136, ty_desc ty_desc_136, label label_136, module module_136, srcloc srcloc_136 -IPE: table_name table_name_137, closure_desc closure_desc_137, ty_desc ty_desc_137, label label_137, module module_137, srcloc srcloc_137 -IPE: table_name table_name_138, closure_desc closure_desc_138, ty_desc ty_desc_138, label label_138, module module_138, srcloc srcloc_138 -IPE: table_name table_name_139, closure_desc closure_desc_139, ty_desc ty_desc_139, label label_139, module module_139, srcloc srcloc_139 -IPE: table_name table_name_140, closure_desc closure_desc_140, ty_desc ty_desc_140, label label_140, module module_140, srcloc srcloc_140 -IPE: table_name table_name_141, closure_desc closure_desc_141, ty_desc ty_desc_141, label label_141, module module_141, srcloc srcloc_141 -IPE: table_name table_name_142, closure_desc closure_desc_142, ty_desc ty_desc_142, label label_142, module module_142, srcloc srcloc_142 -IPE: table_name table_name_143, closure_desc closure_desc_143, ty_desc ty_desc_143, label label_143, module module_143, srcloc srcloc_143 -IPE: table_name table_name_144, closure_desc closure_desc_144, ty_desc ty_desc_144, label label_144, module module_144, srcloc srcloc_144 -IPE: table_name table_name_145, closure_desc closure_desc_145, ty_desc ty_desc_145, label label_145, module module_145, srcloc srcloc_145 -IPE: table_name table_name_146, closure_desc closure_desc_146, ty_desc ty_desc_146, label label_146, module module_146, srcloc srcloc_146 -IPE: table_name table_name_147, closure_desc closure_desc_147, ty_desc ty_desc_147, label label_147, module module_147, srcloc srcloc_147 -IPE: table_name table_name_148, closure_desc closure_desc_148, ty_desc ty_desc_148, label label_148, module module_148, srcloc srcloc_148 -IPE: table_name table_name_149, closure_desc closure_desc_149, ty_desc ty_desc_149, label label_149, module module_149, srcloc srcloc_149 -IPE: table_name table_name_150, closure_desc closure_desc_150, ty_desc ty_desc_150, label label_150, module module_150, srcloc srcloc_150 -IPE: table_name table_name_151, closure_desc closure_desc_151, ty_desc ty_desc_151, label label_151, module module_151, srcloc srcloc_151 -IPE: table_name table_name_152, closure_desc closure_desc_152, ty_desc ty_desc_152, label label_152, module module_152, srcloc srcloc_152 -IPE: table_name table_name_153, closure_desc closure_desc_153, ty_desc ty_desc_153, label label_153, module module_153, srcloc srcloc_153 -IPE: table_name table_name_154, closure_desc closure_desc_154, ty_desc ty_desc_154, label label_154, module module_154, srcloc srcloc_154 -IPE: table_name table_name_155, closure_desc closure_desc_155, ty_desc ty_desc_155, label label_155, module module_155, srcloc srcloc_155 -IPE: table_name table_name_156, closure_desc closure_desc_156, ty_desc ty_desc_156, label label_156, module module_156, srcloc srcloc_156 -IPE: table_name table_name_157, closure_desc closure_desc_157, ty_desc ty_desc_157, label label_157, module module_157, srcloc srcloc_157 -IPE: table_name table_name_158, closure_desc closure_desc_158, ty_desc ty_desc_158, label label_158, module module_158, srcloc srcloc_158 -IPE: table_name table_name_159, closure_desc closure_desc_159, ty_desc ty_desc_159, label label_159, module module_159, srcloc srcloc_159 -IPE: table_name table_name_160, closure_desc closure_desc_160, ty_desc ty_desc_160, label label_160, module module_160, srcloc srcloc_160 -IPE: table_name table_name_161, closure_desc closure_desc_161, ty_desc ty_desc_161, label label_161, module module_161, srcloc srcloc_161 -IPE: table_name table_name_162, closure_desc closure_desc_162, ty_desc ty_desc_162, label label_162, module module_162, srcloc srcloc_162 -IPE: table_name table_name_163, closure_desc closure_desc_163, ty_desc ty_desc_163, label label_163, module module_163, srcloc srcloc_163 -IPE: table_name table_name_164, closure_desc closure_desc_164, ty_desc ty_desc_164, label label_164, module module_164, srcloc srcloc_164 -IPE: table_name table_name_165, closure_desc closure_desc_165, ty_desc ty_desc_165, label label_165, module module_165, srcloc srcloc_165 -IPE: table_name table_name_166, closure_desc closure_desc_166, ty_desc ty_desc_166, label label_166, module module_166, srcloc srcloc_166 -IPE: table_name table_name_167, closure_desc closure_desc_167, ty_desc ty_desc_167, label label_167, module module_167, srcloc srcloc_167 -IPE: table_name table_name_168, closure_desc closure_desc_168, ty_desc ty_desc_168, label label_168, module module_168, srcloc srcloc_168 -IPE: table_name table_name_169, closure_desc closure_desc_169, ty_desc ty_desc_169, label label_169, module module_169, srcloc srcloc_169 -IPE: table_name table_name_170, closure_desc closure_desc_170, ty_desc ty_desc_170, label label_170, module module_170, srcloc srcloc_170 -IPE: table_name table_name_171, closure_desc closure_desc_171, ty_desc ty_desc_171, label label_171, module module_171, srcloc srcloc_171 -IPE: table_name table_name_172, closure_desc closure_desc_172, ty_desc ty_desc_172, label label_172, module module_172, srcloc srcloc_172 -IPE: table_name table_name_173, closure_desc closure_desc_173, ty_desc ty_desc_173, label label_173, module module_173, srcloc srcloc_173 -IPE: table_name table_name_174, closure_desc closure_desc_174, ty_desc ty_desc_174, label label_174, module module_174, srcloc srcloc_174 -IPE: table_name table_name_175, closure_desc closure_desc_175, ty_desc ty_desc_175, label label_175, module module_175, srcloc srcloc_175 -IPE: table_name table_name_176, closure_desc closure_desc_176, ty_desc ty_desc_176, label label_176, module module_176, srcloc srcloc_176 -IPE: table_name table_name_177, closure_desc closure_desc_177, ty_desc ty_desc_177, label label_177, module module_177, srcloc srcloc_177 -IPE: table_name table_name_178, closure_desc closure_desc_178, ty_desc ty_desc_178, label label_178, module module_178, srcloc srcloc_178 -IPE: table_name table_name_179, closure_desc closure_desc_179, ty_desc ty_desc_179, label label_179, module module_179, srcloc srcloc_179 -IPE: table_name table_name_180, closure_desc closure_desc_180, ty_desc ty_desc_180, label label_180, module module_180, srcloc srcloc_180 -IPE: table_name table_name_181, closure_desc closure_desc_181, ty_desc ty_desc_181, label label_181, module module_181, srcloc srcloc_181 -IPE: table_name table_name_182, closure_desc closure_desc_182, ty_desc ty_desc_182, label label_182, module module_182, srcloc srcloc_182 -IPE: table_name table_name_183, closure_desc closure_desc_183, ty_desc ty_desc_183, label label_183, module module_183, srcloc srcloc_183 -IPE: table_name table_name_184, closure_desc closure_desc_184, ty_desc ty_desc_184, label label_184, module module_184, srcloc srcloc_184 -IPE: table_name table_name_185, closure_desc closure_desc_185, ty_desc ty_desc_185, label label_185, module module_185, srcloc srcloc_185 -IPE: table_name table_name_186, closure_desc closure_desc_186, ty_desc ty_desc_186, label label_186, module module_186, srcloc srcloc_186 -IPE: table_name table_name_187, closure_desc closure_desc_187, ty_desc ty_desc_187, label label_187, module module_187, srcloc srcloc_187 -IPE: table_name table_name_188, closure_desc closure_desc_188, ty_desc ty_desc_188, label label_188, module module_188, srcloc srcloc_188 -IPE: table_name table_name_189, closure_desc closure_desc_189, ty_desc ty_desc_189, label label_189, module module_189, srcloc srcloc_189 -IPE: table_name table_name_190, closure_desc closure_desc_190, ty_desc ty_desc_190, label label_190, module module_190, srcloc srcloc_190 -IPE: table_name table_name_191, closure_desc closure_desc_191, ty_desc ty_desc_191, label label_191, module module_191, srcloc srcloc_191 -IPE: table_name table_name_192, closure_desc closure_desc_192, ty_desc ty_desc_192, label label_192, module module_192, srcloc srcloc_192 -IPE: table_name table_name_193, closure_desc closure_desc_193, ty_desc ty_desc_193, label label_193, module module_193, srcloc srcloc_193 -IPE: table_name table_name_194, closure_desc closure_desc_194, ty_desc ty_desc_194, label label_194, module module_194, srcloc srcloc_194 -IPE: table_name table_name_195, closure_desc closure_desc_195, ty_desc ty_desc_195, label label_195, module module_195, srcloc srcloc_195 -IPE: table_name table_name_196, closure_desc closure_desc_196, ty_desc ty_desc_196, label label_196, module module_196, srcloc srcloc_196 -IPE: table_name table_name_197, closure_desc closure_desc_197, ty_desc ty_desc_197, label label_197, module module_197, srcloc srcloc_197 -IPE: table_name table_name_198, closure_desc closure_desc_198, ty_desc ty_desc_198, label label_198, module module_198, srcloc srcloc_198 -IPE: table_name table_name_199, closure_desc closure_desc_199, ty_desc ty_desc_199, label label_199, module module_199, srcloc srcloc_199 -IPE: table_name table_name_200, closure_desc closure_desc_200, ty_desc ty_desc_200, label label_200, module module_200, srcloc srcloc_200 -IPE: table_name table_name_201, closure_desc closure_desc_201, ty_desc ty_desc_201, label label_201, module module_201, srcloc srcloc_201 -IPE: table_name table_name_202, closure_desc closure_desc_202, ty_desc ty_desc_202, label label_202, module module_202, srcloc srcloc_202 -IPE: table_name table_name_203, closure_desc closure_desc_203, ty_desc ty_desc_203, label label_203, module module_203, srcloc srcloc_203 -IPE: table_name table_name_204, closure_desc closure_desc_204, ty_desc ty_desc_204, label label_204, module module_204, srcloc srcloc_204 -IPE: table_name table_name_205, closure_desc closure_desc_205, ty_desc ty_desc_205, label label_205, module module_205, srcloc srcloc_205 -IPE: table_name table_name_206, closure_desc closure_desc_206, ty_desc ty_desc_206, label label_206, module module_206, srcloc srcloc_206 -IPE: table_name table_name_207, closure_desc closure_desc_207, ty_desc ty_desc_207, label label_207, module module_207, srcloc srcloc_207 -IPE: table_name table_name_208, closure_desc closure_desc_208, ty_desc ty_desc_208, label label_208, module module_208, srcloc srcloc_208 -IPE: table_name table_name_209, closure_desc closure_desc_209, ty_desc ty_desc_209, label label_209, module module_209, srcloc srcloc_209 -IPE: table_name table_name_210, closure_desc closure_desc_210, ty_desc ty_desc_210, label label_210, module module_210, srcloc srcloc_210 -IPE: table_name table_name_211, closure_desc closure_desc_211, ty_desc ty_desc_211, label label_211, module module_211, srcloc srcloc_211 -IPE: table_name table_name_212, closure_desc closure_desc_212, ty_desc ty_desc_212, label label_212, module module_212, srcloc srcloc_212 -IPE: table_name table_name_213, closure_desc closure_desc_213, ty_desc ty_desc_213, label label_213, module module_213, srcloc srcloc_213 -IPE: table_name table_name_214, closure_desc closure_desc_214, ty_desc ty_desc_214, label label_214, module module_214, srcloc srcloc_214 -IPE: table_name table_name_215, closure_desc closure_desc_215, ty_desc ty_desc_215, label label_215, module module_215, srcloc srcloc_215 -IPE: table_name table_name_216, closure_desc closure_desc_216, ty_desc ty_desc_216, label label_216, module module_216, srcloc srcloc_216 -IPE: table_name table_name_217, closure_desc closure_desc_217, ty_desc ty_desc_217, label label_217, module module_217, srcloc srcloc_217 -IPE: table_name table_name_218, closure_desc closure_desc_218, ty_desc ty_desc_218, label label_218, module module_218, srcloc srcloc_218 -IPE: table_name table_name_219, closure_desc closure_desc_219, ty_desc ty_desc_219, label label_219, module module_219, srcloc srcloc_219 -IPE: table_name table_name_220, closure_desc closure_desc_220, ty_desc ty_desc_220, label label_220, module module_220, srcloc srcloc_220 -IPE: table_name table_name_221, closure_desc closure_desc_221, ty_desc ty_desc_221, label label_221, module module_221, srcloc srcloc_221 -IPE: table_name table_name_222, closure_desc closure_desc_222, ty_desc ty_desc_222, label label_222, module module_222, srcloc srcloc_222 -IPE: table_name table_name_223, closure_desc closure_desc_223, ty_desc ty_desc_223, label label_223, module module_223, srcloc srcloc_223 -IPE: table_name table_name_224, closure_desc closure_desc_224, ty_desc ty_desc_224, label label_224, module module_224, srcloc srcloc_224 -IPE: table_name table_name_225, closure_desc closure_desc_225, ty_desc ty_desc_225, label label_225, module module_225, srcloc srcloc_225 -IPE: table_name table_name_226, closure_desc closure_desc_226, ty_desc ty_desc_226, label label_226, module module_226, srcloc srcloc_226 -IPE: table_name table_name_227, closure_desc closure_desc_227, ty_desc ty_desc_227, label label_227, module module_227, srcloc srcloc_227 -IPE: table_name table_name_228, closure_desc closure_desc_228, ty_desc ty_desc_228, label label_228, module module_228, srcloc srcloc_228 -IPE: table_name table_name_229, closure_desc closure_desc_229, ty_desc ty_desc_229, label label_229, module module_229, srcloc srcloc_229 -IPE: table_name table_name_230, closure_desc closure_desc_230, ty_desc ty_desc_230, label label_230, module module_230, srcloc srcloc_230 -IPE: table_name table_name_231, closure_desc closure_desc_231, ty_desc ty_desc_231, label label_231, module module_231, srcloc srcloc_231 -IPE: table_name table_name_232, closure_desc closure_desc_232, ty_desc ty_desc_232, label label_232, module module_232, srcloc srcloc_232 -IPE: table_name table_name_233, closure_desc closure_desc_233, ty_desc ty_desc_233, label label_233, module module_233, srcloc srcloc_233 -IPE: table_name table_name_234, closure_desc closure_desc_234, ty_desc ty_desc_234, label label_234, module module_234, srcloc srcloc_234 -IPE: table_name table_name_235, closure_desc closure_desc_235, ty_desc ty_desc_235, label label_235, module module_235, srcloc srcloc_235 -IPE: table_name table_name_236, closure_desc closure_desc_236, ty_desc ty_desc_236, label label_236, module module_236, srcloc srcloc_236 -IPE: table_name table_name_237, closure_desc closure_desc_237, ty_desc ty_desc_237, label label_237, module module_237, srcloc srcloc_237 -IPE: table_name table_name_238, closure_desc closure_desc_238, ty_desc ty_desc_238, label label_238, module module_238, srcloc srcloc_238 -IPE: table_name table_name_239, closure_desc closure_desc_239, ty_desc ty_desc_239, label label_239, module module_239, srcloc srcloc_239 -IPE: table_name table_name_240, closure_desc closure_desc_240, ty_desc ty_desc_240, label label_240, module module_240, srcloc srcloc_240 -IPE: table_name table_name_241, closure_desc closure_desc_241, ty_desc ty_desc_241, label label_241, module module_241, srcloc srcloc_241 -IPE: table_name table_name_242, closure_desc closure_desc_242, ty_desc ty_desc_242, label label_242, module module_242, srcloc srcloc_242 -IPE: table_name table_name_243, closure_desc closure_desc_243, ty_desc ty_desc_243, label label_243, module module_243, srcloc srcloc_243 -IPE: table_name table_name_244, closure_desc closure_desc_244, ty_desc ty_desc_244, label label_244, module module_244, srcloc srcloc_244 -IPE: table_name table_name_245, closure_desc closure_desc_245, ty_desc ty_desc_245, label label_245, module module_245, srcloc srcloc_245 -IPE: table_name table_name_246, closure_desc closure_desc_246, ty_desc ty_desc_246, label label_246, module module_246, srcloc srcloc_246 -IPE: table_name table_name_247, closure_desc closure_desc_247, ty_desc ty_desc_247, label label_247, module module_247, srcloc srcloc_247 -IPE: table_name table_name_248, closure_desc closure_desc_248, ty_desc ty_desc_248, label label_248, module module_248, srcloc srcloc_248 -IPE: table_name table_name_249, closure_desc closure_desc_249, ty_desc ty_desc_249, label label_249, module module_249, srcloc srcloc_249 -IPE: table_name table_name_250, closure_desc closure_desc_250, ty_desc ty_desc_250, label label_250, module module_250, srcloc srcloc_250 -IPE: table_name table_name_251, closure_desc closure_desc_251, ty_desc ty_desc_251, label label_251, module module_251, srcloc srcloc_251 -IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc srcloc_000 -IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc srcloc_001 -IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc srcloc_002 -IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc srcloc_003 -IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc srcloc_004 -IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc srcloc_005 -IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc srcloc_006 -IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc srcloc_007 -IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc srcloc_008 -IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc srcloc_009 -IPE: table_name table_name_010, closure_desc closure_desc_010, ty_desc ty_desc_010, label label_010, module module_010, srcloc srcloc_010 -IPE: table_name table_name_011, closure_desc closure_desc_011, ty_desc ty_desc_011, label label_011, module module_011, srcloc srcloc_011 -IPE: table_name table_name_012, closure_desc closure_desc_012, ty_desc ty_desc_012, label label_012, module module_012, srcloc srcloc_012 -IPE: table_name table_name_013, closure_desc closure_desc_013, ty_desc ty_desc_013, label label_013, module module_013, srcloc srcloc_013 -IPE: table_name table_name_014, closure_desc closure_desc_014, ty_desc ty_desc_014, label label_014, module module_014, srcloc srcloc_014 -IPE: table_name table_name_015, closure_desc closure_desc_015, ty_desc ty_desc_015, label label_015, module module_015, srcloc srcloc_015 -IPE: table_name table_name_016, closure_desc closure_desc_016, ty_desc ty_desc_016, label label_016, module module_016, srcloc srcloc_016 -IPE: table_name table_name_017, closure_desc closure_desc_017, ty_desc ty_desc_017, label label_017, module module_017, srcloc srcloc_017 -IPE: table_name table_name_018, closure_desc closure_desc_018, ty_desc ty_desc_018, label label_018, module module_018, srcloc srcloc_018 -IPE: table_name table_name_019, closure_desc closure_desc_019, ty_desc ty_desc_019, label label_019, module module_019, srcloc srcloc_019 -IPE: table_name table_name_020, closure_desc closure_desc_020, ty_desc ty_desc_020, label label_020, module module_020, srcloc srcloc_020 -IPE: table_name table_name_021, closure_desc closure_desc_021, ty_desc ty_desc_021, label label_021, module module_021, srcloc srcloc_021 -IPE: table_name table_name_022, closure_desc closure_desc_022, ty_desc ty_desc_022, label label_022, module module_022, srcloc srcloc_022 -IPE: table_name table_name_023, closure_desc closure_desc_023, ty_desc ty_desc_023, label label_023, module module_023, srcloc srcloc_023 -IPE: table_name table_name_024, closure_desc closure_desc_024, ty_desc ty_desc_024, label label_024, module module_024, srcloc srcloc_024 -IPE: table_name table_name_025, closure_desc closure_desc_025, ty_desc ty_desc_025, label label_025, module module_025, srcloc srcloc_025 -IPE: table_name table_name_026, closure_desc closure_desc_026, ty_desc ty_desc_026, label label_026, module module_026, srcloc srcloc_026 -IPE: table_name table_name_027, closure_desc closure_desc_027, ty_desc ty_desc_027, label label_027, module module_027, srcloc srcloc_027 -IPE: table_name table_name_028, closure_desc closure_desc_028, ty_desc ty_desc_028, label label_028, module module_028, srcloc srcloc_028 -IPE: table_name table_name_029, closure_desc closure_desc_029, ty_desc ty_desc_029, label label_029, module module_029, srcloc srcloc_029 -IPE: table_name table_name_030, closure_desc closure_desc_030, ty_desc ty_desc_030, label label_030, module module_030, srcloc srcloc_030 -IPE: table_name table_name_031, closure_desc closure_desc_031, ty_desc ty_desc_031, label label_031, module module_031, srcloc srcloc_031 -IPE: table_name table_name_032, closure_desc closure_desc_032, ty_desc ty_desc_032, label label_032, module module_032, srcloc srcloc_032 -IPE: table_name table_name_033, closure_desc closure_desc_033, ty_desc ty_desc_033, label label_033, module module_033, srcloc srcloc_033 -IPE: table_name table_name_034, closure_desc closure_desc_034, ty_desc ty_desc_034, label label_034, module module_034, srcloc srcloc_034 -IPE: table_name table_name_035, closure_desc closure_desc_035, ty_desc ty_desc_035, label label_035, module module_035, srcloc srcloc_035 -IPE: table_name table_name_036, closure_desc closure_desc_036, ty_desc ty_desc_036, label label_036, module module_036, srcloc srcloc_036 -IPE: table_name table_name_037, closure_desc closure_desc_037, ty_desc ty_desc_037, label label_037, module module_037, srcloc srcloc_037 -IPE: table_name table_name_038, closure_desc closure_desc_038, ty_desc ty_desc_038, label label_038, module module_038, srcloc srcloc_038 -IPE: table_name table_name_039, closure_desc closure_desc_039, ty_desc ty_desc_039, label label_039, module module_039, srcloc srcloc_039 -IPE: table_name table_name_040, closure_desc closure_desc_040, ty_desc ty_desc_040, label label_040, module module_040, srcloc srcloc_040 -IPE: table_name table_name_041, closure_desc closure_desc_041, ty_desc ty_desc_041, label label_041, module module_041, srcloc srcloc_041 -IPE: table_name table_name_042, closure_desc closure_desc_042, ty_desc ty_desc_042, label label_042, module module_042, srcloc srcloc_042 -IPE: table_name table_name_043, closure_desc closure_desc_043, ty_desc ty_desc_043, label label_043, module module_043, srcloc srcloc_043 -IPE: table_name table_name_044, closure_desc closure_desc_044, ty_desc ty_desc_044, label label_044, module module_044, srcloc srcloc_044 -IPE: table_name table_name_045, closure_desc closure_desc_045, ty_desc ty_desc_045, label label_045, module module_045, srcloc srcloc_045 -IPE: table_name table_name_046, closure_desc closure_desc_046, ty_desc ty_desc_046, label label_046, module module_046, srcloc srcloc_046 -IPE: table_name table_name_047, closure_desc closure_desc_047, ty_desc ty_desc_047, label label_047, module module_047, srcloc srcloc_047 -IPE: table_name table_name_048, closure_desc closure_desc_048, ty_desc ty_desc_048, label label_048, module module_048, srcloc srcloc_048 -IPE: table_name table_name_049, closure_desc closure_desc_049, ty_desc ty_desc_049, label label_049, module module_049, srcloc srcloc_049 -IPE: table_name table_name_050, closure_desc closure_desc_050, ty_desc ty_desc_050, label label_050, module module_050, srcloc srcloc_050 -IPE: table_name table_name_051, closure_desc closure_desc_051, ty_desc ty_desc_051, label label_051, module module_051, srcloc srcloc_051 -IPE: table_name table_name_052, closure_desc closure_desc_052, ty_desc ty_desc_052, label label_052, module module_052, srcloc srcloc_052 -IPE: table_name table_name_053, closure_desc closure_desc_053, ty_desc ty_desc_053, label label_053, module module_053, srcloc srcloc_053 -IPE: table_name table_name_054, closure_desc closure_desc_054, ty_desc ty_desc_054, label label_054, module module_054, srcloc srcloc_054 -IPE: table_name table_name_055, closure_desc closure_desc_055, ty_desc ty_desc_055, label label_055, module module_055, srcloc srcloc_055 -IPE: table_name table_name_056, closure_desc closure_desc_056, ty_desc ty_desc_056, label label_056, module module_056, srcloc srcloc_056 -IPE: table_name table_name_057, closure_desc closure_desc_057, ty_desc ty_desc_057, label label_057, module module_057, srcloc srcloc_057 -IPE: table_name table_name_058, closure_desc closure_desc_058, ty_desc ty_desc_058, label label_058, module module_058, srcloc srcloc_058 -IPE: table_name table_name_059, closure_desc closure_desc_059, ty_desc ty_desc_059, label label_059, module module_059, srcloc srcloc_059 -IPE: table_name table_name_060, closure_desc closure_desc_060, ty_desc ty_desc_060, label label_060, module module_060, srcloc srcloc_060 -IPE: table_name table_name_061, closure_desc closure_desc_061, ty_desc ty_desc_061, label label_061, module module_061, srcloc srcloc_061 -IPE: table_name table_name_062, closure_desc closure_desc_062, ty_desc ty_desc_062, label label_062, module module_062, srcloc srcloc_062 -IPE: table_name table_name_063, closure_desc closure_desc_063, ty_desc ty_desc_063, label label_063, module module_063, srcloc srcloc_063 -IPE: table_name table_name_064, closure_desc closure_desc_064, ty_desc ty_desc_064, label label_064, module module_064, srcloc srcloc_064 -IPE: table_name table_name_065, closure_desc closure_desc_065, ty_desc ty_desc_065, label label_065, module module_065, srcloc srcloc_065 -IPE: table_name table_name_066, closure_desc closure_desc_066, ty_desc ty_desc_066, label label_066, module module_066, srcloc srcloc_066 -IPE: table_name table_name_067, closure_desc closure_desc_067, ty_desc ty_desc_067, label label_067, module module_067, srcloc srcloc_067 -IPE: table_name table_name_068, closure_desc closure_desc_068, ty_desc ty_desc_068, label label_068, module module_068, srcloc srcloc_068 -IPE: table_name table_name_069, closure_desc closure_desc_069, ty_desc ty_desc_069, label label_069, module module_069, srcloc srcloc_069 -IPE: table_name table_name_070, closure_desc closure_desc_070, ty_desc ty_desc_070, label label_070, module module_070, srcloc srcloc_070 -IPE: table_name table_name_071, closure_desc closure_desc_071, ty_desc ty_desc_071, label label_071, module module_071, srcloc srcloc_071 -IPE: table_name table_name_072, closure_desc closure_desc_072, ty_desc ty_desc_072, label label_072, module module_072, srcloc srcloc_072 -IPE: table_name table_name_073, closure_desc closure_desc_073, ty_desc ty_desc_073, label label_073, module module_073, srcloc srcloc_073 -IPE: table_name table_name_074, closure_desc closure_desc_074, ty_desc ty_desc_074, label label_074, module module_074, srcloc srcloc_074 -IPE: table_name table_name_075, closure_desc closure_desc_075, ty_desc ty_desc_075, label label_075, module module_075, srcloc srcloc_075 -IPE: table_name table_name_076, closure_desc closure_desc_076, ty_desc ty_desc_076, label label_076, module module_076, srcloc srcloc_076 -IPE: table_name table_name_077, closure_desc closure_desc_077, ty_desc ty_desc_077, label label_077, module module_077, srcloc srcloc_077 -IPE: table_name table_name_078, closure_desc closure_desc_078, ty_desc ty_desc_078, label label_078, module module_078, srcloc srcloc_078 -IPE: table_name table_name_079, closure_desc closure_desc_079, ty_desc ty_desc_079, label label_079, module module_079, srcloc srcloc_079 -IPE: table_name table_name_080, closure_desc closure_desc_080, ty_desc ty_desc_080, label label_080, module module_080, srcloc srcloc_080 -IPE: table_name table_name_081, closure_desc closure_desc_081, ty_desc ty_desc_081, label label_081, module module_081, srcloc srcloc_081 -IPE: table_name table_name_082, closure_desc closure_desc_082, ty_desc ty_desc_082, label label_082, module module_082, srcloc srcloc_082 -IPE: table_name table_name_083, closure_desc closure_desc_083, ty_desc ty_desc_083, label label_083, module module_083, srcloc srcloc_083 -IPE: table_name table_name_084, closure_desc closure_desc_084, ty_desc ty_desc_084, label label_084, module module_084, srcloc srcloc_084 -IPE: table_name table_name_085, closure_desc closure_desc_085, ty_desc ty_desc_085, label label_085, module module_085, srcloc srcloc_085 -IPE: table_name table_name_086, closure_desc closure_desc_086, ty_desc ty_desc_086, label label_086, module module_086, srcloc srcloc_086 -IPE: table_name table_name_087, closure_desc closure_desc_087, ty_desc ty_desc_087, label label_087, module module_087, srcloc srcloc_087 -IPE: table_name table_name_088, closure_desc closure_desc_088, ty_desc ty_desc_088, label label_088, module module_088, srcloc srcloc_088 -IPE: table_name table_name_089, closure_desc closure_desc_089, ty_desc ty_desc_089, label label_089, module module_089, srcloc srcloc_089 -IPE: table_name table_name_090, closure_desc closure_desc_090, ty_desc ty_desc_090, label label_090, module module_090, srcloc srcloc_090 -IPE: table_name table_name_091, closure_desc closure_desc_091, ty_desc ty_desc_091, label label_091, module module_091, srcloc srcloc_091 -IPE: table_name table_name_092, closure_desc closure_desc_092, ty_desc ty_desc_092, label label_092, module module_092, srcloc srcloc_092 -IPE: table_name table_name_093, closure_desc closure_desc_093, ty_desc ty_desc_093, label label_093, module module_093, srcloc srcloc_093 -IPE: table_name table_name_094, closure_desc closure_desc_094, ty_desc ty_desc_094, label label_094, module module_094, srcloc srcloc_094 -IPE: table_name table_name_095, closure_desc closure_desc_095, ty_desc ty_desc_095, label label_095, module module_095, srcloc srcloc_095 -IPE: table_name table_name_096, closure_desc closure_desc_096, ty_desc ty_desc_096, label label_096, module module_096, srcloc srcloc_096 -IPE: table_name table_name_097, closure_desc closure_desc_097, ty_desc ty_desc_097, label label_097, module module_097, srcloc srcloc_097 -IPE: table_name table_name_098, closure_desc closure_desc_098, ty_desc ty_desc_098, label label_098, module module_098, srcloc srcloc_098 -IPE: table_name table_name_099, closure_desc closure_desc_099, ty_desc ty_desc_099, label label_099, module module_099, srcloc srcloc_099 -IPE: table_name table_name_100, closure_desc closure_desc_100, ty_desc ty_desc_100, label label_100, module module_100, srcloc srcloc_100 -IPE: table_name table_name_101, closure_desc closure_desc_101, ty_desc ty_desc_101, label label_101, module module_101, srcloc srcloc_101 -IPE: table_name table_name_102, closure_desc closure_desc_102, ty_desc ty_desc_102, label label_102, module module_102, srcloc srcloc_102 -IPE: table_name table_name_103, closure_desc closure_desc_103, ty_desc ty_desc_103, label label_103, module module_103, srcloc srcloc_103 -IPE: table_name table_name_104, closure_desc closure_desc_104, ty_desc ty_desc_104, label label_104, module module_104, srcloc srcloc_104 -IPE: table_name table_name_105, closure_desc closure_desc_105, ty_desc ty_desc_105, label label_105, module module_105, srcloc srcloc_105 -IPE: table_name table_name_106, closure_desc closure_desc_106, ty_desc ty_desc_106, label label_106, module module_106, srcloc srcloc_106 -IPE: table_name table_name_107, closure_desc closure_desc_107, ty_desc ty_desc_107, label label_107, module module_107, srcloc srcloc_107 -IPE: table_name table_name_108, closure_desc closure_desc_108, ty_desc ty_desc_108, label label_108, module module_108, srcloc srcloc_108 -IPE: table_name table_name_109, closure_desc closure_desc_109, ty_desc ty_desc_109, label label_109, module module_109, srcloc srcloc_109 -IPE: table_name table_name_110, closure_desc closure_desc_110, ty_desc ty_desc_110, label label_110, module module_110, srcloc srcloc_110 -IPE: table_name table_name_111, closure_desc closure_desc_111, ty_desc ty_desc_111, label label_111, module module_111, srcloc srcloc_111 -IPE: table_name table_name_112, closure_desc closure_desc_112, ty_desc ty_desc_112, label label_112, module module_112, srcloc srcloc_112 -IPE: table_name table_name_113, closure_desc closure_desc_113, ty_desc ty_desc_113, label label_113, module module_113, srcloc srcloc_113 -IPE: table_name table_name_114, closure_desc closure_desc_114, ty_desc ty_desc_114, label label_114, module module_114, srcloc srcloc_114 -IPE: table_name table_name_115, closure_desc closure_desc_115, ty_desc ty_desc_115, label label_115, module module_115, srcloc srcloc_115 -IPE: table_name table_name_116, closure_desc closure_desc_116, ty_desc ty_desc_116, label label_116, module module_116, srcloc srcloc_116 -IPE: table_name table_name_117, closure_desc closure_desc_117, ty_desc ty_desc_117, label label_117, module module_117, srcloc srcloc_117 -IPE: table_name table_name_118, closure_desc closure_desc_118, ty_desc ty_desc_118, label label_118, module module_118, srcloc srcloc_118 -IPE: table_name table_name_119, closure_desc closure_desc_119, ty_desc ty_desc_119, label label_119, module module_119, srcloc srcloc_119 -IPE: table_name table_name_120, closure_desc closure_desc_120, ty_desc ty_desc_120, label label_120, module module_120, srcloc srcloc_120 -IPE: table_name table_name_121, closure_desc closure_desc_121, ty_desc ty_desc_121, label label_121, module module_121, srcloc srcloc_121 -IPE: table_name table_name_122, closure_desc closure_desc_122, ty_desc ty_desc_122, label label_122, module module_122, srcloc srcloc_122 -IPE: table_name table_name_123, closure_desc closure_desc_123, ty_desc ty_desc_123, label label_123, module module_123, srcloc srcloc_123 -IPE: table_name table_name_124, closure_desc closure_desc_124, ty_desc ty_desc_124, label label_124, module module_124, srcloc srcloc_124 -IPE: table_name table_name_125, closure_desc closure_desc_125, ty_desc ty_desc_125, label label_125, module module_125, srcloc srcloc_125 +7f5278bc0740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000 +7f5278bc0740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001 +7f5278bc0740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002 +7f5278bc0740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003 +7f5278bc0740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004 +7f5278bc0740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005 +7f5278bc0740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006 +7f5278bc0740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007 +7f5278bc0740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008 +7f5278bc0740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc src_file_009:src_span_009 +7f5278bc0740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000 +7f5278bc0740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001 +7f5278bc0740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002 +7f5278bc0740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003 +7f5278bc0740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004 +7f5278bc0740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005 +7f5278bc0740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006 +7f5278bc0740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007 +7f5278bc0740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008 +7f5278bc0740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc src_file_009:src_span_009 ===================================== testsuite/tests/rts/ipeEventLog_fromMap.c ===================================== @@ -4,9 +4,7 @@ #include #include #include - -extern void dumpIPEToEventLog(void); -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i); +#include "ipeEventLog_lib.h" int main(int argc, char *argv[]) { hs_init(&argc, &argv); @@ -14,18 +12,14 @@ int main(int argc, char *argv[]) { HaskellObj one = rts_mkInt(cap, 1); - InfoProvEnt *provEnt_0 = makeAnyProvEntry(cap, 0); - InfoProvEnt *provEnt_1 = makeAnyProvEntry(cap, 1); - - InfoProvEnt **ipeList_1 = malloc(sizeof(InfoProvEnt *) * 3); - ipeList_1[0] = provEnt_0; - ipeList_1[1] = provEnt_1; - ipeList_1[2] = NULL; + IpeBufferListNode *list1 = makeAnyProvEntries(cap, 10); + IpeBufferListNode *list2 = makeAnyProvEntries(cap, 10); - registerInfoProvList(ipeList_1); + registerInfoProvList(list1); + registerInfoProvList(list2); // Query an IPE to initialize the underlying hash map. - lookupIPE(ipeList_1[0]->info); + lookupIPE(list1->entries[0].info); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipeEventLog_fromMap.stderr ===================================== @@ -1,2 +1,20 @@ -IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc srcloc_001 -IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc srcloc_000 +7f3f06934740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000 +7f3f06934740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001 +7f3f06934740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002 +7f3f06934740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003 +7f3f06934740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004 +7f3f06934740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005 +7f3f06934740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006 +7f3f06934740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007 +7f3f06934740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008 +7f3f06934740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc src_file_009:src_span_009 +7f3f06934740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000 +7f3f06934740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001 +7f3f06934740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002 +7f3f06934740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003 +7f3f06934740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004 +7f3f06934740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005 +7f3f06934740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006 +7f3f06934740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007 +7f3f06934740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008 +7f3f06934740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc src_file_009:src_span_009 ===================================== testsuite/tests/rts/ipeEventLog_lib.c ===================================== @@ -1,42 +1,83 @@ #include "Rts.h" #include "rts/IPE.h" #include +#include "ipeEventLog_lib.h" -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i) { +void init_string_table(StringTable *st) { + st->size = 128; + st->n = 0; + st->buffer = malloc(st->size); +} + +uint32_t add_string(StringTable *st, const char *s) { + const size_t len = strlen(s); + const uint32_t n = st->n; + if (st->n + len + 1 > st->size) { + const size_t new_size = 2*st->size + len; + st->buffer = realloc(st->buffer, new_size); + st->size = new_size; + } + + memcpy(&st->buffer[st->n], s, len); + st->n += len; + st->buffer[st->n] = '\0'; + st->n += 1; + return n; +} + +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { HaskellObj fourtyTwo = rts_mkInt(cap, 42); - InfoProvEnt *provEnt = malloc(sizeof(InfoProvEnt)); - provEnt->info = (StgInfoTable *)fourtyTwo->header.info; + IpeBufferEntry provEnt; + provEnt.info = (StgInfoTable *)fourtyTwo->header.info; unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); snprintf(tableName, tableNameLength, "table_name_%03i", i); - provEnt->prov.table_name = tableName; + provEnt.table_name = add_string(st, tableName); unsigned int closureDescLength = strlen("closure_desc_") + 3 /* digits */ + 1 /* null character */; char *closureDesc = malloc(sizeof(char) * closureDescLength); snprintf(closureDesc, closureDescLength, "closure_desc_%03i", i); - provEnt->prov.closure_desc = closureDesc; + provEnt.closure_desc = add_string(st, closureDesc); unsigned int tyDescLength = strlen("ty_desc_") + 3 /* digits */ + 1 /* null character */; char *tyDesc = malloc(sizeof(char) * tyDescLength); snprintf(tyDesc, tyDescLength, "ty_desc_%03i", i); - provEnt->prov.ty_desc = tyDesc; + provEnt.ty_desc = add_string(st, tyDesc); unsigned int labelLength = strlen("label_") + 3 /* digits */ + 1 /* null character */; char *label = malloc(sizeof(char) * labelLength); snprintf(label, labelLength, "label_%03i", i); - provEnt->prov.label = label; + provEnt.label = add_string(st, label); unsigned int moduleLength = strlen("module_") + 3 /* digits */ + 1 /* null character */; char *module = malloc(sizeof(char) * labelLength); snprintf(module, moduleLength, "module_%03i", i); - provEnt->prov.module = module; + provEnt.module_name = add_string(st, module); + + unsigned int srcFileLength = strlen("src_file_") + 3 /* digits */ + 1 /* null character */; + char *srcFile = malloc(sizeof(char) * srcFileLength); + snprintf(srcFile, srcFileLength, "src_file_%03i", i); + provEnt.src_file = add_string(st, srcFile); - unsigned int srcLocLength = strlen("srcloc_") + 3 /* digits */ + 1 /* null character */; - char *srcLoc = malloc(sizeof(char) * srcLocLength); - snprintf(srcLoc, srcLocLength, "srcloc_%03i", i); - provEnt->prov.srcloc = srcLoc; + unsigned int srcSpanLength = strlen("src_span_") + 3 /* digits */ + 1 /* null character */; + char *srcSpan = malloc(sizeof(char) * srcSpanLength); + snprintf(srcSpan, srcSpanLength, "src_span_%03i", i); + provEnt.src_span = add_string(st, srcSpan); return provEnt; } + +IpeBufferListNode *makeAnyProvEntries(Capability *cap, int n) { + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); + for (int i=0; i < n; i++) { + node->entries[i] = makeAnyProvEntry(cap, &st, i); + } + node->next = NULL; + node->count = n; + node->string_table = st.buffer; + return node; +} ===================================== testsuite/tests/rts/ipeEventLog_lib.h ===================================== @@ -0,0 +1,17 @@ +#pragma once + +#include "Rts.h" + +typedef struct { + char *buffer; + size_t n; + size_t size; +} StringTable; + +void init_string_table(StringTable *st); +uint32_t add_string(StringTable *st, const char *s); + +IpeBufferListNode *makeAnyProvEntries(Capability *cap, int n); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i); +void dumpIPEToEventLog(void); + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dafb357befbd39f54b2d16cff89e32845fc187ff...ebc644c1721a309279a996f7ab2917cc8b8044a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dafb357befbd39f54b2d16cff89e32845fc187ff...ebc644c1721a309279a996f7ab2917cc8b8044a1 You're receiving 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 Aug 20 03:28:33 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 Aug 2022 23:28:33 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 10 commits: Refactor IPE initialization Message-ID: <630054e1b6b83_125b2b150e154039096@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: c0d18614 by Ben Gamari at 2022-08-19T23:19:29-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - ebc644c1 by Ben Gamari at 2022-08-19T23:19:29-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 9b26d780 by Ben Gamari at 2022-08-19T23:21:03-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - c3383e5e by Ben Gamari at 2022-08-19T23:21:03-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 95f5b0cd by Ben Gamari at 2022-08-19T23:21:03-04:00 base: Move prettyCallStack to GHC.Stack - - - - - 8f77187c by Ben Gamari at 2022-08-19T23:22:06-04:00 base: Move PrimMVar to GHC.MVar - - - - - b4113d28 by Ben Gamari at 2022-08-19T23:22:06-04:00 base: Introduce exception context - - - - - d43c456f by Ben Gamari at 2022-08-19T23:25:28-04:00 base: Introduce exception backtrace infrastructure - - - - - 5772ed24 by Ben Gamari at 2022-08-19T23:25:28-04:00 base: Collect backtraces in GHC.IO.throwIO - - - - - 8d173dea by Ben Gamari at 2022-08-19T23:25:28-04:00 base: Collect backtraces in GHC.Exception.throw - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/ghc.cabal.in - 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/InfoProv.hsc - 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/base.cabal - rts/IPE.c - rts/IPE.h - rts/RtsStartup.c - rts/Trace.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d00c7af4a4ac3251ccf1bdf2b2fa808b0de5255...8d173dea5e5e04a0a0cfa2b35cd0ec1e45d4e861 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d00c7af4a4ac3251ccf1bdf2b2fa808b0de5255...8d173dea5e5e04a0a0cfa2b35cd0ec1e45d4e861 You're receiving 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 Aug 20 10:34:13 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Sat, 20 Aug 2022 06:34:13 -0400 Subject: [Git][ghc/ghc][wip/21611-move-corem] 45 commits: testsuite: Add test for #21583 Message-ID: <6300b8a5b5c23_125b2b150e33cc43028a@gitlab.mail> Dominik Peteler pushed to branch wip/21611-move-corem at Glasgow Haskell Compiler / GHC Commits: 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 51ffd009 by Swann Moreau at 2022-08-19T18:29:21-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 4dd68771 by Dominik Peteler at 2022-08-20T12:06:27+02:00 Move CoreM to GHC.Plugins.Monad Removes the uses of CoreM in the Specialise, SpecConstr and CallerCC pass. Since CoreM is now only used by Core2core plugins within the Core pipeline the monad got moved to an own module. Additionally CoreToDo and related types got moved to an own module GHC.Core.Opt.Pipeline.Types. Moved the remaining code from GHC.Core.Opt.Monad to GHC.Core.Opt.Utils. GHC.Core.Opt.{SpecConstr,CallerCC} got proper configs / the usual treatment. Split out GHC.Core.Opt.CallerCC.Filter to avoid hs-boot. Removed explicit PrintUnqualified argument from `endPassIO` Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep Fixes #21611. - - - - - 1573d899 by Dominik Peteler at 2022-08-20T12:06:35+02:00 Removed CoreM uses from GHC.Core.Lint - - - - - 958e96b9 by Dominik Peteler at 2022-08-20T12:28:25+02:00 Purified GHC.Core.LateCC.addLateCostCentres * GHC.Driver.Config.Core.Lint: * Removed: endPass * Renamed: endPassHscEnvIO -> endPass * Moved GHC.Core.Opt.Pipeline.initLintAnnotationsConfig to GHC.Driver.Config.Core.Lint - - - - - b58cf2f8 by Dominik Peteler at 2022-08-20T12:28:34+02:00 Run the CoreToDo interpreter in an own monad `SimplCountM` This monad is just `StateT SimplCount IO` wrapped in a newtype. This way we get rid of some `Core.Opt.Pipeline` boilerplate. It lives in GHC.Core.Opt.Counting and `Tick` and `SimplCount` got moved there as well. Also: * GHC.Core.Opt.Pipeline.runCorePasses: Take logger service as an argument - - - - - f1c8835d by Dominik Peteler at 2022-08-20T12:28:35+02:00 Removed references to driver from Specialise pass - - - - - ab775aa5 by Dominik Peteler at 2022-08-20T12:28:36+02:00 Split `Core.EndPass` from `Core.Lint` This better sepates concerns (linting is domain layer, end pass diagnostics is application later), and `Core.Lint` is a huge module to boot. - - - - - fb7959e9 by Dominik Peteler at 2022-08-20T12:28:37+02:00 Get rid of `CoreDesugar`, `CoreDesugarOpt`, `CoreTidy`, `CorePrep` Those are not Core -> Core passes and so they don't belong in that sum type. Also cleaned up a bit: * Removed 'GHC.Driver.Config.Core.Lint.lintCoreBindings' It was dead code. * Removed 'GHC.Driver.Config.Core.Lint.lintPassResult' It run the actual linting and therefore it didn't belong to the GHC.Driver.Config namespace. As it was used only once the definition got inlined. * GHC.Core.Lint: Renamed lintPassResult' to lintPassResult. Also renamed lintCoreBindings' to lintCoreBindings. * GHC.Driver.Config.Core.Lint: Stick to the defaults when initializing the config records. * GHC.Driver.Config.Core.EndPass: Inlined `endPass` * GHC.Driver.Config.Core.EndPass: Removed `endPassLintFlags` as it was never used - - - - - 904da0ad by Dominik Peteler at 2022-08-20T12:28:38+02:00 Simplified initSimplifyOpts - - - - - 247c5541 by Dominik Peteler at 2022-08-20T12:28:38+02:00 Adjusted tests - - - - - 6dc702d6 by Dominik Peteler at 2022-08-20T12:28:39+02:00 Removed RuleBase from getCoreToDo - - - - - b64653eb by Dominik Peteler at 2022-08-20T12:28:40+02:00 Purified initSpecialiseOpts Also pass the rule bases and the visible orphan modules as arguments to the Specialise pass. - - - - - 7a8d2e4e by Dominik Peteler at 2022-08-20T12:28:41+02:00 Simplified CoreToDo interpreter a bit - - - - - dfd74e45 by Dominik Peteler at 2022-08-20T12:33:40+02:00 Config records of some Core passes are now provided by CoreToDo * CoreAddCallerCcs * CoreAddLateCcs * CoreDoFloatInwards * CoreLiberateCase * CoreDoSpecConstr - - - - - 2a2b7171 by Dominik Peteler at 2022-08-20T12:33:43+02:00 Move Core pipeline to the driver * Moved `getCoreToDo` to an own module GHC.Driver.Config.Core.Opt * Moved the remaining part of GHC.Core.Opt.Pipeline to a new module GHC.Driver.Core.Opt * Renamed GHC.Core.Opt.Pipeline.Types to GHC.Core.Opt.Config - - - - - c3c363b5 by Dominik Peteler at 2022-08-20T12:33:44+02:00 Fixed tests - - - - - c6fe37c2 by Dominik Peteler at 2022-08-20T12:33:45+02:00 Fixed note - - - - - 62e4f342 by John Ericson at 2022-08-20T12:33:46+02:00 Add some haddocks - - - - - 5017533f by John Ericson at 2022-08-20T12:33:47+02:00 Move `core2core` to `GHC.Driver.Main` This "pushes up" the planning vs execution split, by not combining the two until a further downstream module. That helps encourage this separation we are very much fans of. Also deduplicate some logic with `liftCoreMToSimplCountM`, which abstracts over a number of details to eliminate a `CoreM` to a `SimpleCountM`. It might be a bit too opinionated at the moment, in which case we will think about how to shuffle some things around. In addition, deduplicate `simplMask`, which is indeed sketchy thing to export, but we can deal with that later. - - - - - 6d7673a2 by John Ericson at 2022-08-20T12:33:47+02:00 Factor out `readRuleEnv` into its own module nad give haddocks Might end up up recombining this but its good separation of concerns for now. - - - - - 109ee718 by John Ericson at 2022-08-20T12:33:48+02:00 Quick and dirty chop up modules once again I decided my earlier recommendation to mmhat was not quite write. It was the one I implemented too. So through this together real quick and dirty. We can make it nicer afterwords Things that are not yet nice: - `CoreOptEnv` is a grab bag of junk. Of course, it is merely reifying how was were accessing `HscEnv` before --- also rather junky! So maybe it cannot totally be improved. But it would be good to go over bits and ask / make issues (like #21926) that would help us clean up later. - Logging tricks for annotations linting is broken from the planning vs execution separation. We'll need to "delay that part of planning too. Can hack it up with more higher order function tricks, might be also a good oppertunity to rethink what should go in which config. - Some of the per-pass config records require info that isn't available at planning time. I hacked up up with functions in `CoreToDo` but we could do better. Conversely, per #21926, perhaps we *should* include the module name in the config after all, since we know it from downsweep before upsweep begins. - `GHC.Driver.Core.Rules` could just go inside `GHC.Driver.Core.Opt`. - - - - - c0f7d376 by John Ericson at 2022-08-20T12:33:49+02:00 Split `GHC.Core.Opt.Utils` Half of it was domain layer (float out switches) but the other half was infrastructure / driver (annotations). - - - - - cff3cbcd by Dominik Peteler at 2022-08-20T12:33:50+02:00 Fixed tests - - - - - a2e796c4 by Dominik Peteler at 2022-08-20T12:33:50+02:00 Better configuration of Core lint debug options - - - - - 97707e4c by Dominik Peteler at 2022-08-20T12:33:51+02:00 Configuration record for rule check pass - - - - - 89462545 by Dominik Peteler at 2022-08-20T12:33:52+02:00 Renamed dmdAnal to demandAnalysis and moved it to GHC.Core.Opt.DmdAnal - - - - - c19f4f85 by Dominik Peteler at 2022-08-20T12:33:53+02:00 Fix tests - - - - - 554e9f19 by Dominik Peteler at 2022-08-20T12:33:53+02:00 Added environment for worker/wrapper pass - - - - - eea78130 by Dominik Peteler at 2022-08-20T12:33:54+02:00 Refactored configuration of Specialise pass again Also removed GHC.Core.Opt.Specialise.Config again. We may introduce separate *.Config modules for the passes once we had a look at the module graph and decide whether the addition of these modules is justified. - - - - - e861ca6c by Dominik Peteler at 2022-08-20T12:33:55+02:00 Removed GHC.Driver.Core.Rules - - - - - fd350960 by Dominik Peteler at 2022-08-20T12:33:56+02:00 Removed CoreDoNothing and CoreDoPasses Rewrote the getCoreToDo function using a Writer monad. This makes these data constructors superfluous. - - - - - 092fb59f by Dominik Peteler at 2022-08-20T12:33:56+02:00 Renamed endPassIO to endPass - - - - - 88e1a5e2 by Dominik Peteler at 2022-08-20T12:33:57+02:00 Renamed hscSimplify/hscSimplify' to optimizeCoreIO/optimizeCoreHsc - - - - - 03b4723f by Dominik Peteler at 2022-08-20T12:33:58+02:00 Run simplifyPgm in SimplCountM - - - - - ffd58d02 by Dominik Peteler at 2022-08-20T12:33:59+02:00 Added note on the architecture of the Core optimizer - - - - - 25 changed files: - compiler/GHC.hs - compiler/GHC/Core.hs - + compiler/GHC/Core/EndPass.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Lint/Interactive.hs - + compiler/GHC/Core/Opt.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Filter.hs - compiler/GHC/Core/Opt/Pipeline/Types.hs → compiler/GHC/Core/Opt/Config.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/FloatOut.hs - + compiler/GHC/Core/Opt/FloatOutSwitches.hs - − compiler/GHC/Core/Opt/Pipeline.hs - + compiler/GHC/Core/Opt/RuleCheck.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/Stats.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ffaadeb905fc6fca09ed0aed0b32629804290330...ffd58d021b5c6c0574b5d013365e1500d40a9fbc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ffaadeb905fc6fca09ed0aed0b32629804290330...ffd58d021b5c6c0574b5d013365e1500d40a9fbc You're receiving 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 Aug 20 14:12:51 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 10:12:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22062 Message-ID: <6300ebe3a19a5_e9d7d487ec911b1@gitlab.mail> Ben Gamari pushed new branch wip/T22062 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22062 You're receiving 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 Aug 20 16:07:14 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 12:07:14 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] 7 commits: Bump haddock submodule Message-ID: <630106b2bb4d5_e9d7d487ec1148d7@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: 42aff86e by Ben Gamari at 2022-08-20T12:07:08-04:00 Bump haddock submodule Bumps haddock-api version to 2.27.1 - - - - - 6466747b by Ben Gamari at 2022-08-20T12:07:08-04:00 Add release notes for 9.4.2 - - - - - 8e6b979c by Ben Gamari at 2022-08-20T12:07:08-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ (cherry picked from commit 37c61cc05f82f4cdc43aece152df8630b7c0419d) - - - - - ed1f88eb by Ben Gamari at 2022-08-20T12:07:08-04:00 users-guide: Add :ghc-flag: reference (cherry picked from commit 14853adf9571c9fe57d70456a4e8470299a81b8e) - - - - - ba137e8b by Ben Gamari at 2022-08-20T12:07:08-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. (cherry picked from commit f0dc6f3e2333cc4625bdfb75990f80ef0ef96638) - - - - - 0ce2dc79 by Ben Gamari at 2022-08-20T12:07:08-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. (cherry picked from commit c57075ebbed5dc8ae82902999b9f5ae5f3e83b0e) - - - - - b67d4ac6 by Ben Gamari at 2022-08-20T12:07:08-04:00 Release 9.4.2 - - - - - 7 changed files: - configure.ac - + docs/users_guide/9.4.2-notes.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - docs/users_guide/release-notes.rst - hadrian/src/Rules/Documentation.hs - utils/haddock 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.4.1], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.4.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 @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.4.1], [glasgow-has AC_CONFIG_MACRO_DIRS([m4]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # 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.4.2-notes.rst ===================================== @@ -0,0 +1,88 @@ +.. _release-9-4-2: + +Version 9.4.2 +============== + +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 +10, 11, 12, or 13. + +Significant Changes +~~~~~~~~~~~~~~~~~~~~ + +This is primarily a bug-fix release addressing packaging issues found in 9.4.1. +These issues include: + + * Building with the ``make`` build system should now work reliably with + GHC 9.0 (:ghc-ticket:`21897`, :ghc-ticket:`22047`) + * Make-built binary distributions should no longer complain about incorrect + GHC versions during installation (:ghc-ticket:) + * Generated Haddock package index pages uploaded to Hackage lacked quick-jump + support (:ghc-ticket:`21984`) + * Cross-package identifier referenced are now linked correctly in Haddock + documentation (:ghc-ticket:`20001`) + * Hadrian-built binary distributions no longer attempt to install documentation + if documentation was not built (:ghc-ticket:`21976`) + * Package registration files installed by Hadrian-built binary distributions now + have the correct permissions + +In addition, a few non-packaging issues have been resolved: + + * the :ghc-flag:`-no-link` flag no longer attempts to link (:ghc-ticket:`21866`) + * a soundness issue in GHCi has been resolved (:ghc-ticket:`22042`, + :ghc-ticket:`21083`) + * a subtle race condition in the IO manager triggered by changing the + capability count was fixed (:ghc-ticket:`21651`) + * GHC no longer attempts to use the platform-reserved `x18` register on + AArch64/Darwin (:ghc-ticket:`21964`) + * GHC's internal linker is now able to resolve symbols provided by FreeBSD's + built-in ``iconv`` implementation (:ghc-ticket:`20354`) + * GHC is now able to correctly locate ``libc++`` on FreeBSD systems + +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/exts/rewrite_rules.rst ===================================== @@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: :: where ``intLookup`` is an implementation of ``genericLookup`` that works very fast for keys of type ``Int``. You might wish to tell GHC to use ``intLookup`` instead of ``genericLookup`` whenever the latter was -called with type ``Table Int b -> Int -> b``. It used to be possible to -write :: +called with type ``Table Int b -> Int -> b``. It used to be possible to write a +:pragma:`SPECIALIZE` pragma with a right-hand-side: :: {-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-} ===================================== docs/users_guide/phases.rst ===================================== @@ -474,7 +474,7 @@ defined by your local GHC installation, the following trick is useful: .. index:: single: __GLASGOW_HASKELL_LLVM__ - Only defined when ``-fllvm`` is specified. When GHC is using version + Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version ``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero is added, so for example when using version 3.7 of LLVM, @@ -621,8 +621,8 @@ Options affecting code generation .. note:: - Note that this GHC release expects an LLVM version in the |llvm-version| - release series. + Note that this GHC release expects an LLVM version between |llvm-version-min| + and |llvm-version-max|. .. ghc-flag:: -fno-code :shortdesc: Omit code generation ===================================== docs/users_guide/release-notes.rst ===================================== @@ -4,4 +4,5 @@ Release notes .. toctree:: :maxdepth: 1 + 9.4.2-notes 9.4.1-notes ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -41,7 +41,7 @@ archiveRoot :: FilePath archiveRoot = docRoot -/- "archives" manPageBuildPath :: FilePath -manPageBuildPath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1" -- TODO: Get rid of this hack. docContext :: Context ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 421e4c36e58cae686d55a99946d5fa54abaa6000 +Subproject commit 6113875efdc0b6be66deedb77e28d3b9e4253d1e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80b46a1a3597be3c8f54ed6c61c26d466ae88dd0...b67d4ac67af7cca18a4b3c93e572478763f2e5fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80b46a1a3597be3c8f54ed6c61c26d466ae88dd0...b67d4ac67af7cca18a4b3c93e572478763f2e5fb You're receiving 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 Aug 20 16:08:05 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 12:08:05 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] hadrian: Don't duplicate binaries on installation Message-ID: <630106e585a10_e9d7d4ee6c1150d@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: c126db99 by Ben Gamari at 2022-08-20T12:07:46-04:00 hadrian: Don't duplicate binaries on installation Previously we used `install` on symbolic links, which ended up copying the target file rather than installing a symbolic link. Fixes #22062. - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -140,7 +140,11 @@ install_bin_libdir: @echo "Copying binaries to $(DESTDIR)$(ActualBinsDir)" $(INSTALL_DIR) "$(DESTDIR)$(ActualBinsDir)" for i in $(BINARIES); do \ - $(INSTALL_PROGRAM) $$i "$(DESTDIR)$(ActualBinsDir)"; \ + if test -L "$$i"; then \ + cp -RP "$$i" "$(DESTDIR)$(ActualBinsDir)"; \ + else \ + $(INSTALL_PROGRAM) "$$i" "$(DESTDIR)$(ActualBinsDir)"; \ + fi; \ done # Work around #17418 on Darwin if [ -e "${XATTR}" ]; then "${XATTR}" -c -r "$(DESTDIR)$(ActualBinsDir)"; fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c126db9925d1fc4a6a9a57ad8d0edfdf9dfd0d38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c126db9925d1fc4a6a9a57ad8d0edfdf9dfd0d38 You're receiving 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 Aug 20 16:11:51 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 12:11:51 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] Document -no-link Message-ID: <630107c7ee0bb_e9d7d488281152ea@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: bd534a70 by Ben Gamari at 2022-08-20T12:11:41-04:00 Document -no-link - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -788,6 +788,13 @@ for example). You can use an external main function if you initialize the RTS manually and pass ``-no-hs-main``. See also :ref:`using-own-main`. +.. ghc-flag:: -no-link + :shortdesc: Stop after generating object (``.o``) file + :type: mode + :category: linking + + Omits the link step. + .. ghc-flag:: -c :shortdesc: Stop after generating object (``.o``) file :type: mode View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd534a701ac16d843300b3f2a2b2845972e3c31b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd534a701ac16d843300b3f2a2b2845972e3c31b You're receiving 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 Aug 20 16:20:35 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 12:20:35 -0400 Subject: [Git][ghc/ghc][wip/backports-9.4] Document -no-link Message-ID: <630109d3d444b_e9d7d4e890115476@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.4 at Glasgow Haskell Compiler / GHC Commits: e8a889a7 by Ben Gamari at 2022-08-20T12:20:29-04:00 Document -no-link - - - - - 2 changed files: - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -80,7 +80,6 @@ -n -no-keep-hi-file -no-keep-o-file --no-link -no-recomp -no-rtsopts -no-user-package-conf ===================================== docs/users_guide/phases.rst ===================================== @@ -788,6 +788,13 @@ for example). You can use an external main function if you initialize the RTS manually and pass ``-no-hs-main``. See also :ref:`using-own-main`. +.. ghc-flag:: -no-link + :shortdesc: Stop after generating object (``.o``) file + :type: mode + :category: linking + + Omits the link step. + .. ghc-flag:: -c :shortdesc: Stop after generating object (``.o``) file :type: mode View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8a889a7fc670532a3bf883a3e25acba92e6e6e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8a889a7fc670532a3bf883a3e25acba92e6e6e1 You're receiving 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 Aug 20 17:47:28 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 13:47:28 -0400 Subject: [Git][ghc/ghc][wip/T22077] 2 commits: Refactor IPE initialization Message-ID: <63011e3045b67_e9d7d4ee6c122683@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 809cb0cc by Ben Gamari at 2022-08-20T13:47:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 572dc039 by Ben Gamari at 2022-08-20T13:47:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 28 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/ghc.cabal.in - libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/Stack/CloneStack.hs - rts/IPE.c - rts/IPE.h - rts/RtsStartup.c - rts/Trace.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - rts/include/stg/SMP.h - testsuite/tests/rts/all.T - + testsuite/tests/rts/ipe/all.T - + testsuite/tests/rts/ipe/ipeEventLog.c - + testsuite/tests/rts/ipe/ipeEventLog.stderr - testsuite/tests/rts/ipeEventLog_fromMap.c → testsuite/tests/rts/ipe/ipeEventLog_fromMap.c - + testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr - testsuite/tests/rts/ipeMap.c → testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipeEventLog_lib.c → testsuite/tests/rts/ipe/ipe_lib.c - + testsuite/tests/rts/ipe/ipe_lib.h - − testsuite/tests/rts/ipeEventLog.c - − testsuite/tests/rts/ipeEventLog.stderr - − testsuite/tests/rts/ipeEventLog_fromMap.stderr Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -299,6 +299,7 @@ data ModuleLabelKind | MLK_InitializerArray | MLK_Finalizer String | MLK_FinalizerArray + | MLK_IPEBuffer deriving (Eq, Ord) instance Outputable ModuleLabelKind where @@ -306,6 +307,7 @@ instance Outputable ModuleLabelKind where ppr (MLK_Initializer s) = text ("init__" ++ s) ppr MLK_FinalizerArray = text "fini_arr" ppr (MLK_Finalizer s) = text ("fini__" ++ s) + ppr MLK_IPEBuffer = text "ipe_buf" isIdLabel :: CLabel -> Bool isIdLabel IdLabel{} = True @@ -830,10 +832,10 @@ instance OutputableP Platform InfoProvEnt where -- Constructing Cost Center Labels mkCCLabel :: CostCentre -> CLabel mkCCSLabel :: CostCentreStack -> CLabel -mkIPELabel :: InfoProvEnt -> CLabel +mkIPELabel :: Module -> CLabel mkCCLabel cc = CC_Label cc mkCCSLabel ccs = CCS_Label ccs -mkIPELabel ipe = IPE_Label ipe +mkIPELabel mod = ModuleLabel mod MLK_IPEBuffer mkRtsApFastLabel :: FastString -> CLabel mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str)) @@ -1011,6 +1013,7 @@ modLabelNeedsCDecl :: ModuleLabelKind -> Bool -- Code for finalizers and initializers are emitted in stub objects modLabelNeedsCDecl (MLK_Initializer _) = True modLabelNeedsCDecl (MLK_Finalizer _) = True +modLabelNeedsCDecl MLK_IPEBuffer = True -- The finalizer and initializer arrays are emitted in the code of the module modLabelNeedsCDecl MLK_InitializerArray = False modLabelNeedsCDecl MLK_FinalizerArray = False @@ -1208,6 +1211,7 @@ moduleLabelKindType kind = MLK_InitializerArray -> DataLabel MLK_Finalizer _ -> CodeLabel MLK_FinalizerArray -> DataLabel + MLK_IPEBuffer -> DataLabel idInfoLabelType :: IdLabelInfo -> CLabelType idInfoLabelType info = ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -224,6 +224,7 @@ import GHC.StgToCmm.Layout hiding (ArgRep(..)) import GHC.StgToCmm.Ticky import GHC.StgToCmm.Prof import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame ) +import GHC.StgToCmm.InfoTableProv import GHC.Cmm.Opt import GHC.Cmm.Graph @@ -1518,9 +1519,12 @@ parseCmmFile cmmpConfig this_mod home_unit filename = do let fcode = do ((), cmm) <- getCmm $ unEC code "global" (initEnv (pdProfile pdConfig)) [] >> return () -- See Note [Mapping Info Tables to Source Positions] (IPE Maps) - let used_info = map (cmmInfoTableToInfoProvEnt this_mod) - (mapMaybe topInfoTable cmm) - ((), cmm2) <- getCmm $ mapM_ emitInfoTableProv used_info + let used_info + | do_ipe = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTable cmm) + | otherwise = [] + where + do_ipe = stgToCmmInfoTableMap $ cmmpStgToCmmConfig cmmpConfig + ((), cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info return (cmm ++ cmm2, used_info) (cmm, _) = runC (cmmpStgToCmmConfig cmmpConfig) fstate st fcode (warnings,errors) = getPsMessages pst ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -368,24 +368,17 @@ ipInitCode :: Bool -- is Opt_InfoTableMap enabled or not -> Platform -> Module - -> [InfoProvEnt] -> CStub -ipInitCode do_info_table platform this_mod ents +ipInitCode do_info_table platform this_mod | not do_info_table = mempty - | otherwise = initializerCStub platform fn_nm decls body + | otherwise = initializerCStub platform fn_nm ipe_buffer_decl body where fn_nm = mkInitializerStubLabel this_mod "ip_init" - decls = vcat - $ map emit_ipe_decl ents - ++ [emit_ipe_list ents] - body = text "registerInfoProvList" <> parens local_ipe_list_label <> semi - emit_ipe_decl ipe = - text "extern InfoProvEnt" <+> ipe_lbl <> text "[];" - where ipe_lbl = pprCLabel platform CStyle (mkIPELabel ipe) - local_ipe_list_label = text "local_ipe_" <> ppr this_mod - emit_ipe_list ipes = - text "static InfoProvEnt *" <> local_ipe_list_label <> text "[] =" - <+> braces (vcat $ [ pprCLabel platform CStyle (mkIPELabel ipe) <> comma - | ipe <- ipes - ] ++ [text "NULL"]) - <> semi + + body = text "registerInfoProvList" <> parens (text "&" <> ipe_buffer_label) <> semi + + ipe_buffer_label = pprCLabel platform CStyle (mkIPELabel this_mod) + + ipe_buffer_decl = + text "extern IpeBufferListNode" <+> ipe_buffer_label <> text ";" + ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1830,7 +1830,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs mod_name = mkModuleName $ "Cmm$" ++ original_filename cmm_mod = mkHomeModule home_unit mod_name cmmpConfig = initCmmParserConfig dflags - (cmm, ents) <- ioMsgMaybe + (cmm, _ents) <- ioMsgMaybe $ do (warns,errs,cmm) <- withTiming logger (text "ParseCmm"<+>brackets (text filename)) (\_ -> ()) $ parseCmmFile cmmpConfig cmm_mod home_unit filename @@ -1857,7 +1857,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs Just h -> h dflags Nothing (Stream.yield cmmgroup) let foreign_stubs _ = - let ip_init = ipInitCode do_info_table platform cmm_mod ents + let ip_init = ipInitCode do_info_table platform cmm_mod in NoStubs `appendStubC` ip_init (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -0,0 +1,144 @@ +module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where + +import GHC.Prelude +import GHC.Platform +import GHC.Unit.Module +import GHC.Utils.Outputable +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) +import GHC.Data.FastString (unpackFS) + +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 + +emitIpeBufferListNode :: Module + -> [InfoProvEnt] + -> FCode () +emitIpeBufferListNode _ [] = return () +emitIpeBufferListNode this_mod ents = do + cfg <- getStgToCmmConfig + let ctx = stgToCmmContext cfg + platform = stgToCmmPlatform cfg + + 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 + +toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt +toCgIPE platform ctx module_name ipe = do + table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (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 (src_loc_file, src_loc_span) = + case infoTableProv ipe of + Nothing -> ("", "") + Just (span, _) -> + let file = unpackFS $ srcSpanFile span + coords = renderWithContext ctx (pprUserRealSpan False span) + in (file, coords) + label <- lookupStringTable $ ST.pack label_str + src_file <- lookupStringTable $ ST.pack src_loc_file + src_span <- lookupStringTable $ ST.pack src_loc_span + return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe + , ipeTableName = table_name + , ipeClosureDesc = closure_desc + , ipeTypeDesc = type_desc + , ipeLabel = label + , ipeModuleName = module_name + , ipeSrcFile = src_file + , ipeSrcSpan = src_span + } + +data CgInfoProvEnt = CgInfoProvEnt + { ipeInfoTablePtr :: !CLabel + , ipeTableName :: !StrTabOffset + , ipeClosureDesc :: !StrTab