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 :: !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 ===================================== @@ -196,37 +196,6 @@ test('EventlogOutput_IPE', def noCapabilityOutputFilter(s): return re.sub(r'[a-f0-9]+: IPE:', 'IPE:', s) -# Manually create IPE entries and dump them to event log (stderr). -test('ipeEventLog', - [ c_src, - extra_files(['ipeEventLog_lib.c']), - extra_run_opts('+RTS -va -RTS'), - grep_errmsg('IPE:'), - only_ways(debug_ways), - normalise_errmsg_fun(noCapabilityOutputFilter), - ignore_stdout, - # Due to issues on Darwin CI runners that couldn't be tracked down. - # In general this test should work on Darwin - Just not on our CI. - when(opsys('darwin'), fragile(0)) - ], - compile_and_run, ['ipeEventLog_lib.c']) - -# Manually create IPE entries, force the initialization of the underlying hash map -# and dump them to event log (stderr). -test('ipeEventLog_fromMap', - [ c_src, - extra_files(['ipeEventLog_lib.c']), - extra_run_opts('+RTS -va -RTS'), - grep_errmsg('IPE:'), - only_ways(debug_ways), - normalise_errmsg_fun(noCapabilityOutputFilter), - ignore_stdout, - # Due to issues on Darwin CI runners that couldn't be tracked down. - # In general this test should work on Darwin - Just not on our CI. - when(opsys('darwin'), fragile(0)) - ], - compile_and_run, ['ipeEventLog_lib.c']) - test('T4059', [], makefile_test, ['T4059']) # Test for #4274 @@ -509,8 +478,6 @@ test('T19381', test('T20199', [ grep_errmsg('Hello') ] , makefile_test, []) -test('ipeMap', [c_src], compile_and_run, ['']) - test('cloneMyStack', [extra_files(['cloneStackLib.c'])], compile_and_run, ['cloneStackLib.c']) test('cloneMyStack2', ignore_stdout, compile_and_run, ['']) test('cloneMyStack_retBigStackFrame', [extra_files(['cloneStackLib.c']), ignore_stdout], compile_and_run, ['cloneStackLib.c']) ===================================== testsuite/tests/rts/ipe/all.T ===================================== @@ -0,0 +1,33 @@ +test('ipeMap', [extra_files(['ipe_lib.c', 'ipe_lib.h']), c_src], compile_and_run, ['ipe_lib.c']) + +# Manually create IPE entries and dump them to event log (stderr). +test('ipeEventLog', + [ c_src, + extra_files(['ipe_lib.c', 'ipe_lib.h']), + extra_run_opts('+RTS -va -RTS'), + grep_errmsg('table_name_'), + only_ways(debug_ways), + normalise_errmsg_fun(noCapabilityOutputFilter), + ignore_stdout, + # Due to issues on Darwin CI runners that couldn't be tracked down. + # In general this test should work on Darwin - Just not on our CI. + when(opsys('darwin'), fragile(0)) + ], + compile_and_run, ['ipe_lib.c']) + +# Manually create IPE entries, force the initialization of the underlying hash map +# and dump them to event log (stderr). +test('ipeEventLog_fromMap', + [ c_src, + extra_files(['ipe_lib.c', 'ipe_lib.h']), + extra_run_opts('+RTS -va -RTS'), + grep_errmsg('table_name_'), + only_ways(debug_ways), + normalise_errmsg_fun(noCapabilityOutputFilter), + ignore_stdout, + # Due to issues on Darwin CI runners that couldn't be tracked down. + # In general this test should work on Darwin - Just not on our CI. + when(opsys('darwin'), fragile(0)) + ], + compile_and_run, ['ipe_lib.c']) + ===================================== testsuite/tests/rts/ipe/ipeEventLog.c ===================================== @@ -0,0 +1,24 @@ +#include "Rts.h" +#include "RtsAPI.h" +#include "rts/IPE.h" +#include +#include +#include +#include "ipeEventLog_lib.h" + +int main(int argc, char *argv[]) { + hs_init(&argc, &argv); + Capability *cap = rts_lock(); + + IpeBufferListNode *list1 = makeAnyProvEntries(cap, 0, 10); + IpeBufferListNode *list2 = makeAnyProvEntries(cap, 0, 10); + + registerInfoProvList(list1); + registerInfoProvList(list2); + + // Trace all IPE events. Expected count (see Makefile): 381 + 2 = 383 + dumpIPEToEventLog(); + + rts_unlock(cap); + hs_exit(); +} ===================================== testsuite/tests/rts/ipe/ipeEventLog.stderr ===================================== @@ -0,0 +1,20 @@ +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 → testsuite/tests/rts/ipe/ipeEventLog_fromMap.c ===================================== @@ -4,9 +4,7 @@ #include #include #include - -extern void dumpIPEToEventLog(void); -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i); +#include "ipe_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, 0, 10); + IpeBufferListNode *list2 = makeAnyProvEntries(cap, 0, 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/ipe/ipeEventLog_fromMap.stderr ===================================== @@ -0,0 +1,20 @@ +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 +7f8f9c139740: 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 ===================================== testsuite/tests/rts/ipeMap.c → testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -2,13 +2,13 @@ #include #include "Rts.h" +#include "ipe_lib.h" -void assertStringsEqual(char *s1, char *s2); +void assertStringsEqual(const char *s1, const char *s2); void shouldFindNothingInAnEmptyIPEMap(Capability *cap); HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap); void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo); void shouldFindTwoFromTheSameList(Capability *cap); -void shouldFindTheLastEntryOfManyLists(Capability *cap); void shouldDealWithAnEmptyList(Capability *cap, HaskellObj); // This is a unit test for IPE.c, the IPE map. @@ -22,7 +22,6 @@ int main(int argc, char *argv[]) { HaskellObj fortyTwo = shouldFindOneIfItHasBeenRegistered(cap); shouldFindTwoIfTwoHaveBeenRegistered(cap, fortyTwo); shouldFindTwoFromTheSameList(cap); - shouldFindTheLastEntryOfManyLists(cap); shouldDealWithAnEmptyList(cap, fortyTwo); rts_unlock(cap); @@ -41,167 +40,118 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); - InfoProvEnt *provEnt = malloc(sizeof(InfoProvEnt)); - provEnt->info = get_itbl(fortyTwo); - provEnt->prov.table_name = "table_name_42"; - provEnt->prov.closure_desc = "closure_desc_42"; - provEnt->prov.ty_desc = "ty_desc_42"; - provEnt->prov.label = "label_42"; - provEnt->prov.module = "module_42"; - provEnt->prov.srcloc = "srcloc_42"; + HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); + node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); + node->count = 1; + node->next = NULL; + node->string_table = st.buffer; - InfoProvEnt *ipeList[] = {provEnt, NULL}; + registerInfoProvList(node); - registerInfoProvList(ipeList); InfoProvEnt *result = lookupIPE(get_itbl(fortyTwo)); if (result == NULL) { - errorBelch("Found no entry in IPE map!"); + errorBelch("shouldFindOneIfItHasBeenRegistered: Found no entry in IPE map!"); exit(1); } - assertStringsEqual(result->prov.table_name, "table_name_42"); - assertStringsEqual(result->prov.closure_desc, "closure_desc_42"); - assertStringsEqual(result->prov.ty_desc, "ty_desc_42"); - assertStringsEqual(result->prov.label, "label_42"); - assertStringsEqual(result->prov.module, "module_42"); - assertStringsEqual(result->prov.srcloc, "srcloc_42"); + assertStringsEqual(result->prov.table_name, "table_name_042"); + assertStringsEqual(result->prov.closure_desc, "closure_desc_042"); + assertStringsEqual(result->prov.ty_desc, "ty_desc_042"); + assertStringsEqual(result->prov.label, "label_042"); + assertStringsEqual(result->prov.module, "module_042"); + assertStringsEqual(result->prov.srcloc, "srcloc_042"); return fortyTwo; } void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); - InfoProvEnt *provEnt = malloc(sizeof(InfoProvEnt)); - provEnt->info = get_itbl(twentyThree); - provEnt->prov.table_name = "table_name_23"; - provEnt->prov.closure_desc = "closure_desc_23"; - provEnt->prov.ty_desc = "ty_desc_23"; - provEnt->prov.label = "label_23"; - provEnt->prov.module = "module_23"; - provEnt->prov.srcloc = "srcloc_23"; + HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); + node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); + node->count = 1; + node->next = NULL; + node->string_table = st.buffer; - InfoProvEnt *ipeList[] = {provEnt, NULL}; - - registerInfoProvList(ipeList); + registerInfoProvList(node); InfoProvEnt *resultFortyTwo = lookupIPE(get_itbl(fortyTwo)); InfoProvEnt *resultTwentyThree = lookupIPE(get_itbl(twentyThree)); - if (resultFortyTwo == NULL || resultTwentyThree == NULL) { - errorBelch("Found no entry in IPE map!"); + if (resultFortyTwo == NULL) { + errorBelch("shouldFindTwoIfTwoHaveBeenRegistered(42): Found no entry in IPE map!"); + exit(1); + } + if (resultTwentyThree == NULL) { + errorBelch("shouldFindTwoIfTwoHaveBeenRegistered(23): Found no entry in IPE map!"); exit(1); } - assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_42"); - assertStringsEqual(resultTwentyThree->prov.table_name, "table_name_23"); + assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_042"); + assertStringsEqual(resultTwentyThree->prov.table_name, "table_name_023"); } void shouldFindTwoFromTheSameList(Capability *cap) { - HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); - - InfoProvEnt *provEntOne = malloc(sizeof(InfoProvEnt)); - provEntOne->info = get_itbl(one); - provEntOne->prov.table_name = "table_name_1"; - provEntOne->prov.closure_desc = "closure_desc_1"; - provEntOne->prov.ty_desc = "ty_desc_1"; - provEntOne->prov.label = "label_1"; - provEntOne->prov.module = "module_1"; - provEntOne->prov.srcloc = "srcloc_1"; + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); + HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); + node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); + node->count = 2; + node->next = NULL; + node->string_table = st.buffer; - InfoProvEnt *provEntTwo = malloc(sizeof(InfoProvEnt)); - provEntTwo->info = get_itbl(two); - provEntTwo->prov.table_name = "table_name_2"; - provEntTwo->prov.closure_desc = "closure_desc_2"; - provEntTwo->prov.ty_desc = "ty_desc_2"; - provEntTwo->prov.label = "label_2"; - provEntTwo->prov.module = "module_2"; - provEntTwo->prov.srcloc = "srcloc_2"; - - InfoProvEnt *ipeList[] = {provEntOne, provEntTwo, NULL}; - - registerInfoProvList(ipeList); + registerInfoProvList(node); InfoProvEnt *resultOne = lookupIPE(get_itbl(one)); InfoProvEnt *resultTwo = lookupIPE(get_itbl(two)); - if (resultOne == NULL || resultOne == NULL) { - errorBelch("Found no entry in IPE map!"); + if (resultOne == NULL) { + errorBelch("shouldFindTwoFromTheSameList(1): Found no entry in IPE map!"); exit(1); } - - assertStringsEqual(resultOne->prov.table_name, "table_name_1"); - assertStringsEqual(resultTwo->prov.table_name, "table_name_2"); -} - -void shouldFindTheLastEntryOfManyLists(Capability *cap) { - HaskellObj three = UNTAG_CLOSURE(rts_mkInt64(cap, 3)); - - InfoProvEnt *provEntThree = malloc(sizeof(InfoProvEnt)); - provEntThree->info = get_itbl(three); - provEntThree->prov.table_name = "table_name_3"; - provEntThree->prov.closure_desc = "closure_desc_3"; - provEntThree->prov.ty_desc = "ty_desc_3"; - provEntThree->prov.label = "label_3"; - provEntThree->prov.module = "module_3"; - provEntThree->prov.srcloc = "srcloc_3"; - - HaskellObj four = UNTAG_CLOSURE(rts_mkWord8(cap, 4)); - - InfoProvEnt *provEntFour = malloc(sizeof(InfoProvEnt)); - provEntFour->info = get_itbl(four); - provEntFour->prov.table_name = "table_name_4"; - provEntFour->prov.closure_desc = "closure_desc_4"; - provEntFour->prov.ty_desc = "ty_desc_4"; - provEntFour->prov.label = "label_4"; - provEntFour->prov.module = "module_4"; - provEntFour->prov.srcloc = "srcloc_4"; - - InfoProvEnt *ipeListThree[] = {provEntThree, NULL}; - InfoProvEnt *ipeListFour[] = {provEntFour, NULL}; - - // Force the creation of 4 IpeBufferListNodes - for (int i = 0; i <= 126 * 3 + 1; i++) { - registerInfoProvList(ipeListThree); - } - - registerInfoProvList(ipeListFour); - - InfoProvEnt *resultFour = lookupIPE(get_itbl(four)); - - if (resultFour == NULL) { - errorBelch("Found no entry in IPE map!"); + if (resultTwo == NULL) { + errorBelch("shouldFindTwoFromTheSameList(2): Found no entry in IPE map!"); exit(1); } - assertStringsEqual(resultFour->prov.table_name, "table_name_4"); + assertStringsEqual(resultOne->prov.table_name, "table_name_001"); + assertStringsEqual(resultTwo->prov.table_name, "table_name_002"); } void shouldDealWithAnEmptyList(Capability *cap, HaskellObj fortyTwo) { - InfoProvEnt *emptyIpeList[] = {NULL}; + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->count = 0; + node->next = NULL; + node->string_table = ""; - registerInfoProvList(emptyIpeList); + registerInfoProvList(node); InfoProvEnt *resultFortyTwo = lookupIPE(get_itbl(fortyTwo)); if (resultFortyTwo == NULL) { - errorBelch("Found no entry in IPE map!"); + errorBelch("shouldDealWithAnEmptyList: Found no entry in IPE map!"); exit(1); } - assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_42"); + assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_042"); } -void assertStringsEqual(char *s1, char *s2) { +void assertStringsEqual(const char *s1, const char *s2) { if (strcmp(s1, s2) != 0) { errorBelch("%s != %s", s1, s2); exit(1); ===================================== testsuite/tests/rts/ipeEventLog_lib.c → testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -1,42 +1,83 @@ #include "Rts.h" #include "rts/IPE.h" #include +#include "ipe_lib.h" -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i) { - HaskellObj fourtyTwo = rts_mkInt(cap, 42); +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; +} - InfoProvEnt *provEnt = malloc(sizeof(InfoProvEnt)); - provEnt->info = (StgInfoTable *)fourtyTwo->header.info; +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { + IpeBufferEntry provEnt; + provEnt.info = get_itbl(closure); unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); 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 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 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 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 start, int end) { + const int n = end - start; + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); + for (int i=start; i < end; i++) { + HaskellObj closure = rts_mkInt(cap, 42); + node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + } + node->next = NULL; + node->count = n; + node->string_table = st.buffer; + return node; +} ===================================== testsuite/tests/rts/ipe/ipe_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 start, int end); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +void dumpIPEToEventLog(void); + ===================================== testsuite/tests/rts/ipeEventLog.c deleted ===================================== @@ -1,60 +0,0 @@ -#include "Rts.h" -#include "RtsAPI.h" -#include "rts/IPE.h" -#include -#include -#include - -extern void dumpIPEToEventLog(void); -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i); - -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; - - registerInfoProvList(ipeList_2); - - // Trace all IPE events. Expected count (see Makefile): 381 + 2 = 383 - dumpIPEToEventLog(); - - rts_unlock(cap); - hs_exit(); -} ===================================== testsuite/tests/rts/ipeEventLog.stderr deleted ===================================== @@ -1,383 +0,0 @@ -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 ===================================== testsuite/tests/rts/ipeEventLog_fromMap.stderr deleted ===================================== @@ -1,2 +0,0 @@ -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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebc644c1721a309279a996f7ab2917cc8b8044a1...572dc03973a9fbc545099b294f703ecaed509df0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebc644c1721a309279a996f7ab2917cc8b8044a1...572dc03973a9fbc545099b294f703ecaed509df0 You're receiving 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:54:37 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 13:54:37 -0400 Subject: [Git][ghc/ghc][wip/T22077] Separate IPE source file from span Message-ID: <63011fddc6b51_e9d7d48828122812@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 9970aea6 by Ben Gamari at 2022-08-20T13:54:16-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/CloneStack.hs - rts/IPE.c - rts/Trace.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - testsuite/tests/profiling/should_run/staticcallstack001.stdout - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/rts/ipe/ipeEventLog.stderr - testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c 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 @@ -45,7 +46,9 @@ 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) + , int32 0 ] int n = mkIntCLit platform n @@ -64,16 +67,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 @@ -83,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. ===================================== 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 ===================================== @@ -78,7 +78,8 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeB .ty_desc = &strings[ent->ty_desc], .label = &strings[ent->label], .module = &strings[ent->module_name], - .srcloc = &strings[ent->srcloc] + .src_file = &strings[ent->src_file], + .src_span = &strings[ent->src_span] } }; } ===================================== 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 ===================================== @@ -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,9 @@ typedef struct { StringIdx ty_desc; StringIdx label; StringIdx module_name; - StringIdx srcloc; + StringIdx src_file; + StringIdx src_span; + uint32_t _padding; } IpeBufferEntry; typedef struct IpeBufferListNode_ { ===================================== testsuite/tests/profiling/should_run/staticcallstack001.stdout ===================================== @@ -1,3 +1,3 @@ -Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack001.hs:16:13-27"}) -Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "caf", ipMod = "Main", ipLoc = "staticcallstack001.hs:13:1-9"}) -Just (InfoProv {ipName = "sat_s11g_info", ipDesc = "15", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack001.hs:18:23-32"}) +Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "16:13-27"}) +Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "caf", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "13:1-9"}) +Just (InfoProv {ipName = "sat_s11M_info", ipDesc = "15", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "18:23-32"}) ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s10U_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:10:23-39"}) -Just (InfoProv {ipName = "sat_s11a_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:11:23-42"}) -Just (InfoProv {ipName = "sat_s11q_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:12:23-46"}) -Just (InfoProv {ipName = "sat_s11G_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:13:23-44"}) +Just (InfoProv {ipName = "sat_s11p_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "sat_s11F_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "sat_s11V_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "sat_s12b_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/rts/ipe/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/ipe/ipeEventLog_fromMap.stderr ===================================== @@ -1,20 +1,68 @@ -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 +7f86c4be8740: created capset 0 of type 2 +7f86c4be8740: created capset 1 of type 3 +7f86c4be8740: cap 0: initialised +7f86c4be8740: assigned cap 0 to capset 0 +7f86c4be8740: assigned cap 0 to capset 1 +7f86c4be8740: cap 0: created thread 1[""] +7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC) +7f86c4be8740: cap 0: thread 1[""] stopped (stack overflow, size 109) +7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC) +7f86c4be8740: cap 0: created thread 2[""] +7f86c4be8740: cap 0: thread 2 has label IOManager on cap 0 +7f86c4be8740: cap 0: thread 1[""] stopped (yielding) +7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC) +7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (yielding) +7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC) +7f86c4be8740: cap 0: created thread 3[""] +7f86c4be8740: cap 0: thread 3 has label TimerManager +7f86c4be8740: cap 0: thread 1[""] stopped (finished) +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: cap 0: created thread 4[""] +7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC) +7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (suspended while making a foreign call) +7f86b5ffb640: cap 0: running thread 3["TimerManager"] (ThreadRunGHC) +7f86b5ffb640: cap 0: thread 3["TimerManager"] stopped (suspended while making a foreign call) +7f86c4be8740: cap 0: running thread 4[""] (ThreadRunGHC) +7f86c4be8740: cap 0: thread 4[""] stopped (yielding) +7f86c4be8740: cap 0: running thread 4[""] (ThreadRunGHC) +7f86c4be8740: cap 0: thread 4[""] stopped (finished) +7f86b57fa640: cap 0: requesting sequential GC +7f86b57fa640: cap 0: starting GC +7f86b57fa640: cap 0: GC working +7f86b57fa640: cap 0: GC idle +7f86b57fa640: cap 0: GC done +7f86b57fa640: cap 0: GC idle +7f86b57fa640: cap 0: GC done +7f86b57fa640: cap 0: GC idle +7f86b57fa640: cap 0: GC done +7f86b57fa640: cap 0: Memory Return (Current: 6) (Needed: 8) (Returned: 0) +7f86b57fa640: cap 0: all caps stopped for GC +7f86b57fa640: cap 0: finished GC +7f86b5ffb640: cap 0: running thread 3["TimerManager"] (ThreadRunGHC) +7f86b5ffb640: cap 0: thread 3["TimerManager"] stopped (finished) +7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC) +7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (finished) +7f86c4be8740: removed cap 0 from capset 0 +7f86c4be8740: removed cap 0 from capset 1 +7f86c4be8740: cap 0: shutting down +7f86c4be8740: deleted capset 0 +7f86c4be8740: deleted capset 1 ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -64,7 +64,8 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { assertStringsEqual(result->prov.ty_desc, "ty_desc_042"); assertStringsEqual(result->prov.label, "label_042"); assertStringsEqual(result->prov.module, "module_042"); - assertStringsEqual(result->prov.srcloc, "srcloc_042"); + assertStringsEqual(result->prov.src_file, "src_file_042"); + assertStringsEqual(result->prov.src_span, "src_span_042"); return fortyTwo; } ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -54,10 +54,15 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo snprintf(module, moduleLength, "module_%03i", i); provEnt.module_name = add_string(st, module); - unsigned int srcLocLength = strlen("srcloc_") + 3 /* digits */ + 1 /* null character */; - char *srcLoc = malloc(sizeof(char) * srcLocLength); - snprintf(srcLoc, srcLocLength, "srcloc_%03i", i); - provEnt.srcloc = add_string(st, srcLoc); + 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 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; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9970aea669c15ebfcdcdad0416855a91b66cf0d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9970aea669c15ebfcdcdad0416855a91b66cf0d3 You're receiving 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 18:04:16 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 14:04:16 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 10 commits: Refactor IPE initialization Message-ID: <630122209e2e2_e9d7d488641233e4@gitlab.mail> Ben Gamari pushed to branch wip/exception-context 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. - - - - - 9970aea6 by Ben Gamari at 2022-08-20T13:54:16-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. - - - - - f6acb523 by Ben Gamari at 2022-08-20T13:56:12-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - c2ca84d5 by Ben Gamari at 2022-08-20T13:56:12-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 9d52d6a0 by Ben Gamari at 2022-08-20T13:56:12-04:00 base: Move prettyCallStack to GHC.Stack - - - - - 2b1591a1 by Ben Gamari at 2022-08-20T13:56:12-04:00 base: Move PrimMVar to GHC.MVar - - - - - e7567dd4 by Ben Gamari at 2022-08-20T13:56:12-04:00 base: Introduce exception context - - - - - 6ee2ba4e by Ben Gamari at 2022-08-20T13:56:12-04:00 base: Introduce exception backtrace infrastructure - - - - - 333163b5 by Ben Gamari at 2022-08-20T13:56:12-04:00 base: Collect backtraces in GHC.IO.throwIO - - - - - 72acb8b7 by Ben Gamari at 2022-08-20T13:56:12-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/8d173dea5e5e04a0a0cfa2b35cd0ec1e45d4e861...72acb8b70d641c5f180d3612ec36796d712230e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d173dea5e5e04a0a0cfa2b35cd0ec1e45d4e861...72acb8b70d641c5f180d3612ec36796d712230e3 You're receiving 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 20:24:37 2022 From: gitlab at gitlab.haskell.org (John Ericson (@Ericson2314)) Date: Sat, 20 Aug 2022 16:24:37 -0400 Subject: [Git][ghc/ghc][wip/wither-eq1-and-friends] 30 commits: typo Message-ID: <630143059fe6b_e9d7d48864130610@gitlab.mail> John Ericson pushed to branch wip/wither-eq1-and-friends 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. - - - - - 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 - - - - - 8615c3ad by John Ericson at 2022-08-20T16:22:11-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 171d6ff2 by John Ericson at 2022-08-20T16:24:11-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 - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - 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.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/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.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/ghci.rst - docs/users_guide/phases.rst - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Haddock.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00161be6942ed3d9b51954518d6100d815dcbd4a...171d6ff265ad804e33a3692bf3abeeeec80ee746 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00161be6942ed3d9b51954518d6100d815dcbd4a...171d6ff265ad804e33a3692bf3abeeeec80ee746 You're receiving 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 21:52:02 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Sat, 20 Aug 2022 17:52:02 -0400 Subject: [Git][ghc/ghc][wip/romes/ttg-prune-2] Fixed tests Message-ID: <6301578292864_e9d7d4ee6c1417fc@gitlab.mail> Dominik Peteler pushed to branch wip/romes/ttg-prune-2 at Glasgow Haskell Compiler / GHC Commits: ae314b77 by Dominik Peteler at 2022-08-20T23:51:53+02:00 Fixed tests - - - - - 4 changed files: - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -438,6 +438,7 @@ Library GHC.Driver.Ppr GHC.Driver.Session GHC.Hs + GHC.Hs.Basic GHC.Hs.Binds GHC.Hs.Decls GHC.Hs.Doc ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -111,6 +111,7 @@ GHC.Driver.Plugins GHC.Driver.Ppr GHC.Driver.Session GHC.Hs +GHC.Hs.Basic GHC.Hs.Binds GHC.Hs.Decls GHC.Hs.Doc ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -112,6 +112,7 @@ GHC.Driver.Plugins GHC.Driver.Ppr GHC.Driver.Session GHC.Hs +GHC.Hs.Basic GHC.Hs.Binds GHC.Hs.Decls GHC.Hs.Doc ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -28,7 +28,6 @@ import GHC.Data.Bag import qualified GHC.Data.BooleanFormula as BF import GHC.Data.FastString import GHC.Types.Basic hiding (EP) -import GHC.Types.Fixity import GHC.Types.ForeignCall import GHC.Types.SourceText import GHC.Types.PkgQual @@ -39,6 +38,8 @@ import GHC.Utils.Misc import GHC.Utils.Panic import GHC.TypeLits +import Language.Haskell.Syntax.Basic + import Control.Monad.Identity import Control.Monad.RWS import Data.Data ( Data ) @@ -2294,16 +2295,16 @@ instance ExactPrint (HsCmdTop GhcPs) where -- --------------------------------------------------------------------- instance ExactPrint (HsCmd GhcPs) where - getAnnotationEntry (HsCmdArrApp an _ _ _ _) = fromAnn an - getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an - getAnnotationEntry (HsCmdApp an _ _ ) = fromAnn an - getAnnotationEntry (HsCmdLam {}) = NoEntryVal - getAnnotationEntry (HsCmdPar an _ _ _) = fromAnn an - getAnnotationEntry (HsCmdCase an _ _) = fromAnn an - getAnnotationEntry (HsCmdLamCase an _ _) = fromAnn an - getAnnotationEntry (HsCmdIf an _ _ _ _) = fromAnn an - getAnnotationEntry (HsCmdLet an _ _ _ _) = fromAnn an - getAnnotationEntry (HsCmdDo an _) = fromAnn an + getAnnotationEntry (HsCmdArrApp an _ _ _ _) = fromAnn an + getAnnotationEntry (HsCmdArrForm an _ _ _ ) = fromAnn an + getAnnotationEntry (HsCmdApp an _ _ ) = fromAnn an + getAnnotationEntry (HsCmdLam {}) = NoEntryVal + getAnnotationEntry (HsCmdPar an _ _ _) = fromAnn an + getAnnotationEntry (HsCmdCase an _ _) = fromAnn an + getAnnotationEntry (HsCmdLamCase an _ _) = fromAnn an + getAnnotationEntry (HsCmdIf an _ _ _ _) = fromAnn an + getAnnotationEntry (HsCmdLet an _ _ _ _) = fromAnn an + getAnnotationEntry (HsCmdDo an _) = fromAnn an @@ -2318,7 +2319,7 @@ instance ExactPrint (HsCmd GhcPs) where markKw (anns an) markAnnotated arr - exact (HsCmdArrForm an e fixity _mf cs) = do + exact (HsCmdArrForm an e fixity cs) = do markLocatedMAA an al_open case (fixity, cs) of (Infix, (arg1:argrest)) -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae314b77a14dc3ee9e4859cfcd75083fe645f838 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae314b77a14dc3ee9e4859cfcd75083fe645f838 You're receiving 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 22:48:37 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Sat, 20 Aug 2022 18:48:37 -0400 Subject: [Git][ghc/ghc][wip/romes/ttg-prune-2] 138 commits: Make withDict opaque to the specialiser Message-ID: <630164c525cad_e9d7d4883c14405b@gitlab.mail> Dominik Peteler pushed to branch wip/romes/ttg-prune-2 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 - - - - - 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 - - - - - aff27ef7 by romes at 2022-08-21T00:09:05+02:00 Split TTG orphans from internal `Fixity` data type Filling in missing instances and creating a separate "semantic" datatype are two different layers of abstraction, and so we should create two different modules for them. - - - - - 1bc5abf6 by Dominik Peteler at 2022-08-21T00:47:21+02:00 Fixed tests and updated Haddock submodule - - - - - 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.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae314b77a14dc3ee9e4859cfcd75083fe645f838...1bc5abf6965374402d70d63006e6fedc46e8f64e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae314b77a14dc3ee9e4859cfcd75083fe645f838...1bc5abf6965374402d70d63006e6fedc46e8f64e You're receiving 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 23:53:22 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 19:53:22 -0400 Subject: [Git][ghc/ghc][ghc-9.4] 9 commits: Bump haddock submodule Message-ID: <630173f2a622c_e9d7d4ee58147876@gitlab.mail> Ben Gamari pushed to branch ghc-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 - - - - - 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. - - - - - e8a889a7 by Ben Gamari at 2022-08-20T12:20:29-04:00 Document -no-link - - - - - 9 changed files: - configure.ac - + docs/users_guide/9.4.2-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/phases.rst - docs/users_guide/release-notes.rst - hadrian/bindist/Makefile - 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/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/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 @@ -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 ===================================== docs/users_guide/release-notes.rst ===================================== @@ -4,4 +4,5 @@ Release notes .. toctree:: :maxdepth: 1 + 9.4.2-notes 9.4.1-notes ===================================== 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 ===================================== 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/b9ed1a481f6163f46e902c71e58f2e3143bf8914...e8a889a7fc670532a3bf883a3e25acba92e6e6e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9ed1a481f6163f46e902c71e58f2e3143bf8914...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 Sun Aug 21 00:20:30 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 20 Aug 2022 20:20:30 -0400 Subject: [Git][ghc/ghc][wip/T22077] 17 commits: testsuite: Add test for #21583 Message-ID: <63017a4e381d6_e9d7d48878148534@gitlab.mail> Ben Gamari pushed to branch wip/T22077 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 - - - - - eddc6278 by Ben Gamari at 2022-08-20T20:19:44-04:00 rts: Add missing declarations - - - - - b4f1469d by Ben Gamari at 2022-08-20T20:19:44-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - ba78fa2d by Ben Gamari at 2022-08-20T20:19:44-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - a179743a by Ben Gamari at 2022-08-20T20:19:44-04:00 rts: Refactor IPE tracing support - - - - - ae132bdf by Ben Gamari at 2022-08-20T20:20:23-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. - - - - - 85608401 by Ben Gamari at 2022-08-20T20:20:23-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. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - 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/CodeOutput.hs - compiler/GHC/Driver/Main.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 - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/ghc.cabal.in - docs/users_guide/ghci.rst - 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/base/Foreign/C/String.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/InfoProv.hsc - libraries/base/GHC/Stack/CCS.hsc The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9970aea669c15ebfcdcdad0416855a91b66cf0d3...856084017213fdba7e6c880fae008008bb31d443 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9970aea669c15ebfcdcdad0416855a91b66cf0d3...856084017213fdba7e6c880fae008008bb31d443 You're receiving 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 21 00:51:35 2022 From: gitlab at gitlab.haskell.org (Trevis Elser (@telser)) Date: Sat, 20 Aug 2022 20:51:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/telser/doc-deepsubsumption-language-variant Message-ID: <63018197bec26_e9d7d4887814927f@gitlab.mail> Trevis Elser pushed new branch wip/telser/doc-deepsubsumption-language-variant at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/telser/doc-deepsubsumption-language-variant You're receiving 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 21 17:51:43 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 21 Aug 2022 13:51:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Print constraints in quotes (#21167) Message-ID: <630270af4b8d7_e9d7d4885025748a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job 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 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 7d8b44a3 by MorrowM at 2022-08-21T13:51:20-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - c1f081de by Matthew Pickering at 2022-08-21T13:51:27-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - 30 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Module.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/src/Settings/Default.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdbeded4c87de29f5dbbc1107e0c29d8b47d172e...c1f081de87ca2c354dfcb94bcc8c8676c9e8f77e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdbeded4c87de29f5dbbc1107e0c29d8b47d172e...c1f081de87ca2c354dfcb94bcc8c8676c9e8f77e You're receiving 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 21 18:34:59 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Sun, 21 Aug 2022 14:34:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/inplace-final Message-ID: <63027ad3f32be_e9d7d4ee6c26299@gitlab.mail> Matthew Pickering pushed new branch wip/inplace-final at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/inplace-final You're receiving 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 21 19:45:48 2022 From: gitlab at gitlab.haskell.org (John Ericson (@Ericson2314)) Date: Sun, 21 Aug 2022 15:45:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/lhs-token-for-hs-arg Message-ID: <63028b6c271a6_e9d7d4ee6c2742fa@gitlab.mail> John Ericson pushed new branch wip/lhs-token-for-hs-arg at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/lhs-token-for-hs-arg You're receiving 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 21 20:51:55 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 21 Aug 2022 16:51:55 -0400 Subject: [Git][ghc/ghc][master] Recognize file-header pragmas in GHCi (#21507) Message-ID: <63029aebb2cac_e9d7d488502790f2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - 5 changed files: - docs/users_guide/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - + testsuite/tests/ghci/scripts/T21507.script - testsuite/tests/ghci/scripts/all.T Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -66,6 +66,21 @@ Compiler - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. + +GHCi +~~~~ + +- GHCi will now accept any file-header pragmas it finds, such as + ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, + instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, + you could instead write: + + .. code-block:: none + + ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} + +This can be convenient when pasting large multi-line blocks of code into GHCi. + ``base`` library ~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -3173,6 +3173,15 @@ example, to turn on :ghc-flag:`-Wmissing-signatures`, you would say: ghci> :set -Wmissing-signatures +GHCi will also accept any file-header pragmas it finds, such as +``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, +instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, +you could instead write: + +.. code-block:: none + + ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} + Any GHC command-line option that is designated as dynamic (see the table in :ref:`flag-reference`), may be set using :ghci-cmd:`:set`. To unset an option, you can set the reverse option: ===================================== ghc/GHCi/UI.hs ===================================== @@ -78,6 +78,7 @@ import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrNam import GHC.Types.SrcLoc as SrcLoc import qualified GHC.Parser.Lexer as Lexer import GHC.Parser.Header ( toArgs ) +import qualified GHC.Parser.Header as Header import GHC.Types.PkgQual import GHC.Unit @@ -1249,6 +1250,9 @@ runStmt input step = do let source = progname st let line = line_number st + -- Add any LANGUAGE/OPTIONS_GHC pragmas we find find. + set_pragmas pflags + if | GHC.isStmt pflags input -> do hsc_env <- GHC.getSession mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input)) @@ -1282,6 +1286,12 @@ runStmt input step = do run_imports imports = mapM_ (addImportToContext . unLoc) imports + set_pragmas pflags = + let stringbuf = stringToStringBuffer input + (_msgs, loc_opts) = Header.getOptions pflags stringbuf "" + opts = unLoc <$> loc_opts + in setOptions opts + run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult) run_stmt stmt = do m_result <- GhciMonad.runStmt stmt input step ===================================== testsuite/tests/ghci/scripts/T21507.script ===================================== @@ -0,0 +1,5 @@ +:{ +{-# LANGUAGE TypeFamilies #-} +type family T21507 a where + T21507 a = a +:} ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -368,3 +368,4 @@ test('T21110', [extra_files(['T21110A.hs'])], ghci_script, ['T21110.script']) test('T17830', [filter_stdout_lines(r'======.*')], ghci_script, ['T17830.script']) test('T21294a', normal, ghci_script, ['T21294a.script']) +test('T21507', normal, ghci_script, ['T21507.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9939e95fb7b808b68aca00dfabbb99079927f482 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9939e95fb7b808b68aca00dfabbb99079927f482 You're receiving 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 21 20:52:28 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 21 Aug 2022 16:52:28 -0400 Subject: [Git][ghc/ghc][master] hadrian: Fix bootstrapping with ghc-9.4 Message-ID: <63029b0c5dc27_e9d7d4ee6c284431@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - 1 changed file: - hadrian/src/Settings/Default.hs Changes: ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -77,6 +77,7 @@ stage0Packages = do , cabalSyntax , cabal , compiler + , containers , directory , process , exceptions View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb7c2d99f7df880b00b0d31ee7436c6d8eb3ba15 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb7c2d99f7df880b00b0d31ee7436c6d8eb3ba15 You're receiving 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 21 21:29:36 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Sun, 21 Aug 2022 17:29:36 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] 3 commits: fix prefix Message-ID: <6302a3c0dfe9e_e9d7d4882828627f@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: dda447ca by Matthew Pickering at 2022-08-21T22:28:48+01:00 fix prefix - - - - - 09bdffd9 by Matthew Pickering at 2022-08-21T22:28:59+01:00 Remove uncessary deps - - - - - 5aebb6cd by Matthew Pickering at 2022-08-21T22:29:23+01:00 fixes - - - - - 4 changed files: - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/ToolArgs.hs Changes: ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -304,7 +304,7 @@ write_fake_conf pkg_path res_path pd lbi = do let fixupIncludeDir dir | cwd `isPrefixOf` dir = [prefix ++ drop (length cwd) dir] | otherwise = [dir] where - prefix = "${pkgroot}/../../../../" + prefix = "${pkgroot}/../../../" let installedPkgInfo = C.inplaceInstalledPackageInfo (cwd pkg_path) build_dir pd (C.mkAbiHash "inplace") lib lbi clbi ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -119,10 +119,7 @@ buildPackage root fp = do depPkgs <- packageDependencies <$> readPackageData (package ctx) -- Stage packages are those we have in this stage. stagePkgs <- stagePackages stage - -- We'll need those packages in our package database. - deps <- sequence [ pkgConfFile (ctx { package = pkg }) - | pkg <- depPkgs, pkg `elem` stagePkgs ] - need deps + need (srcs ++ gens) -- ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -119,14 +119,15 @@ registerPackageRules rs stage iplace = do Final -> buildConfFinal rs ctx conf buildConfFinal :: [(Resource, Int)] -> Context -> FilePath -> Action () -buildConfFinal _ context at Context {..} _conf = do +buildConfFinal rs context at Context {..} _conf = do depPkgIds <- cabalDependencies context ensureConfigured context - need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage Final) <&> (-/- pkgId <.> "conf")) depPkgIds - ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) need =<< mapM pkgStampFile [ context { way = w } | w <- Set.toList ways ] + need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage Final) <&> (-/- pkgId <.> "conf")) depPkgIds + + -- We might need some package-db resource to limit read/write, see packageRules. path <- buildPath context @@ -150,6 +151,8 @@ buildConfFinal _ context at Context {..} _conf = do -- Copy and register the package. Cabal.copyPackage context Cabal.registerPackage context + buildWithResources rs $ + target context (GhcPkg Init stage) [] [] -- We declare that this rule also produces files matching: -- - /stage/lib/--ghc-/*libHS* @@ -167,7 +170,7 @@ buildConfFinal _ context at Context {..} _conf = do produces files buildConfInplace :: [(Resource, Int)] -> Context -> FilePath -> Action () -buildConfInplace _ context at Context {..} _conf = do +buildConfInplace rs context at Context {..} _conf = do depPkgIds <- cabalDependencies context ensureConfigured context need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage Inplace) <&> (-/- pkgId <.> "conf")) depPkgIds @@ -201,7 +204,7 @@ buildConfInplace _ context at Context {..} _conf = do conf <- pkgInplaceConfig context -- runBuilder (GhcPkg Update stage) [] [conf] [] - build $ + buildWithResources rs $ target context (GhcPkg Update stage) [conf] [] -- Cabal. ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -16,6 +16,7 @@ import System.Directory (canonicalizePath) import System.Environment (lookupEnv) import qualified Data.Set as Set import Oracles.ModuleFiles +import Utilities -- | @tool:@ is used by tooling in order to get the arguments necessary -- to set up a GHC API session which can compile modules from GHC. When @@ -123,7 +124,7 @@ mkToolTarget es p = do -- this generically yet. putProgressInfo ("Computing arguments for " ++ pkgName p) allDeps - let fake_target = target (Context stage0InTree p (if windowsHost then vanilla else dynamic) Inplace) + let fake_target = target (Context stage0InTree p (if windowsHost then vanilla else dynamic) Final) (Ghc ToolArgs stage0InTree) [] ["ignored"] arg_list <- interpret fake_target getArgs liftIO $ writeOutput (arg_list ++ es) @@ -134,7 +135,7 @@ allDeps = do -- We can't build DLLs on Windows (yet). Actually we should only -- include the dynamic way when we have a dynamic host GHC, but just -- checking for Windows seems simpler for now. - let fake_target = target (Context stage0InTree compiler (if windowsHost then vanilla else dynamic) Inplace) + let fake_target = target (Context stage0InTree compiler (if windowsHost then vanilla else dynamic) Final) (Ghc ToolArgs stage0InTree) [] ["ignored"] -- need the autogenerated files so that they are precompiled @@ -189,6 +190,8 @@ toolTargets = [ binary -- | Create a mapping from files to which component it belongs to. dirMap :: Action [(FilePath, (Package, [String]))] dirMap = do + depPkgIds <- concat <$> mapM (cabalDependencies . vanillaContext stage0InTree) toolTargets + need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage0InTree Final) <&> (-/- pkgId <.> "conf")) depPkgIds auto <- concatMapM go toolTargets -- Mush the ghc executable into the compiler component so the whole of ghc is not built when -- configuring @@ -200,12 +203,12 @@ dirMap = do -- configuring would build the whole GHC library which we probably -- don't want to do. mkGhc = do - let c = (Context stage0InTree compiler (if windowsHost then vanilla else dynamic) Inplace) + let c = (Context stage0InTree compiler (if windowsHost then vanilla else dynamic) Final) cd <- readContextData c fp <- liftIO $ canonicalizePath "ghc/" return (fp, (compiler, "-ighc" : modules cd ++ otherModules cd ++ ["ghc/Main.hs"])) go p = do - let c = (Context stage0InTree p (if windowsHost then vanilla else dynamic) Inplace) + let c = (Context stage0InTree p (if windowsHost then vanilla else dynamic) Final) -- readContextData has the effect of configuring the package so all -- dependent packages will also be built. cd <- readContextData c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aed9cf4fe1d1c419b7ab7d3f3569c2f4fd7b77b3...5aebb6cd77ecc9e07c0e45e8b1880811d5b9b71e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aed9cf4fe1d1c419b7ab7d3f3569c2f4fd7b77b3...5aebb6cd77ecc9e07c0e45e8b1880811d5b9b71e You're receiving 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 21 21:47:41 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Sun, 21 Aug 2022 17:47:41 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] fixes Message-ID: <6302a7fd72a06_e9d7d4ee5828839f@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: 38607298 by Matthew Pickering at 2022-08-21T22:46:58+01:00 fixes - - - - - 1 changed file: - hadrian/src/Rules/ToolArgs.hs Changes: ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE ViewPatterns #-} module Rules.ToolArgs(toolArgsTarget) where -import qualified Rules.Generate +import Rules.Generate import Development.Shake import Target import Context @@ -61,7 +61,6 @@ multiSetup pkg_s = do -- Get the arguments for all the targets pargs <- mapM one_args tool_targets -- Build any other dependencies (such as generated files) - allDeps liftIO $ writeOutput (concatMap (\x -> ["-unit", x]) (map ( "@" <>) pargs)) where @@ -84,7 +83,8 @@ multiSetup pkg_s = do -- dependent packages will also be built. cd <- readContextData c srcs <- hsSources c - need srcs + gens <- interpretInContext c generatedDependencies + need (srcs ++ gens) let rexp m = ["-reexported-module", m] writeFile' (resp_file root p) (intercalate "\n" (th_hack arg_list ++ modules cd @@ -123,36 +123,24 @@ mkToolTarget es p = do -- This builds automatically generated dependencies. Not sure how to do -- this generically yet. putProgressInfo ("Computing arguments for " ++ pkgName p) - allDeps - let fake_target = target (Context stage0InTree p (if windowsHost then vanilla else dynamic) Final) + + let context = Context stage0InTree p (if windowsHost then vanilla else dynamic) Final + let fake_target = target context (Ghc ToolArgs stage0InTree) [] ["ignored"] + -- Generate any source files for this target + cd <- readContextData context + srcs <- hsSources context + gens <- interpretInContext context generatedDependencies + + -- Build any necessary dependencies + depPkgIds <- cabalDependencies context + dep_confs <- mapM (\pkgId -> packageDbPath (PackageDbLoc stage0InTree Final) <&> (-/- pkgId <.> "conf")) depPkgIds + + need (gens ++ srcs ++ dep_confs) + arg_list <- interpret fake_target getArgs liftIO $ writeOutput (arg_list ++ es) -allDeps :: Action () -allDeps = do - do - -- We can't build DLLs on Windows (yet). Actually we should only - -- include the dynamic way when we have a dynamic host GHC, but just - -- checking for Windows seems simpler for now. - let fake_target = target (Context stage0InTree compiler (if windowsHost then vanilla else dynamic) Final) - (Ghc ToolArgs stage0InTree) [] ["ignored"] - - -- need the autogenerated files so that they are precompiled - interpret fake_target Rules.Generate.compilerDependencies >>= need - - root <- buildRoot - let ghc_prim = buildDir (vanillaContext stage0InTree ghcPrim) - let dir = buildDir (vanillaContext stage0InTree compiler) - need [ root -/- dir -/- "GHC" -/- "Settings" -/- "Config.hs" ] - need [ root -/- dir -/- "GHC" -/- "Parser.hs" ] - need [ root -/- dir -/- "GHC" -/- "Parser" -/- "Lexer.hs" ] - need [ root -/- dir -/- "GHC" -/- "Parser" -/- "HaddockLex.hs" ] - need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Parser.hs" ] - need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Lexer.hs" ] - - need [ root -/- ghc_prim -/- "GHC" -/- "PrimopWrappers.hs" ] - -- This list is quite a lot like stage0packages but doesn't include -- critically the `exe:ghc` component as that depends on the GHC library -- which takes a while to compile. @@ -190,8 +178,6 @@ toolTargets = [ binary -- | Create a mapping from files to which component it belongs to. dirMap :: Action [(FilePath, (Package, [String]))] dirMap = do - depPkgIds <- concat <$> mapM (cabalDependencies . vanillaContext stage0InTree) toolTargets - need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage0InTree Final) <&> (-/- pkgId <.> "conf")) depPkgIds auto <- concatMapM go toolTargets -- Mush the ghc executable into the compiler component so the whole of ghc is not built when -- configuring View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38607298f61d01f70536557a3fb1271acd48d513 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38607298f61d01f70536557a3fb1271acd48d513 You're receiving 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 21 22:30:58 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Sun, 21 Aug 2022 18:30:58 -0400 Subject: [Git][ghc/ghc][wip/romes/ttg-prune-2] Fixed arrow desugaring bug Message-ID: <6302b22264c08_e9d7d4e8902887bd@gitlab.mail> Dominik Peteler pushed to branch wip/romes/ttg-prune-2 at Glasgow Haskell Compiler / GHC Commits: 96a1b01d by Dominik Peteler at 2022-08-22T00:30:17+02:00 Fixed arrow desugaring bug This was dead code before. - - - - - 1 changed file: - compiler/GHC/Rename/Expr.hs Changes: ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -822,17 +822,6 @@ rnCmd (HsCmdArrApp _ arrow arg ho rtl) -- Local bindings, inside the enclosing proc, are not in scope -- inside 'arrow'. In the higher-order case (-<<), they are. --- infix form -rnCmd (HsCmdArrForm _ op _ [arg1, arg2]) - = do { (op',fv_op) <- escapeArrowScope (rnLExpr op) - ; let L _ (HsVar _ (L _ op_name)) = op' - ; (arg1',fv_arg1) <- rnCmdTop arg1 - ; (arg2',fv_arg2) <- rnCmdTop arg2 - -- Deal with fixity - ; fixity <- lookupFixityRn op_name - ; final_e <- mkOpFormRn arg1' op' fixity arg2' - ; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) } - rnCmd (HsCmdArrForm _ op f cmds) = do { (op',fvOp) <- escapeArrowScope (rnLExpr op) ; (cmds',fvCmds) <- rnCmdArgs cmds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96a1b01d65bfaf1e095f66cad0bdb354258ee909 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96a1b01d65bfaf1e095f66cad0bdb354258ee909 You're receiving 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 22 07:33:47 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 Aug 2022 03:33:47 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Wibbles, add tests Message-ID: <6303315b750f6_e9d7d487ec311353@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: cd0b60cf by Simon Peyton Jones at 2022-08-22T08:33:57+01:00 Wibbles, add tests - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.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/Utils.hs - + testsuite/tests/simplCore/should_compile/T21948.hs - + testsuite/tests/simplCore/should_compile/T21960.hs - + testsuite/tests/simplCore/should_compile/T21960.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -755,7 +755,7 @@ Join points must follow these invariants: 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] + Note [Arity for recursive join bindings] Historical note: see #17294. ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -54,7 +54,7 @@ import GHC.Core.TyCon as TyCon import GHC.Core.Coercion.Axiom import GHC.Core.Unify import GHC.Core.Coercion.Opt ( checkAxInstCo ) -import GHC.Core.Opt.Arity ( typeArity ) +import GHC.Core.Opt.Arity ( typeArity, exprIsDeadEnd ) import GHC.Core.Opt.Monad ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Core.Opt.Arity , arityTypeArity, idArityType -- ** Bottoming things - , exprBotStrictness_maybe, arityTypeBotSigs_maybe + , exprIsDeadEnd, exprBotStrictness_maybe, arityTypeBotSigs_maybe -- ** typeArity and the state hack , typeArity, typeOneShots, typeOneShot @@ -1248,8 +1248,8 @@ data ArityEnv , 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 + -- am_no_eta: see Note [Arity for recursive join bindings] + -- point 5, in GHC.Core.Opt.Simplify.Utils instance Outputable ArityEnv where ppr (AE { am_sigs = sigs, am_no_eta = no_eta }) @@ -1449,8 +1449,9 @@ idArityType v -------------------- cheapArityType :: HasDebugCallStack => CoreExpr -> ArityType - --- Returns ArityType with IsCheap everywhere +-- A fast and cheap version of arityType. +-- Returns an ArityType with IsCheap everywhere +-- c.f. GHC.Core.Utils.exprIsDeadEnd cheapArityType e = go e where go (Var v) = idArityType v @@ -1499,8 +1500,65 @@ exprArity e = go e go _ = 0 -{- Note [No free join points in arityType] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +exprIsDeadEnd :: CoreExpr -> Bool +-- See Note [Bottoming expressions] +-- This function is, in effect, just a specialised (and hence cheap) +-- version of cheapArityType +-- See also exprBotStrictness_maybe, which uses cheapArityType +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 + 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 n (Var v) | isDeadEndAppSig (idDmdSig v) n = True + | isEmptyTy (idType v) = True + | otherwise = False + +{- Note [Bottoming expressions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A bottoming expression is guaranteed to diverge, or raise an +exception. We can test for it in two different ways, and exprIsDeadEnd +checks for both of these situations: + +* Visibly-bottom computations. For example + (error Int "Hello") + is visibly bottom. The strictness analyser also finds out if + a function diverges or raises an exception, and puts that info + in its strictness signature. + +* Empty types. If a type is empty, its only inhabitant is bottom. + For example: + data T + f :: T -> Bool + f = \(x:t). case x of Bool {} + Since T has no data constructors, the case alternatives are of course + empty. However note that 'x' is not bound to a visibly-bottom value; + it's the *type* that tells us it's going to diverge. + +A GADT may also be empty even though it has constructors: + data T a where + T1 :: a -> T Bool + T2 :: T Int + ...(case (x::T Char) of {})... +Here (T Char) is uninhabited. A more realistic case is (Int ~ Bool), +which is likewise uninhabited. + +Note [No free join points in arityType] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we call arityType on this expression (EX1) \x . case x of True -> \y. e False -> $j 3 @@ -1524,8 +1582,8 @@ 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). + right-hand sides. See Note [Arity for recursive join bindings] + point (5) in GHC.Core.Opt.Simplify.Utils. * The invariant (no free join point in arityType) risks being invalidated by one very narrow special case: runRW# @@ -1580,59 +1638,8 @@ 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. -But see Note [Arity type for recursive join bindings] for dark corners. - -Note [Arity type for recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f x = joinrec j 0 = \ a b c -> (a,x,b) - 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 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 - 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. +But see Note [Arity for recursive join bindings] in +GHC.Core.Opt.Simplify.Utils for dark corners. -} {- ===================================== compiler/GHC/Core/Opt/FloatOut.hs ===================================== @@ -219,13 +219,6 @@ floatBind :: LevelledBind -> (FloatStats, FloatBinds, [CoreBind]) -- See Note [Floating out of Rec rhss] for why things get arranged this way. floatBind (NonRec (TB var _) rhs) = case (floatRhs var rhs) of { (fs, rhs_floats, 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' - (fs, rhs_floats, [NonRec var rhs']) } floatBind (Rec pairs) ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -976,16 +976,6 @@ Id, *immediately*, for three reasons: thing is based on the cheap-and-cheerful exprIsDeadEnd, I'm not sure that it'll nail all such cases. -Note [Bottoming floats: eta expansion] c.f Note [Bottoming floats] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Tiresomely, though, the simplifier has an invariant that the manifest -arity of the RHS should be the same as the arity; but we can't call -etaExpand during GHC.Core.Opt.SetLevels because it works over a decorated form of -CoreExpr. So we do the eta expansion later, in GHC.Core.Opt.FloatOut. -But we should only eta-expand if the RHS doesn't already have the right -exprArity, otherwise we get unnecessary top-level bindings if the RHS was -trivial after the next run of the Simplifier. - Note [Case MFEs] ~~~~~~~~~~~~~~~~ We don't float a case expression as an MFE from a strict context. Why not? ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -39,7 +39,7 @@ import GHC.Core.Unfold import GHC.Core.Unfold.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType, exprArity, arityTypeBotSigs_maybe - , pushCoTyArg, pushCoValArg + , pushCoTyArg, pushCoValArg, exprIsDeadEnd , typeArity, arityTypeArity, etaExpandAT ) import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe ) import GHC.Core.FVs ( mkRuleInfo ) ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1787,7 +1787,8 @@ 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] + -- See Note [Arity for non-recursive join bindings] + -- and Note [Arity for recursive join bindings] arity_type = case is_rec of NonRecursive -> cheapArityType rhs Recursive -> findRhsArity (seArityOpts env) Recursive @@ -1932,17 +1933,67 @@ 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] +Note [Arity for recursive join bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -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 +Consider + f x = joinrec j 0 = \ a b c -> (a,x,b) + 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 + 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 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` (See Note [arityType for let-bindings] in GHC.Core.Opt.Arity) + - 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 GHC.Core.Opt.Arity 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. + + +Note [Arity for non-recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +So much for recursive join bindings (see previous Note). What about +/non-recursive/ones? If we just call findRhsArity, it 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 @@ -1951,6 +2002,7 @@ purposes. (Side note: maybe we should use cheapArity for the RHS of let bindings in the main arityType function.) + ************************************************************************ * * \subsection{Floating lets out of big lambdas} ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Core.Utils ( -- * Properties of expressions exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes, mkFunctionType, - exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsDeadEnd, + exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun, exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprOkForSpecEval, @@ -1073,69 +1073,8 @@ getIdFromTrivialExpr_maybe e go (Var v) = Just v go _ = Nothing -{- -exprIsDeadEnd is a very cheap and cheerful function; it may return -False for bottoming expressions, but it never costs much to ask. See -also GHC.Core.Opt.Arity.exprBotStrictness_maybe, but that's a bit more -expensive. --} -exprIsDeadEnd :: CoreExpr -> Bool --- See Note [Bottoming expressions] -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 - 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 n (Var v) | isDeadEndAppSig (idDmdSig v) n = True - | isEmptyTy (idType v) = True - | otherwise = False - -{- Note [Bottoming expressions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A bottoming expression is guaranteed to diverge, or raise an -exception. We can test for it in two different ways, and exprIsDeadEnd -checks for both of these situations: - -* Visibly-bottom computations. For example - (error Int "Hello") - is visibly bottom. The strictness analyser also finds out if - a function diverges or raises an exception, and puts that info - in its strictness signature. - -* Empty types. If a type is empty, its only inhabitant is bottom. - For example: - data T - f :: T -> Bool - f = \(x:t). case x of Bool {} - Since T has no data constructors, the case alternatives are of course - empty. However note that 'x' is not bound to a visibly-bottom value; - it's the *type* that tells us it's going to diverge. - -A GADT may also be empty even though it has constructors: - data T a where - T1 :: a -> T Bool - T2 :: T Int - ...(case (x::T Char) of {})... -Here (T Char) is uninhabited. A more realistic case is (Int ~ Bool), -which is likewise uninhabited. - - -************************************************************************ +{- ********************************************************************* * * exprIsDupable * * ===================================== testsuite/tests/simplCore/should_compile/T21948.hs ===================================== @@ -0,0 +1,11 @@ +module T21948 where + +import GHC.Int( Int64 ) + +nf' :: (b -> ()) -> (a -> b) -> a -> (Int64 -> IO ()) +nf' reduce f x = go + where + go n | n <= 0 = return () + | otherwise = let !y = f x + in reduce y `seq` go (n-1) +{-# NOINLINE nf' #-} ===================================== testsuite/tests/simplCore/should_compile/T21960.hs ===================================== @@ -0,0 +1,102 @@ +{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash, + UnliftedFFITypes #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Data.Text.Encoding +-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan, +-- (c) 2009 Duncan Coutts, +-- (c) 2008, 2009 Tom Harper +-- (c) 2021 Andrew Lelechenko +-- +-- License : BSD-style +-- Maintainer : bos at serpentine.com +-- Portability : portable +-- +-- Functions for converting 'Text' values to and from 'ByteString', +-- using several standard encodings. +-- +-- To gain access to a much larger family of encodings, use the +-- . + +module Data.Text.Encoding + ( + encodeUtf8BuilderEscaped + ) where + +import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) + +import Control.Exception (evaluate, try) +import Control.Monad.ST (runST, ST) +import Data.Bits (shiftR, (.&.)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString.Short.Internal as SBS +import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode, lenientDecode) +import Data.Text.Internal (Text(..), safe, empty, append) +import Data.Text.Internal.Unsafe (unsafeWithForeignPtr) +import Data.Text.Internal.Unsafe.Char (unsafeWrite) +import Data.Text.Unsafe (unsafeDupablePerformIO) +import Data.Word (Word8) +import Foreign.C.Types (CSize(..)) +import Foreign.Ptr (Ptr, minusPtr, plusPtr) +import Foreign.Storable (poke, peekByteOff) +import GHC.Exts (byteArrayContents#, unsafeCoerce#) +import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(PlainPtr)) +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Builder.Internal as B hiding (empty, append) +import qualified Data.ByteString.Builder.Prim as BP +import qualified Data.ByteString.Builder.Prim.Internal as BP +import Data.Text.Internal.Encoding.Utf8 (utf8DecodeStart, utf8DecodeContinue, DecoderResult(..)) +import qualified Data.Text.Array as A +import qualified Data.Text.Internal.Encoding.Fusion as E +import qualified Data.Text.Internal.Fusion as F +import Data.Text.Internal.ByteStringCompat + + + +-- | Encode text using UTF-8 encoding and escape the ASCII characters using +-- a 'BP.BoundedPrim'. +-- +-- Use this function is to implement efficient encoders for text-based formats +-- like JSON or HTML. +-- +-- @since 1.1.0.0 +{-# INLINE encodeUtf8BuilderEscaped #-} +-- TODO: Extend documentation with references to source code in @blaze-html@ +-- or @aeson@ that uses this function. +encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder +encodeUtf8BuilderEscaped be = + -- manual eta-expansion to ensure inlining works as expected + \txt -> B.builder (mkBuildstep txt) + where + bound = max 4 $ BP.sizeBound be + + mkBuildstep (Text arr off len) !k = + outerLoop off + where + iend = off + len + + outerLoop !i0 !br@(B.BufferRange op0 ope) + | i0 >= iend = k br + | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining) + -- TODO: Use a loop with an integrated bound's check if outRemaining + -- is smaller than 8, as this will save on divisions. + | otherwise = return $ B.bufferFull bound op0 (outerLoop i0) + where + outRemaining = (ope `minusPtr` op0) `quot` bound + inpRemaining = iend - i0 + + goPartial !iendTmp = go i0 op0 + where + go !i !op + | i < iendTmp = do + let w = A.unsafeIndex arr i + if w < 0x80 + then BP.runB be w op >>= go (i + 1) + else poke op w >> go (i + 1) (op `plusPtr` 1) + | otherwise = outerLoop i (B.BufferRange op ope) + ===================================== testsuite/tests/simplCore/should_compile/T21960.stderr ===================================== @@ -0,0 +1 @@ + \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -422,3 +422,4 @@ test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0 test('T21801', normal, compile, ['-O -dcore-lint']) test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) test('T21694b', [grep_errmsg(r'Arity=4') ], compile, ['-O -ddump-simpl']) +test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd0b60cf295d26b584bf04e9b86120143af4324a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd0b60cf295d26b584bf04e9b86120143af4324a You're receiving 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 22 10:27:10 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 22 Aug 2022 06:27:10 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] 2 commits: Add some more packages to multi-cradle Message-ID: <630359feba8c_e9d7d4883c3543d0@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: 96ee4385 by Matthew Pickering at 2022-08-21T23:12:37+01:00 Add some more packages to multi-cradle - - - - - d216e7ad by Matthew Pickering at 2022-08-22T11:21:57+01:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - 5 changed files: - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Builder.hs ===================================== @@ -6,7 +6,7 @@ module Builder ( TarMode (..), GitMode (..), Builder (..), Win32TarballsMode(..), -- * Builder properties - builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, + builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, needBuilders, runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath, builderEnvironment, ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -12,7 +12,7 @@ -- functions that can be used to invoke builders. ----------------------------------------------------------------------------- module Hadrian.Builder ( - Builder (..), BuildInfo (..), needBuilder, runBuilder, + Builder (..), BuildInfo (..), needBuilder, needBuilders, runBuilder, runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions, getBuilderPath, builderEnvironment, askWithResources ) where @@ -26,7 +26,6 @@ import Hadrian.Oracles.ArgsHash import Hadrian.Target import Hadrian.Utilities -import Base -- | This data structure captures all information relevant to invoking a builder. data BuildInfo = BuildInfo { @@ -67,18 +66,19 @@ class ShakeValue b => Builder b where -- | Make sure a builder and its runtime dependencies are up-to-date. needBuilder :: Builder b => b -> Action () -needBuilder builder = do - path <- builderPath builder - deps <- runtimeDependencies builder +needBuilder builder = needBuilders [builder] + +needBuilders :: Builder b => [b] -> Action () +needBuilders bs = do + paths <- mapM builderPath bs + deps <- mapM runtimeDependencies bs -- so `path` might be just `gcc`, in which case we won't issue a "need" on -- it. If someone really wants the full qualified path, he ought to pass -- CC=$(which gcc) to the configure script. If CC=gcc was passed, we should -- respect that choice and not resolve that via $PATH into a fully qualified -- path. We can only `need` fully qualified path's though, hence we won't -- `need` bare tool names. - when (path /= takeFileName path) $ - need [path] - need deps + need (concat $ [path | path <- paths, path /= takeFileName path] : deps) -- | Run a builder with a specified list of command line arguments, reading a -- list of input files and writing a list of output files. A lightweight version ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -79,8 +79,6 @@ multiSetup pkg_s = do (Ghc ToolArgs stage0InTree) [] ["ignored"] arg_list <- interpret fake_target getArgs let c = Context stage0InTree p (if windowsHost then vanilla else dynamic) Inplace -- Critical use of Inplace, one of the main motivations! - -- readContextData has the effect of configuring the package so all - -- dependent packages will also be built. cd <- readContextData c srcs <- hsSources c gens <- interpretInContext c generatedDependencies @@ -154,17 +152,17 @@ toolTargets = [ binary , directory , process , exceptions --- , ghc # depends on ghc library --- , runGhc # depends on ghc library + -- , ghc -- # depends on ghc library + -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh , ghcHeap , ghci --- , ghcPkg # executable --- , haddock # depends on ghc library --- , hsc2hs # executable + , ghcPkg -- # executable + -- , haddock -- # depends on ghc library + , hsc2hs -- # executable , hpc --- , hpcBin # executable + , hpcBin -- # executable , mtl , parsec , time @@ -172,7 +170,7 @@ toolTargets = [ binary , text , terminfo , transformers --- , unlit # executable + , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] -- | Create a mapping from files to which component it belongs to. ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -71,7 +71,6 @@ cabalSetupArgs = builder (Cabal Setup) ? do top <- expr topDirectory stage <- getStage path <- getContextPath - ctx <- getContext mconcat [ arg "configure" , arg "--distdir" , arg $ top -/- path @@ -113,16 +112,15 @@ commonCabalArgs stage = do , arg "--htmldir" , arg $ "${pkgroot}/../../doc/html/libraries/" ++ package_id - , withStaged $ Ghc CompileHs + -- These trigger a need on each dependency, so every important to need + -- them in parallel or it linearises the build of Ghc and GhcPkg + , withStageds [Ghc CompileHs, GhcPkg Update, Cc CompileC, Ar Pack] , withBuilderArgs (Ghc CompileHs stage) - , withStaged (GhcPkg Update) , withBuilderArgs (GhcPkg Update stage) , bootPackageDatabaseArgs , libraryArgs , bootPackageConstraints - , withStaged $ Cc CompileC , notStage0 ? with (Ld stage) - , withStaged (Ar Pack) , with Alex , with Happy -- Update Target.trackArgument if changing these: @@ -245,16 +243,23 @@ withBuilderArgs b = case b of -- | Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex. with :: Builder -> Args -with b = do - path <- getBuilderPath b - if null path then mempty else do - top <- expr topDirectory - expr $ needBuilder b +with b = withs [b] + +-- | Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex. +withs :: [Builder] -> Args +withs bs = do + paths <- filter (not . null . snd) <$> mapM (\b -> (b,) <$> getBuilderPath b) bs + let bs = map fst paths + expr $ (needBuilders bs) + top <- expr topDirectory + mconcat $ map (\(b, path) -> -- Do not inject top, if we have a bare name. E.g. do not turn -- `ar` into `$top/ar`. But let `ar` be `ar` as found on $PATH. arg $ withBuilderKey b ++ unifyPath (if path /= takeFileName path then top path - else path) + else path)) paths -withStaged :: (Stage -> Builder) -> Args -withStaged sb = with . sb =<< getStage +withStageds :: [Stage -> Builder] -> Args +withStageds sb = do + st <- getStage + withs (map (\f -> f st) sb) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -255,7 +255,7 @@ packageGhcArgs = do , arg "-no-user-package-db" , arg "-package-env -" , packageDatabaseArgs - , libraryPackage ? arg ("-this-unit-id " ++ pkgId) + , arg ("-this-unit-id " ++ pkgId) , map ("-package-id " ++) <$> getContextData depIds ] includeGhcArgs :: Args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38607298f61d01f70536557a3fb1271acd48d513...d216e7ad0df3eb091aa9d0357c11fad808595677 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38607298f61d01f70536557a3fb1271acd48d513...d216e7ad0df3eb091aa9d0357c11fad808595677 You're receiving 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 22 12:18:17 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 Aug 2022 08:18:17 -0400 Subject: [Git][ghc/ghc][wip/T21623] More wibbles, mainly to error messages Message-ID: <63037409d825c_e9d7d4d1d43815ec@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: a3f8b75a by Simon Peyton Jones at 2022-08-22T13:19:30+01:00 More wibbles, mainly to error messages - - - - - 5 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Solver/Canonical.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -83,7 +83,7 @@ module GHC.Builtin.Types ( unboxedUnitTy, unboxedUnitTyCon, unboxedUnitDataCon, unboxedTupleKind, unboxedSumKind, - filterCTuple, + filterCTuple, mkConstraintTupleTy, -- ** Constraint tuples cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, @@ -2150,6 +2150,17 @@ mkBoxedTupleTy tys = mkTupleTy Boxed tys unitTy :: Type unitTy = mkTupleTy Boxed [] +-- Make a constraint tuple +-- One-tuples vanish +-- If we get a constraint tuple that is bigger than the pre-built +-- ones (in ghc-prim:GHC.Tuple), then just make one up anyway; it +-- this is used only in filling in extra-constraint wildcards +-- See GHC.Tc.Gen.HsType Note [Extra-constraint holes in partial type signatures] +mkConstraintTupleTy :: [Type] -> Type +mkConstraintTupleTy [ty] = ty +mkConstraintTupleTy tys = mkTyConApp (cTupleTyCon (length tys)) tys + + {- ********************************************************************* * * The sum types ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -3,7 +3,7 @@ -- -- Type - public interface -{-# LANGUAGE FlexibleContexts, PatternSynonyms, ViewPatterns #-} +{-# LANGUAGE FlexibleContexts, PatternSynonyms, ViewPatterns, MultiWayIf #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -72,7 +72,8 @@ module GHC.Core.Type ( isPredTy, - getRuntimeRep_maybe, kindRep_maybe, kindRep, + getRuntimeRep, splitRuntimeRep_maybe, kindRep_maybe, kindRep, + getLevity, levityType_maybe, mkCastTy, mkCoercionTy, splitCastTy_maybe, @@ -140,7 +141,6 @@ module GHC.Core.Type ( isLevityTy, isLevityVar, isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy, dropRuntimeRepArgs, - getRuntimeRep, getLevity, getLevity_maybe, -- * Multiplicity @@ -716,46 +716,6 @@ pickyIsLiftedTypeKind kind , tc `hasKey` liftedTypeKindTyConKey = True | otherwise = False - --- | See 'isBoxedRuntimeRep_maybe'. -isBoxedRuntimeRep :: Type -> Bool -isBoxedRuntimeRep rep = isJust (isBoxedRuntimeRep_maybe rep) - --- | `isBoxedRuntimeRep_maybe (rep :: RuntimeRep)` returns `Just lev` if `rep` --- expands to `Boxed lev` and returns `Nothing` otherwise. --- --- Types with this runtime rep are represented by pointers on the GC'd heap. -isBoxedRuntimeRep_maybe :: Type -> Maybe Type -isBoxedRuntimeRep_maybe rep - | Just [lev] <- isTyConKeyApp_maybe boxedRepDataConKey rep - = Just lev - | otherwise - = Nothing - --- | Check whether a type of kind 'RuntimeRep' is lifted, unlifted, or unknown. --- --- `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). -runtimeRepLevity_maybe :: Type -> Maybe Levity -runtimeRepLevity_maybe rep - | TyConApp rr_tc args <- coreFullView rep - , isPromotedDataCon rr_tc = - -- NB: args might be non-empty e.g. TupleRep [r1, .., rn] - if (rr_tc `hasKey` boxedRepDataConKey) - then case args of - [lev] | isLiftedLevity lev -> Just Lifted - | isUnliftedLevity lev -> Just Unlifted - _ -> Nothing - else Just Unlifted - -- Avoid searching all the unlifted RuntimeRep type cons - -- In the RuntimeRep data type, only LiftedRep is lifted - -- But be careful of type families (F tys) :: RuntimeRep, - -- hence the isPromotedDataCon rr_tc -runtimeRepLevity_maybe _ = Nothing - -- | Check whether a kind is of the form `TYPE (BoxedRep Lifted)` -- or `TYPE (BoxedRep Unlifted)`. -- @@ -835,6 +795,82 @@ isMultiplicityTy = isNullaryTyConKeyApp multiplicityTyConKey isMultiplicityVar :: TyVar -> Bool isMultiplicityVar = isMultiplicityTy . tyVarKind +-------------------------------------------- +-- Splitting RuntimeRep +-------------------------------------------- + +-- | (splitRuntimeRep_maybe rr) takes a Type rr :: RuntimeRep, and +-- returns the (TyCon,[Type]) for the RuntimeRep, if possible, where +-- the TyCon is one of the promoted DataCons of RuntimeRep. +-- Remember: the unique on TyCon that is a a promoted DataCon is the +-- same as the unique on the DataCon +-- See Note [Promoted data constructors] in GHC.Core.TyCon +-- May not be possible if `rr` is a type variable or type +-- family application +splitRuntimeRep_maybe :: Type -> Maybe (TyCon, [Type]) +splitRuntimeRep_maybe rep + | TyConApp rr_tc args <- coreFullView rep + , isPromotedDataCon rr_tc + = Just (rr_tc, args) + | otherwise + = Nothing + +-- | See 'isBoxedRuntimeRep_maybe'. +isBoxedRuntimeRep :: Type -> Bool +isBoxedRuntimeRep rep = isJust (isBoxedRuntimeRep_maybe rep) + +-- | `isBoxedRuntimeRep_maybe (rep :: RuntimeRep)` returns `Just lev` if `rep` +-- expands to `Boxed lev` and returns `Nothing` otherwise. +-- +-- Types with this runtime rep are represented by pointers on the GC'd heap. +isBoxedRuntimeRep_maybe :: Type -> Maybe Type +isBoxedRuntimeRep_maybe rep + | Just (rr_tc, args) <- splitRuntimeRep_maybe rep + , rr_tc `hasKey` boxedRepDataConKey + , [lev] <- args + = Just lev + | otherwise + = Nothing + +-- | Check whether a type of kind 'RuntimeRep' is lifted, unlifted, or unknown. +-- +-- `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). +runtimeRepLevity_maybe :: Type -> Maybe Levity +runtimeRepLevity_maybe rep + | Just (rr_tc, args) <- splitRuntimeRep_maybe rep + = -- NB: args might be non-empty e.g. TupleRep [r1, .., rn] + if (rr_tc `hasKey` boxedRepDataConKey) + then case args of + [lev] -> levityType_maybe lev + _ -> pprPanic "runtimeRepLevity_maybe" (ppr rep) + else Just Unlifted + -- Avoid searching all the unlifted RuntimeRep type cons + -- In the RuntimeRep data type, only LiftedRep is lifted + -- But be careful of type families (F tys) :: RuntimeRep, + -- hence the isPromotedDataCon rr_tc + | otherwise + = Nothing + +-------------------------------------------- +-- Splitting Levity +-------------------------------------------- + +-- | `levity_maybe` takes a Type of kind Levity, and returns its levity +-- May not be possible for a type variable or type family application +levityType_maybe :: Type -> Maybe Levity +levityType_maybe lev + | TyConApp lev_tc args <- coreFullView lev + = if | lev_tc `hasKey` liftedDataConKey -> assert( null args) $ Just Lifted + | lev_tc `hasKey` unliftedDataConKey -> assert( null args) $ Just Unlifted + | otherwise -> Nothing + | otherwise + = Nothing + + {- ********************************************************************* * * mapType ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2089,10 +2089,10 @@ pprTcSolverReportMsg _ pprTcSolverReportMsg ctxt (TypeEqMismatch { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds , teq_mismatch_item = item - , teq_mismatch_ty1 = ty1 - , teq_mismatch_ty2 = ty2 - , teq_mismatch_expected = exp - , teq_mismatch_actual = act + , teq_mismatch_ty1 = ty1 -- These types are the context + , teq_mismatch_ty2 = ty2 -- of the mis-match + , teq_mismatch_expected = exp -- These are the kinds that + , teq_mismatch_actual = act -- don't match , teq_mismatch_what = mb_thing }) = addArising ct_loc $ pprWithExplicitKindsWhen ppr_explicit_kinds msg where @@ -2123,18 +2123,16 @@ pprTcSolverReportMsg ctxt | 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 + case (splitRuntimeRep_maybe exp_rep, splitRuntimeRep_maybe act_rep) of + (Just (exp_rr_tc, exp_rr_args), Just (act_rr_tc, act_rr_args)) + | exp_rr_tc == act_rr_tc -> msg_for_same_rep exp_rr_args act_rr_args + | otherwise -> msg_for_different_rep exp_rr_tc act_rr_tc + _ -> bale_out_msg | otherwise = -- (TYPE _) ~ (CONSTRAINT _) or (TYPE _) ~ Bool, etc maybe_num_args_msg $$ - sep [ text "Expected a" <+> pp_exp_thing <+> text "but" + 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" @@ -2143,11 +2141,31 @@ pprTcSolverReportMsg ctxt 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" + -- (TYPE (BoxedRep lev1)) ~ (TYPE (BoxedRep lev2)) + msg_for_same_rep exp_rr_args act_rr_args + | [exp_lev_ty] <- exp_rr_args -- BoxedRep has exactly one arg + , [act_lev_ty] <- act_rr_args + , Just exp_lev <- levityType_maybe exp_lev_ty + , Just act_lev <- levityType_maybe act_lev_ty + = 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 ] + msg_for_same_rep _ _ + = bale_out_msg + + msg_for_different_rep exp_rr_tc act_rr_tc + = sep [ text "Expecting a" <+> what <+> text "but" + , case mb_thing of + Just thing -> quotes (ppr thing) + Nothing -> quotes (pprWithTYPE act) + <+> text "has representation" <+> ppr_rep act_rr_tc ] + where + what | exp_rr_tc `hasKey` boxedRepDataConKey + = text "boxed" <+> pp_exp_thing + | otherwise + = pp_exp_thing <+> text "with representation" <+> ppr_rep exp_rr_tc ct_loc = errorItemCtLoc item orig = errorItemOrigin item @@ -2173,6 +2191,14 @@ pprTcSolverReportMsg ctxt maybe_num_args_msg = num_args_msg `orElse` empty count_args ty = count isVisibleBinder $ fst $ splitPiTys ty + + ppr_lev Lifted = text "lifted" + ppr_lev Unlifted = text "unlifted" + ppr_an_lev Lifted = text "a lifted" + ppr_an_lev Unlifted = text "an unlifted" + + ppr_rep rep_tc = quotes (ppr (getOccName rep_tc)) -- Don't qualify + pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = vcat (map make_msg frr_origs) where ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -53,7 +53,7 @@ import GHC.Tc.Instance.Family( tcGetFamInstEnvs ) import GHC.Core.Class ( Class ) import GHC.Tc.Utils.TcType import GHC.Core.Type (mkStrLitTy, tidyOpenType, mkCastTy) -import GHC.Builtin.Types ( mkBoxedTupleTy ) +import GHC.Builtin.Types ( mkConstraintTupleTy ) import GHC.Builtin.Types.Prim import GHC.Types.SourceText import GHC.Types.Id @@ -1005,7 +1005,7 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs -- We know that wc_co must have type kind(wc_var) ~ Constraint, as it -- comes from the checkExpectedKind in GHC.Tc.Gen.HsType.tcAnonWildCardOcc. -- So, to make the kinds work out, we reverse the cast here. - Just (wc_var, wc_co) -> writeMetaTyVar wc_var (mk_ctuple diff_theta + Just (wc_var, wc_co) -> writeMetaTyVar wc_var (mkConstraintTupleTy diff_theta `mkCastTy` mkTcSymCo wc_co) Nothing -> pprPanic "chooseInferredQuantifiers 1" (ppr wc_var_ty) @@ -1019,10 +1019,6 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs -- Return (annotated_theta ++ diff_theta) -- See Note [Extra-constraints wildcards] - mk_ctuple preds = mkBoxedTupleTy preds - -- Hack alert! See GHC.Tc.Gen.HsType: - -- Note [Extra-constraint holes in partial type signatures] - chooseInferredQuantifiers _ _ _ _ (Just (TISI { sig_inst_sig = sig@(CompleteSig {}) })) = pprPanic "chooseInferredQuantifiers" (ppr sig) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -943,7 +943,7 @@ unknown kind. For instance, we may have, FunTy (a :: k) Int -Where k is a unification variable. So the calls to getRuntimeRep_maybe may +Where k is a unification variable. So the calls to splitRuntimeRep_maybe may fail (returning Nothing). In that case we'll fall through, zonk, and try again. Zonking should fill the variable k, meaning that decomposition will succeed the second time around. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3f8b75abb53c99032e3f4f79ce92a9d2bc0a647 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3f8b75abb53c99032e3f4f79ce92a9d2bc0a647 You're receiving 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 22 14:08:15 2022 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 22 Aug 2022 10:08:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22039 Message-ID: <63038dcff22ff_e9d7d48850398437@gitlab.mail> Sebastian Graf pushed new branch wip/T22039 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22039 You're receiving 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 22 14:30:46 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 Aug 2022 10:30:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/upload-creds Message-ID: <63039316c5719_e9d7d4d1d44114ae@gitlab.mail> Ben Gamari pushed new branch wip/upload-creds at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/upload-creds You're receiving 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 22 14:33:14 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 Aug 2022 10:33:14 -0400 Subject: [Git][ghc/ghc][wip/upload-creds] upload_ghc_libs: Add means of passing Hackage credentials Message-ID: <630393aa78f2c_e9d7d209eca084116bb@gitlab.mail> Ben Gamari pushed to branch wip/upload-creds at Glasgow Haskell Compiler / GHC Commits: e098b975 by Ben Gamari at 2022-08-22T14:33:06+00:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 1 changed file: - .gitlab/upload_ghc_libs.py Changes: ===================================== .gitlab/upload_ghc_libs.py ===================================== @@ -17,6 +17,7 @@ There are two modes, preparation and upload. """ from subprocess import run, check_call +from getpass import getpass import shutil from pathlib import Path from typing import NamedTuple, Callable, List, Dict, Optional @@ -36,6 +37,10 @@ class Package(NamedTuple): path: Path prepare_sdist: Callable[[], None] +class Credentials(NamedTuple): + username: str + password: str + def no_prep(): pass @@ -97,11 +102,15 @@ PACKAGES = { } # Dict[str, Package] -def cabal_upload(tarball: Path, publish: bool=False, extra_args=[]): +def cabal_upload(tarball: Path, creds: Credentials, publish: bool=False, extra_args=[]): if publish: extra_args += ['--publish'] - run(['cabal', 'upload'] + extra_args + [tarball], check=True) + creds_args = [ + f'--username={creds.username}' + f'--password={creds.password}' + ] + run(['cabal', 'upload'] + extra_args + [tarball] + creds_args, check=True) def prepare_sdist(pkg: Package): @@ -115,13 +124,13 @@ def prepare_sdist(pkg: Package): res_path = shutil.copy(sdist, OUT_DIR) return os.path.relpath(res_path, OUT_DIR) -def upload_pkg_sdist(sdist : Path, pkg : Package, publish : bool): +def upload_pkg_sdist(sdist : Path, pkg: Package, publish: bool, creds: Credentials): publish_tag = '-publish' if publish else '' stamp = WORK_DIR / f'{pkg.name}-sdist{publish_tag}' if stamp.is_file(): return print(f'Uploading package {pkg.name}...') - cabal_upload(sdist, publish) + cabal_upload(sdist, publish=publish, creds=creds) stamp.write_text('') def get_version(cabal_file: Path) -> Optional[str]: @@ -137,8 +146,8 @@ def prepare_docs(bindist: Path, pkg: Package): """ cabal_file = pkg.path / f'{pkg.name}.cabal' version = get_version(cabal_file) - docdir = bindist / 'doc' / 'html' / 'libraries' / (pkg.name + "-" + version) assert version is not None + docdir = bindist / 'doc' / 'html' / 'libraries' / (pkg.name + "-" + version) # Build the documentation tarball from the bindist documentation stem = f'{pkg.name}-{version}-docs' @@ -148,20 +157,20 @@ def prepare_docs(bindist: Path, pkg: Package): run(['tar', '-czf', OUT_DIR / tarball, '-H', 'ustar', '-C', tmp.name, stem]) return tarball -def upload_docs(tarball : Path, pkg : Package, publish : bool): +def upload_docs(tarball : Path, pkg : Package, publish : bool, creds: Credentials): publish_tag = '-publish' if publish else '' stamp = WORK_DIR / f'{pkg.name}-docs{publish_tag}' if stamp.is_file(): return # Upload the documentation tarball print(f'Uploading documentation for {pkg.name}...') - cabal_upload(tarball, publish=publish, extra_args=['--documentation']) + cabal_upload(tarball, publish=publish, extra_args=['--documentation'], creds=creds) stamp.write_text('') -def upload_pkg(pkg: Package, d : Path, meta, publish : bool): +def upload_pkg(pkg: Package, d : Path, meta, publish : bool, creds: Credentials): print(f'Uploading {pkg.name}...') - upload_pkg_sdist(d / meta['sdist'], pkg, publish=publish) - upload_docs(d / meta['docs'], pkg, publish=publish) + upload_pkg_sdist(d / meta['sdist'], pkg, publish=publish, creds=creds) + upload_docs(d / meta['docs'], pkg, publish=publish, creds=creds) def prepare_pkg(bindist : Path, pkg : Package): if pkg.path.exists(): @@ -172,11 +181,6 @@ def prepare_pkg(bindist : Path, pkg : Package): else: print(f"Package {pkg.name} doesn't exist... skipping") - -def upload_all(bindist: Path): - for pkg in PACKAGES.values(): - upload_pkg(bindist, pkg) - def main() -> None: import argparse @@ -212,13 +216,16 @@ def main() -> None: pickle.dump(manifest, fout) elif args.command == "upload": + username = input('Hackage username: ') + password = getpass('Hackage password: ') + creds = Credentials(username, password) manifest_path = args.docs with open(manifest_path / 'manifest.pickle', 'rb') as fin: manifest = pickle.load(fin) for pkg, item in manifest.items(): if pkg.name in pkgs: print(pkg, item) - upload_pkg(pkg, manifest_path, item, publish=args.publish) + upload_pkg(pkg, manifest_path, item, publish=args.publish, creds=creds) if __name__ == '__main__': main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e098b9750bbec37134cd52d7e204ffd0212088eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e098b9750bbec37134cd52d7e204ffd0212088eb You're receiving 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 22 14:52:07 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 22 Aug 2022 10:52:07 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] clean Message-ID: <63039817883ab_e9d7d1fa4ae244295b@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: 54395443 by Matthew Pickering at 2022-08-22T15:52:00+01:00 clean - - - - - 4 changed files: - hadrian/src/Builder.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/GhcPkg.hs Changes: ===================================== hadrian/src/Builder.hs ===================================== @@ -103,7 +103,7 @@ instance NFData ConfigurationInfo -- TODO: Do we really need all these modes? Why do we need 'Dependencies'? We -- can extract dependencies using the Cabal library. -- | 'GhcPkg' can initialise a package database and register packages in it. -data GhcPkgMode = Init -- ^ Initialise an empty package database +data GhcPkgMode = Recache -- ^ Recache a package database | Copy -- ^ Copy a package from one database to another. | Dependencies -- ^ Compute package dependencies. | Unregister -- ^ Unregister a package. ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -17,7 +17,6 @@ import Target import Utilities import Data.Time.Clock import Rules.Generate (generatedDependencies) -import Hadrian.Oracles.Cabal (readPackageData) import Oracles.Flag @@ -111,20 +110,15 @@ buildGhciLibO root ghcilibPath = do buildPackage :: FilePath -> FilePath -> Action () buildPackage root fp = do - l@(BuildPath _ stage _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp + l@(BuildPath _ _ _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp let ctx = stampContext l srcs <- hsSources ctx gens <- interpretInContext ctx generatedDependencies - depPkgs <- packageDependencies <$> readPackageData (package ctx) - -- Stage packages are those we have in this stage. - stagePkgs <- stagePackages stage + lib_targets <- libraryTargets True ctx - need (srcs ++ gens) + need (srcs ++ gens ++ lib_targets) --- ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) - need =<< libraryTargets True ctx - --unless (null srcs) (build $ target ctx (Ghc (CompileHs GhcMake) stage) srcs []) time <- liftIO $ getCurrentTime liftIO $ writeFile fp (show time) ways <- interpretInContext ctx getLibraryWays ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -95,7 +95,7 @@ registerPackageRules rs stage iplace = do -- a package gets registered but there's not a package.cache file (which -- leads to errors in GHC). buildWithResources rs $ - target (Context stage compiler vanilla iplace) (GhcPkg Init stage) [] [] + target (Context stage compiler vanilla iplace) (GhcPkg Recache stage) [] [] writeFileLines stamp [] -- Register a package. @@ -152,7 +152,7 @@ buildConfFinal rs context at Context {..} _conf = do Cabal.copyPackage context Cabal.registerPackage context buildWithResources rs $ - target context (GhcPkg Init stage) [] [] + target context (GhcPkg Recache stage) [] [] -- We declare that this rule also produces files matching: -- - /stage/lib/--ghc-/*libHS* @@ -175,10 +175,6 @@ buildConfInplace rs context at Context {..} _conf = do ensureConfigured context need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage Inplace) <&> (-/- pkgId <.> "conf")) depPkgIds - -- ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) - -- need . traceShowId =<< mapM pkgStampFile [ context { way = w } | w <- Set.toList ways ] - - -- We might need some package-db resource to limit read/write, see packageRules. path <- buildPath context -- Special package cases (these should ideally be rolled into Cabal). @@ -198,31 +194,12 @@ buildConfInplace rs context at Context {..} _conf = do when (bignum == "gmp") $ need [path -/- "include/ghc-gmp.h"] - -- Copy and register the package. --- Cabal.copyPackage context + -- Write an "inplace" package conf which points into the build directories + -- for finding the build products Cabal.writeFakePkgConf context conf <- pkgInplaceConfig context --- runBuilder (GhcPkg Update stage) [] [conf] [] - buildWithResources rs $ target context (GhcPkg Update stage) [conf] [] --- Cabal. - - -- We declare that this rule also produces files matching: - -- - /stage/lib/--ghc-/*libHS* - -- (for .so files, Cabal's registration mechanism places them there) - -- - /stage/lib/--ghc-//** - -- (for interface files, static libs, ghci libs, includes, ...) - -- - -- so that if any change ends up modifying a library (but not its .conf - -- file), we still rebuild things that depend on it. - dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package - files <- liftIO $ - (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] - <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] - produces files - copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action () ===================================== hadrian/src/Settings/Builders/GhcPkg.hs ===================================== @@ -4,7 +4,7 @@ import Settings.Builders.Common ghcPkgBuilderArgs :: Args ghcPkgBuilderArgs = mconcat - [ builder (GhcPkg Init) ? do + [ builder (GhcPkg Recache) ? do loc <- getPackageDbLoc pkgDb <- expr $ packageDbPath loc -- Confusingly calls recache rather than init because shake "creates" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5439544354ef7240174e473b97771ae1efefa6a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5439544354ef7240174e473b97771ae1efefa6a5 You're receiving 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 22 15:07:10 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 22 Aug 2022 11:07:10 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] Remove stage1:exe:ghc-bin pre-build from CI script Message-ID: <63039b9ee8532_e9d7d4ee6c43015a@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: bd05afe1 by Matthew Pickering at 2022-08-22T16:05:47+01:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -535,10 +535,6 @@ function build_hadrian() { check_release_build - # N.B. First build Hadrian, unsetting MACOSX_DEPLOYMENT_TARGET which may warn - # if the bootstrap libraries were built with a different version expectation. - MACOSX_DEPLOYMENT_TARGET="" run_hadrian -V stage1:exe:ghc-bin - if [[ -n "${REINSTALL_GHC:-}" ]]; then run_hadrian build-cabal -V else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd05afe1097e32d1b08d9f746a2b31c35e6402f8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd05afe1097e32d1b08d9f746a2b31c35e6402f8 You're receiving 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 22 15:18:42 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 Aug 2022 11:18:42 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles Message-ID: <63039e527e0ed_e9d7d1fa4ae24430757@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: e7cf241c by Simon Peyton Jones at 2022-08-22T16:19:13+01:00 Wibbles - - - - - 3 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - testsuite/tests/typecheck/should_fail/tcfail212.stderr - testsuite/tests/typecheck/should_fail/tcfail215.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2142,21 +2142,22 @@ pprTcSolverReportMsg ctxt pp_exp_thing = case exp_torc of TypeLike -> text "type"; ConstraintLike -> text "constraint" - -- (TYPE (BoxedRep lev1)) ~ (TYPE (BoxedRep lev2)) + -- (TYPE (BoxedRep lev1)) ~ (TYPE (BoxedRep lev2)); or CONSTRAINT ditto msg_for_same_rep exp_rr_args act_rr_args | [exp_lev_ty] <- exp_rr_args -- BoxedRep has exactly one arg , [act_lev_ty] <- act_rr_args , Just exp_lev <- levityType_maybe exp_lev_ty , Just act_lev <- levityType_maybe act_lev_ty - = sep [ text "Expecting" <+> ppr_an_lev exp_lev <+> pp_exp_thing <+> text "but" + = sep [ text "Expected" <+> 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 ] msg_for_same_rep _ _ = bale_out_msg + -- (TYPE (BoxedRep lev)) ~ (TYPE IntRep); or CONSTRAINT ditto msg_for_different_rep exp_rr_tc act_rr_tc - = sep [ text "Expecting a" <+> what <+> text "but" + = sep [ text "Expected a" <+> what <> text ", but" , case mb_thing of Just thing -> quotes (ppr thing) Nothing -> quotes (pprWithTYPE act) ===================================== testsuite/tests/typecheck/should_fail/tcfail212.stderr ===================================== @@ -10,9 +10,9 @@ tcfail212.hs:10:14: error: • In the type signature: f :: (Maybe, Either Int) tcfail212.hs:13:7: error: - • Expecting a lifted type, but ‘Int#’ is unlifted + • Expected a boxed type, but ‘Int#’ has representation ‘IntRep’ • In the type signature: g :: (Int#, Int#) tcfail212.hs:13:13: error: - • Expecting a lifted type, but ‘Int#’ is unlifted + • Expected a boxed type, but ‘Int#’ has representation ‘IntRep’ • In the type signature: g :: (Int#, Int#) ===================================== testsuite/tests/typecheck/should_fail/tcfail215.stderr ===================================== @@ -1,5 +1,4 @@ tcfail215.hs:8:15: error: - • Expecting a lifted type, but ‘Int#’ is unlifted - • In the type signature: - foo :: (?x :: Int#) => Int + • Expected a boxed type, but ‘Int#’ has representation ‘IntRep’ + • In the type signature: foo :: (?x :: Int#) => Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7cf241ce262e210f39458bff72f3031dafecd5e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7cf241ce262e210f39458bff72f3031dafecd5e You're receiving 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 22 15:33:17 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 Aug 2022 11:33:17 -0400 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.4.2-release Message-ID: <6303a1bdda322_e9d7d4d1d4434998@gitlab.mail> Ben Gamari pushed new tag ghc-9.4.2-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.4.2-release You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Aug 22 15:36:57 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Mon, 22 Aug 2022 11:36:57 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 181 commits: hadrian: Don't attempt to install documentation if doc/ doesn't exist Message-ID: <6303a299a0ba0_e9d7d4d1d443712c@gitlab.mail> doyougnu pushed to branch wip/js-staging 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 - - - - - 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 - - - - - 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. - - - - - ed2a7527 by Josh Meredith at 2022-08-19T14:39:59-04:00 Add ghcjs changes to deriveConstants: - change String targetOS option in deriveConstants to an enum - separate out getWantedGHSJS, removing generated c file in this path - - - - - 1e877f96 by doyougnu at 2022-08-19T14:40:02-04:00 Add JavaScript code generator Adapt code generator of GHCJS to GHC head. Currently it is only enabled with the hidden -fjavascript flag. It produces .o files that can't be used yet except by GHCJS's linker. Codegen: doc Codegen: correctly return linkable object Now we can build a static library (-staticlib) Codegen: doc genLit Codegen: use assignAll Codegen: introduce TypedExpr Refactor assignAll et al, add documentation Codegen: minor changes Doc - - - - - 2b9be3b1 by doyougnu at 2022-08-19T14:40:02-04:00 Add JS.Rts JS.Rts: compiles reword: progress on RtsTypes StgToJS.Config: add SDoc Context JSRts: move ppr, workaround def type JSRts.Types: compiles JS.Rts: closer to compiling JS.Rts: move jsIdIdent' to StgToJS.Monad JS.Rts: remove unused predicates JS: cleanup, comment sections, math funcs to Make JS.Rts.Types: compiles StgToJS.Expr: fix compilation errors StgToJS.DataCon: move initClosure JS.Rts: remove Alloc module JS.Rts: initalize Rts module, remove redundant fs JS: init Rts.Alloc move initClosure JS.Apply: unwinding combinators in progress JS: add helpers and fixmes JS.Rts.Apply: no more e's, add closure, reg helper StgToJS: add ToStat instance ClosureInfo JS.Rts.Apply: closer to compiling JS.Rts.Apply: more removal of # JS.Rts.Apply: (#) removed JS.Rts.Apply: compiles JS.Rts.Rts: just pretty printing left JS.Rts: Add Notes JS.Rts: add file headers and notes JS.Rts.Rts: fixing stringy issues JS.Rts.Rts: compiles JS.Rts.Rts: fix non-exhaustive patterns warnings - - - - - e4f0874b by Sylvain Henry at 2022-08-19T14:40:03-04:00 Doc has been moved into GHC.StgToJs top-level module - - - - - dd224da1 by Sylvain Henry at 2022-08-19T14:40:03-04:00 JS.Rts; refactoring and move to StgToJS * add closure manipulation helpers and use them in Apply * add cache (Array) for pre-generated PAP names * reduce line length: * use BlockArguments instead of parens * remove implicit mconcat in jVar's body Rts: more refactorings Rts: move into StgToJS hierarchy - - - - - fbb3834f by Sylvain Henry at 2022-08-19T14:40:03-04:00 JS: cleanup, renaming, better module layout Various degrees of cleanup adapting GHCJS to GHC. We move several functions to CoreUtils, remove duplication between the JS.Rts.Apply and Apply module and factor out closure related code into a Closure module for cohesion. Deduplicate code between Rts.Apply and Apply Move might_be_a_function into CoreUtils Factorize closure stuff into Closure module Rename closureExtra into closureField Minor renamings, comments... - - - - - 24fa76a4 by Sylvain Henry at 2022-08-19T14:40:03-04:00 JS.Backend: add FFI code but don't implement yet FFI: don't crash on JavaScript foreign imports Note that they are still not desugared properly!! But the following cmd doesn't crash anymore: ghc -fjavascript Test.hs -fforce-recomp -ddump-tc -fno-code -ddump-ds FFI: adapt GHCJS desugarer FFI: support direct application The following example: foo :: Int# -> Int# foo = add 50000# foreign import javascript "(function(x,y) { return (x + y) })" add :: Int# -> Int# -> Int# is compiled into an application like this: var h$mainZCMzifoozur2_e; h$mainZCMzifoozur2_e = (function() { var h$mainZCMziaddzur1; h$mainZCMziaddzur1 = h$r1.d1; var h$$mainZCMzietazuB0_8KXnScrCjF5; h$$mainZCMzietazuB0_8KXnScrCjF5 = h$r2; h$r3 = h$$mainZCMzietazuB0_8KXnScrCjF5; h$r2 = 50000; h$r1 = h$mainZCMziaddzur1; return h$ap_2_2_fast(); return h$rs(); }); var h$mainZCMziaddzur1_e; h$mainZCMziaddzur1_e = (function() { var h$$mainZCMzidszusAk_236l8r0P8S9; h$$mainZCMzidszusAk_236l8r0P8S9 = h$r2; var h$$mainZCMzids1zusAl_336l8r0P8S9; h$$mainZCMzids1zusAl_336l8r0P8S9 = h$r3; var h$$mainZCM_2; var h$$mainZCMziwildzusAn_536l8r0P8S9; try { h$$mainZCMziwildzusAn_536l8r0P8S9 = (function(x,y) { return (x + y) })(h$$mainZCMzidszusAk_236l8r0P8S9, h$$mainZCMzids1zusAl_336l8r0P8S9) } catch(except) { return h$throwJSException(except) }; var h$$mainZCMzids3zusAp_736l8r0P8S9; h$$mainZCMzids3zusAp_736l8r0P8S9 = h$$mainZCMziwildzusAn_536l8r0P8S9; h$r1 = h$$mainZCMzids3zusAp_736l8r0P8S9; return h$rs(); }); FFI: correctly dispatch for foreign exports too FFI: move C FFI desugaring into its own module FFI: avoid DynFlags in toJsName (copy of toCName) - - - - - 9990270f by Sylvain Henry at 2022-08-19T14:40:03-04:00 Configure: preliminary support for triple js-unknown-ghcjs - - - - - 2686798b by Sylvain Henry at 2022-08-19T14:40:03-04:00 Driver: enable JS backend by default for JS arch - - - - - 0a9295ab by doyougnu at 2022-08-19T14:40:04-04:00 JS.Backend: Add JS specific Linker JS: initialize Linker, DynamicLinking JS.Printer: adapted to GHC Head JS.Printer: some cleanup and init Printer StgToJS.Printer: Compiles JS.Linker: Add types, expose JS keywords JS.Syntax: add Binary instance on Ident's JS.Linker: Migrate more Types to Data.Binary JS.Linker.Types: compiles and adapted to GHC Head JS.Linker.Types: compiles JS.Linker.Types: add UseBase type JS.Linker: Comments and Cleanup JS.Linker.Types: add TH types, Env type, DepsLoc JS.Linker: more FIXMEs numerous Linker fixes JS.Linker: removed Text references JS.UnitUtils: add package related helper functions JS.Linker: more DynFlags removal JS.Linker: Time for semantic errors JS.Linker: DynFlags finally removed JS.Linker: 107 compile errors to go JS.Linker.Utils: initialized, adapted to GHC Head JS.Linker.Utils: initialize Utils module JS.Linker.Utils: more utils JS.Rts: move rtsText to Rts JS.Linker: linkerStats implemented JS.Compactor: compiles, adapted to GHC Head JS.Compactor: have to retrofit compact for linker JS.Linker.Compactor: unwinding lenses JS.Linker.Compactor: comments over addItem JS.Linker.Compactor: Lenses removed JS.Linker.Compactor: SHA256 removed JS.Linker.Compactor: only missing instances left JS.Linker.Compactor: compiles JS.Linker: compiles, adapted to ghc Head JS.Linker: More progress JS.Linker: link in memory compiles JS.Linker: just shims left JS.Linker.DynamicLinking compiles: adapted to head JS.Linker.DynamicLinking: initialization JS.Linker.DynamicLinking: compiles up to Variants JS.Variants: initialize JS.Linker: numerous and various fixes JS.Linker.DynamicLinking: only small errors left JS.Linker.Archive: compiles, adapted to GHC Head JS.Linker: initialize Archive compat module JS.Linker.Archive: minor fixes JS.Linker.DynamicLinking: compiles JS.Linker: cleanup, remove Variants, add comments fixup: more cleanup JS.Linker: more cleanup and comments - - - - - 97062013 by Sylvain Henry at 2022-08-19T14:40:04-04:00 Minor panic fix - - - - - 7aca1493 by Sylvain Henry at 2022-08-19T14:40:04-04:00 Linker: fix stage2 build - - - - - d42f6c19 by Sylvain Henry at 2022-08-19T14:40:04-04:00 Configure: Add support fo JS as unregistered ABI Configure: detect emscripten tools e.g. on ArchLinux: EMSDK=/usr/lib/emscripten EMSDK_LLVM=/opt/emscripten-llvm ./configure --target=js-unknown-ghcjs Configure: detect nm tool too, required by Hadrian Configure: make StgToJS use non-unregisterised ABI It should probably be a third kind of ABI... - - - - - bc67ae68 by doyougnu at 2022-08-19T14:40:04-04:00 JS.Linker: Hook up to GHC.Driver.Pipeline JS.Linker.Types: Add newGhcjsEnv function JS.UnitUtils: fix encodeModule api JS.Linker: more removal of HscEnv JS.Linker: hooked into GHC.Driver.Pipeline - - - - - 1368877b by Sylvain Henry at 2022-08-19T14:40:04-04:00 VERY WIP Hadrian/rts fixes export EMSDK_LLVM=/opt/emscripten-llvm export EMSDK=/usr/lib/emscripten export PATH=./inplace/ghcjs_toolchain/bin:$PATH ./configure --target=js-unknown-ghcjs ./hadrian/build --flavour=quick-js -j --bignum=native --docs=none -V - - - - - ee07aaa8 by Sylvain Henry at 2022-08-19T14:40:05-04:00 Force creation of rts library with dummy file - - - - - 6f26eca2 by Sylvain Henry at 2022-08-19T14:40:05-04:00 ghc-prim: avoid building C files - - - - - 1856ea2e by Sylvain Henry at 2022-08-19T14:40:05-04:00 Hadrian: disable -fllvm - - - - - c1548e76 by Sylvain Henry at 2022-08-19T14:40:05-04:00 JS: fix caches Note that the fact that we need index 0 may hide another issue... - - - - - 8afd04ee by Sylvain Henry at 2022-08-19T14:40:05-04:00 codegen: enhance genCon debug message - - - - - 9cbb03e5 by Sylvain Henry at 2022-08-19T14:40:05-04:00 RTS: fix stupid comment - - - - - bb19a368 by Sylvain Henry at 2022-08-19T14:40:05-04:00 RTS: embed headers - - - - - ca2a9bf7 by Sylvain Henry at 2022-08-19T14:40:06-04:00 JS.StgToJS: add documentation header for JS Types - - - - - b3918b71 by Sylvain Henry at 2022-08-19T14:40:06-04:00 CodeGen: refactor ExprCtx code - - - - - 2239a453 by Sylvain Henry at 2022-08-19T14:40:06-04:00 CodeGen: cache LNE frame size - - - - - a27e41e5 by doyougnu at 2022-08-19T14:40:06-04:00 JS.Types: Add Outputable for TypedExpr - - - - - 33dc493c by doyougnu at 2022-08-19T14:40:06-04:00 JS.CoreUtils: handle IOPort case - - - - - 0de46411 by doyougnu at 2022-08-19T14:40:06-04:00 JS.Expr: Fix unhandled datacon for RuntimeRep - - - - - 26cf273d by doyougnu at 2022-08-19T14:40:06-04:00 JS.Literals: Adapt genLit to new Literal domain - - - - - b738b182 by Sylvain Henry at 2022-08-19T14:40:07-04:00 RTS: expose more headers (required to build base) - - - - - efa2516d by Sylvain Henry at 2022-08-19T14:40:07-04:00 Base: don't build C and Cmm sources with ghcjs - - - - - 279b9d16 by Sylvain Henry at 2022-08-19T14:40:07-04:00 Tentatively set NO_REGS for JS platforms - - - - - b8becfc1 by Sylvain Henry at 2022-08-19T14:40:07-04:00 CodeGen: output LitRubbish as null JS values - - - - - c75b51a9 by Sylvain Henry at 2022-08-19T14:40:07-04:00 base: disable forkOS and bound thread machinery - - - - - 5ef992ff by Sylvain Henry at 2022-08-19T14:40:07-04:00 CodeGen: support StackSnapshot# in primTypeVt - - - - - 2af83d6a by Sylvain Henry at 2022-08-19T14:40:08-04:00 CodeGen: better debug message for assignCoerce1 - - - - - 33a8801c by Sylvain Henry at 2022-08-19T14:40:08-04:00 Misc: enable HasDebugCallStack for zipWithEqual* - - - - - 65b9a872 by Sylvain Henry at 2022-08-19T14:40:08-04:00 CodeGen: remove useless imports - - - - - 6eab57b7 by Sylvain Henry at 2022-08-19T14:40:08-04:00 Stg: expose pprStgAlt - - - - - 9d4fdae7 by Sylvain Henry at 2022-08-19T14:40:08-04:00 CodeGen: restore assignAll (instead of assignAllEqual) - - - - - d0aa2d67 by Sylvain Henry at 2022-08-19T14:40:08-04:00 CodeGen: handle proxy# - - - - - 545e820e by doyougnu at 2022-08-19T14:40:08-04:00 ghc-heap: Don't compile Cmm file for JS-Backend - - - - - abeabc36 by doyougnu at 2022-08-19T14:40:09-04:00 Driver.Main: minor refactor do_code_gen To clearly separate the JS-Backend from any other backend - - - - - 0cb652af by Sylvain Henry at 2022-08-19T14:40:09-04:00 Configure: fix echo on Mac, add ghcjs target OS - - - - - 591fba0d by Sylvain Henry at 2022-08-19T14:40:09-04:00 Configure: fix previous commit - - - - - ca9609d0 by Luite Stegeman at 2022-08-19T14:40:09-04:00 fix package name in module name field of system dependencies - - - - - edd37ddf by Luite Stegeman at 2022-08-19T14:40:09-04:00 fix duplicate module name in symbols - - - - - 7ebd4274 by doyougnu at 2022-08-19T14:40:09-04:00 GHCi.FFI: ignore ffi.h and friends for js-backend - - - - - 86eca523 by Sylvain Henry at 2022-08-19T14:40:10-04:00 RTS: fix build of native rts - - - - - fe2771d5 by Sylvain Henry at 2022-08-19T14:40:10-04:00 Remove temporary -fjavascript flag - - - - - e9fc4bb9 by Sylvain Henry at 2022-08-19T14:40:10-04:00 Codegen: fix symbol names ppr - - - - - 277dbd5c by Sylvain Henry at 2022-08-19T14:40:10-04:00 Outputable: add ShortText instance - - - - - 6473ef7b by Sylvain Henry at 2022-08-19T14:40:10-04:00 Linker: enhance debugging message - - - - - 51ae4df5 by Sylvain Henry at 2022-08-19T14:40:10-04:00 Remove unused ghcjs unit related code - - - - - 95dc70cf by Sylvain Henry at 2022-08-19T14:40:10-04:00 ghci: Avoid unused-xyz warnings - - - - - 5f28fcb6 by Sylvain Henry at 2022-08-19T14:40:11-04:00 Linker: remove wiring of ghcjs-prim and ghcjs-th They will be replaced by ghc-prim, base, template-haskell, etc. - - - - - 8d2d6319 by Sylvain Henry at 2022-08-19T14:40:11-04:00 Add outputable instance for Deps - - - - - b2eb6089 by doyougnu at 2022-08-19T14:40:11-04:00 Docs: JS.Syntax, JS.Make docs done JS-backend: Add documentation headers Docs: JS.Syntax done Docs: JS.Make done Docs: JS.Make JS.Syntax refined a bit - - - - - e15d2cc5 by Sylvain Henry at 2022-08-19T14:40:11-04:00 Rename u_env into unit_env (more common) - - - - - 8747b778 by Sylvain Henry at 2022-08-19T14:40:11-04:00 Linker: deduplication + fixes - deduplicate code that was copied from old GHC - explicitly add preloadUnits to the link - avoid calling getShims - - - - - 745458d8 by Sylvain Henry at 2022-08-19T14:40:11-04:00 Linker: reenable packStrings (not yet implemented though) - - - - - d8b36e93 by Sylvain Henry at 2022-08-19T14:40:11-04:00 ShortText: add singleton - - - - - 6c5d5f46 by Sylvain Henry at 2022-08-19T14:40:12-04:00 Linker: force less efficient (but working) static encoding - - - - - 35c4c625 by Luite Stegeman at 2022-08-19T14:40:12-04:00 add GHCJS modules to base package - - - - - 41083e4d by Sylvain Henry at 2022-08-19T14:40:12-04:00 Linker: remove JS Shims,tiny GHC.Linker refactor - - - - - 7b11750f by doyougnu at 2022-08-19T14:40:12-04:00 Hadrian: QuickJS ways [] --> Set - - - - - 8ac34ae2 by doyougnu at 2022-08-19T14:40:12-04:00 JS-Backend: rebased to master 468f919b First rebase of the JS-Backend. This rebase includes the JS backend combined with !7442 (new backend design). Unfortunately we have to short circuit the new backend design because the JS backend takes over after STG and not after StgToCmm. What's working: - hadrian builds JS backend - JS backend outputs .js files and "links" them What still has to be done: - JS backend is missing core js libraries as we add these we discover bugs in the linker and js rts. - - - - - 33ad67f1 by doyougnu at 2022-08-19T14:40:12-04:00 JS: silence haddock warnings JS Backend: remove misc. warnings - - - - - 55691c71 by doyougnu at 2022-08-19T14:40:13-04:00 JS Backend: ghcjs_HOST_OS --> js_HOST_ARCH - - - - - 94fd858a by Sylvain Henry at 2022-08-19T14:40:13-04:00 JS.Linker: add shims GHCJS uses JS files for primitive things like the GC and RTS. We call these JS files "shims". This sequence of commits adds shims from JS and includes them for linking. In addition the shim directory is controlled via an evironment variable JS_RTS_PATH...at least for now. Linker: implement tryReadShimFile Linker: link with shims provided via an env variable Use JS_RTS_PATH to provide a directory into which .js and .js.pp files will be linked into rts.js JS.Linker: add js dir at root, fix js cpp includes JS.gc.pp: remove variadic macro JS.RTS: add rts JS shims files, remove shim CPP RTS: remove the need for rts.h and add rts JS files rts.h only contained a few constants duplicated in the codegen. Let's use the Haskell version as the single source of truth and pass defined values explicitly to cpp command line ("-DXYZ=abc" arguments). Also switch from "raw" (use_cpp_and_not_cc_dash_E = True) to the opposite: in both case we call "cc -E" (meh), but with False the preprocessor doesn't choke one varargs in macros. RTS: remove integer.js.pp We use the native ghc-bignum backend, so we don't need the GMP compatible JS code. In addition, this code was failing to run as it requires the JSBN (https://www.npmjs.com/package/jsbn) "Javascript big number" library, which we don't necessarily have installed. RTS: fix typo in field name RTS: generate CPP macros in Haskell RTS: share common CPP def into CAFs - - - - - 79f69019 by Sylvain Henry at 2022-08-19T14:40:13-04:00 CPP: disable line markers CPP: move option before input filename (to be squashed) - - - - - b8d128c0 by Sylvain Henry at 2022-08-19T14:40:13-04:00 Linker: add more types Some cleanup Enhance and fix LinkerStats Document and refactor renderLinker Split collectDeps Fix collectDeps Fix linker stats rendering Remove unused seqListSpine It isn't used in ghcjs either - - - - - f0f7392a by Sylvain Henry at 2022-08-19T14:40:13-04:00 Add some missing primops (Word32,Int32) Also fix the rendering of missing primops (they must be z-encoded to avoid having a "#" in their JS name) - - - - - 0783a3ea by Sylvain Henry at 2022-08-19T14:40:13-04:00 FFI: desugar every foreign import/export in JS with JS backend It means we also desugar CApi calls into JS. It's probably wrong but instead of generating invalid JS we will only get the failure at runtime when we will use the function. fixup - - - - - 2c39321f by doyougnu at 2022-08-19T14:40:14-04:00 JS.Linker: remove dflags includePath workaround. We implemented a workaround for shims that modified the dynflags includePaths so that the JS backend would find the rts.h file during CPP of shims. Since aebcca98 this is no longer required because we've removed the need for rts.h completely. Thus, this commit reverts that modification. - - - - - 1f583ff4 by Sylvain Henry at 2022-08-19T14:40:14-04:00 Temporarily wire-in base's shim Use JS_BASE_PATH env var to set base's shim directory (js_base for now) Also minor other changes base: fix encoding for JS arch - - - - - 33a4f0e2 by Sylvain Henry at 2022-08-19T14:40:14-04:00 Add primops Add primop - - - - - dc2e8714 by doyougnu at 2022-08-19T14:40:14-04:00 Make Shims type, refactor JS Linker This commit: - Adds a proper Shim type and associated utilities. These utitlies are purposefully limited to ensure the ShimLbl tag is preserved thus guarenteeing shim ordering at link time. - Refactors the JS backend linker to use this ordering and Shim API. The ordering is not correct (yet!) but with this API its much easier to triage, experiment and diagnose link time issues. Refactor linker to compile time shim ordering - - - - - f9c7e01b by doyougnu at 2022-08-19T14:40:14-04:00 Base: Adapt primitives to JS backend, add base.js - - - - - b53f3029 by doyougnu at 2022-08-19T14:40:14-04:00 Base: Remove binding forms in JS ffi - - - - - 1bd65ee6 by Josh Meredith at 2022-08-19T14:40:14-04:00 Replace GHCJS Objectable with GHC Binary - - - - - 259ac2a7 by Sylvain Henry at 2022-08-19T14:40:15-04:00 Binary: remove unused Map instance - - - - - 344e1e3a by Sylvain Henry at 2022-08-19T14:40:15-04:00 CodeGen: Add export list - - - - - 32d6d215 by Sylvain Henry at 2022-08-19T14:40:15-04:00 Primops: add some Int64/Word64 primops - - - - - 8eb2c18f by Sylvain Henry at 2022-08-19T14:40:15-04:00 base: fix one ffi import - - - - - 2ade3063 by doyougnu at 2022-08-19T14:40:15-04:00 base: CPP for JS-backend, adapt write in base shim This commit ports over each CPP directive from GHCJS to base. In addition, it adds struct.js.pp to Base shim directory and modifies h$base_write to always take 6 arguments. Thereby avoiding errors such as "c(bytesWritten) is not a function". The missing parameter was the file descriptor object, fdo, which was looked up in the function itself and is now passed through to comport with the FFI expectations. - - - - - d4c8b10f by doyougnu at 2022-08-19T14:40:15-04:00 fixup: remove redundant struct.js.pp in js_base - - - - - 12bc8256 by doyougnu at 2022-08-19T14:40:16-04:00 JS.Linker: enable linker RTS symbols - - - - - ec857684 by doyougnu at 2022-08-19T14:40:16-04:00 base.GHCJS: adapt Prim to direct call FFI format - - - - - d49017dc by doyougnu at 2022-08-19T14:40:16-04:00 Linker: Load JSVal from base not ghc-prim - - - - - 948a9bbc by doyougnu at 2022-08-19T14:40:16-04:00 fixup: caught one more reference to JSVal in prim - - - - - 5feb246d by Sylvain Henry at 2022-08-19T14:40:16-04:00 base: match on js arch , not ghcjs os - - - - - d06c1e66 by Sylvain Henry at 2022-08-19T14:40:16-04:00 Fix MK_JSVAL - - - - - a10c0817 by doyougnu at 2022-08-19T14:40:16-04:00 Prim: cleanup comments - - - - - 38f0f1ce by doyougnu at 2022-08-19T14:40:17-04:00 JS.Prim: add Int64 PrimOps - - - - - 45733599 by Sylvain Henry at 2022-08-19T14:40:17-04:00 Vendor MD5 lib - - - - - 37f69ab7 by Sylvain Henry at 2022-08-19T14:40:17-04:00 More 64-bit primops - - - - - e0cf00c2 by Sylvain Henry at 2022-08-19T14:40:17-04:00 CodeGen: use if10 helper - - - - - d10e68f9 by Sylvain Henry at 2022-08-19T14:40:17-04:00 Ppr: fix selector to avoid adding a newline - - - - - 7cffcefd by doyougnu at 2022-08-19T14:40:17-04:00 base: GHCJS.Prim make ffi imports use anon funcs - - - - - e4b728c9 by Sylvain Henry at 2022-08-19T14:40:17-04:00 Linker: disable invalid constructors again - - - - - 706b60f7 by Sylvain Henry at 2022-08-19T14:40:18-04:00 More 64-bits primops - - - - - 2e39045c by Sylvain Henry at 2022-08-19T14:40:18-04:00 Fix base_write function - - - - - db9eaa34 by Sylvain Henry at 2022-08-19T14:40:18-04:00 Fix base_write for 32-bit size_t - - - - - f0408cff by Sylvain Henry at 2022-08-19T14:40:18-04:00 Configure: fix detection of the target toolchain - - - - - 29065faa by Sylvain Henry at 2022-08-19T14:40:18-04:00 Remove js_base directory - - - - - fc67159e by Sylvain Henry at 2022-08-19T14:40:18-04:00 Kill Node when the main loop reports an unhandled exception - - - - - 95103014 by Sylvain Henry at 2022-08-19T14:40:19-04:00 CodeGen: preparation to make match on primops complete - - - - - e3651658 by Sylvain Henry at 2022-08-19T14:40:19-04:00 Primops: fix Compact primops - - - - - 9d3ad4e8 by Sylvain Henry at 2022-08-19T14:40:19-04:00 Ignore result arity for some exception primops - - - - - d592fd05 by Sylvain Henry at 2022-08-19T14:40:19-04:00 Fix more primops. Bump array submodule! - - - - - d2c11256 by Sylvain Henry at 2022-08-19T14:40:19-04:00 Compact: fix return of 3 values - - - - - 5d51cd7c by Sylvain Henry at 2022-08-19T14:40:19-04:00 Configure: switch to absolute path - - - - - ed9afe4c by Sylvain Henry at 2022-08-19T14:40:19-04:00 Add a few primops - - - - - fa510ac3 by Sylvain Henry at 2022-08-19T14:40:20-04:00 Primop: implement WordAdd2 - - - - - 7fd42370 by Luite Stegeman at 2022-08-19T14:40:20-04:00 quick fix for uTypeVt and typePrimRep panics this may cause other panics, a full fix will require a bit more rework and probably removal of VarType - - - - - df0f3405 by Josh Meredith at 2022-08-19T14:40:20-04:00 Replace ShortText with (Lexical)FastString in GHCJS backend - - - - - e5ea96cd by Sylvain Henry at 2022-08-19T14:46:30-04:00 Primops: add arithmetic ops Primops: add decodeDoubleInt64 back Primop: added timesInt2# Primop: add mulWord32 and mul2Word32 - - - - - 195a6ef5 by Sylvain Henry at 2022-08-19T14:46:44-04:00 Reduce dependency on goog - - - - - 272b629a by Sylvain Henry at 2022-08-19T14:46:44-04:00 Primop: implement quotWord32, remWord32, and quotRemWord32 - - - - - 735e9b63 by Sylvain Henry at 2022-08-19T14:46:45-04:00 Primop: Implement quotRem2Word32, misc fixes Primop: implement quotRem2Word32 Primop: fix timesInt2# Primop: fix some shifting primops - - - - - eaeb5d11 by Sylvain Henry at 2022-08-19T14:47:04-04:00 Fix bug in upd_frame I've introduced this bug when I've refactored the code to use helpers to assign closures. - - - - - 72a4dd5c by Sylvain Henry at 2022-08-19T14:47:04-04:00 Primop: throw an exception for unimplemented primops - - - - - af1b8397 by Sylvain Henry at 2022-08-19T14:47:04-04:00 Primop: fix remWord32 - - - - - cdbf4a93 by Josh Meredith at 2022-08-19T14:47:05-04:00 Configure: add EMSDK_BIN, match emsdk expectations Change EMSDK vars to match emscripten/emsdk_env.sh definitions Add EMSDK_BIN environment variable to configure - - - - - 0119f00b by Sylvain Henry at 2022-08-19T14:47:32-04:00 resultSize: correctly handle Void# - - - - - 4e279942 by Sylvain Henry at 2022-08-19T14:47:32-04:00 Primop: fix Sized test, more shifting fixes Primop: ensure that we return u32 values for word primops Also a refactoring from i3 to i32 for clarity. Primop: add/fix more shifting primops Primops: fix Sized test! - - - - - 91f216c3 by Sylvain Henry at 2022-08-19T14:48:01-04:00 StgToJS.Apply: Docs Doc Doc - - - - - 26405af1 by Josh Meredith at 2022-08-19T14:48:19-04:00 Fix EMSDK configure condition - - - - - 0f0850cb by doyougnu at 2022-08-19T14:48:19-04:00 StgToJS.Arg: Unboxable Literal Optimization note - - - - - 54205725 by Sylvain Henry at 2022-08-19T14:48:19-04:00 Fix Outputable instances for JExpr/JVal - Put orphan instances in JS.Ppr - Also fix some redundant imports - - - - - b06be719 by doyougnu at 2022-08-19T14:48:19-04:00 configure: avoid CXX stdlib check for js backend and some cleanup for a previously mis-applied commit during rebasing - - - - - 5e545be1 by doyougnu at 2022-08-19T14:48:19-04:00 fixup: misc. fixes post rebase - - - - - 4e43b816 by Sylvain Henry at 2022-08-19T14:48:19-04:00 PrimOps: add more 64-bit primops PrimOp: implement more 64-bit primops + PM fix Ensure that we cover every primop explicitly - - - - - 448a9e1e by Sylvain Henry at 2022-08-19T14:48:20-04:00 PrimOp: correclty (un)handle new thread related primops - - - - - 9c15a18e by Sylvain Henry at 2022-08-19T14:48:20-04:00 PrimOp: disable LabelThreadOp for now - - - - - b2f0752b by Sylvain Henry at 2022-08-19T14:48:20-04:00 Minor doc/cleanup Fix more redundant imports - - - - - a0df3161 by doyougnu at 2022-08-19T14:48:20-04:00 base: GHCJS.Prim directory --> GHC.JS.Prim - - - - - bbba07a8 by Luite Stegeman at 2022-08-19T14:48:20-04:00 implement KeepAlive primop - - - - - 17061650 by Sylvain Henry at 2022-08-19T14:48:20-04:00 Remove orphan instance for StaticArg - - - - - 4f436afd by Sylvain Henry at 2022-08-19T14:48:20-04:00 Remove redundant jsIdIdent' function - - - - - 24be596e by Sylvain Henry at 2022-08-19T14:48:21-04:00 Split StgToJS.Monad into StgToJS.{Monad,Ids,Stack} - - - - - cc5c19b9 by Sylvain Henry at 2022-08-19T14:48:21-04:00 Apply: remove commented case (wasn't optimized either in latest ghcjs) - - - - - c0708eb9 by Sylvain Henry at 2022-08-19T14:48:21-04:00 Doc: Apply Apply: doc and refactoring - use new types instead of Bool/Int - factorize some code - - - - - 53264fae by Sylvain Henry at 2022-08-19T14:48:21-04:00 Primop: arith fixes Primop: fix 64-bit shifting primops + add some traces Primop: fix quotRem2Word32 Primop: fix timesInt2. Progress towards passing arith003 PrimOp: fix timesInt32 PrimOp: use mulWord32 when appropriate - - - - - 408c44c7 by doyougnu at 2022-08-19T14:48:21-04:00 Configure: remove EMSDK hacks and wrapper scripts configure JS: remove wrapper scripts Configure: remove EMSDK hacks. Use emconfigure instead emconfigure ./configure --target=js-unknown-ghcjs - - - - - 003bce79 by Sylvain Henry at 2022-08-19T14:48:21-04:00 GHCJS.Prim leftovers - - - - - f9dc097e by Sylvain Henry at 2022-08-19T14:48:21-04:00 Linker: fix linking issue for tuples - - - - - 08c3c478 by Sylvain Henry at 2022-08-19T14:48:22-04:00 FFI: remove narrowing Fix tests such as cgrun015 (Core lint error) - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Graph/Directed.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backend/Internal.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/StgToCmm.hs - + compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - + compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3936af4da705a5f99b3713e04578e177fb610b66...08c3c4783c72d3173d79ccda2ac282e2d3e04e34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3936af4da705a5f99b3713e04578e177fb610b66...08c3c4783c72d3173d79ccda2ac282e2d3e04e34 You're receiving 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 22 15:51:01 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 22 Aug 2022 11:51:01 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] comments Message-ID: <6303a5e58bb16_e9d7d209eca084375cc@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: 064c07eb by Matthew Pickering at 2022-08-22T16:50:52+01:00 comments - - - - - 9 changed files: - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Context/Type.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Stage.hs Changes: ===================================== hadrian/src/Base.hs ===================================== @@ -88,7 +88,7 @@ relativePackageDbPath :: PackageDbLoc -> FilePath relativePackageDbPath (PackageDbLoc stage Final) = stageString stage-/- "lib/package.conf.d" relativePackageDbPath (PackageDbLoc stage Inplace) = stageString stage -/- "inplace/package.conf.d" - +-- See Note [Inplace vs Final package databases] data PackageDbLoc = PackageDbLoc { db_stage :: Stage, db_inplace :: Inplace } -- | Path to the package database used in a given 'Stage', including ===================================== hadrian/src/Builder.hs ===================================== @@ -66,7 +66,6 @@ data GhcMode = CompileHs | CompileCppWithGhc | FindHsDependencies | LinkHs - | AbiHash | ToolArgs deriving (Eq, Generic, Show) @@ -296,11 +295,6 @@ instance H.Builder Builder where withResources buildResources $ do Stdout stdout <- cmd' [path] buildArgs pure stdout - Ghc AbiHash _ -> do - path <- builderPath builder - withResources buildResources $ do - Stdout stdout <- cmd' [path] buildArgs - pure stdout _ -> error $ "Builder " ++ show builder ++ " can not be asked!" runBuilderWith :: Builder -> BuildInfo -> Action () ===================================== hadrian/src/Context.hs ===================================== @@ -141,6 +141,8 @@ pkgConfFile Context {..} = do dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" +-- | Path to the stamp file for a given 'Context'. The stamp file records if +-- we have built all the objects necessary for a certain way or not. pkgStampFile :: Context -> Action FilePath pkgStampFile c at Context{..} = do let extension = waySuffix way ===================================== hadrian/src/Context/Type.hs ===================================== @@ -13,7 +13,7 @@ data Context = Context { stage :: Stage -- ^ Currently build Stage , package :: Package -- ^ Currently build Package , way :: Way -- ^ Currently build Way (usually 'vanilla') - , iplace :: Inplace + , iplace :: Inplace -- ^ Whether to use the inplace or final package database } deriving (Eq, Generic, Show) instance Binary Context ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -12,7 +12,7 @@ ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal.Parse ( parsePackageData, resolveContextData, parseCabalPkgId, configurePackage, - buildAutogenFiles, copyPackage, writeFakePkgConf, registerPackage + buildAutogenFiles, copyPackage, writeInplacePkgConf, registerPackage ) where import Data.Bifunctor @@ -67,6 +67,7 @@ import qualified Distribution.Simple.Register as C import System.Directory (getCurrentDirectory) import qualified Distribution.InstalledPackageInfo as CP import Distribution.Simple.Utils (writeUTF8File) +import Utilities -- | Parse the Cabal file of a given 'Package'. This operation is cached by the @@ -296,9 +297,10 @@ resolveContextData context at Context {..} = do in return cdata - -write_fake_conf :: FilePath -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -write_fake_conf pkg_path res_path pd lbi = do +-- Writes a .conf file which points directly into the build directory of a package +-- so the artefacts can be used as they are produced. +write_inplace_conf :: FilePath -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () +write_inplace_conf pkg_path res_path pd lbi = do withLibLBI pd lbi $ \lib clbi -> do cwd <- getCurrentDirectory let fixupIncludeDir dir | cwd `isPrefixOf` dir = [prefix ++ drop (length cwd) dir] @@ -327,9 +329,9 @@ write_fake_conf pkg_path res_path pd lbi = do (C.toUTF8LBS content) -- This uses the API directly because no way to register into a different package db which is --- configured. -registerPackage :: Context -> Action () -registerPackage context = do +-- configured. See the use of C.SpecificPackageDB +registerPackage :: [(Resource, Int)] -> Context -> Action () +registerPackage rs context = do cPath <- Context.contextPath context setupConfig <- pkgSetupConfigFile context need [setupConfig] -- This triggers 'configurePackage' @@ -341,8 +343,12 @@ registerPackage context = do -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath liftIO $ register db_path pid dist_dir pd lbi + -- Then after the register, which just writes the .conf file, do the recache step. + buildWithResources rs $ + target context (GhcPkg Recache (stage context)) [] [] - +-- This is copied and simplified from Cabal, because we want to install the package +-- into a different package database to the one it was configured against. register :: FilePath -> FilePath -> FilePath @@ -354,23 +360,16 @@ register pkg_db conf_file build_dir pd lbi absPackageDBs <- C.absolutePackageDBPaths packageDbs installedPkgInfo <- C.generateRegistrationInfo - C.verbose pd lib lbi clbi False reloc build_dir + C.silent pd lib lbi clbi False reloc build_dir (C.registrationPackageDB absPackageDBs) - - -- Three different modes: writeRegistrationFile installedPkgInfo where regFile = conf_file - reloc = relocatable lbi - -- FIXME: there's really no guarantee this will work. - -- registering into a totally different db stack can - -- fail if dependencies cannot be satisfied. + -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] --- distPref = fromFlag (regDistPref regFlags) --- verbosity = fromFlag (regVerbosity regFlags) writeRegistrationFile installedPkgInfo = do writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) @@ -389,9 +388,10 @@ buildAutogenFiles context = do lbi <- C.getPersistBuildConfig cPath C.initialBuildSteps cPath pd (lbi { C.localPkgDescr = pd }) C.silent --- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . -writeFakePkgConf :: Context -> Action () -writeFakePkgConf context = do +-- | Write a .conf file for the inplace package database which points into the +-- build directories rather than the final install locations. +writeInplacePkgConf :: Context -> Action () +writeInplacePkgConf context = do cPath <- Context.contextPath context setupConfig <- pkgSetupConfigFile context need [setupConfig] -- This triggers 'configurePackage' @@ -400,7 +400,7 @@ writeFakePkgConf context = do -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath - liftIO $ write_fake_conf (pkgPath (package context)) conf pd (lbi { C.localPkgDescr = pd }) + liftIO $ write_inplace_conf (pkgPath (package context)) conf pd (lbi { C.localPkgDescr = pd }) -- | Look for a @.buildinfo@ in all of the specified directories, stopping on ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -119,6 +119,8 @@ buildPackage root fp = do need (srcs ++ gens ++ lib_targets) + -- Write the current time into the file so the file always changes if + -- we restamp it because a dependency changes. time <- liftIO $ getCurrentTime liftIO $ writeFile fp (show time) ways <- interpretInContext ctx getLibraryWays ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -114,6 +114,7 @@ registerPackageRules rs stage iplace = do case stage of Stage0 _ | isBoot -> copyConf rs ctx conf _ -> + -- See Note [Inplace vs Final package databases] case iplace of Inplace -> buildConfInplace rs ctx conf Final -> buildConfFinal rs ctx conf @@ -151,8 +152,6 @@ buildConfFinal rs context at Context {..} _conf = do -- Copy and register the package. Cabal.copyPackage context Cabal.registerPackage context - buildWithResources rs $ - target context (GhcPkg Recache stage) [] [] -- We declare that this rule also produces files matching: -- - /stage/lib/--ghc-/*libHS* @@ -196,7 +195,7 @@ buildConfInplace rs context at Context {..} _conf = do -- Write an "inplace" package conf which points into the build directories -- for finding the build products - Cabal.writeFakePkgConf context + Cabal.writeInplacePkgConf context conf <- pkgInplaceConfig context buildWithResources rs $ target context (GhcPkg Update stage) [conf] [] ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -28,8 +28,7 @@ ghcBuilderArgs = mconcat let nextStageRtsBuildIncludeDir = nextStageRtsBuildDir "include" builder Ghc ? arg ("-I" ++ nextStageRtsBuildIncludeDir) , compileAndLinkHs, compileC, compileCxx, findHsDependencies - , toolArgs - , abiHashArgs] + , toolArgs ] toolArgs :: Args toolArgs = do @@ -41,10 +40,6 @@ toolArgs = do , map ("-optP" ++) <$> getContextData cppOpts ] -abiHashArgs :: Args -abiHashArgs = builder (Ghc AbiHash) ? do - mconcat [ arg "--abi-hash", commonGhcArgs, getInputs ] - compileAndLinkHs :: Args compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do ways <- getLibraryWays ===================================== hadrian/src/Stage.hs ===================================== @@ -29,18 +29,29 @@ data Stage = Stage0 WhichLibs | Stage1 | Stage2 | Stage3 deriving (Show, Eq, Ord, Generic) {- +Note [Inplace vs Final package databases] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + There are two package databases we maintain an "inplace" one and a "final" one. The inplace one is created by pre-configuring all the packages before doing any building. All GHC invocations to build .hs files will use an inplace package database for two reasons. -1. To increase parrelism +1. To increase parallelism 2. ./hadrian/ghci-multi can use the inplace package db to avoid having to build everything before starting. -Once we need to create the final library, we instead need the .conf in the "final" -database which has the effect of needing the "final".conf for all dependent packages -and so on as well as building the libraries. +The "inplace" database has .conf files which point directly to the build folders. +The "final" database has a .conf file which points like normall to the install folder. + +Therefore when we are building modules, we can start compiling a module as soon as +all it's dependencies are available in the build folder, rather than waiting for the +whole package to finish, be copied and installed like before. + +Once we need to do a final link then we need to wait for the "final" versions to +be enabled because then we want to make sure to create objects with the right rpaths and +so on. The "final" .conf has dependencies on all the objects in the package (unlike the "inplace" .conf +which has no such dependencies). -} data Inplace = Inplace | Final deriving (Show, Eq, Generic) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/064c07ebf4967bf1e1ba381d4e78454dea9ea7f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/064c07ebf4967bf1e1ba381d4e78454dea9ea7f7 You're receiving 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 22 15:52:34 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 22 Aug 2022 11:52:34 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] fix build Message-ID: <6303a64293ada_e9d7d1ee7674c439842@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: c6d08273 by Matthew Pickering at 2022-08-22T16:52:23+01:00 fix build - - - - - 1 changed file: - hadrian/src/Rules/Register.hs Changes: ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -151,7 +151,7 @@ buildConfFinal rs context at Context {..} _conf = do -- Copy and register the package. Cabal.copyPackage context - Cabal.registerPackage context + Cabal.registerPackage rs context -- We declare that this rule also produces files matching: -- - /stage/lib/--ghc-/*libHS* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6d082737dadfcb5de95329906c247873f4758e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6d082737dadfcb5de95329906c247873f4758e9 You're receiving 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 22 15:57:14 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 Aug 2022 11:57:14 -0400 Subject: [Git][ghc/ghc][wip/upload-creds] upload_ghc_libs: Add means of passing Hackage credentials Message-ID: <6303a75a4bf68_e9d7d4882844418c@gitlab.mail> Ben Gamari pushed to branch wip/upload-creds at Glasgow Haskell Compiler / GHC Commits: 081c290c by Ben Gamari at 2022-08-22T15:57:09+00:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 1 changed file: - .gitlab/upload_ghc_libs.py Changes: ===================================== .gitlab/upload_ghc_libs.py ===================================== @@ -17,6 +17,7 @@ There are two modes, preparation and upload. """ from subprocess import run, check_call +from getpass import getpass import shutil from pathlib import Path from typing import NamedTuple, Callable, List, Dict, Optional @@ -36,6 +37,10 @@ class Package(NamedTuple): path: Path prepare_sdist: Callable[[], None] +class Credentials(NamedTuple): + username: str + password: str + def no_prep(): pass @@ -97,11 +102,15 @@ PACKAGES = { } # Dict[str, Package] -def cabal_upload(tarball: Path, publish: bool=False, extra_args=[]): +def cabal_upload(tarball: Path, creds: Credentials, publish: bool=False, extra_args=[]): if publish: extra_args += ['--publish'] - run(['cabal', 'upload'] + extra_args + [tarball], check=True) + creds_args = [ + f'--username={creds.username}', + f'--password={creds.password}' + ] + run(['cabal', 'upload'] + extra_args + [tarball] + creds_args, check=True) def prepare_sdist(pkg: Package): @@ -115,13 +124,13 @@ def prepare_sdist(pkg: Package): res_path = shutil.copy(sdist, OUT_DIR) return os.path.relpath(res_path, OUT_DIR) -def upload_pkg_sdist(sdist : Path, pkg : Package, publish : bool): +def upload_pkg_sdist(sdist : Path, pkg: Package, publish: bool, creds: Credentials): publish_tag = '-publish' if publish else '' stamp = WORK_DIR / f'{pkg.name}-sdist{publish_tag}' if stamp.is_file(): return print(f'Uploading package {pkg.name}...') - cabal_upload(sdist, publish) + cabal_upload(sdist, publish=publish, creds=creds) stamp.write_text('') def get_version(cabal_file: Path) -> Optional[str]: @@ -137,8 +146,8 @@ def prepare_docs(bindist: Path, pkg: Package): """ cabal_file = pkg.path / f'{pkg.name}.cabal' version = get_version(cabal_file) - docdir = bindist / 'doc' / 'html' / 'libraries' / (pkg.name + "-" + version) assert version is not None + docdir = bindist / 'doc' / 'html' / 'libraries' / (pkg.name + "-" + version) # Build the documentation tarball from the bindist documentation stem = f'{pkg.name}-{version}-docs' @@ -148,20 +157,20 @@ def prepare_docs(bindist: Path, pkg: Package): run(['tar', '-czf', OUT_DIR / tarball, '-H', 'ustar', '-C', tmp.name, stem]) return tarball -def upload_docs(tarball : Path, pkg : Package, publish : bool): +def upload_docs(tarball : Path, pkg : Package, publish : bool, creds: Credentials): publish_tag = '-publish' if publish else '' stamp = WORK_DIR / f'{pkg.name}-docs{publish_tag}' if stamp.is_file(): return # Upload the documentation tarball print(f'Uploading documentation for {pkg.name}...') - cabal_upload(tarball, publish=publish, extra_args=['--documentation']) + cabal_upload(tarball, publish=publish, extra_args=['--documentation'], creds=creds) stamp.write_text('') -def upload_pkg(pkg: Package, d : Path, meta, publish : bool): +def upload_pkg(pkg: Package, d : Path, meta, publish : bool, creds: Credentials): print(f'Uploading {pkg.name}...') - upload_pkg_sdist(d / meta['sdist'], pkg, publish=publish) - upload_docs(d / meta['docs'], pkg, publish=publish) + upload_pkg_sdist(d / meta['sdist'], pkg, publish=publish, creds=creds) + upload_docs(d / meta['docs'], pkg, publish=publish, creds=creds) def prepare_pkg(bindist : Path, pkg : Package): if pkg.path.exists(): @@ -172,11 +181,6 @@ def prepare_pkg(bindist : Path, pkg : Package): else: print(f"Package {pkg.name} doesn't exist... skipping") - -def upload_all(bindist: Path): - for pkg in PACKAGES.values(): - upload_pkg(bindist, pkg) - def main() -> None: import argparse @@ -212,13 +216,16 @@ def main() -> None: pickle.dump(manifest, fout) elif args.command == "upload": + username = input('Hackage username: ') + password = getpass('Hackage password: ') + creds = Credentials(username, password) manifest_path = args.docs with open(manifest_path / 'manifest.pickle', 'rb') as fin: manifest = pickle.load(fin) for pkg, item in manifest.items(): if pkg.name in pkgs: print(pkg, item) - upload_pkg(pkg, manifest_path, item, publish=args.publish) + upload_pkg(pkg, manifest_path, item, publish=args.publish, creds=creds) if __name__ == '__main__': main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/081c290c97a094112af7047982ac9b672f50f3d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/081c290c97a094112af7047982ac9b672f50f3d0 You're receiving 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 22 16:14:09 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 22 Aug 2022 12:14:09 -0400 Subject: [Git][ghc/ghc][wip/T21694] 14 commits: testsuite: Add test for #21583 Message-ID: <6303ab5144b77_e9d7d4d1d44449e3@gitlab.mail> Andreas Klebinger pushed to branch wip/T21694 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - eedc33d0 by Simon Peyton Jones at 2022-08-22T18:11:23+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 - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.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 - 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/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.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 - hadrian/src/Settings/Default.hs - libraries/base/tests/T9681.stderr - − m4/fp_prog_ld_build_id.m4 - mk/config.mk.in - rts/include/ghc.mk - testsuite/tests/ado/T16628.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85048c986d6b8763f818de8e46c9b979f056e3e7...eedc33d0e4f46994e8ccd2533bb2629ac95c6951 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85048c986d6b8763f818de8e46c9b979f056e3e7...eedc33d0e4f46994e8ccd2533bb2629ac95c6951 You're receiving 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 22 16:27:16 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 22 Aug 2022 12:27:16 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] Revert "Add some more packages to multi-cradle" Message-ID: <6303ae64959_e9d7d488284509a5@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: a76f915e by Matthew Pickering at 2022-08-22T17:26:16+01:00 Revert "Add some more packages to multi-cradle" This reverts commit 96ee4385326312be13480b16bb05241f70435e48. Broken on 9.0.2 - - - - - 2 changed files: - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -79,6 +79,8 @@ multiSetup pkg_s = do (Ghc ToolArgs stage0InTree) [] ["ignored"] arg_list <- interpret fake_target getArgs let c = Context stage0InTree p (if windowsHost then vanilla else dynamic) Inplace -- Critical use of Inplace, one of the main motivations! + -- readContextData has the effect of configuring the package so all + -- dependent packages will also be built. cd <- readContextData c srcs <- hsSources c gens <- interpretInContext c generatedDependencies @@ -152,17 +154,17 @@ toolTargets = [ binary , directory , process , exceptions - -- , ghc -- # depends on ghc library - -- , runGhc -- # depends on ghc library +-- , ghc # depends on ghc library +-- , runGhc # depends on ghc library , ghcBoot , ghcBootTh , ghcHeap , ghci - , ghcPkg -- # executable - -- , haddock -- # depends on ghc library - , hsc2hs -- # executable +-- , ghcPkg # executable +-- , haddock # depends on ghc library +-- , hsc2hs # executable , hpc - , hpcBin -- # executable +-- , hpcBin # executable , mtl , parsec , time @@ -170,7 +172,7 @@ toolTargets = [ binary , text , terminfo , transformers - , unlit -- # executable +-- , unlit # executable ] ++ if windowsHost then [ win32 ] else [ unix ] -- | Create a mapping from files to which component it belongs to. ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -250,7 +250,7 @@ packageGhcArgs = do , arg "-no-user-package-db" , arg "-package-env -" , packageDatabaseArgs - , arg ("-this-unit-id " ++ pkgId) + , libraryPackage ? arg ("-this-unit-id " ++ pkgId) , map ("-package-id " ++) <$> getContextData depIds ] includeGhcArgs :: Args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a76f915ed981bfeef2ec4c8f5dced21d41edebd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a76f915ed981bfeef2ec4c8f5dced21d41edebd2 You're receiving 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 22 16:50:50 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 Aug 2022 12:50:50 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles to errors Message-ID: <6303b3ea8421a_e9d7d209eca0845766b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 3a8417cc by Simon Peyton Jones at 2022-08-22T17:52:09+01:00 Wibbles to errors - - - - - 6 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/typecheck/should_fail/T5570.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2023,6 +2023,7 @@ pprTcSolverReportMsg _ (CannotUnifyWithPolytype item tv1 ty2) = where what = text $ levelString $ ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel + pprTcSolverReportMsg _ (Mismatch { mismatch_ea = add_ea , mismatch_item = item @@ -2051,11 +2052,11 @@ pprTcSolverReportMsg _ herald1 = conc [ "Couldn't match" , if is_repr then "representation of" else "" - , if add_ea then "expected" else "" + , if add_ea then "expected" else "" , what ] herald2 = conc [ "with" - , if is_repr then "that of" else "" - , if add_ea then ("actual " ++ what) else "" ] + , if is_repr then "that of" else "" + , if add_ea then ("actual " ++ what) else "" ] padding = length herald1 - length herald2 @@ -2070,6 +2071,7 @@ pprTcSolverReportMsg _ add_space s1 s2 | null s1 = s2 | null s2 = s1 | otherwise = s1 ++ (' ' : s2) + pprTcSolverReportMsg _ (KindMismatch { kmismatch_what = thing , kmismatch_expected = exp @@ -2089,10 +2091,10 @@ pprTcSolverReportMsg _ pprTcSolverReportMsg ctxt (TypeEqMismatch { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds , teq_mismatch_item = item - , teq_mismatch_ty1 = ty1 -- These types are the context - , teq_mismatch_ty2 = ty2 -- of the mis-match - , teq_mismatch_expected = exp -- These are the kinds that - , teq_mismatch_actual = act -- don't match + , teq_mismatch_ty1 = ty1 -- These types are the actual types + , teq_mismatch_ty2 = ty2 -- that don't match; may be swapped + , teq_mismatch_expected = exp -- These are the context of + , teq_mismatch_actual = act -- the mis-match , teq_mismatch_what = mb_thing }) = addArising ct_loc $ pprWithExplicitKindsWhen ppr_explicit_kinds msg where @@ -2132,8 +2134,8 @@ pprTcSolverReportMsg ctxt | otherwise = -- (TYPE _) ~ (CONSTRAINT _) or (TYPE _) ~ Bool, etc maybe_num_args_msg $$ - sep [ text "Expected a" <+> pp_exp_thing <> text ", but" - , case mb_thing of + sep [ text "Expected a" <+> pp_exp_thing <> comma + , text "but" <+> case mb_thing of Nothing -> text "found something with kind" Just thing -> quotes (ppr thing) <+> text "has kind" , quotes (pprWithTYPE act) ] @@ -2148,8 +2150,8 @@ pprTcSolverReportMsg ctxt , [act_lev_ty] <- act_rr_args , Just exp_lev <- levityType_maybe exp_lev_ty , Just act_lev <- levityType_maybe act_lev_ty - = sep [ text "Expected" <+> ppr_an_lev exp_lev <+> pp_exp_thing <> text ", but" - , case mb_thing of + = sep [ text "Expected" <+> ppr_an_lev exp_lev <+> pp_exp_thing <> comma + , 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 ] msg_for_same_rep _ _ @@ -2157,8 +2159,8 @@ pprTcSolverReportMsg ctxt -- (TYPE (BoxedRep lev)) ~ (TYPE IntRep); or CONSTRAINT ditto msg_for_different_rep exp_rr_tc act_rr_tc - = sep [ text "Expected a" <+> what <> text ", but" - , case mb_thing of + = sep [ text "Expected a" <+> what <> comma + , text "but" <+> case mb_thing of Just thing -> quotes (ppr thing) Nothing -> quotes (pprWithTYPE act) <+> text "has representation" <+> ppr_rep act_rr_tc ] ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1699,7 +1699,7 @@ non-exported generic functions. -} unifyType :: Maybe TypedThing -- ^ If present, the thing that has type ty1 - -> TcTauType -> TcTauType -- ty1, ty2 + -> TcTauType -> TcTauType -- ty1 (actual), ty2 (expected) -> TcM TcCoercionN -- :: ty1 ~# ty2 -- Actual and expected types -- Returns a coercion : ty1 ~ ty2 @@ -1753,6 +1753,8 @@ uType, uType_defer -------------- -- It is always safe to defer unification to the main constraint solver -- See Note [Deferred unification] +-- ty1 is "actual" +-- ty2 is "expected" uType_defer t_or_k origin ty1 ty2 = do { co <- emitWantedEq origin t_or_k Nominal ty1 ty2 ===================================== testsuite/tests/typecheck/should_fail/T5570.stderr ===================================== @@ -1,6 +1,7 @@ T5570.hs:7:16: error: - • Expecting a lifted type, but ‘Double#’ is unlifted + • Expected a boxed type, + but ‘Double#’ has representation ‘DoubleRep’ • In the first argument of ‘($)’, namely ‘D#’ In the second argument of ‘($)’, namely ‘D# $ 3.0##’ In the expression: print $ D# $ 3.0## ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr ===================================== @@ -1,7 +1,6 @@ UnliftedNewtypesInstanceFail.hs:13:3: error: - • Couldn't match kind ‘'IntRep’ with ‘'WordRep’ - Expected kind ‘TYPE 'WordRep’, - but ‘Bar Bool’ has kind ‘TYPE 'IntRep’ + • Expected a type with representation ‘WordRep’, + but ‘Bar Bool’ has representation ‘IntRep’ • In the newtype instance declaration for ‘Bar’ In the instance declaration for ‘Foo Bool’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr ===================================== @@ -1,6 +1,6 @@ UnliftedNewtypesMismatchedKind.hs:12:10: error: - • Expecting a lifted type, but ‘Int#’ is unlifted + • Expected a boxed type, but ‘Int#’ has representation ‘IntRep’ • In the type ‘Int#’ In the definition of data constructor ‘MkT’ In the newtype declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesMultiFieldGadt.stderr ===================================== @@ -1,12 +1,14 @@ UnliftedNewtypesMultiFieldGadt.hs:19:11: error: - • Expecting an unlifted type, but ‘Bool’ is lifted + • Expected a type with representation ‘IntRep’, but + ‘Bool’ has representation ‘BoxedRep’ • In the type ‘Bool’ In the definition of data constructor ‘FooC’ In the newtype declaration for ‘Foo’ UnliftedNewtypesMultiFieldGadt.hs:19:19: error: - • Expecting an unlifted type, but ‘Char’ is lifted + • Expected a type with representation ‘IntRep’, but + ‘Char’ has representation ‘BoxedRep’ • In the type ‘Char’ In the definition of data constructor ‘FooC’ In the newtype declaration for ‘Foo’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a8417cc86761f58881ddad449c252638d37f3aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a8417cc86761f58881ddad449c252638d37f3aa You're receiving 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 22 16:51:45 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 22 Aug 2022 12:51:45 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] 2 commits: Revert "Revert "Add some more packages to multi-cradle"" Message-ID: <6303b421317b4_e9d7d1fa4ae2445825d@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: 3ec09df9 by Matthew Pickering at 2022-08-22T17:35:21+01:00 Revert "Revert "Add some more packages to multi-cradle"" This reverts commit a76f915ed981bfeef2ec4c8f5dced21d41edebd2. - - - - - 9b7fd2df by Matthew Pickering at 2022-08-22T17:51:38+01:00 fix - - - - - 2 changed files: - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -79,8 +79,6 @@ multiSetup pkg_s = do (Ghc ToolArgs stage0InTree) [] ["ignored"] arg_list <- interpret fake_target getArgs let c = Context stage0InTree p (if windowsHost then vanilla else dynamic) Inplace -- Critical use of Inplace, one of the main motivations! - -- readContextData has the effect of configuring the package so all - -- dependent packages will also be built. cd <- readContextData c srcs <- hsSources c gens <- interpretInContext c generatedDependencies @@ -128,7 +126,6 @@ mkToolTarget es p = do let fake_target = target context (Ghc ToolArgs stage0InTree) [] ["ignored"] -- Generate any source files for this target - cd <- readContextData context srcs <- hsSources context gens <- interpretInContext context generatedDependencies @@ -154,17 +151,17 @@ toolTargets = [ binary , directory , process , exceptions --- , ghc # depends on ghc library --- , runGhc # depends on ghc library + -- , ghc -- # depends on ghc library + -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh , ghcHeap , ghci --- , ghcPkg # executable --- , haddock # depends on ghc library --- , hsc2hs # executable + , ghcPkg -- # executable + -- , haddock -- # depends on ghc library + , hsc2hs -- # executable , hpc --- , hpcBin # executable + , hpcBin -- # executable , mtl , parsec , time @@ -172,7 +169,7 @@ toolTargets = [ binary , text , terminfo , transformers --- , unlit # executable + , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] -- | Create a mapping from files to which component it belongs to. ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -13,6 +13,7 @@ import qualified Context as Context import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory +import Data.Version.Extra ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -245,12 +246,15 @@ wayGhcArgs = do packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) pkgId <- expr $ pkgIdentifier package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" , packageDatabaseArgs - , libraryPackage ? arg ("-this-unit-id " ++ pkgId) + -- We want to pass -this-unit-id for executables as well for multi-repl to + -- work with executable packages but this is buggy on GHC-9.0.2 + , (isLibrary package || (ghc_ver >= makeVersion [9,2,1])) ? arg ("-this-unit-id " ++ pkgId) , map ("-package-id " ++) <$> getContextData depIds ] includeGhcArgs :: Args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a76f915ed981bfeef2ec4c8f5dced21d41edebd2...9b7fd2df8c392340902ead4439b6561020b69480 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a76f915ed981bfeef2ec4c8f5dced21d41edebd2...9b7fd2df8c392340902ead4439b6561020b69480 You're receiving 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 22 20:10:06 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 Aug 2022 16:10:06 -0400 Subject: [Git][ghc/ghc][wip/T22077] Separate IPE source file from span Message-ID: <6303e29ec2e9d_e9d7d488784775fd@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 782c6196 by Ben Gamari at 2022-08-22T16:09:57-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/CloneStack.hs - rts/IPE.c - rts/Trace.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - testsuite/tests/profiling/should_run/staticcallstack001.stdout - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/rts/ipe/ipeEventLog.stderr - testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c 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 @@ -45,7 +46,9 @@ 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) + , int32 0 ] int n = mkIntCLit platform n @@ -64,16 +67,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 @@ -83,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. ===================================== 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 ===================================== @@ -78,7 +78,8 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeB .ty_desc = &strings[ent->ty_desc], .label = &strings[ent->label], .module = &strings[ent->module_name], - .srcloc = &strings[ent->srcloc] + .src_file = &strings[ent->src_file], + .src_span = &strings[ent->src_span] } }; } ===================================== 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 ===================================== @@ -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,9 @@ typedef struct { StringIdx ty_desc; StringIdx label; StringIdx module_name; - StringIdx srcloc; + StringIdx src_file; + StringIdx src_span; + uint32_t _padding; } IpeBufferEntry; typedef struct IpeBufferListNode_ { ===================================== testsuite/tests/profiling/should_run/staticcallstack001.stdout ===================================== @@ -1,3 +1,3 @@ -Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack001.hs:16:13-27"}) -Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "caf", ipMod = "Main", ipLoc = "staticcallstack001.hs:13:1-9"}) -Just (InfoProv {ipName = "sat_s11g_info", ipDesc = "15", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack001.hs:18:23-32"}) +Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "16:13-27"}) +Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "caf", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "13:1-9"}) +Just (InfoProv {ipName = "sat_s11M_info", ipDesc = "15", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "18:23-32"}) ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s10U_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:10:23-39"}) -Just (InfoProv {ipName = "sat_s11a_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:11:23-42"}) -Just (InfoProv {ipName = "sat_s11q_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:12:23-46"}) -Just (InfoProv {ipName = "sat_s11G_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipLoc = "staticcallstack002.hs:13:23-44"}) +Just (InfoProv {ipName = "sat_s11p_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "sat_s11F_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "sat_s11V_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "sat_s12b_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/rts/ipe/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/ipe/ipeEventLog_fromMap.stderr ===================================== @@ -1,20 +1,68 @@ -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 -7f8f9c139740: 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 +7f86c4be8740: created capset 0 of type 2 +7f86c4be8740: created capset 1 of type 3 +7f86c4be8740: cap 0: initialised +7f86c4be8740: assigned cap 0 to capset 0 +7f86c4be8740: assigned cap 0 to capset 1 +7f86c4be8740: cap 0: created thread 1[""] +7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC) +7f86c4be8740: cap 0: thread 1[""] stopped (stack overflow, size 109) +7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC) +7f86c4be8740: cap 0: created thread 2[""] +7f86c4be8740: cap 0: thread 2 has label IOManager on cap 0 +7f86c4be8740: cap 0: thread 1[""] stopped (yielding) +7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC) +7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (yielding) +7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC) +7f86c4be8740: cap 0: created thread 3[""] +7f86c4be8740: cap 0: thread 3 has label TimerManager +7f86c4be8740: cap 0: thread 1[""] stopped (finished) +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: 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 +7f86c4be8740: cap 0: created thread 4[""] +7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC) +7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (suspended while making a foreign call) +7f86b5ffb640: cap 0: running thread 3["TimerManager"] (ThreadRunGHC) +7f86b5ffb640: cap 0: thread 3["TimerManager"] stopped (suspended while making a foreign call) +7f86c4be8740: cap 0: running thread 4[""] (ThreadRunGHC) +7f86c4be8740: cap 0: thread 4[""] stopped (yielding) +7f86c4be8740: cap 0: running thread 4[""] (ThreadRunGHC) +7f86c4be8740: cap 0: thread 4[""] stopped (finished) +7f86b57fa640: cap 0: requesting sequential GC +7f86b57fa640: cap 0: starting GC +7f86b57fa640: cap 0: GC working +7f86b57fa640: cap 0: GC idle +7f86b57fa640: cap 0: GC done +7f86b57fa640: cap 0: GC idle +7f86b57fa640: cap 0: GC done +7f86b57fa640: cap 0: GC idle +7f86b57fa640: cap 0: GC done +7f86b57fa640: cap 0: Memory Return (Current: 6) (Needed: 8) (Returned: 0) +7f86b57fa640: cap 0: all caps stopped for GC +7f86b57fa640: cap 0: finished GC +7f86b5ffb640: cap 0: running thread 3["TimerManager"] (ThreadRunGHC) +7f86b5ffb640: cap 0: thread 3["TimerManager"] stopped (finished) +7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC) +7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (finished) +7f86c4be8740: removed cap 0 from capset 0 +7f86c4be8740: removed cap 0 from capset 1 +7f86c4be8740: cap 0: shutting down +7f86c4be8740: deleted capset 0 +7f86c4be8740: deleted capset 1 ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -64,7 +64,8 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { assertStringsEqual(result->prov.ty_desc, "ty_desc_042"); assertStringsEqual(result->prov.label, "label_042"); assertStringsEqual(result->prov.module, "module_042"); - assertStringsEqual(result->prov.srcloc, "srcloc_042"); + assertStringsEqual(result->prov.src_file, "src_file_042"); + assertStringsEqual(result->prov.src_span, "src_span_042"); return fortyTwo; } ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -54,10 +54,15 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo snprintf(module, moduleLength, "module_%03i", i); provEnt.module_name = add_string(st, module); - unsigned int srcLocLength = strlen("srcloc_") + 3 /* digits */ + 1 /* null character */; - char *srcLoc = malloc(sizeof(char) * srcLocLength); - snprintf(srcLoc, srcLocLength, "srcloc_%03i", i); - provEnt.srcloc = add_string(st, srcLoc); + 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 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; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/782c6196cc3b0014221a7cb6ba9ce46b99ca114d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/782c6196cc3b0014221a7cb6ba9ce46b99ca114d You're receiving 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 22 20:36:29 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 Aug 2022 16:36:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Recognize file-header pragmas in GHCi (#21507) Message-ID: <6303e8cd94b1_e9d7d1ee7674c48167b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - 0500bfcd by Mario Blažević at 2022-08-22T16:36:09-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - a200cdb3 by Mario Blažević at 2022-08-22T16:36:09-04:00 Fix and test for issue #21723 - - - - - aa3dc6f8 by Mario Blažević at 2022-08-22T16:36:09-04:00 Test for issue #21942 - - - - - 5d999039 by Mario Blažević at 2022-08-22T16:36:09-04:00 Updated the changelog - - - - - fa7e1c02 by Ben Gamari at 2022-08-22T16:36:11-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. - - - - - 18 changed files: - docs/users_guide/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/bindist/Makefile - hadrian/src/Settings/Default.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - libraries/template-haskell/changelog.md - + testsuite/tests/ghci/scripts/T21507.script - testsuite/tests/ghci/scripts/all.T - testsuite/tests/th/T15845.stderr - + testsuite/tests/th/T21723.hs - + testsuite/tests/th/T21723.stdout - + testsuite/tests/th/T21942.hs - + testsuite/tests/th/T21942.stdout - testsuite/tests/th/T9262.stderr - testsuite/tests/th/TH_reifyExplicitForAllFams.stderr - testsuite/tests/th/TH_unresolvedInfix.stdout - testsuite/tests/th/all.T Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -66,6 +66,21 @@ Compiler - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. + +GHCi +~~~~ + +- GHCi will now accept any file-header pragmas it finds, such as + ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, + instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, + you could instead write: + + .. code-block:: none + + ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} + +This can be convenient when pasting large multi-line blocks of code into GHCi. + ``base`` library ~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -3173,6 +3173,15 @@ example, to turn on :ghc-flag:`-Wmissing-signatures`, you would say: ghci> :set -Wmissing-signatures +GHCi will also accept any file-header pragmas it finds, such as +``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, +instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, +you could instead write: + +.. code-block:: none + + ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} + Any GHC command-line option that is designated as dynamic (see the table in :ref:`flag-reference`), may be set using :ghci-cmd:`:set`. To unset an option, you can set the reverse option: ===================================== ghc/GHCi/UI.hs ===================================== @@ -78,6 +78,7 @@ import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrNam import GHC.Types.SrcLoc as SrcLoc import qualified GHC.Parser.Lexer as Lexer import GHC.Parser.Header ( toArgs ) +import qualified GHC.Parser.Header as Header import GHC.Types.PkgQual import GHC.Unit @@ -1249,6 +1250,9 @@ runStmt input step = do let source = progname st let line = line_number st + -- Add any LANGUAGE/OPTIONS_GHC pragmas we find find. + set_pragmas pflags + if | GHC.isStmt pflags input -> do hsc_env <- GHC.getSession mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input)) @@ -1282,6 +1286,12 @@ runStmt input step = do run_imports imports = mapM_ (addImportToContext . unLoc) imports + set_pragmas pflags = + let stringbuf = stringToStringBuffer input + (_msgs, loc_opts) = Header.getOptions pflags stringbuf "" + opts = unLoc <$> loc_opts + in setOptions opts + run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult) run_stmt stmt = do m_result <- GhciMonad.runStmt stmt input step ===================================== hadrian/bindist/Makefile ===================================== @@ -139,7 +139,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 \ ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -77,6 +77,7 @@ stage0Packages = do , cabalSyntax , cabal , compiler + , containers , directory , process , exceptions ===================================== libraries/template-haskell/Language/Haskell/TH/Ppr.hs ===================================== @@ -23,10 +23,12 @@ nestDepth :: Int nestDepth = 4 type Precedence = Int -appPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence -appPrec = 4 -- Argument of a function application -opPrec = 3 -- Argument of an infix operator -unopPrec = 2 -- Argument of an unresolved infix operator +appPrec, opPrec, unopPrec, funPrec, qualPrec, sigPrec, noPrec :: Precedence +appPrec = 6 -- Argument of a function or type application +opPrec = 5 -- Argument of an infix operator +unopPrec = 4 -- Argument of an unresolved infix operator +funPrec = 3 -- Argument of a function arrow +qualPrec = 2 -- Forall-qualified type or result of a function arrow sigPrec = 1 -- Argument of an explicit type signature noPrec = 0 -- Others @@ -220,7 +222,7 @@ pprExp _ (CompE ss) = pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e - <+> dcolon <+> ppr t + <+> dcolon <+> pprType sigPrec t pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs) pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs) pprExp i (StaticE e) = parensIf (i >= appPrec) $ @@ -792,60 +794,63 @@ pprStrictType :: (Strict, Type) -> Doc pprStrictType = pprBangType ------------------------------ -pprParendType :: Type -> Doc -pprParendType (VarT v) = pprName' Applied v +pprType :: Precedence -> Type -> Doc +pprType _ (VarT v) = pprName' Applied v -- `Applied` is used here instead of `ppr` because of infix names (#13887) -pprParendType (ConT c) = pprName' Applied c -pprParendType (TupleT 0) = text "()" -pprParendType (TupleT 1) = pprParendType (ConT (tupleTypeName 1)) -pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma)) -pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma -pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar -pprParendType ArrowT = parens (text "->") -pprParendType MulArrowT = text "FUN" -pprParendType ListT = text "[]" -pprParendType (LitT l) = pprTyLit l -pprParendType (PromotedT c) = text "'" <> pprName' Applied c -pprParendType (PromotedTupleT 0) = text "'()" -pprParendType (PromotedTupleT 1) = pprParendType (PromotedT (tupleDataName 1)) -pprParendType (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma)) -pprParendType PromotedNilT = text "'[]" -pprParendType PromotedConsT = text "'(:)" -pprParendType StarT = char '*' -pprParendType ConstraintT = text "Constraint" -pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) -pprParendType WildCardT = char '_' -pprParendType t@(InfixT {}) = parens (pprInfixT t) -pprParendType t@(UInfixT {}) = parens (pprInfixT t) -pprParendType t@(PromotedInfixT {}) = parens (pprInfixT t) -pprParendType t@(PromotedUInfixT {}) = parens (pprInfixT t) -pprParendType (ParensT t) = ppr t -pprParendType tuple | (TupleT n, args) <- split tuple - , length args == n - = parens (commaSep args) -pprParendType (ImplicitParamT n t) = text ('?':n) <+> text "::" <+> ppr t -pprParendType EqualityT = text "(~)" -pprParendType t@(ForallT {}) = parens (ppr t) -pprParendType t@(ForallVisT {}) = parens (ppr t) -pprParendType t@(AppT {}) = parens (ppr t) -pprParendType t@(AppKindT {}) = parens (ppr t) - -pprInfixT :: Type -> Doc -pprInfixT = \case - (InfixT x n y) -> with x n y "" ppr - (UInfixT x n y) -> with x n y "" pprInfixT - (PromotedInfixT x n y) -> with x n y "'" ppr - (PromotedUInfixT x n y) -> with x n y "'" pprInfixT - t -> ppr t +pprType _ (ConT c) = pprName' Applied c +pprType _ (TupleT 0) = text "()" +pprType p (TupleT 1) = pprType p (ConT (tupleTypeName 1)) +pprType _ (TupleT n) = parens (hcat (replicate (n-1) comma)) +pprType _ (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma +pprType _ (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar +pprType _ ArrowT = parens (text "->") +pprType _ MulArrowT = text "FUN" +pprType _ ListT = text "[]" +pprType _ (LitT l) = pprTyLit l +pprType _ (PromotedT c) = text "'" <> pprName' Applied c +pprType _ (PromotedTupleT 0) = text "'()" +pprType p (PromotedTupleT 1) = pprType p (PromotedT (tupleDataName 1)) +pprType _ (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma)) +pprType _ PromotedNilT = text "'[]" +pprType _ PromotedConsT = text "'(:)" +pprType _ StarT = char '*' +pprType _ ConstraintT = text "Constraint" +pprType _ (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) +pprType _ WildCardT = char '_' +pprType p t@(InfixT {}) = pprInfixT p t +pprType p t@(UInfixT {}) = pprInfixT p t +pprType p t@(PromotedInfixT {}) = pprInfixT p t +pprType p t@(PromotedUInfixT {}) = pprInfixT p t +pprType _ (ParensT t) = parens (pprType noPrec t) +pprType p (ImplicitParamT n ty) = + parensIf (p >= sigPrec) $ text ('?':n) <+> text "::" <+> pprType sigPrec ty +pprType _ EqualityT = text "(~)" +pprType p (ForallT tvars ctxt ty) = + parensIf (p >= funPrec) $ sep [pprForall tvars ctxt, pprType qualPrec ty] +pprType p (ForallVisT tvars ty) = + parensIf (p >= funPrec) $ sep [pprForallVis tvars [], pprType qualPrec ty] +pprType p t at AppT{} = pprTyApp p (split t) +pprType p t at AppKindT{} = pprTyApp p (split t) + +------------------------------ +pprParendType :: Type -> Doc +pprParendType = pprType appPrec + +pprInfixT :: Precedence -> Type -> Doc +pprInfixT p = \case + InfixT x n y -> with x n y "" opPrec + UInfixT x n y -> with x n y "" unopPrec + PromotedInfixT x n y -> with x n y "'" opPrec + PromotedUInfixT x n y -> with x n y "'" unopPrec + t -> pprParendType t where - with x n y prefix ppr' = ppr' x <+> text prefix <> pprName' Infix n <+> ppr' y + with x n y prefix p' = + parensIf + (p >= p') + (pprType opPrec x <+> text prefix <> pprName' Infix n <+> pprType opPrec y) instance Ppr Type where - ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty] - ppr (ForallVisT tvars ty) = sep [pprForallVis tvars [], ppr ty] - ppr ty = pprTyApp (split ty) - -- Works, in a degenerate way, for SigT, and puts parens round (ty :: kind) - -- See Note [Pretty-printing kind signatures] + ppr = pprType noPrec instance Ppr TypeArg where ppr (TANormal ty) = parensIf (isStarT ty) (ppr ty) ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki) @@ -866,38 +871,40 @@ parens around it. E.g. the parens are required here: type instance F Int = (Bool :: *) So we always print a SigT with parens (see #10050). -} -pprTyApp :: (Type, [TypeArg]) -> Doc -pprTyApp (MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2]) - | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", ppr arg2] - | c == manyName = sep [pprFunArgType arg1 <+> text "->", ppr arg2] -pprTyApp (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) = - sep [pprFunArgType arg1 <+> text "%" <> ppr argm <+> text "->", ppr arg2] -pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2] -pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) = - sep [pprFunArgType arg1 <+> text "~", ppr arg2] -pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg) -pprTyApp (TupleT 1, args) = pprTyApp (ConT (tupleTypeName 1), args) -pprTyApp (PromotedTupleT 1, args) = pprTyApp (PromotedT (tupleDataName 1), args) -pprTyApp (TupleT n, args) +pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc +pprTyApp p app@(MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2]) + | p >= funPrec = parens (pprTyApp noPrec app) + | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", pprType qualPrec arg2] + | c == manyName = sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2] +pprTyApp p (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) = + parensIf (p >= funPrec) $ + sep [pprFunArgType arg1 <+> text "%" <> pprType appPrec argm <+> text "->", + pprType qualPrec arg2] +pprTyApp p (ArrowT, [TANormal arg1, TANormal arg2]) = + parensIf (p >= funPrec) $ + sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2] +pprTyApp p (EqualityT, [TANormal arg1, TANormal arg2]) = + parensIf (p >= opPrec) $ + sep [pprType opPrec arg1 <+> text "~", pprType opPrec arg2] +pprTyApp _ (ListT, [TANormal arg]) = brackets (pprType noPrec arg) +pprTyApp p (TupleT 1, args) = pprTyApp p (ConT (tupleTypeName 1), args) +pprTyApp _ (TupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = parens (commaSep args') -pprTyApp (PromotedTupleT n, args) +pprTyApp p (PromotedTupleT 1, args) = pprTyApp p (PromotedT (tupleDataName 1), args) +pprTyApp _ (PromotedTupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = quoteParens (commaSep args') -pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args) +pprTyApp p (fun, args) = + parensIf (p >= appPrec) $ pprParendType fun <+> sep (map pprParendTypeArg args) fromTANormal :: TypeArg -> Maybe Type fromTANormal (TANormal arg) = Just arg fromTANormal (TyArg _) = Nothing -pprFunArgType :: Type -> Doc -- Should really use a precedence argument --- Everything except forall and (->) binds more tightly than (->) -pprFunArgType ty@(ForallT {}) = parens (ppr ty) -pprFunArgType ty@(ForallVisT {}) = parens (ppr ty) -pprFunArgType ty@(((MulArrowT `AppT` _) `AppT` _) `AppT` _) = parens (ppr ty) -pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty) -pprFunArgType ty@(SigT _ _) = parens (ppr ty) -pprFunArgType ty = ppr ty +-- Print the type to the left of @->@. Everything except forall and (->) binds more tightly than (->). +pprFunArgType :: Type -> Doc +pprFunArgType = pprType funPrec data ForallVisFlag = ForallVis -- forall a -> {...} | ForallInvis -- forall a. {...} ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,5 +1,10 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.20.0.0 + + * The `Ppr.pprInfixT` function has gained a `Precedence` argument. + * The values of named precedence levels like `Ppr.appPrec` have changed. + ## 2.19.0.0 * Add `DefaultD` constructor to support Haskell `default` declarations. ===================================== testsuite/tests/ghci/scripts/T21507.script ===================================== @@ -0,0 +1,5 @@ +:{ +{-# LANGUAGE TypeFamilies #-} +type family T21507 a where + T21507 a = a +:} ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -368,3 +368,4 @@ test('T21110', [extra_files(['T21110A.hs'])], ghci_script, ['T21110.script']) test('T17830', [filter_stdout_lines(r'======.*')], ghci_script, ['T17830.script']) test('T21294a', normal, ghci_script, ['T21294a.script']) +test('T21507', normal, ghci_script, ['T21507.script']) ===================================== testsuite/tests/th/T15845.stderr ===================================== @@ -1,5 +1,5 @@ data family T15845.F1 (a_0 :: *) (b_1 :: *) :: * -data instance forall (a_2 :: *) (b_3 :: *). T15845.F1 ([a_2]) b_3 +data instance forall (a_2 :: *) (b_3 :: *). T15845.F1 [a_2] b_3 = T15845.MkF1 data family T15845.F2 (a_0 :: *) :: * data instance forall (a_1 :: *). T15845.F2 a_1 = T15845.MkF2 ===================================== testsuite/tests/th/T21723.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import Language.Haskell.TH + +main :: IO () +main = do + putStrLn $ pprint (InfixT (ArrowT `AppT` StarT `AppT` StarT) (mkName ":>:") StarT) + putStrLn $ pprint (InfixT (ParensT $ ArrowT `AppT` StarT `AppT` StarT) (mkName ":>:") StarT) ===================================== testsuite/tests/th/T21723.stdout ===================================== @@ -0,0 +1,2 @@ +(* -> *) :>: * +(* -> *) :>: * ===================================== testsuite/tests/th/T21942.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE LinearTypes, TemplateHaskell #-} + +module Main where + +import Language.Haskell.TH + +main :: IO () +main = runQ [t| forall a m n. a %(m n) -> a |] >>= putStrLn . pprint ===================================== testsuite/tests/th/T21942.stdout ===================================== @@ -0,0 +1 @@ +forall a_0 m_1 n_2 . a_0 %(m_1 n_2) -> a_0 ===================================== testsuite/tests/th/T9262.stderr ===================================== @@ -1 +1 @@ -instance GHC.Classes.Eq a_0 => GHC.Classes.Eq ([a_0]) +instance GHC.Classes.Eq a_0 => GHC.Classes.Eq [a_0] ===================================== testsuite/tests/th/TH_reifyExplicitForAllFams.stderr ===================================== @@ -3,13 +3,13 @@ data instance forall (a_1 :: *). TH_reifyExplicitForAllFams.F (GHC.Maybe.Maybe a = TH_reifyExplicitForAllFams.MkF a_1 class TH_reifyExplicitForAllFams.C (a_0 :: *) where {type TH_reifyExplicitForAllFams.G (a_0 :: *) (b_1 :: *) :: *} -instance TH_reifyExplicitForAllFams.C ([a_2]) +instance TH_reifyExplicitForAllFams.C [a_2] type family TH_reifyExplicitForAllFams.G (a_0 :: *) (b_1 :: *) :: * type instance forall (a_2 :: *) - (b_3 :: *). TH_reifyExplicitForAllFams.G ([a_2]) + (b_3 :: *). TH_reifyExplicitForAllFams.G [a_2] b_3 = Data.Proxy.Proxy b_3 type family TH_reifyExplicitForAllFams.H (a_0 :: *) (b_1 :: *) :: * where - forall (x_2 :: *) (y_3 :: *). TH_reifyExplicitForAllFams.H ([x_2]) + forall (x_2 :: *) (y_3 :: *). TH_reifyExplicitForAllFams.H [x_2] (Data.Proxy.Proxy y_3) = Data.Either.Either x_2 y_3 forall (z_4 :: *). TH_reifyExplicitForAllFams.H z_4 ===================================== testsuite/tests/th/TH_unresolvedInfix.stdout ===================================== @@ -44,5 +44,5 @@ N :+ (N :+ N :+ N) (N) N :+ (N :+ N :+ N) (N) -(Int + (Int + Int + Int)) -Int +Int + (Int + (Int + Int)) +(Int) ===================================== testsuite/tests/th/all.T ===================================== @@ -553,3 +553,5 @@ test('T20711', normal, compile_and_run, ['']) test('T20868', normal, compile_and_run, ['']) test('Lift_ByteArray', normal, compile_and_run, ['']) test('T21920', normal, compile_and_run, ['']) +test('T21723', normal, compile_and_run, ['']) +test('T21942', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1f081de87ca2c354dfcb94bcc8c8676c9e8f77e...fa7e1c02752b6be391c7c76825979e6dc7b969e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1f081de87ca2c354dfcb94bcc8c8676c9e8f77e...fa7e1c02752b6be391c7c76825979e6dc7b969e3 You're receiving 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 22 23:11:32 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 Aug 2022 19:11:32 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles Message-ID: <63040d2469829_e9d7d4d1d4492411@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: d1463b52 by Simon Peyton Jones at 2022-08-23T00:11:35+01:00 Wibbles But especially: treat Constraint as Typeable - - - - - 4 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -233,6 +233,11 @@ unexposedPrimTyCons = [ eqPrimTyCon , eqReprPrimTyCon , eqPhantPrimTyCon + + -- These are un-exposed for now + , ctArrowTyCon -- (=>) + , ccArrowTyCon -- (==>) + , tcArrowTyCon -- (-=>) ] -- | Primitive 'TyCon's that are defined in, and exported from, GHC.Prim. @@ -973,6 +978,8 @@ It is an almost-ordinary class defined as if by * In addition (~) is magical syntax, as ~ is a reserved symbol. It cannot be exported or imported. + * The data constructor of the class is "Eq#", not ":C~" + Within GHC, ~ is called eqTyCon, and it is defined in GHC.Builtin.Types. Historical note: prior to July 18 (~) was defined as a ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -358,7 +358,7 @@ initExitJoinUnique = mkUnique 's' 0 -- * u+1: the TyConRepName of the TyCon mkPreludeTyConUnique :: Int -> Unique -mkPreludeTyConUnique i = mkUnique '3' (2*i) +mkPreludeTyConUnique i = mkUnique '3' (2*i) tyConRepNameUnique :: Unique -> Unique tyConRepNameUnique u = incrUnique u @@ -371,7 +371,7 @@ tyConRepNameUnique u = incrUnique u -- Prelude data constructors are too simple to need wrappers. mkPreludeDataConUnique :: Int -> Unique -mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic +mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic -------------------------------------------------- dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -654,7 +654,6 @@ matchTypeable clas [k,t] -- clas = Typeable | k `eqType` naturalTy = doTyLit knownNatClassName t | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t | k `eqType` charTy = doTyLit knownCharClassName t - | isConstraintKind t = doTyConApp clas t constraintKindTyCon [] | Just (af,mult,arg,ret) <- splitFunTy_maybe t , isVisibleAnonArg af = doFunTy clas t mult arg ret | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] @@ -682,10 +681,9 @@ doFunTy clas ty mult arg_ty ret_ty doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcM ClsInstResult doTyConApp clas ty tc kind_args | tyConIsTypeable tc - = do - return $ OneInst { cir_new_theta = (map (mk_typeable_pred clas) kind_args) - , cir_mk_ev = mk_ev - , cir_what = BuiltinTypeableInstance tc } + = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) kind_args + , cir_mk_ev = mk_ev + , cir_what = BuiltinTypeableInstance tc } | otherwise = return NoInstance where ===================================== compiler/GHC/Tc/Instance/Typeable.hs ===================================== @@ -422,9 +422,8 @@ mkTyConRepBinds stuff todo (TypeableTyCon {..}) -- | Is a particular 'TyCon' representable by @Typeable@?. These exclude type -- families and polytypes. tyConIsTypeable :: TyCon -> Bool -tyConIsTypeable tc = - isJust (tyConRepName_maybe tc) - && kindIsTypeable (dropForAlls $ tyConKind tc) +tyConIsTypeable tc = isJust (tyConRepName_maybe tc) + && kindIsTypeable (dropForAlls $ tyConKind tc) -- | Is a particular 'Kind' representable by @Typeable@? Here we look for -- polytypes and types containing casts (which may be, for instance, a type View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1463b52fe519774cc19ca5569f785dfb989169a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1463b52fe519774cc19ca5569f785dfb989169a You're receiving 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 22 23:55:44 2022 From: gitlab at gitlab.haskell.org (John Ericson (@Ericson2314)) Date: Mon, 22 Aug 2022 19:55:44 -0400 Subject: [Git][ghc/ghc][wip/lhs-token-for-hs-arg] WIP Get rid of `SrcSpan` in the base AST Message-ID: <63041780e2398_e9d7d1ee7674c4987de@gitlab.mail> John Ericson pushed to branch wip/lhs-token-for-hs-arg at Glasgow Haskell Compiler / GHC Commits: 1603c41b by John Ericson at 2022-08-22T19:54:44-04:00 WIP Get rid of `SrcSpan` in the base AST I beleive `HsToken` is the correct thing to use instead. Progress towards #19623 and #19218 - - - - - 14 changed files: - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Type.hs Changes: ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -514,10 +514,10 @@ deriving instance Data thing => Data (HsScaled GhcPs thing) deriving instance Data thing => Data (HsScaled GhcRn thing) deriving instance Data thing => Data (HsScaled GhcTc thing) -deriving instance (Data a, Data b) => Data (HsArg a b) --- deriving instance Data (HsArg (Located (HsType GhcPs)) (Located (HsKind GhcPs))) --- deriving instance Data (HsArg (Located (HsType GhcRn)) (Located (HsKind GhcRn))) --- deriving instance Data (HsArg (Located (HsType GhcTc)) (Located (HsKind GhcTc))) +-- deriving instance (DataId p, Data a, Data b) => Data (HsArg p a b) +deriving instance (Data a, Data b) => Data (HsArg GhcPs a b) +deriving instance (Data a, Data b) => Data (HsArg GhcRn a b) +deriving instance (Data a, Data b) => Data (HsArg GhcTc a b) -- deriving instance (DataIdLR p p) => Data (ConDeclField p) deriving instance Data (ConDeclField GhcPs) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -1,5 +1,5 @@ - {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -312,7 +312,7 @@ type instance XIParamTy (GhcPass _) = EpAnn [AddEpAnn] type instance XStarTy (GhcPass _) = NoExtField type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn] -type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives +type instance XAppKindTy (GhcPass _) = NoExtField type instance XSpliceTy GhcPs = NoExtField type instance XSpliceTy GhcRn = HsUntypedSpliceResult (HsType GhcRn) @@ -489,10 +489,10 @@ mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) mkHsAppTys = foldl' mkHsAppTy -mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) +mkHsAppKindTy :: LHsType (GhcPass p) -> LHsToken "@" (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -mkHsAppKindTy ext ty k - = addCLocAA ty k (HsAppKindTy ext ty k) +mkHsAppKindTy ty at k + = addCLocAA ty k (HsAppKindTy NoExtField ty at k) {- ************************************************************************ @@ -541,7 +541,7 @@ hsTyGetAppHead_maybe = go where go (L _ (HsTyVar _ _ ln)) = Just ln go (L _ (HsAppTy _ l _)) = go l - go (L _ (HsAppKindTy _ t _)) = go t + go (L _ (HsAppKindTy _ t _ _)) = go t go (L _ (HsOpTy _ _ _ ln _)) = Just ln go (L _ (HsParTy _ t)) = go t go (L _ (HsKindSig _ t _)) = go t @@ -553,12 +553,12 @@ hsTyGetAppHead_maybe = go lhsTypeArgSrcSpan :: LHsTypeArg (GhcPass pass) -> SrcSpan lhsTypeArgSrcSpan arg = case arg of HsValArg tm -> getLocA tm - HsTypeArg at ty -> at `combineSrcSpans` getLocA ty - HsArgPar sp -> sp + HsTypeArg at ty -> tokenSrcSpan (getLoc at) `combineSrcSpans` getLocA ty + HsArgPar sp -> tokenSrcSpan (getLoc sp) -------------------------------- -numVisibleArgs :: [HsArg tm ty] -> Arity +numVisibleArgs :: [HsArg p tm ty] -> Arity numVisibleArgs = count is_vis where is_vis (HsValArg _) = True is_vis _ = False @@ -576,7 +576,7 @@ numVisibleArgs = count is_vis -- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering -- @ pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty) - => id -> LexicalFixity -> [HsArg tm ty] -> SDoc + => id -> LexicalFixity -> [HsArg p tm ty] -> SDoc pprHsArgsApp thing fixity (argl:argr:args) | Infix <- fixity = let pp_op_app = hsep [ ppr_single_hs_arg argl @@ -591,7 +591,7 @@ pprHsArgsApp thing _fixity args -- | Pretty-print a prefix identifier to a list of 'HsArg's. ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty) - => SDoc -> [HsArg tm ty] -> SDoc + => SDoc -> [HsArg p tm ty] -> SDoc ppr_hs_args_prefix_app acc [] = acc ppr_hs_args_prefix_app acc (arg:args) = case arg of @@ -601,7 +601,7 @@ ppr_hs_args_prefix_app acc (arg:args) = -- | Pretty-print an 'HsArg' in isolation. ppr_single_hs_arg :: (Outputable tm, Outputable ty) - => HsArg tm ty -> SDoc + => HsArg p tm ty -> SDoc ppr_single_hs_arg (HsValArg tm) = ppr tm ppr_single_hs_arg (HsTypeArg _ ty) = char '@' <> ppr ty -- GHC shouldn't be constructing ASTs such that this case is ever reached. @@ -611,10 +611,10 @@ ppr_single_hs_arg (HsArgPar{}) = empty -- | This instance is meant for debug-printing purposes. If you wish to -- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead. -instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where +instance (Outputable tm, Outputable ty) => Outputable (HsArg (GhcPass p) tm ty) where ppr (HsValArg tm) = text "HsValArg" <+> ppr tm - ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr sp <+> ppr ty - ppr (HsArgPar sp) = text "HsArgPar" <+> ppr sp + ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr (getLoc sp) <+> ppr ty + ppr (HsArgPar sp) = text "HsArgPar" <+> ppr (getLoc sp) -------------------------------- @@ -1180,8 +1180,8 @@ ppr_mono_ty (HsStarTy _ isUni) = char (if isUni then '★' else '*') ppr_mono_ty (HsAppTy _ fun_ty arg_ty) = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty] -ppr_mono_ty (HsAppKindTy _ ty k) - = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k +ppr_mono_ty (HsAppKindTy _ ty at k) + = ppr_mono_lty ty <+> ppr at <> ppr_mono_lty k ppr_mono_ty (HsOpTy _ prom ty1 (L _ op) ty2) = sep [ ppr_mono_lty ty1 , sep [pprOccWithTick Infix prom op, ppr_mono_lty ty2 ] ] @@ -1295,7 +1295,7 @@ lhsTypeHasLeadingPromotionQuote ty go (HsWildCardTy{}) = False go (HsStarTy{}) = False go (HsAppTy _ t _) = goL t - go (HsAppKindTy _ t _) = goL t + go (HsAppKindTy _ t _ _) = goL t go (HsParTy{}) = False go (HsDocTy _ t _) = goL t go (XHsType{}) = False ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -621,13 +621,13 @@ nlHsTyConApp prom fixity tycon tys mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg -- parenthesize things like `(A + B) C` mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun (parenthesizeHsType appPrec ty)) - mk_app fun (HsTypeArg _ ki) = noLocA (HsAppKindTy noSrcSpan fun (parenthesizeHsType appPrec ki)) + mk_app fun (HsTypeArg _ ki) = noLocA (HsAppKindTy noExtField fun noHsTok (parenthesizeHsType appPrec ki)) mk_app fun (HsArgPar _) = noLocA (HsParTy noAnn fun) nlHsAppKindTy :: LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p) nlHsAppKindTy f k - = noLocA (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k)) + = noLocA (HsAppKindTy noExtField f noHsTok (parenthesizeHsType appPrec k)) {- Tuples. All these functions are *pre-typechecker* because they lack ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1375,7 +1375,7 @@ repTy (HsAppTy _ f a) = do f1 <- repLTy f a1 <- repLTy a repTapp f1 a1 -repTy (HsAppKindTy _ ty ki) = do +repTy (HsAppKindTy _ ty _ ki) = do ty1 <- repLTy ty ki1 <- repLTy ki repTappKind ty1 ki1 ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -552,6 +552,9 @@ instance HasLoc (LocatedA a) where instance HasLoc (LocatedN a) where loc (L la _) = locA la +instance HasLoc (GenLocated TokenLocation a) where + loc (L tl _) = tokenSrcSpan tl + instance HasLoc a => HasLoc [a] where loc [] = noSrcSpan loc xs = foldl1' combineSrcSpans $ map loc xs @@ -563,10 +566,10 @@ instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where HsOuterExplicit{hso_bndrs = tvs} -> foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c] -instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where +instance (HiePass p, HasLoc tm, HasLoc ty) => HasLoc (HsArg (GhcPass p) tm ty) where loc (HsValArg tm) = loc tm loc (HsTypeArg _ ty) = loc ty - loc (HsArgPar sp) = sp + loc (HsArgPar sp) = loc sp instance HasLoc (HsDataDefn GhcRn) where loc def@(HsDataDefn{}) = loc $ dd_cons def @@ -595,6 +598,9 @@ instance (ToHie a) => ToHie (Bag a) where instance (ToHie a) => ToHie (Maybe a) where toHie = maybe (pure []) toHie +instance ToHie (GenLocated TokenLocation (HsToken sym)) where + toHie = locOnly . loc + instance ToHie (IEContext (LocatedA ModuleName)) where toHie (IEC c (L (SrcSpanAnn _ (RealSrcSpan span _)) mname)) = do org <- ask @@ -1760,8 +1766,9 @@ instance ToHie (LocatedA (HsType GhcRn)) where [ toHie a , toHie b ] - HsAppKindTy _ ty ki -> + HsAppKindTy _ ty at ki -> [ toHie ty + , toHie at , toHie ki ] HsFunTy _ w a b -> @@ -1818,10 +1825,10 @@ instance ToHie (LocatedA (HsType GhcRn)) where HsStarTy _ _ -> [] XHsType _ -> [] -instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where +instance (ToHie tm, ToHie ty) => ToHie (HsArg GhcRn tm ty) where toHie (HsValArg tm) = toHie tm toHie (HsTypeArg _ ty) = toHie ty - toHie (HsArgPar sp) = locOnly sp + toHie (HsArgPar sp) = toHie sp instance Data flag => ToHie (TVScoped (LocatedA (HsTyVarBndr flag GhcRn))) where toHie (TVS tsc sc (L span bndr)) = concatM $ makeNodeA bndr span : case bndr of ===================================== compiler/GHC/Parser.y ===================================== @@ -2190,7 +2190,7 @@ ftype :: { forall b. DisambTD b => PV (LocatedA b) } | ftype tyarg { $1 >>= \ $1 -> mkHsAppTyPV $1 $2 } | ftype PREFIX_AT atype { $1 >>= \ $1 -> - mkHsAppKindTyPV $1 (getLoc $2) $3 } + mkHsAppKindTyPV $1 (hsTok $2) $3 } tyarg :: { LHsType GhcPs } : atype { $1 } ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -15,6 +15,7 @@ module GHC.Parser.Annotation ( AddEpAnn(..), EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn, TokenLocation(..), + mkTokenLocation, tokenSrcSpan, DeltaPos(..), deltaPos, getDeltaLine, EpAnn(..), Anchor(..), AnchorOperation(..), @@ -413,6 +414,15 @@ data EpaLocation = EpaSpan !RealSrcSpan data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation deriving (Data,Eq) +mkTokenLocation :: SrcSpan -> TokenLocation +mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc +mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + +tokenSrcSpan :: TokenLocation -> SrcSpan +tokenSrcSpan NoTokenLoc = UnhelpfulSpan UnhelpfulNoLocationInfo -- TODO reason in TokenLocation? +tokenSrcSpan (TokenLoc (EpaSpan r)) = RealSrcSpan r Strict.Nothing +tokenSrcSpan (TokenLoc _ ) = error "Not yet handled" + instance Outputable a => Outputable (GenLocated TokenLocation a) where ppr (L _ x) = ppr x @@ -462,6 +472,10 @@ instance Outputable EpaLocation where instance Outputable AddEpAnn where ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss +instance Outputable TokenLocation where + ppr NoTokenLoc = text "NoTokenLoc" + ppr (TokenLoc e) = text "TokenLoc" <+> ppr e + -- --------------------------------------------------------------------- -- | The exact print annotations (EPAs) are kept in the HsSyn AST for ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -77,9 +77,6 @@ module GHC.Parser.PostProcess ( UnpackednessPragma(..), mkMultTy, - -- Token location - mkTokenLocation, - -- Help with processing exports ImpExpSubSpec(..), ImpExpQcSpec(..), @@ -891,7 +888,7 @@ checkTyVars pp_what equals_or_where tc tparms check (HsTypeArg _ ki@(L loc _)) = addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ (PsErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) check (HsValArg ty) = chkParens [] [] emptyComments ty - check (HsArgPar sp) = addFatalError $ mkPlainErrorMsgEnvelope sp $ + check (HsArgPar sp) = addFatalError $ mkPlainErrorMsgEnvelope (tokenSrcSpan $ getLoc sp) $ (PsErrMalformedDecl pp_what (unLoc tc)) -- Keep around an action for adjusting the annotations of extra parens chkParens :: [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> LHsType GhcPs @@ -1019,7 +1016,7 @@ checkTyClHdr is_cls ty where (o,c) = mkParensEpAnn (realSrcSpan l) go _ (HsAppTy _ t1 t2) acc ops cps fix = goL t1 (HsValArg t2:acc) ops cps fix - go _ (HsAppKindTy l ty ki) acc ops cps fix = goL ty (HsTypeArg l ki:acc) ops cps fix + go _ (HsAppKindTy _ ty at ki) acc ops cps fix = goL ty (HsTypeArg at ki:acc) ops cps fix go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ops cps fix = return (L (noAnnSrcSpan l) (nameRdrName tup_name) , map HsValArg ts, fix, (reverse ops)++cps) @@ -1956,7 +1953,7 @@ class DisambTD b where -- | Disambiguate @f x@ (function application or prefix data constructor). mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b) -- | Disambiguate @f \@t@ (visible kind application) - mkHsAppKindTyPV :: LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b) + mkHsAppKindTyPV :: LocatedA b -> LHsToken "@" GhcPs -> LHsType GhcPs -> PV (LocatedA b) -- | Disambiguate @f \# x@ (infix operator) mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b) -- | Disambiguate @{-\# UNPACK \#-} t@ (unpack/nounpack pragma) @@ -1965,7 +1962,7 @@ class DisambTD b where instance DisambTD (HsType GhcPs) where mkHsAppTyHeadPV = return mkHsAppTyPV t1 t2 = return (mkHsAppTy t1 t2) - mkHsAppKindTyPV t l_at ki = return (mkHsAppKindTy l_at t ki) + mkHsAppKindTyPV t at ki = return (mkHsAppKindTy t at ki) mkHsOpTyPV prom t1 op t2 = return (mkLHsOpTy prom t1 op t2) mkUnpackednessPV = addUnpackednessP @@ -2001,8 +1998,8 @@ instance DisambTD DataConBuilder where -- the grammar in Parser.y is written (see infixtype/ftype). panic "mkHsAppTyPV: InfixDataConBuilder" - mkHsAppKindTyPV lhs l_at ki = - addFatalError $ mkPlainErrorMsgEnvelope l_at $ + mkHsAppKindTyPV lhs at ki = + addFatalError $ mkPlainErrorMsgEnvelope (tokenSrcSpan $ getLoc at) $ (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki)) mkHsOpTyPV prom lhs tc rhs = do @@ -3102,10 +3099,6 @@ mkMultTy pct t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1))) arr locOfPct1 = token_location_widenR (getLoc pct) (locA (getLoc t)) mkMultTy pct t arr = HsExplicitMult pct t arr -mkTokenLocation :: SrcSpan -> TokenLocation -mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc -mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) - -- Precondition: the TokenLocation has EpaSpan, never EpaDelta. token_location_widenR :: TokenLocation -> SrcSpan -> TokenLocation token_location_widenR NoTokenLoc _ = NoTokenLoc ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -724,12 +724,12 @@ rnHsTyKi env (HsAppTy _ ty1 ty2) ; (ty2', fvs2) <- rnLHsTyKi env ty2 ; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) } -rnHsTyKi env (HsAppKindTy l ty k) +rnHsTyKi env (HsAppKindTy l ty at k) = do { kind_app <- xoptM LangExt.TypeApplications ; unless kind_app (addErr (typeAppErr "kind" k)) ; (ty', fvs1) <- rnLHsTyKi env ty ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k - ; return (HsAppKindTy l ty' k', fvs1 `plusFV` fvs2) } + ; return (HsAppKindTy l ty' at k', fvs1 `plusFV` fvs2) } rnHsTyKi env t@(HsIParamTy x n ty) = do { notInKinds env t @@ -1957,7 +1957,7 @@ extract_lty (L _ ty) acc flds HsAppTy _ ty1 ty2 -> extract_lty ty1 $ extract_lty ty2 acc - HsAppKindTy _ ty k -> extract_lty ty $ + HsAppKindTy _ ty _ k -> extract_lty ty $ extract_lty k acc HsListTy _ ty -> extract_lty ty acc HsTupleTy _ _ tys -> extract_ltys tys acc ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1508,12 +1508,13 @@ splitHsAppTys hs_ty is_app _ = False go :: LHsType GhcRn - -> [HsArg (LHsType GhcRn) (LHsKind GhcRn)] + -> [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)] -> (LHsType GhcRn, - [HsArg (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp - go (L _ (HsAppTy _ f a)) as = go f (HsValArg a : as) - go (L _ (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as) - go (L sp (HsParTy _ f)) as = go f (HsArgPar (locA sp) : as) + [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp + go (L _ (HsAppTy _ f a)) as = go f (HsValArg a : as) + go (L _ (HsAppKindTy _ ty at k)) as = go ty (HsTypeArg at k : as) + go (L sp (HsParTy _ f)) as = go f (HsArgPar at : as) + where at = L (mkTokenLocation $ locA sp) HsTok go (L _ (HsOpTy _ prom l op@(L sp _) r)) as = ( L (na2la sp) (HsTyVar noAnn prom op) , HsValArg l : HsValArg r : as ) @@ -1690,7 +1691,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args substed_fun_ki = substTy subst fun_ki hs_ty = appTypeToArg orig_hs_ty (take (n-1) orig_hs_args) - n_initial_val_args :: [HsArg tm ty] -> Arity + n_initial_val_args :: [HsArg GhcRn tm ty] -> Arity -- Count how many leading HsValArgs we have n_initial_val_args (HsValArg {} : args) = 1 + n_initial_val_args args n_initial_val_args (HsArgPar {} : args) = n_initial_val_args args @@ -1881,11 +1882,11 @@ unsaturated arguments: see #11246. Hence doing this in tcInferApps. -} appTypeToArg :: LHsType GhcRn -> [LHsTypeArg GhcRn] -> LHsType GhcRn -appTypeToArg f [] = f -appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args -appTypeToArg f (HsArgPar _ : args) = appTypeToArg f args -appTypeToArg f (HsTypeArg l arg : args) - = appTypeToArg (mkHsAppKindTy l f arg) args +appTypeToArg f [] = f +appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args +appTypeToArg f (HsArgPar _ : args) = appTypeToArg f args +appTypeToArg f (HsTypeArg at arg : args) + = appTypeToArg (mkHsAppKindTy f at arg) args {- ********************************************************************* ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -297,7 +297,7 @@ no_anon_wc_ty lty = go lty go (L _ ty) = case ty of HsWildCardTy _ -> False HsAppTy _ ty1 ty2 -> go ty1 && go ty2 - HsAppKindTy _ ty ki -> go ty && go ki + HsAppKindTy _ ty _ ki -> go ty && go ki HsFunTy _ w ty1 ty2 -> go ty1 && go ty2 && go (arrowToHsType w) HsListTy _ ty -> go ty HsTupleTy _ _ tys -> gos tys ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -3028,7 +3028,7 @@ tcTyFamInstEqn fam_tc mb_clsinfo (map (const Nominal) qtvs) (locA loc)) } -checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg tm ty] -> TcM () +checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg GhcRn tm ty] -> TcM () checkTyFamInstEqn tc_fam_tc eqn_tc_name hs_pats = do { -- Ensure that each equation's type constructor is for the right -- type family. E.g. barf on ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1784,7 +1784,7 @@ mk_apps head_ty type_args = do HsValArg ty -> do p_ty <- add_parens ty mk_apps (HsAppTy noExtField phead_ty p_ty) args HsTypeArg l ki -> do p_ki <- add_parens ki - mk_apps (HsAppKindTy l phead_ty p_ki) args + mk_apps (HsAppKindTy noExtField phead_ty l p_ki) args HsArgPar _ -> mk_apps (HsParTy noAnn phead_ty) args go type_args @@ -1829,8 +1829,10 @@ split_ty_app ty = go ty [] where go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg a':as') } go (AppKindT ty ki) as' = do { ki' <- cvtKind ki - ; go ty (HsTypeArg noSrcSpan ki':as') } - go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') } + ; go ty (HsTypeArg noHsTok ki':as') } + go (ParensT t) as' = do { loc <- getL + ; go t $ HsArgPar (L (mkTokenLocation loc) HsTok) : as' + } go f as = return (f,as) cvtTyLit :: TH.TyLit -> HsTyLit (GhcPass p) ===================================== compiler/Language/Haskell/Syntax/Type.hs ===================================== @@ -62,7 +62,6 @@ import Language.Haskell.Syntax.Extension import GHC.Types.Name.Reader ( RdrName ) import GHC.Core.DataCon( HsSrcBang(..) ) import GHC.Core.Type (Specificity) -import GHC.Types.SrcLoc (SrcSpan) import GHC.Hs.Doc (LHsDoc) import GHC.Data.FastString (FastString) @@ -755,6 +754,7 @@ data HsType pass | HsAppKindTy (XAppKindTy pass) -- type level type app (LHsType pass) + (LHsToken "@" pass) (LHsKind pass) | HsFunTy (XFunTy pass) @@ -1178,29 +1178,32 @@ if they correspond to a visible 'forall'. -} -- | Arguments in an expression/type after splitting -data HsArg tm ty - = HsValArg tm -- Argument is an ordinary expression (f arg) - | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty) - -- SrcSpan is location of the `@` - | HsArgPar SrcSpan -- See Note [HsArgPar] +-- +-- A HsArgPar indicates that everything to the left of this in the argument list is +-- enclosed in parentheses together with the function itself. It is necessary so +-- that we can recreate the parenthesis structure in the original source after +-- typechecking the arguments. +-- +-- The SrcSpan is the span of the original HsPar +-- +-- @((f arg1) arg2 arg3)@ results in an input argument list of +-- @[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2]@ +data HsArg pass tm ty --- type level equivalent -type LHsTypeArg p = HsArg (LHsType p) (LHsKind p) + -- | Argument is an ordinary expression (f arg) + = HsValArg tm -{- -Note [HsArgPar] -~~~~~~~~~~~~~~~ -A HsArgPar indicates that everything to the left of this in the argument list is -enclosed in parentheses together with the function itself. It is necessary so -that we can recreate the parenthesis structure in the original source after -typechecking the arguments. - -The SrcSpan is the span of the original HsPar + -- | Argument is a visible type application (f @ty) + | HsTypeArg (LHsToken "@" pass) ty -((f arg1) arg2 arg3) results in an input argument list of -[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2] + -- | A closing paren. + -- + -- The correponding opening parens are all at the front, so there is + -- no ambiguity from just storing the closing one. + | HsArgPar (LHsToken ")" pass) --} +-- type level equivalent +type LHsTypeArg p = HsArg p (LHsType p) (LHsKind p) {- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1603c41b1484c3a2af9849b19b4b2dc19f2e5eda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1603c41b1484c3a2af9849b19b4b2dc19f2e5eda You're receiving 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 23 00:08:49 2022 From: gitlab at gitlab.haskell.org (John Ericson (@Ericson2314)) Date: Mon, 22 Aug 2022 20:08:49 -0400 Subject: [Git][ghc/ghc][wip/lhs-token-for-hs-arg] 3 commits: Recognize file-header pragmas in GHCi (#21507) Message-ID: <63041a917b150_e9d7d488285008a8@gitlab.mail> John Ericson pushed to branch wip/lhs-token-for-hs-arg at Glasgow Haskell Compiler / GHC Commits: 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b745e21d by John Ericson at 2022-08-22T20:07:57-04:00 WIP Get rid of `SrcSpan` in the base AST I beleive `HsToken` is the correct thing to use instead. Progress towards #19623 and #19218 - - - - - 20 changed files: - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Type.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/src/Settings/Default.hs - + testsuite/tests/ghci/scripts/T21507.script - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -514,10 +514,10 @@ deriving instance Data thing => Data (HsScaled GhcPs thing) deriving instance Data thing => Data (HsScaled GhcRn thing) deriving instance Data thing => Data (HsScaled GhcTc thing) -deriving instance (Data a, Data b) => Data (HsArg a b) --- deriving instance Data (HsArg (Located (HsType GhcPs)) (Located (HsKind GhcPs))) --- deriving instance Data (HsArg (Located (HsType GhcRn)) (Located (HsKind GhcRn))) --- deriving instance Data (HsArg (Located (HsType GhcTc)) (Located (HsKind GhcTc))) +-- deriving instance (DataId p, Data a, Data b) => Data (HsArg p a b) +deriving instance (Data a, Data b) => Data (HsArg GhcPs a b) +deriving instance (Data a, Data b) => Data (HsArg GhcRn a b) +deriving instance (Data a, Data b) => Data (HsArg GhcTc a b) -- deriving instance (DataIdLR p p) => Data (ConDeclField p) deriving instance Data (ConDeclField GhcPs) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -1,5 +1,5 @@ - {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -312,7 +312,7 @@ type instance XIParamTy (GhcPass _) = EpAnn [AddEpAnn] type instance XStarTy (GhcPass _) = NoExtField type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn] -type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives +type instance XAppKindTy (GhcPass _) = NoExtField type instance XSpliceTy GhcPs = NoExtField type instance XSpliceTy GhcRn = HsUntypedSpliceResult (HsType GhcRn) @@ -489,10 +489,10 @@ mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) mkHsAppTys = foldl' mkHsAppTy -mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) +mkHsAppKindTy :: LHsType (GhcPass p) -> LHsToken "@" (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -mkHsAppKindTy ext ty k - = addCLocAA ty k (HsAppKindTy ext ty k) +mkHsAppKindTy ty at k + = addCLocAA ty k (HsAppKindTy NoExtField ty at k) {- ************************************************************************ @@ -541,7 +541,7 @@ hsTyGetAppHead_maybe = go where go (L _ (HsTyVar _ _ ln)) = Just ln go (L _ (HsAppTy _ l _)) = go l - go (L _ (HsAppKindTy _ t _)) = go t + go (L _ (HsAppKindTy _ t _ _)) = go t go (L _ (HsOpTy _ _ _ ln _)) = Just ln go (L _ (HsParTy _ t)) = go t go (L _ (HsKindSig _ t _)) = go t @@ -553,12 +553,12 @@ hsTyGetAppHead_maybe = go lhsTypeArgSrcSpan :: LHsTypeArg (GhcPass pass) -> SrcSpan lhsTypeArgSrcSpan arg = case arg of HsValArg tm -> getLocA tm - HsTypeArg at ty -> at `combineSrcSpans` getLocA ty - HsArgPar sp -> sp + HsTypeArg at ty -> tokenSrcSpan (getLoc at) `combineSrcSpans` getLocA ty + HsArgPar sp -> tokenSrcSpan (getLoc sp) -------------------------------- -numVisibleArgs :: [HsArg tm ty] -> Arity +numVisibleArgs :: [HsArg p tm ty] -> Arity numVisibleArgs = count is_vis where is_vis (HsValArg _) = True is_vis _ = False @@ -576,7 +576,7 @@ numVisibleArgs = count is_vis -- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering -- @ pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty) - => id -> LexicalFixity -> [HsArg tm ty] -> SDoc + => id -> LexicalFixity -> [HsArg p tm ty] -> SDoc pprHsArgsApp thing fixity (argl:argr:args) | Infix <- fixity = let pp_op_app = hsep [ ppr_single_hs_arg argl @@ -591,7 +591,7 @@ pprHsArgsApp thing _fixity args -- | Pretty-print a prefix identifier to a list of 'HsArg's. ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty) - => SDoc -> [HsArg tm ty] -> SDoc + => SDoc -> [HsArg p tm ty] -> SDoc ppr_hs_args_prefix_app acc [] = acc ppr_hs_args_prefix_app acc (arg:args) = case arg of @@ -601,7 +601,7 @@ ppr_hs_args_prefix_app acc (arg:args) = -- | Pretty-print an 'HsArg' in isolation. ppr_single_hs_arg :: (Outputable tm, Outputable ty) - => HsArg tm ty -> SDoc + => HsArg p tm ty -> SDoc ppr_single_hs_arg (HsValArg tm) = ppr tm ppr_single_hs_arg (HsTypeArg _ ty) = char '@' <> ppr ty -- GHC shouldn't be constructing ASTs such that this case is ever reached. @@ -611,10 +611,10 @@ ppr_single_hs_arg (HsArgPar{}) = empty -- | This instance is meant for debug-printing purposes. If you wish to -- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead. -instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where +instance (Outputable tm, Outputable ty) => Outputable (HsArg (GhcPass p) tm ty) where ppr (HsValArg tm) = text "HsValArg" <+> ppr tm - ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr sp <+> ppr ty - ppr (HsArgPar sp) = text "HsArgPar" <+> ppr sp + ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr (getLoc sp) <+> ppr ty + ppr (HsArgPar sp) = text "HsArgPar" <+> ppr (getLoc sp) -------------------------------- @@ -1180,8 +1180,8 @@ ppr_mono_ty (HsStarTy _ isUni) = char (if isUni then '★' else '*') ppr_mono_ty (HsAppTy _ fun_ty arg_ty) = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty] -ppr_mono_ty (HsAppKindTy _ ty k) - = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k +ppr_mono_ty (HsAppKindTy _ ty at k) + = ppr_mono_lty ty <+> ppr at <> ppr_mono_lty k ppr_mono_ty (HsOpTy _ prom ty1 (L _ op) ty2) = sep [ ppr_mono_lty ty1 , sep [pprOccWithTick Infix prom op, ppr_mono_lty ty2 ] ] @@ -1295,7 +1295,7 @@ lhsTypeHasLeadingPromotionQuote ty go (HsWildCardTy{}) = False go (HsStarTy{}) = False go (HsAppTy _ t _) = goL t - go (HsAppKindTy _ t _) = goL t + go (HsAppKindTy _ t _ _) = goL t go (HsParTy{}) = False go (HsDocTy _ t _) = goL t go (XHsType{}) = False ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -621,13 +621,13 @@ nlHsTyConApp prom fixity tycon tys mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg -- parenthesize things like `(A + B) C` mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun (parenthesizeHsType appPrec ty)) - mk_app fun (HsTypeArg _ ki) = noLocA (HsAppKindTy noSrcSpan fun (parenthesizeHsType appPrec ki)) + mk_app fun (HsTypeArg _ ki) = noLocA (HsAppKindTy noExtField fun noHsTok (parenthesizeHsType appPrec ki)) mk_app fun (HsArgPar _) = noLocA (HsParTy noAnn fun) nlHsAppKindTy :: LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p) nlHsAppKindTy f k - = noLocA (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k)) + = noLocA (HsAppKindTy noExtField f noHsTok (parenthesizeHsType appPrec k)) {- Tuples. All these functions are *pre-typechecker* because they lack ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1375,7 +1375,7 @@ repTy (HsAppTy _ f a) = do f1 <- repLTy f a1 <- repLTy a repTapp f1 a1 -repTy (HsAppKindTy _ ty ki) = do +repTy (HsAppKindTy _ ty _ ki) = do ty1 <- repLTy ty ki1 <- repLTy ki repTappKind ty1 ki1 ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -552,6 +552,9 @@ instance HasLoc (LocatedA a) where instance HasLoc (LocatedN a) where loc (L la _) = locA la +instance HasLoc (GenLocated TokenLocation a) where + loc (L tl _) = tokenSrcSpan tl + instance HasLoc a => HasLoc [a] where loc [] = noSrcSpan loc xs = foldl1' combineSrcSpans $ map loc xs @@ -563,10 +566,10 @@ instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where HsOuterExplicit{hso_bndrs = tvs} -> foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c] -instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where +instance (HiePass p, HasLoc tm, HasLoc ty) => HasLoc (HsArg (GhcPass p) tm ty) where loc (HsValArg tm) = loc tm loc (HsTypeArg _ ty) = loc ty - loc (HsArgPar sp) = sp + loc (HsArgPar sp) = loc sp instance HasLoc (HsDataDefn GhcRn) where loc def@(HsDataDefn{}) = loc $ dd_cons def @@ -595,6 +598,9 @@ instance (ToHie a) => ToHie (Bag a) where instance (ToHie a) => ToHie (Maybe a) where toHie = maybe (pure []) toHie +instance ToHie (GenLocated TokenLocation (HsToken sym)) where + toHie = locOnly . loc + instance ToHie (IEContext (LocatedA ModuleName)) where toHie (IEC c (L (SrcSpanAnn _ (RealSrcSpan span _)) mname)) = do org <- ask @@ -1760,8 +1766,9 @@ instance ToHie (LocatedA (HsType GhcRn)) where [ toHie a , toHie b ] - HsAppKindTy _ ty ki -> + HsAppKindTy _ ty at ki -> [ toHie ty + , toHie at , toHie ki ] HsFunTy _ w a b -> @@ -1818,10 +1825,10 @@ instance ToHie (LocatedA (HsType GhcRn)) where HsStarTy _ _ -> [] XHsType _ -> [] -instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where +instance (ToHie tm, ToHie ty) => ToHie (HsArg GhcRn tm ty) where toHie (HsValArg tm) = toHie tm toHie (HsTypeArg _ ty) = toHie ty - toHie (HsArgPar sp) = locOnly sp + toHie (HsArgPar sp) = toHie sp instance Data flag => ToHie (TVScoped (LocatedA (HsTyVarBndr flag GhcRn))) where toHie (TVS tsc sc (L span bndr)) = concatM $ makeNodeA bndr span : case bndr of ===================================== compiler/GHC/Parser.y ===================================== @@ -2190,7 +2190,7 @@ ftype :: { forall b. DisambTD b => PV (LocatedA b) } | ftype tyarg { $1 >>= \ $1 -> mkHsAppTyPV $1 $2 } | ftype PREFIX_AT atype { $1 >>= \ $1 -> - mkHsAppKindTyPV $1 (getLoc $2) $3 } + mkHsAppKindTyPV $1 (hsTok $2) $3 } tyarg :: { LHsType GhcPs } : atype { $1 } ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -15,6 +15,7 @@ module GHC.Parser.Annotation ( AddEpAnn(..), EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn, TokenLocation(..), + mkTokenLocation, tokenSrcSpan, DeltaPos(..), deltaPos, getDeltaLine, EpAnn(..), Anchor(..), AnchorOperation(..), @@ -413,6 +414,15 @@ data EpaLocation = EpaSpan !RealSrcSpan data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation deriving (Data,Eq) +mkTokenLocation :: SrcSpan -> TokenLocation +mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc +mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + +tokenSrcSpan :: TokenLocation -> SrcSpan +tokenSrcSpan NoTokenLoc = UnhelpfulSpan UnhelpfulNoLocationInfo -- TODO reason in TokenLocation? +tokenSrcSpan (TokenLoc (EpaSpan r)) = RealSrcSpan r Strict.Nothing +tokenSrcSpan (TokenLoc _ ) = error "Not yet handled" + instance Outputable a => Outputable (GenLocated TokenLocation a) where ppr (L _ x) = ppr x @@ -462,6 +472,10 @@ instance Outputable EpaLocation where instance Outputable AddEpAnn where ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss +instance Outputable TokenLocation where + ppr NoTokenLoc = text "NoTokenLoc" + ppr (TokenLoc e) = text "TokenLoc" <+> ppr e + -- --------------------------------------------------------------------- -- | The exact print annotations (EPAs) are kept in the HsSyn AST for ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -77,9 +77,6 @@ module GHC.Parser.PostProcess ( UnpackednessPragma(..), mkMultTy, - -- Token location - mkTokenLocation, - -- Help with processing exports ImpExpSubSpec(..), ImpExpQcSpec(..), @@ -891,7 +888,7 @@ checkTyVars pp_what equals_or_where tc tparms check (HsTypeArg _ ki@(L loc _)) = addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ (PsErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) check (HsValArg ty) = chkParens [] [] emptyComments ty - check (HsArgPar sp) = addFatalError $ mkPlainErrorMsgEnvelope sp $ + check (HsArgPar sp) = addFatalError $ mkPlainErrorMsgEnvelope (tokenSrcSpan $ getLoc sp) $ (PsErrMalformedDecl pp_what (unLoc tc)) -- Keep around an action for adjusting the annotations of extra parens chkParens :: [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> LHsType GhcPs @@ -1019,7 +1016,7 @@ checkTyClHdr is_cls ty where (o,c) = mkParensEpAnn (realSrcSpan l) go _ (HsAppTy _ t1 t2) acc ops cps fix = goL t1 (HsValArg t2:acc) ops cps fix - go _ (HsAppKindTy l ty ki) acc ops cps fix = goL ty (HsTypeArg l ki:acc) ops cps fix + go _ (HsAppKindTy _ ty at ki) acc ops cps fix = goL ty (HsTypeArg at ki:acc) ops cps fix go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ops cps fix = return (L (noAnnSrcSpan l) (nameRdrName tup_name) , map HsValArg ts, fix, (reverse ops)++cps) @@ -1956,7 +1953,7 @@ class DisambTD b where -- | Disambiguate @f x@ (function application or prefix data constructor). mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b) -- | Disambiguate @f \@t@ (visible kind application) - mkHsAppKindTyPV :: LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b) + mkHsAppKindTyPV :: LocatedA b -> LHsToken "@" GhcPs -> LHsType GhcPs -> PV (LocatedA b) -- | Disambiguate @f \# x@ (infix operator) mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b) -- | Disambiguate @{-\# UNPACK \#-} t@ (unpack/nounpack pragma) @@ -1965,7 +1962,7 @@ class DisambTD b where instance DisambTD (HsType GhcPs) where mkHsAppTyHeadPV = return mkHsAppTyPV t1 t2 = return (mkHsAppTy t1 t2) - mkHsAppKindTyPV t l_at ki = return (mkHsAppKindTy l_at t ki) + mkHsAppKindTyPV t at ki = return (mkHsAppKindTy t at ki) mkHsOpTyPV prom t1 op t2 = return (mkLHsOpTy prom t1 op t2) mkUnpackednessPV = addUnpackednessP @@ -2001,8 +1998,8 @@ instance DisambTD DataConBuilder where -- the grammar in Parser.y is written (see infixtype/ftype). panic "mkHsAppTyPV: InfixDataConBuilder" - mkHsAppKindTyPV lhs l_at ki = - addFatalError $ mkPlainErrorMsgEnvelope l_at $ + mkHsAppKindTyPV lhs at ki = + addFatalError $ mkPlainErrorMsgEnvelope (tokenSrcSpan $ getLoc at) $ (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki)) mkHsOpTyPV prom lhs tc rhs = do @@ -3102,10 +3099,6 @@ mkMultTy pct t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1))) arr locOfPct1 = token_location_widenR (getLoc pct) (locA (getLoc t)) mkMultTy pct t arr = HsExplicitMult pct t arr -mkTokenLocation :: SrcSpan -> TokenLocation -mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc -mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) - -- Precondition: the TokenLocation has EpaSpan, never EpaDelta. token_location_widenR :: TokenLocation -> SrcSpan -> TokenLocation token_location_widenR NoTokenLoc _ = NoTokenLoc ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -724,12 +724,12 @@ rnHsTyKi env (HsAppTy _ ty1 ty2) ; (ty2', fvs2) <- rnLHsTyKi env ty2 ; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) } -rnHsTyKi env (HsAppKindTy l ty k) +rnHsTyKi env (HsAppKindTy l ty at k) = do { kind_app <- xoptM LangExt.TypeApplications ; unless kind_app (addErr (typeAppErr "kind" k)) ; (ty', fvs1) <- rnLHsTyKi env ty ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k - ; return (HsAppKindTy l ty' k', fvs1 `plusFV` fvs2) } + ; return (HsAppKindTy l ty' at k', fvs1 `plusFV` fvs2) } rnHsTyKi env t@(HsIParamTy x n ty) = do { notInKinds env t @@ -1957,7 +1957,7 @@ extract_lty (L _ ty) acc flds HsAppTy _ ty1 ty2 -> extract_lty ty1 $ extract_lty ty2 acc - HsAppKindTy _ ty k -> extract_lty ty $ + HsAppKindTy _ ty _ k -> extract_lty ty $ extract_lty k acc HsListTy _ ty -> extract_lty ty acc HsTupleTy _ _ tys -> extract_ltys tys acc ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1508,12 +1508,13 @@ splitHsAppTys hs_ty is_app _ = False go :: LHsType GhcRn - -> [HsArg (LHsType GhcRn) (LHsKind GhcRn)] + -> [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)] -> (LHsType GhcRn, - [HsArg (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp - go (L _ (HsAppTy _ f a)) as = go f (HsValArg a : as) - go (L _ (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as) - go (L sp (HsParTy _ f)) as = go f (HsArgPar (locA sp) : as) + [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp + go (L _ (HsAppTy _ f a)) as = go f (HsValArg a : as) + go (L _ (HsAppKindTy _ ty at k)) as = go ty (HsTypeArg at k : as) + go (L sp (HsParTy _ f)) as = go f (HsArgPar at : as) + where at = L (mkTokenLocation $ locA sp) HsTok go (L _ (HsOpTy _ prom l op@(L sp _) r)) as = ( L (na2la sp) (HsTyVar noAnn prom op) , HsValArg l : HsValArg r : as ) @@ -1690,7 +1691,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args substed_fun_ki = substTy subst fun_ki hs_ty = appTypeToArg orig_hs_ty (take (n-1) orig_hs_args) - n_initial_val_args :: [HsArg tm ty] -> Arity + n_initial_val_args :: [HsArg GhcRn tm ty] -> Arity -- Count how many leading HsValArgs we have n_initial_val_args (HsValArg {} : args) = 1 + n_initial_val_args args n_initial_val_args (HsArgPar {} : args) = n_initial_val_args args @@ -1881,11 +1882,11 @@ unsaturated arguments: see #11246. Hence doing this in tcInferApps. -} appTypeToArg :: LHsType GhcRn -> [LHsTypeArg GhcRn] -> LHsType GhcRn -appTypeToArg f [] = f -appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args -appTypeToArg f (HsArgPar _ : args) = appTypeToArg f args -appTypeToArg f (HsTypeArg l arg : args) - = appTypeToArg (mkHsAppKindTy l f arg) args +appTypeToArg f [] = f +appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args +appTypeToArg f (HsArgPar _ : args) = appTypeToArg f args +appTypeToArg f (HsTypeArg at arg : args) + = appTypeToArg (mkHsAppKindTy f at arg) args {- ********************************************************************* ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -297,7 +297,7 @@ no_anon_wc_ty lty = go lty go (L _ ty) = case ty of HsWildCardTy _ -> False HsAppTy _ ty1 ty2 -> go ty1 && go ty2 - HsAppKindTy _ ty ki -> go ty && go ki + HsAppKindTy _ ty _ ki -> go ty && go ki HsFunTy _ w ty1 ty2 -> go ty1 && go ty2 && go (arrowToHsType w) HsListTy _ ty -> go ty HsTupleTy _ _ tys -> gos tys ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -3028,7 +3028,7 @@ tcTyFamInstEqn fam_tc mb_clsinfo (map (const Nominal) qtvs) (locA loc)) } -checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg tm ty] -> TcM () +checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg GhcRn tm ty] -> TcM () checkTyFamInstEqn tc_fam_tc eqn_tc_name hs_pats = do { -- Ensure that each equation's type constructor is for the right -- type family. E.g. barf on ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1784,7 +1784,7 @@ mk_apps head_ty type_args = do HsValArg ty -> do p_ty <- add_parens ty mk_apps (HsAppTy noExtField phead_ty p_ty) args HsTypeArg l ki -> do p_ki <- add_parens ki - mk_apps (HsAppKindTy l phead_ty p_ki) args + mk_apps (HsAppKindTy noExtField phead_ty l p_ki) args HsArgPar _ -> mk_apps (HsParTy noAnn phead_ty) args go type_args @@ -1829,8 +1829,10 @@ split_ty_app ty = go ty [] where go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg a':as') } go (AppKindT ty ki) as' = do { ki' <- cvtKind ki - ; go ty (HsTypeArg noSrcSpan ki':as') } - go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') } + ; go ty (HsTypeArg noHsTok ki':as') } + go (ParensT t) as' = do { loc <- getL + ; go t $ HsArgPar (L (mkTokenLocation loc) HsTok) : as' + } go f as = return (f,as) cvtTyLit :: TH.TyLit -> HsTyLit (GhcPass p) ===================================== compiler/Language/Haskell/Syntax/Type.hs ===================================== @@ -62,7 +62,6 @@ import Language.Haskell.Syntax.Extension import GHC.Types.Name.Reader ( RdrName ) import GHC.Core.DataCon( HsSrcBang(..) ) import GHC.Core.Type (Specificity) -import GHC.Types.SrcLoc (SrcSpan) import GHC.Hs.Doc (LHsDoc) import GHC.Data.FastString (FastString) @@ -755,6 +754,7 @@ data HsType pass | HsAppKindTy (XAppKindTy pass) -- type level type app (LHsType pass) + (LHsToken "@" pass) (LHsKind pass) | HsFunTy (XFunTy pass) @@ -1178,29 +1178,32 @@ if they correspond to a visible 'forall'. -} -- | Arguments in an expression/type after splitting -data HsArg tm ty - = HsValArg tm -- Argument is an ordinary expression (f arg) - | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty) - -- SrcSpan is location of the `@` - | HsArgPar SrcSpan -- See Note [HsArgPar] +-- +-- A HsArgPar indicates that everything to the left of this in the argument list is +-- enclosed in parentheses together with the function itself. It is necessary so +-- that we can recreate the parenthesis structure in the original source after +-- typechecking the arguments. +-- +-- The SrcSpan is the span of the original HsPar +-- +-- @((f arg1) arg2 arg3)@ results in an input argument list of +-- @[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2]@ +data HsArg pass tm ty --- type level equivalent -type LHsTypeArg p = HsArg (LHsType p) (LHsKind p) + -- | Argument is an ordinary expression (f arg) + = HsValArg tm -{- -Note [HsArgPar] -~~~~~~~~~~~~~~~ -A HsArgPar indicates that everything to the left of this in the argument list is -enclosed in parentheses together with the function itself. It is necessary so -that we can recreate the parenthesis structure in the original source after -typechecking the arguments. - -The SrcSpan is the span of the original HsPar + -- | Argument is a visible type application (f @ty) + | HsTypeArg (LHsToken "@" pass) ty -((f arg1) arg2 arg3) results in an input argument list of -[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2] + -- | A closing paren. + -- + -- The correponding opening parens are all at the front, so there is + -- no ambiguity from just storing the closing one. + | HsArgPar (LHsToken ")" pass) --} +-- type level equivalent +type LHsTypeArg p = HsArg p (LHsType p) (LHsKind p) {- ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -66,6 +66,21 @@ Compiler - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. + +GHCi +~~~~ + +- GHCi will now accept any file-header pragmas it finds, such as + ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, + instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, + you could instead write: + + .. code-block:: none + + ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} + +This can be convenient when pasting large multi-line blocks of code into GHCi. + ``base`` library ~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -3173,6 +3173,15 @@ example, to turn on :ghc-flag:`-Wmissing-signatures`, you would say: ghci> :set -Wmissing-signatures +GHCi will also accept any file-header pragmas it finds, such as +``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, +instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, +you could instead write: + +.. code-block:: none + + ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} + Any GHC command-line option that is designated as dynamic (see the table in :ref:`flag-reference`), may be set using :ghci-cmd:`:set`. To unset an option, you can set the reverse option: ===================================== ghc/GHCi/UI.hs ===================================== @@ -78,6 +78,7 @@ import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrNam import GHC.Types.SrcLoc as SrcLoc import qualified GHC.Parser.Lexer as Lexer import GHC.Parser.Header ( toArgs ) +import qualified GHC.Parser.Header as Header import GHC.Types.PkgQual import GHC.Unit @@ -1249,6 +1250,9 @@ runStmt input step = do let source = progname st let line = line_number st + -- Add any LANGUAGE/OPTIONS_GHC pragmas we find find. + set_pragmas pflags + if | GHC.isStmt pflags input -> do hsc_env <- GHC.getSession mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input)) @@ -1282,6 +1286,12 @@ runStmt input step = do run_imports imports = mapM_ (addImportToContext . unLoc) imports + set_pragmas pflags = + let stringbuf = stringToStringBuffer input + (_msgs, loc_opts) = Header.getOptions pflags stringbuf "" + opts = unLoc <$> loc_opts + in setOptions opts + run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult) run_stmt stmt = do m_result <- GhciMonad.runStmt stmt input step ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -77,6 +77,7 @@ stage0Packages = do , cabalSyntax , cabal , compiler + , containers , directory , process , exceptions ===================================== testsuite/tests/ghci/scripts/T21507.script ===================================== @@ -0,0 +1,5 @@ +:{ +{-# LANGUAGE TypeFamilies #-} +type family T21507 a where + T21507 a = a +:} ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -368,3 +368,4 @@ test('T21110', [extra_files(['T21110A.hs'])], ghci_script, ['T21110.script']) test('T17830', [filter_stdout_lines(r'======.*')], ghci_script, ['T17830.script']) test('T21294a', normal, ghci_script, ['T21294a.script']) +test('T21507', normal, ghci_script, ['T21507.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1603c41b1484c3a2af9849b19b4b2dc19f2e5eda...b745e21d645594cad92984034330f78d032085a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1603c41b1484c3a2af9849b19b4b2dc19f2e5eda...b745e21d645594cad92984034330f78d032085a4 You're receiving 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 23 02:06:44 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 Aug 2022 22:06:44 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. Message-ID: <630436346509e_e9d7d4d1d4521689@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 11 changed files: - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - libraries/template-haskell/changelog.md - testsuite/tests/th/T15845.stderr - + testsuite/tests/th/T21723.hs - + testsuite/tests/th/T21723.stdout - + testsuite/tests/th/T21942.hs - + testsuite/tests/th/T21942.stdout - testsuite/tests/th/T9262.stderr - testsuite/tests/th/TH_reifyExplicitForAllFams.stderr - testsuite/tests/th/TH_unresolvedInfix.stdout - testsuite/tests/th/all.T Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Ppr.hs ===================================== @@ -23,10 +23,12 @@ nestDepth :: Int nestDepth = 4 type Precedence = Int -appPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence -appPrec = 4 -- Argument of a function application -opPrec = 3 -- Argument of an infix operator -unopPrec = 2 -- Argument of an unresolved infix operator +appPrec, opPrec, unopPrec, funPrec, qualPrec, sigPrec, noPrec :: Precedence +appPrec = 6 -- Argument of a function or type application +opPrec = 5 -- Argument of an infix operator +unopPrec = 4 -- Argument of an unresolved infix operator +funPrec = 3 -- Argument of a function arrow +qualPrec = 2 -- Forall-qualified type or result of a function arrow sigPrec = 1 -- Argument of an explicit type signature noPrec = 0 -- Others @@ -220,7 +222,7 @@ pprExp _ (CompE ss) = pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e - <+> dcolon <+> ppr t + <+> dcolon <+> pprType sigPrec t pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs) pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs) pprExp i (StaticE e) = parensIf (i >= appPrec) $ @@ -792,60 +794,63 @@ pprStrictType :: (Strict, Type) -> Doc pprStrictType = pprBangType ------------------------------ -pprParendType :: Type -> Doc -pprParendType (VarT v) = pprName' Applied v +pprType :: Precedence -> Type -> Doc +pprType _ (VarT v) = pprName' Applied v -- `Applied` is used here instead of `ppr` because of infix names (#13887) -pprParendType (ConT c) = pprName' Applied c -pprParendType (TupleT 0) = text "()" -pprParendType (TupleT 1) = pprParendType (ConT (tupleTypeName 1)) -pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma)) -pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma -pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar -pprParendType ArrowT = parens (text "->") -pprParendType MulArrowT = text "FUN" -pprParendType ListT = text "[]" -pprParendType (LitT l) = pprTyLit l -pprParendType (PromotedT c) = text "'" <> pprName' Applied c -pprParendType (PromotedTupleT 0) = text "'()" -pprParendType (PromotedTupleT 1) = pprParendType (PromotedT (tupleDataName 1)) -pprParendType (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma)) -pprParendType PromotedNilT = text "'[]" -pprParendType PromotedConsT = text "'(:)" -pprParendType StarT = char '*' -pprParendType ConstraintT = text "Constraint" -pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) -pprParendType WildCardT = char '_' -pprParendType t@(InfixT {}) = parens (pprInfixT t) -pprParendType t@(UInfixT {}) = parens (pprInfixT t) -pprParendType t@(PromotedInfixT {}) = parens (pprInfixT t) -pprParendType t@(PromotedUInfixT {}) = parens (pprInfixT t) -pprParendType (ParensT t) = ppr t -pprParendType tuple | (TupleT n, args) <- split tuple - , length args == n - = parens (commaSep args) -pprParendType (ImplicitParamT n t) = text ('?':n) <+> text "::" <+> ppr t -pprParendType EqualityT = text "(~)" -pprParendType t@(ForallT {}) = parens (ppr t) -pprParendType t@(ForallVisT {}) = parens (ppr t) -pprParendType t@(AppT {}) = parens (ppr t) -pprParendType t@(AppKindT {}) = parens (ppr t) - -pprInfixT :: Type -> Doc -pprInfixT = \case - (InfixT x n y) -> with x n y "" ppr - (UInfixT x n y) -> with x n y "" pprInfixT - (PromotedInfixT x n y) -> with x n y "'" ppr - (PromotedUInfixT x n y) -> with x n y "'" pprInfixT - t -> ppr t +pprType _ (ConT c) = pprName' Applied c +pprType _ (TupleT 0) = text "()" +pprType p (TupleT 1) = pprType p (ConT (tupleTypeName 1)) +pprType _ (TupleT n) = parens (hcat (replicate (n-1) comma)) +pprType _ (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma +pprType _ (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar +pprType _ ArrowT = parens (text "->") +pprType _ MulArrowT = text "FUN" +pprType _ ListT = text "[]" +pprType _ (LitT l) = pprTyLit l +pprType _ (PromotedT c) = text "'" <> pprName' Applied c +pprType _ (PromotedTupleT 0) = text "'()" +pprType p (PromotedTupleT 1) = pprType p (PromotedT (tupleDataName 1)) +pprType _ (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma)) +pprType _ PromotedNilT = text "'[]" +pprType _ PromotedConsT = text "'(:)" +pprType _ StarT = char '*' +pprType _ ConstraintT = text "Constraint" +pprType _ (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) +pprType _ WildCardT = char '_' +pprType p t@(InfixT {}) = pprInfixT p t +pprType p t@(UInfixT {}) = pprInfixT p t +pprType p t@(PromotedInfixT {}) = pprInfixT p t +pprType p t@(PromotedUInfixT {}) = pprInfixT p t +pprType _ (ParensT t) = parens (pprType noPrec t) +pprType p (ImplicitParamT n ty) = + parensIf (p >= sigPrec) $ text ('?':n) <+> text "::" <+> pprType sigPrec ty +pprType _ EqualityT = text "(~)" +pprType p (ForallT tvars ctxt ty) = + parensIf (p >= funPrec) $ sep [pprForall tvars ctxt, pprType qualPrec ty] +pprType p (ForallVisT tvars ty) = + parensIf (p >= funPrec) $ sep [pprForallVis tvars [], pprType qualPrec ty] +pprType p t at AppT{} = pprTyApp p (split t) +pprType p t at AppKindT{} = pprTyApp p (split t) + +------------------------------ +pprParendType :: Type -> Doc +pprParendType = pprType appPrec + +pprInfixT :: Precedence -> Type -> Doc +pprInfixT p = \case + InfixT x n y -> with x n y "" opPrec + UInfixT x n y -> with x n y "" unopPrec + PromotedInfixT x n y -> with x n y "'" opPrec + PromotedUInfixT x n y -> with x n y "'" unopPrec + t -> pprParendType t where - with x n y prefix ppr' = ppr' x <+> text prefix <> pprName' Infix n <+> ppr' y + with x n y prefix p' = + parensIf + (p >= p') + (pprType opPrec x <+> text prefix <> pprName' Infix n <+> pprType opPrec y) instance Ppr Type where - ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty] - ppr (ForallVisT tvars ty) = sep [pprForallVis tvars [], ppr ty] - ppr ty = pprTyApp (split ty) - -- Works, in a degenerate way, for SigT, and puts parens round (ty :: kind) - -- See Note [Pretty-printing kind signatures] + ppr = pprType noPrec instance Ppr TypeArg where ppr (TANormal ty) = parensIf (isStarT ty) (ppr ty) ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki) @@ -866,38 +871,40 @@ parens around it. E.g. the parens are required here: type instance F Int = (Bool :: *) So we always print a SigT with parens (see #10050). -} -pprTyApp :: (Type, [TypeArg]) -> Doc -pprTyApp (MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2]) - | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", ppr arg2] - | c == manyName = sep [pprFunArgType arg1 <+> text "->", ppr arg2] -pprTyApp (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) = - sep [pprFunArgType arg1 <+> text "%" <> ppr argm <+> text "->", ppr arg2] -pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2] -pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) = - sep [pprFunArgType arg1 <+> text "~", ppr arg2] -pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg) -pprTyApp (TupleT 1, args) = pprTyApp (ConT (tupleTypeName 1), args) -pprTyApp (PromotedTupleT 1, args) = pprTyApp (PromotedT (tupleDataName 1), args) -pprTyApp (TupleT n, args) +pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc +pprTyApp p app@(MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2]) + | p >= funPrec = parens (pprTyApp noPrec app) + | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", pprType qualPrec arg2] + | c == manyName = sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2] +pprTyApp p (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) = + parensIf (p >= funPrec) $ + sep [pprFunArgType arg1 <+> text "%" <> pprType appPrec argm <+> text "->", + pprType qualPrec arg2] +pprTyApp p (ArrowT, [TANormal arg1, TANormal arg2]) = + parensIf (p >= funPrec) $ + sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2] +pprTyApp p (EqualityT, [TANormal arg1, TANormal arg2]) = + parensIf (p >= opPrec) $ + sep [pprType opPrec arg1 <+> text "~", pprType opPrec arg2] +pprTyApp _ (ListT, [TANormal arg]) = brackets (pprType noPrec arg) +pprTyApp p (TupleT 1, args) = pprTyApp p (ConT (tupleTypeName 1), args) +pprTyApp _ (TupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = parens (commaSep args') -pprTyApp (PromotedTupleT n, args) +pprTyApp p (PromotedTupleT 1, args) = pprTyApp p (PromotedT (tupleDataName 1), args) +pprTyApp _ (PromotedTupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = quoteParens (commaSep args') -pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args) +pprTyApp p (fun, args) = + parensIf (p >= appPrec) $ pprParendType fun <+> sep (map pprParendTypeArg args) fromTANormal :: TypeArg -> Maybe Type fromTANormal (TANormal arg) = Just arg fromTANormal (TyArg _) = Nothing -pprFunArgType :: Type -> Doc -- Should really use a precedence argument --- Everything except forall and (->) binds more tightly than (->) -pprFunArgType ty@(ForallT {}) = parens (ppr ty) -pprFunArgType ty@(ForallVisT {}) = parens (ppr ty) -pprFunArgType ty@(((MulArrowT `AppT` _) `AppT` _) `AppT` _) = parens (ppr ty) -pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty) -pprFunArgType ty@(SigT _ _) = parens (ppr ty) -pprFunArgType ty = ppr ty +-- Print the type to the left of @->@. Everything except forall and (->) binds more tightly than (->). +pprFunArgType :: Type -> Doc +pprFunArgType = pprType funPrec data ForallVisFlag = ForallVis -- forall a -> {...} | ForallInvis -- forall a. {...} ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,5 +1,10 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.20.0.0 + + * The `Ppr.pprInfixT` function has gained a `Precedence` argument. + * The values of named precedence levels like `Ppr.appPrec` have changed. + ## 2.19.0.0 * Add `DefaultD` constructor to support Haskell `default` declarations. ===================================== testsuite/tests/th/T15845.stderr ===================================== @@ -1,5 +1,5 @@ data family T15845.F1 (a_0 :: *) (b_1 :: *) :: * -data instance forall (a_2 :: *) (b_3 :: *). T15845.F1 ([a_2]) b_3 +data instance forall (a_2 :: *) (b_3 :: *). T15845.F1 [a_2] b_3 = T15845.MkF1 data family T15845.F2 (a_0 :: *) :: * data instance forall (a_1 :: *). T15845.F2 a_1 = T15845.MkF2 ===================================== testsuite/tests/th/T21723.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import Language.Haskell.TH + +main :: IO () +main = do + putStrLn $ pprint (InfixT (ArrowT `AppT` StarT `AppT` StarT) (mkName ":>:") StarT) + putStrLn $ pprint (InfixT (ParensT $ ArrowT `AppT` StarT `AppT` StarT) (mkName ":>:") StarT) ===================================== testsuite/tests/th/T21723.stdout ===================================== @@ -0,0 +1,2 @@ +(* -> *) :>: * +(* -> *) :>: * ===================================== testsuite/tests/th/T21942.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE LinearTypes, TemplateHaskell #-} + +module Main where + +import Language.Haskell.TH + +main :: IO () +main = runQ [t| forall a m n. a %(m n) -> a |] >>= putStrLn . pprint ===================================== testsuite/tests/th/T21942.stdout ===================================== @@ -0,0 +1 @@ +forall a_0 m_1 n_2 . a_0 %(m_1 n_2) -> a_0 ===================================== testsuite/tests/th/T9262.stderr ===================================== @@ -1 +1 @@ -instance GHC.Classes.Eq a_0 => GHC.Classes.Eq ([a_0]) +instance GHC.Classes.Eq a_0 => GHC.Classes.Eq [a_0] ===================================== testsuite/tests/th/TH_reifyExplicitForAllFams.stderr ===================================== @@ -3,13 +3,13 @@ data instance forall (a_1 :: *). TH_reifyExplicitForAllFams.F (GHC.Maybe.Maybe a = TH_reifyExplicitForAllFams.MkF a_1 class TH_reifyExplicitForAllFams.C (a_0 :: *) where {type TH_reifyExplicitForAllFams.G (a_0 :: *) (b_1 :: *) :: *} -instance TH_reifyExplicitForAllFams.C ([a_2]) +instance TH_reifyExplicitForAllFams.C [a_2] type family TH_reifyExplicitForAllFams.G (a_0 :: *) (b_1 :: *) :: * type instance forall (a_2 :: *) - (b_3 :: *). TH_reifyExplicitForAllFams.G ([a_2]) + (b_3 :: *). TH_reifyExplicitForAllFams.G [a_2] b_3 = Data.Proxy.Proxy b_3 type family TH_reifyExplicitForAllFams.H (a_0 :: *) (b_1 :: *) :: * where - forall (x_2 :: *) (y_3 :: *). TH_reifyExplicitForAllFams.H ([x_2]) + forall (x_2 :: *) (y_3 :: *). TH_reifyExplicitForAllFams.H [x_2] (Data.Proxy.Proxy y_3) = Data.Either.Either x_2 y_3 forall (z_4 :: *). TH_reifyExplicitForAllFams.H z_4 ===================================== testsuite/tests/th/TH_unresolvedInfix.stdout ===================================== @@ -44,5 +44,5 @@ N :+ (N :+ N :+ N) (N) N :+ (N :+ N :+ N) (N) -(Int + (Int + Int + Int)) -Int +Int + (Int + (Int + Int)) +(Int) ===================================== testsuite/tests/th/all.T ===================================== @@ -553,3 +553,5 @@ test('T20711', normal, compile_and_run, ['']) test('T20868', normal, compile_and_run, ['']) test('Lift_ByteArray', normal, compile_and_run, ['']) test('T21920', normal, compile_and_run, ['']) +test('T21723', normal, compile_and_run, ['']) +test('T21942', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb7c2d99f7df880b00b0d31ee7436c6d8eb3ba15...c96552517acc55ba307add250d499d97dc203677 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb7c2d99f7df880b00b0d31ee7436c6d8eb3ba15...c96552517acc55ba307add250d499d97dc203677 You're receiving 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 23 02:07:12 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 Aug 2022 22:07:12 -0400 Subject: [Git][ghc/ghc][master] hadrian: Don't duplicate binaries on installation Message-ID: <630436504072a_e9d7d48828526889@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 80102356 by Ben Gamari at 2022-08-22T22:06:57-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 ===================================== @@ -139,7 +139,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 \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80102356468d87b683d5360a291c44b057a52ade -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80102356468d87b683d5360a291c44b057a52ade You're receiving 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 23 11:46:48 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 23 Aug 2022 07:46:48 -0400 Subject: [Git][ghc/ghc][wip/T21623] More wibbles Message-ID: <6304be28dbb6a_e9d7d4ee6c6013d4@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 8812d764 by Simon Peyton Jones at 2022-08-23T12:48:06+01:00 More wibbles - - - - - 10 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Instance/Class.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -183,7 +183,6 @@ 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 ) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -521,20 +520,6 @@ tupleRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TupleRep sumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "SumRep") sumRepDataConKey sumRepDataCon boxedRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "BoxedRep") boxedRepDataConKey boxedRepDataCon --- See Note [Wiring in RuntimeRep] -runtimeRepSimpleDataConNames :: [Name] -runtimeRepSimpleDataConNames - = zipWith3Lazy mk_special_dc_name - [ fsLit "IntRep" - , fsLit "Int8Rep", fsLit "Int16Rep", fsLit "Int32Rep", fsLit "Int64Rep" - , fsLit "WordRep" - , fsLit "Word8Rep", fsLit "Word16Rep", fsLit "Word32Rep", fsLit "Word64Rep" - , fsLit "AddrRep" - , fsLit "FloatRep", fsLit "DoubleRep" - ] - runtimeRepSimpleDataConKeys - runtimeRepSimpleDataCons - vecCountTyConName :: Name vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") vecCountTyConKey vecCountTyCon @@ -1505,8 +1490,6 @@ constraintKindTyCon constraintKindTyConName :: Name constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon --- Old comment: todo --- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon! typeToTypeKind, constraintKind :: Kind constraintKind = mkTyConTy constraintKindTyCon @@ -1694,6 +1677,20 @@ runtimeRepSimpleDataCons mk_runtime_rep_dc primrep name = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep])) +-- See Note [Wiring in RuntimeRep] +runtimeRepSimpleDataConNames :: [Name] +runtimeRepSimpleDataConNames + = zipWith3Lazy mk_special_dc_name + [ fsLit "IntRep" + , fsLit "Int8Rep", fsLit "Int16Rep", fsLit "Int32Rep", fsLit "Int64Rep" + , fsLit "WordRep" + , fsLit "Word8Rep", fsLit "Word16Rep", fsLit "Word32Rep", fsLit "Word64Rep" + , fsLit "AddrRep" + , fsLit "FloatRep", fsLit "DoubleRep" + ] + runtimeRepSimpleDataConKeys + runtimeRepSimpleDataCons + -- See Note [Wiring in RuntimeRep] intRepDataConTy, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -421,7 +421,7 @@ decomposeCo :: Arity -> Coercion -> [Coercion] decomposeCo arity co rs = [mkSelCo r (SelTyCon n) co | (n,r) <- [0..(arity-1)] `zip` rs ] - -- Remember, Nth is zero-indexed + -- Remember, SelTyCon is zero-indexed decomposeFunCo :: HasDebugCallStack => Role -- Role of the input coercion @@ -1851,7 +1851,7 @@ The KPUSH rule deals with this situation We want to push the coercion inside the constructor application. So we do this - g' :: t1~t2 = Nth 0 g + g' :: t1~t2 = SelCo (SelTyCon 0) g case K @t2 (x |> g' -> Maybe g') of K (y:t2 -> Maybe t2) -> rhs @@ -1868,7 +1868,7 @@ available at www.cis.upenn.edu/~sweirich/papers/fckinds-extended.pdf Note [extendLiftingContextEx] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider we have datatype - K :: \/k. \/a::k. P -> T k -- P be some type + K :: /\k. /\a::k. P -> T k -- P be some type g :: T k1 ~ T k2 case (K @k1 @t1 x) |> g of @@ -1876,7 +1876,7 @@ Consider we have datatype We want to push the coercion inside the constructor application. We first get the coercion mapped by the universal type variable k: - lc = k |-> Nth 0 g :: k1~k2 + lc = k |-> SelCo (SelTyCon 0) g :: k1~k2 Here, the important point is that the kind of a is coerced, and P might be dependent on the existential type variable a. ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -1194,7 +1194,9 @@ etaAppCo_maybe co etaTyConAppCo_maybe :: TyCon -> Coercion -> Maybe [Coercion] -- If possible, split a coercion -- g :: T s1 .. sn ~ T t1 .. tn --- into [ Nth 0 g :: s1~t1, ..., Nth (n-1) g :: sn~tn ] +-- into [ SelCo (SelTyCon 0) g :: s1~t1 +-- , ... +-- , SelCo (SelTyCon (n-1)) g :: sn~tn ] etaTyConAppCo_maybe tc (TyConAppCo _ tc2 cos2) = assert (tc == tc2) $ Just cos2 ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -2728,11 +2728,11 @@ pushCoDataCon dc dc_args co collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) -- Collect lambda binders, pushing coercions inside if possible -- E.g. (\x.e) |> g g :: -> blah --- = (\x. e |> Nth 1 g) +-- = (\x. e |> SelCo (SelFun SelRes) g) -- -- That is, -- --- collectBindersPushingCo ((\x.e) |> g) === ([x], e |> Nth 1 g) +-- collectBindersPushingCo ((\x.e) |> g) === ([x], e |> SelCo (SelFun SelRes) g) collectBindersPushingCo e = go [] e where ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1563,7 +1563,7 @@ their representation type (see Type.coreView and Type.predTypeRep). This collapse is done by mkPredCo; there is no PredCo constructor in Coercion. This is important because we need Nth to work on predicates too: - Nth 1 ((~) [c] g) = g + SelCo (SelTyCon 1) ((~) [c] g) = g See Simplify.simplCoercionF, which generates such selections. Note [Roles] ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -45,7 +45,7 @@ module GHC.Core.TyCon( noTcTyConScopedTyVars, -- ** Predicates on TyCons - isAlgTyCon, isVanillaAlgTyCon, isConstraintKindCon, + isAlgTyCon, isVanillaAlgTyCon, isClassTyCon, isFamInstTyCon, isPrimTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, @@ -2067,16 +2067,6 @@ isVanillaAlgTyCon :: TyCon -> Bool isVanillaAlgTyCon (AlgTyCon { algTcFlavour = VanillaAlgTyCon _ }) = True isVanillaAlgTyCon _ = False --- | Returns @True@ for the 'TyCon' of the 'Constraint' kind. -{-# INLINE isConstraintKindCon #-} -- See Note [Inlining coreView] in GHC.Core.Type -isConstraintKindCon :: TyCon -> Bool --- NB: We intentionally match on AlgTyCon, because 'constraintKindTyCon' is --- always an AlgTyCon (see 'pcTyCon' in TysWiredIn) and the record selector --- for 'tyConUnique' would generate unreachable code for every other data --- constructor of TyCon (see #18026). -isConstraintKindCon AlgTyCon { tyConUnique = u } = u == constraintKindTyConKey -isConstraintKindCon _ = False - isDataTyCon :: TyCon -> Bool -- ^ Returns @True@ for data types that are /definitely/ represented by -- heap-allocated constructors. These are scrutinised by Core-level ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Type ( KindOrType, PredType, ThetaType, FRRType, Var, TyVar, isTyVar, TyCoVar, TyCoBinder, TyCoVarBinder, TyVarBinder, Mult, Scaled, - KnotTied, + KnotTied, RuntimeRepType, -- ** Constructing and deconstructing types mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe, @@ -44,7 +44,7 @@ module GHC.Core.Type ( tyConAppTyCon_maybe, tyConAppTyConPicky_maybe, tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs, - splitTyConApp_maybe, splitTyConAppNoSyn_maybe, splitTyConApp, tyConAppArgN, + splitTyConApp_maybe, splitTyConAppNoSyn_maybe, splitTyConApp, tcSplitTyConApp_maybe, mkForAllTy, mkForAllTys, mkInvisForAllTys, mkTyCoInvForAllTys, @@ -241,7 +241,6 @@ module GHC.Core.Type ( tidyTyCoVarBinder, tidyTyCoVarBinders, -- * Kinds - isConstraintKindCon, classifiesTypeWithValues, isConcrete, isFixedRuntimeRepKind, ) where @@ -299,7 +298,6 @@ import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Data.FastString import GHC.Data.Pair -import GHC.Data.List.SetOps import GHC.Types.Unique ( nonDetCmpUnique ) import GHC.Data.Maybe ( orElse, isJust ) @@ -807,7 +805,7 @@ isMultiplicityVar = isMultiplicityTy . tyVarKind -- See Note [Promoted data constructors] in GHC.Core.TyCon -- May not be possible if `rr` is a type variable or type -- family application -splitRuntimeRep_maybe :: Type -> Maybe (TyCon, [Type]) +splitRuntimeRep_maybe :: RuntimeRepType -> Maybe (TyCon, [Type]) splitRuntimeRep_maybe rep | TyConApp rr_tc args <- coreFullView rep , isPromotedDataCon rr_tc @@ -1637,13 +1635,6 @@ tyConAppArgs_maybe ty = case splitTyConApp_maybe ty of tyConAppArgs :: HasCallStack => Type -> [Type] tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty) -tyConAppArgN :: Int -> Type -> Type --- Executing Nth -tyConAppArgN n ty - = case tyConAppArgs_maybe ty of - Just tys -> tys `getNth` n - Nothing -> pprPanic "tyConAppArgN" (ppr n <+> ppr ty) - -- | Attempts to tease a type apart into a type constructor and the application -- of a number of arguments to that constructor. Panics if that is not possible. -- See also 'splitTyConApp_maybe' @@ -2838,15 +2829,11 @@ nonDetCmpTypesX _ [] _ = LT nonDetCmpTypesX _ _ [] = GT ------------- --- | Compare two 'TyCon's. NB: This should /never/ see 'Constraint' (as --- recognized by Kind.isConstraintKindCon) which is considered a synonym for --- 'Type' in Core. --- See Note [Kind Constraint and kind Type] in "GHC.Core.Type". +-- | Compare two 'TyCon's. -- See Note [nonDetCmpType nondeterminism] nonDetCmpTc :: TyCon -> TyCon -> Ordering nonDetCmpTc tc1 tc2 - = assert (not (isConstraintKindCon tc1) && not (isConstraintKindCon tc2)) $ - u1 `nonDetCmpUnique` u2 + = u1 `nonDetCmpUnique` u2 where u1 = tyConUnique tc1 u2 = tyConUnique tc2 ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1787,7 +1787,7 @@ ppr_co ctxt_prec (IfaceTransCo co1 co2) in maybeParen ctxt_prec opPrec $ vcat (ppr_co topPrec co1 : ppr_trans co2) ppr_co ctxt_prec (IfaceSelCo d co) - = ppr_special_co ctxt_prec (text "Nth:" <> ppr d) [co] + = ppr_special_co ctxt_prec (text "SelCo:" <> ppr d) [co] ppr_co ctxt_prec (IfaceLRCo lr co) = ppr_special_co ctxt_prec (ppr lr) [co] ppr_co ctxt_prec (IfaceSubCo co) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2105,8 +2105,7 @@ pprTcSolverReportMsg ctxt , 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 + | ea_looks_same ty1 ty2 exp act , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig = pprTcSolverReportMsg ctxt ea_msg @@ -2123,52 +2122,37 @@ pprTcSolverReportMsg ctxt -- '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 (splitRuntimeRep_maybe exp_rep, splitRuntimeRep_maybe act_rep) of - (Just (exp_rr_tc, exp_rr_args), Just (act_rr_tc, act_rr_args)) - | exp_rr_tc == act_rr_tc -> msg_for_same_rep exp_rr_args act_rr_args - | otherwise -> msg_for_different_rep exp_rr_tc act_rr_tc - _ -> bale_out_msg - + = -- (TYPE exp_rep) ~ (CONSTRAINT act_rep) etc + msg_torc_torc act_torc act_rep | otherwise - = -- (TYPE _) ~ (CONSTRAINT _) or (TYPE _) ~ Bool, etc + = -- (TYPE _) ~ Bool, etc maybe_num_args_msg $$ - sep [ text "Expected a" <+> pp_exp_thing <> comma + sep [ text "Expected a" <+> ppr_torc exp_torc <> comma , text "but" <+> case mb_thing of Nothing -> text "found something with kind" Just thing -> quotes (ppr thing) <+> text "has kind" , quotes (pprWithTYPE act) ] where - pp_exp_thing = case exp_torc of TypeLike -> text "type"; - ConstraintLike -> text "constraint" - - -- (TYPE (BoxedRep lev1)) ~ (TYPE (BoxedRep lev2)); or CONSTRAINT ditto - msg_for_same_rep exp_rr_args act_rr_args - | [exp_lev_ty] <- exp_rr_args -- BoxedRep has exactly one arg - , [act_lev_ty] <- act_rr_args - , Just exp_lev <- levityType_maybe exp_lev_ty - , Just act_lev <- levityType_maybe act_lev_ty - = sep [ text "Expected" <+> ppr_an_lev exp_lev <+> pp_exp_thing <> comma + msg_torc_torc act_torc act_rep + | exp_torc == act_torc + = msg_same_torc act_torc act_rep + | otherwise + = sep [ text "Expected a" <+> ppr_torc exp_torc <> comma , 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 ] - msg_for_same_rep _ _ - = bale_out_msg - - -- (TYPE (BoxedRep lev)) ~ (TYPE IntRep); or CONSTRAINT ditto - msg_for_different_rep exp_rr_tc act_rr_tc - = sep [ text "Expected a" <+> what <> comma + Nothing -> text "found a" + Just thing -> quotes (ppr thing) <+> text "is a" + <+> ppr_torc act_torc ] + + msg_same_torc act_torc act_rep + | Just exp_doc <- describe_rep exp_rep + , Just act_doc <- describe_rep act_rep + = sep [ text "Expected" <+> exp_doc <+> ppr_torc exp_torc <> comma , text "but" <+> case mb_thing of - Just thing -> quotes (ppr thing) - Nothing -> quotes (pprWithTYPE act) - <+> text "has representation" <+> ppr_rep act_rr_tc ] - where - what | exp_rr_tc `hasKey` boxedRepDataConKey - = text "boxed" <+> pp_exp_thing - | otherwise - = pp_exp_thing <+> text "with representation" <+> ppr_rep exp_rr_tc + Just thing -> quotes (ppr thing) <+> text "is" + Nothing -> text "got" + <+> act_doc <+> ppr_torc act_torc ] + msg_same_torc _ _ = bale_out_msg ct_loc = errorItemCtLoc item orig = errorItemOrigin item @@ -2195,13 +2179,36 @@ pprTcSolverReportMsg ctxt count_args ty = count isVisibleBinder $ fst $ splitPiTys ty + ppr_torc TypeLike = text "type"; + ppr_torc 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" ppr_rep rep_tc = quotes (ppr (getOccName rep_tc)) -- Don't qualify + describe_rep :: RuntimeRepType -> Maybe SDoc + describe_rep rep + | Just (rr_tc, rr_args) <- splitRuntimeRep_maybe rep + = case rr_args of + [lev_ty] | rr_tc `hasKey` boxedRepDataConKey + , Just lev <- levityType_maybe lev_ty + -> case lev of + Lifted -> Just (text "a lifted") + Unlifted -> Just (text "a boxed unlifted") + [] | rr_tc `hasKey` tupleRepDataConTyConKey -> Just (text "a zero-bit") + | starts_with_vowel rr_tc -> Just (text "an" <+> ppr rr_tc) + | otherwise -> Just (text "a" <+> ppr rr_tc) + _ -> Nothing -- Must be TupleRep [r1..rn] + | otherwise = Nothing + + starts_with_vowel tc + | (c:_) <- occNameString (getOccName tc) = c `elem` "aeiou" + | otherwise = False + pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = vcat (map make_msg frr_origs) where ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -654,10 +654,15 @@ matchTypeable clas [k,t] -- clas = Typeable | k `eqType` naturalTy = doTyLit knownNatClassName t | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t | k `eqType` charTy = doTyLit knownCharClassName t + + -- Functions | Just (af,mult,arg,ret) <- splitFunTy_maybe t , isVisibleAnonArg af = doFunTy clas t mult arg ret + + -- Applications | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks + | Just (f,kt) <- splitAppTy_maybe t = doTyApp clas t f kt matchTypeable _ _ = return NoInstance @@ -738,14 +743,31 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc {- Note [Typeable (T a b c)] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + For type applications we always decompose using binary application, -via doTyApp, until we get to a *kind* instantiation. Example - Proxy :: forall k. k -> * +via doTyApp (building a TrApp), until we get to a *kind* instantiation +(building a TrTyCon). We detect a pure kind instantiation using +`onlyNamedBndrsApplied`. + +Example: Proxy :: forall k. k -> * + + To solve Typeable (Proxy @(* -> *) Maybe) we + + - First decompose with doTyApp (onlyNamedBndrsApplied is False) + to get (Typeable (Proxy @(* -> *))) and Typeable Maybe. + This step returns a TrApp. + + - Then solve (Typeable (Proxy @(* -> *))) with doTyConApp + (onlyNamedBndrsApplied is True). + This step returns a TrTyCon + + So the TypeRep we build is + TrApp (TrTyCon ("Proxy" @(*->*))) (TrTyCon "Maybe") -To solve Typeable (Proxy (* -> *) Maybe) we - - First decompose with doTyApp, - to get (Typeable (Proxy (* -> *))) and Typeable Maybe - - Then solve (Typeable (Proxy (* -> *))) with doTyConApp +Notice also that TYPE and CONSTRAINT are distinct so, in effect, we +allow (Typeable TYPE) and (Typeable CONSTRAINT), giving disinct TypeReps. +This is very important: we may want to get a TypeRep for a kind like + Type -> Constraint If we attempt to short-cut by solving it all at once, via doTyConApp View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8812d7641dc563e93bcc1083ef1657d919ae5780 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8812d7641dc563e93bcc1083ef1657d919ae5780 You're receiving 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 23 13:32:30 2022 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 23 Aug 2022 09:32:30 -0400 Subject: [Git][ghc/ghc][wip/andreask/ghci-tag-nullary] 36 commits: typo Message-ID: <6304d6ee7d874_e9d7d1ee7674c61424b@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/ghci-tag-nullary 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. - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - ff483eda by Andreas Klebinger at 2022-08-23T15:30:01+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. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 30 changed files: - .gitlab/gen_ci.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - 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/GenerateCgIPEStub.hs - compiler/GHC/Driver/Main.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/Make.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.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/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Name/Set.hs - compiler/GHC/Types/Var.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ba257a34f4bd4ecc1b3a93b40711dc04e39e995...ff483eda5536ff2c1fc8a6dbfb9f5b832979162f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ba257a34f4bd4ecc1b3a93b40711dc04e39e995...ff483eda5536ff2c1fc8a6dbfb9f5b832979162f You're receiving 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 23 15:25:31 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 23 Aug 2022 11:25:31 -0400 Subject: [Git][ghc/ghc][wip/T21623] More changes Message-ID: <6304f16b28eac_e9d7d4882869063c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 5eddeca2 by Simon Peyton Jones at 2022-08-23T16:26:26+01:00 More changes * Move role into SelTyCon * Get rid of mkTcSymCo and friends - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5eddeca2036ae46fcb2227f969495d1768e1d97b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5eddeca2036ae46fcb2227f969495d1768e1d97b You're receiving 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 23 15:33:54 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 23 Aug 2022 11:33:54 -0400 Subject: [Git][ghc/ghc][wip/kill-make] 48 commits: Add support for external static plugins (#20964) Message-ID: <6304f362bc30c_e9d7d4ee6c691054@gitlab.mail> Ben Gamari pushed to branch wip/kill-make 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 - - - - - 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 - - - - - 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 - - - - - 9b74ef87 by Ben Gamari at 2022-08-23T11:33:23-04:00 validate: Drop --legacy flag - - - - - fbcb1ccd by Ben Gamari at 2022-08-23T11:33:32-04:00 Drop make build system - - - - - 4735317f by Ben Gamari at 2022-08-23T11:33:33-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - ae3ecec9 by Ben Gamari at 2022-08-23T11:33:33-04:00 gitlab-ci: Drop make build validation jobs - - - - - f2dbe0ff by Ben Gamari at 2022-08-23T11:33:34-04:00 hadrian: Fix whitespace - - - - - 96d0512d by Ben Gamari at 2022-08-23T11:33:34-04:00 Notes - - - - - f2c6db81 by Ben Gamari at 2022-08-23T11:33:34-04:00 Drop MAKEHELP.md - - - - - a7419352 by Ben Gamari at 2022-08-23T11:33:34-04:00 Drop hc-build script This has not worked for many, many years. - - - - - a12ab403 by Ben Gamari at 2022-08-23T11:33:34-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4178bd7c by Ben Gamari at 2022-08-23T11:33:43-04:00 Drop mk/{build,install,config}.mk.in - - - - - 0b455176 by Ben Gamari at 2022-08-23T11:33:44-04:00 compiler: Drop comment references to make - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/CodeGen.Platform.h - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.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/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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41a01daf46b9c614fd5fdff392c6100fdfb99880...0b455176e3de0f0bc53938d8be6d0a26357101c0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41a01daf46b9c614fd5fdff392c6100fdfb99880...0b455176e3de0f0bc53938d8be6d0a26357101c0 You're receiving 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 23 15:36:53 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 23 Aug 2022 11:36:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22091 Message-ID: <6304f4151202a_e9d7d488786924c3@gitlab.mail> Ben Gamari pushed new branch wip/T22091 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22091 You're receiving 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 23 16:08:01 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 23 Aug 2022 12:08:01 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Respond to SG Message-ID: <6304fb61e6ecb_e9d7d4ee6c705032@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: 5175f211 by Simon Peyton Jones at 2022-08-23T17:09:20+01:00 Respond to SG - - - - - 2 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -1243,28 +1243,28 @@ dictionary-typed expression, but that's more work. --------------------------- data ArityEnv - = AE { am_opts :: !ArityOpts - , am_no_eta :: !Bool - , am_sigs :: !(IdEnv SafeArityType) } + = AE { am_opts :: !ArityOpts + , am_free_joins :: !Bool -- True <=> free join points allowed + , 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 for recursive join bindings] + -- am_free_joins: see Note [Arity for recursive join bindings] -- point 5, in GHC.Core.Opt.Simplify.Utils instance Outputable ArityEnv where - ppr (AE { am_sigs = sigs, am_no_eta = no_eta }) - = text "AE" <+> braces (sep [ text "no-eta" <+> ppr no_eta - , text "sigs" <+> ppr sigs ]) + ppr (AE { am_sigs = sigs, am_free_joins = free_joins }) + = text "AE" <+> braces (sep [ text "free joins:" <+> ppr free_joins + , text "sigs:" <+> ppr sigs ]) -- | The @ArityEnv@ used by 'findRhsArity'. findRhsArityEnv :: ArityOpts -> Bool -> ArityEnv -findRhsArityEnv opts no_eta - = AE { am_opts = opts - , am_no_eta = no_eta - , am_sigs = emptyVarEnv } +findRhsArityEnv opts free_joins + = AE { am_opts = opts + , am_free_joins = free_joins + , am_sigs = emptyVarEnv } -isNoEtaEnv :: ArityEnv -> Bool -isNoEtaEnv (AE { am_no_eta = no_eta }) = no_eta +freeJoinsOK :: ArityEnv -> Bool +freeJoinsOK (AE { am_free_joins = free_joins }) = free_joins -- First some internal functions in snake_case for deleting in certain VarEnvs -- of the ArityType. Don't call these; call delInScope* instead! @@ -1348,11 +1348,14 @@ arityType :: HasDebugCallStack => ArityEnv -> CoreExpr -> ArityType -- Precondition: all the free join points of the expression -- are bound by the ArityEnv -- See Note [No free join points in arityType] +-- +-- Returns ArityType, not SafeArityType. The caller must do +-- trimArityType if necessary. arityType env (Var v) | Just at <- lookupSigEnv env v -- Local binding = at | otherwise - = assertPpr (isNoEtaEnv env || not (isJoinId v)) (ppr v) $ + = assertPpr (freeJoinsOK env || not (isJoinId v)) (ppr v) $ -- All join-point should be in the ae_sigs -- See Note [No free join points in arityType] idArityType v @@ -1403,14 +1406,14 @@ arityType env (Case scrut bndr _ alts) alts_type = foldr1 (andArityType env) (map arity_type_alt alts) arityType env (Let (NonRec b rhs) e) - = -- See Note [arityType for let-bindings] + = -- See Note [arityType for non-recursive let-bindings] floatIn rhs_cost (arityType env' e) where rhs_cost = exprCost env rhs (Just (idType b)) env' = extendSigEnv env b (safeArityType (arityType env rhs)) arityType env (Let (Rec prs) e) - = -- See Note [arityType for let-bindings] + = -- See Note [arityType for recursive let-bindings] floatIn (allCosts bind_cost prs) (arityType env' e) where bind_cost (b,e) = exprCost env' e (Just (idType b)) @@ -1418,10 +1421,7 @@ arityType env (Let (Rec prs) e) extend_rec :: ArityEnv -> (Id,CoreExpr) -> ArityEnv extend_rec env (b,_) = extendSigEnv env b $ idArityType b - -- 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] + -- See Note [arityType for recursive let-bindings] arityType env (Tick t e) | not (tickishIsCode t) = arityType env e @@ -1452,9 +1452,15 @@ cheapArityType :: HasDebugCallStack => CoreExpr -> ArityType -- A fast and cheap version of arityType. -- Returns an ArityType with IsCheap everywhere -- c.f. GHC.Core.Utils.exprIsDeadEnd +-- Does not expect to encounter a free join-point Id +-- See Note [No free join points in arityType] +-- +-- Returns ArityType, not SafeArityType. The caller must do +-- trimArityType if necessary. cheapArityType e = go e where - go (Var v) = idArityType v + go (Var v) = assertPpr( not (isJoinId v) ) (ppr v) $ + idArityType v go (Cast e _) = go e go (Lam x e) | isId x = arityLam x (go e) | otherwise = go e @@ -1473,8 +1479,9 @@ cheapArityType e = go e -- 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 + arity_app arg at@(AT ((cost,_):lams) div) + | assertPpr (cost == IsCheap) (ppr at $$ ppr arg) $ + isDeadEndDiv div = AT lams div | exprIsTrivial arg = AT lams topDiv | otherwise = topArityType @@ -1503,7 +1510,9 @@ exprArity e = go e exprIsDeadEnd :: CoreExpr -> Bool -- See Note [Bottoming expressions] -- This function is, in effect, just a specialised (and hence cheap) --- version of cheapArityType +-- version of cheapArityType: +-- exprIsDeadEnd e = case cheapArityType e of +-- AT lams div -> null lams && isDeadEndDiv div -- See also exprBotStrictness_maybe, which uses cheapArityType exprIsDeadEnd e = go 0 e @@ -1600,8 +1609,8 @@ Wrinkles 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] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [arityType for non-recursive let-bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For non-recursive let-bindings, we just get the arityType of the RHS, and extend the environment. That works nicely for things like this (#18793): @@ -1632,11 +1641,24 @@ arity of f? If we inlined the join point, we'd definitely say "arity 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, +Note [arityType for recursive let-bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For /recursive/ bindings it's more difficult, to call arityType +(as we do in Note [arityType for non-recursive let-bindings]) 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. +recursively bound Ids. So for we satisfy ourselves with whizzing up +up an ArityType from the idArity of the function, via idArityType. + +That is nearly equivalent to deleting the binder from the envt, at +which point we'll call idArityType at the occurrences. But doing it +here means + + (a) we only call idArityType once, no matter how many + occurrences, and + + (b) we can check (in the arityType (Var v) case) that + we don't mention free join-point Ids. See + Note [No free join points in arityType]. But see Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils for dark corners. ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1989,11 +1989,13 @@ Obviously `f` should get arity 4. But it's a bit tricky: Note [Arity for non-recursive join bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -So much for recursive join bindings (see previous Note). What about -/non-recursive/ones? If we just call findRhsArity, it 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 +Note [Arity for recursive join bindings] deals with recursive join +bindings. But what about /non-recursive/ones? If we just call +findRhsArity, it 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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5175f2111987eec1cb0ca5a04ab71494b4eefec1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5175f2111987eec1cb0ca5a04ab71494b4eefec1 You're receiving 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 23 16:30:56 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 23 Aug 2022 12:30:56 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Linker: disable logs with default verbosity Message-ID: <630500c0bc57d_e9d7d209eca087095de@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: c73b9b1e by Sylvain Henry at 2022-08-23T18:33:45+02:00 Linker: disable logs with default verbosity - - - - - 1 changed file: - compiler/GHC/StgToJS/Linker/Linker.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -125,7 +125,7 @@ import System.Directory ( createDirectoryIfMissing import GHC.Driver.Session (targetWays_, DynFlags(..)) import Language.Haskell.Syntax.Module.Name import GHC.Unit.Module (moduleStableString) -import GHC.Utils.Logger (Logger) +import GHC.Utils.Logger (Logger, logVerbAtLeast) import GHC.Utils.TmpFs (TmpFs) import GHC.Linker.Static.Utils (exeFileName) @@ -301,7 +301,8 @@ link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFil (archsDepsMap, archsRequiredUnits) <- loadArchiveDeps env =<< getPackageArchives cfg (map snd $ mkPkgLibPaths ue_state pkgs') pkgArchs <- getPackageArchives cfg (map snd $ mkPkgLibPaths ue_state pkgs'') - logInfo logger $ hang (text "Linking with archives:") 2 (vcat (fmap text pkgArchs)) + when (logVerbAtLeast logger 2) $ + logInfo logger $ hang (text "Linking with archives:") 2 (vcat (fmap text pkgArchs)) -- compute dependencies -- FIXME (Sylvain 2022-06): why are we appending the home unit here? @@ -313,8 +314,9 @@ link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFil all_deps <- getDeps (fmap fst dep_map) excluded_units dep_fun_roots dep_unit_roots - logInfo logger $ hang (text "Units to link:") 2 (vcat (fmap ppr dep_units)) - -- logInfo logger $ hang (text "All deps:") 2 (vcat (fmap ppr (S.toList all_deps))) + when (logVerbAtLeast logger 2) $ + logInfo logger $ hang (text "Units to link:") 2 (vcat (fmap ppr dep_units)) + -- logInfo logger $ hang (text "All deps:") 2 (vcat (fmap ppr (S.toList all_deps))) -- retrieve code for dependencies code <- collectDeps dep_map dep_units all_deps View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c73b9b1e5ac480d0faeb5def943ed3411d052c81 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c73b9b1e5ac480d0faeb5def943ed3411d052c81 You're receiving 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 23 17:21:39 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 23 Aug 2022 13:21:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/alpine-fix2 Message-ID: <63050ca3a9abd_e9d7d323c611c71164e@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/alpine-fix2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/alpine-fix2 You're receiving 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 23 18:00:18 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 23 Aug 2022 14:00:18 -0400 Subject: [Git][ghc/ghc][wip/T21623] Unused variable Message-ID: <630515b2d11cf_e9d7d4887872499d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: e4b36fa0 by Simon Peyton Jones at 2022-08-23T18:59:58+01:00 Unused variable - - - - - 1 changed file: - compiler/GHC/Core/Lint.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2312,7 +2312,7 @@ lintCoercion the_co@(SelCo cs co) ; _ -> case (isFunTy s, isFunTy t) of { (True, True) - | SelFun fs <- cs + | SelFun {} <- cs -> return (SelCo cs co') ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4b36fa07c5c91a546aebe5efb042677d4fbc6a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4b36fa07c5c91a546aebe5efb042677d4fbc6a2 You're receiving 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 23 18:16:29 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 23 Aug 2022 14:16:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. Message-ID: <6305197d6255_e9d7d323c611c733946@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - 700e00ed by M Farkas-Dyck at 2022-08-23T14:16:09-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 3172c7b0 by Cheng Shao at 2022-08-23T14:16:11-04:00 driver: don't actually merge objects when ar -L works - - - - - 14 changed files: - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Driver/Pipeline/Execute.hs - hadrian/bindist/Makefile - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - libraries/template-haskell/changelog.md - testsuite/tests/th/T15845.stderr - + testsuite/tests/th/T21723.hs - + testsuite/tests/th/T21723.stdout - + testsuite/tests/th/T21942.hs - + testsuite/tests/th/T21942.stdout - testsuite/tests/th/T9262.stderr - testsuite/tests/th/TH_reifyExplicitForAllFams.stderr - testsuite/tests/th/TH_unresolvedInfix.stdout - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -136,19 +136,18 @@ the unusable strictness-info into the interfaces. data WwOpts = MkWwOpts - -- | Environment of type/data family instances - { wo_fam_envs :: !FamInstEnvs - -- | Options for the "Simple optimiser" - , wo_simple_opts :: !SimpleOpts - -- | Whether to enable "Constructed Product Result" analysis. - -- (Originally from DOI: 10.1017/S0956796803004751) - , wo_cpr_anal :: !Bool - -- | Used for absent argument error message - , wo_module :: !Module - -- | Generate workers even if the only effect is some args get passed - -- unlifted. See Note [WW for calling convention] - , wo_unlift_strict :: !Bool - } + { -- | Environment of type/data family instances + wo_fam_envs :: !FamInstEnvs + , -- | Options for the "Simple optimiser" + wo_simple_opts :: !SimpleOpts + , -- | Whether to enable "Constructed Product Result" analysis. + -- (Originally from DOI: 10.1017/S0956796803004751) + wo_cpr_anal :: !Bool + , -- | Used for absent argument error message + wo_module :: !Module + , -- | Generate workers even if the only effect is some args get passed + -- unlifted. See Note [WW for calling convention] + wo_unlift_strict :: !Bool } type WwResult = ([Demand], -- Demands for worker (value) args ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -1180,7 +1180,7 @@ via gcc. -- | See Note [Object merging]. joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO () joinObjectFiles hsc_env o_files output_fn - | can_merge_objs = do + | can_merge_objs && not dashLSupported = do 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) ( ===================================== hadrian/bindist/Makefile ===================================== @@ -139,7 +139,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 \ ===================================== libraries/template-haskell/Language/Haskell/TH/Ppr.hs ===================================== @@ -23,10 +23,12 @@ nestDepth :: Int nestDepth = 4 type Precedence = Int -appPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence -appPrec = 4 -- Argument of a function application -opPrec = 3 -- Argument of an infix operator -unopPrec = 2 -- Argument of an unresolved infix operator +appPrec, opPrec, unopPrec, funPrec, qualPrec, sigPrec, noPrec :: Precedence +appPrec = 6 -- Argument of a function or type application +opPrec = 5 -- Argument of an infix operator +unopPrec = 4 -- Argument of an unresolved infix operator +funPrec = 3 -- Argument of a function arrow +qualPrec = 2 -- Forall-qualified type or result of a function arrow sigPrec = 1 -- Argument of an explicit type signature noPrec = 0 -- Others @@ -220,7 +222,7 @@ pprExp _ (CompE ss) = pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e - <+> dcolon <+> ppr t + <+> dcolon <+> pprType sigPrec t pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs) pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs) pprExp i (StaticE e) = parensIf (i >= appPrec) $ @@ -792,60 +794,63 @@ pprStrictType :: (Strict, Type) -> Doc pprStrictType = pprBangType ------------------------------ -pprParendType :: Type -> Doc -pprParendType (VarT v) = pprName' Applied v +pprType :: Precedence -> Type -> Doc +pprType _ (VarT v) = pprName' Applied v -- `Applied` is used here instead of `ppr` because of infix names (#13887) -pprParendType (ConT c) = pprName' Applied c -pprParendType (TupleT 0) = text "()" -pprParendType (TupleT 1) = pprParendType (ConT (tupleTypeName 1)) -pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma)) -pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma -pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar -pprParendType ArrowT = parens (text "->") -pprParendType MulArrowT = text "FUN" -pprParendType ListT = text "[]" -pprParendType (LitT l) = pprTyLit l -pprParendType (PromotedT c) = text "'" <> pprName' Applied c -pprParendType (PromotedTupleT 0) = text "'()" -pprParendType (PromotedTupleT 1) = pprParendType (PromotedT (tupleDataName 1)) -pprParendType (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma)) -pprParendType PromotedNilT = text "'[]" -pprParendType PromotedConsT = text "'(:)" -pprParendType StarT = char '*' -pprParendType ConstraintT = text "Constraint" -pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) -pprParendType WildCardT = char '_' -pprParendType t@(InfixT {}) = parens (pprInfixT t) -pprParendType t@(UInfixT {}) = parens (pprInfixT t) -pprParendType t@(PromotedInfixT {}) = parens (pprInfixT t) -pprParendType t@(PromotedUInfixT {}) = parens (pprInfixT t) -pprParendType (ParensT t) = ppr t -pprParendType tuple | (TupleT n, args) <- split tuple - , length args == n - = parens (commaSep args) -pprParendType (ImplicitParamT n t) = text ('?':n) <+> text "::" <+> ppr t -pprParendType EqualityT = text "(~)" -pprParendType t@(ForallT {}) = parens (ppr t) -pprParendType t@(ForallVisT {}) = parens (ppr t) -pprParendType t@(AppT {}) = parens (ppr t) -pprParendType t@(AppKindT {}) = parens (ppr t) - -pprInfixT :: Type -> Doc -pprInfixT = \case - (InfixT x n y) -> with x n y "" ppr - (UInfixT x n y) -> with x n y "" pprInfixT - (PromotedInfixT x n y) -> with x n y "'" ppr - (PromotedUInfixT x n y) -> with x n y "'" pprInfixT - t -> ppr t +pprType _ (ConT c) = pprName' Applied c +pprType _ (TupleT 0) = text "()" +pprType p (TupleT 1) = pprType p (ConT (tupleTypeName 1)) +pprType _ (TupleT n) = parens (hcat (replicate (n-1) comma)) +pprType _ (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma +pprType _ (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar +pprType _ ArrowT = parens (text "->") +pprType _ MulArrowT = text "FUN" +pprType _ ListT = text "[]" +pprType _ (LitT l) = pprTyLit l +pprType _ (PromotedT c) = text "'" <> pprName' Applied c +pprType _ (PromotedTupleT 0) = text "'()" +pprType p (PromotedTupleT 1) = pprType p (PromotedT (tupleDataName 1)) +pprType _ (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma)) +pprType _ PromotedNilT = text "'[]" +pprType _ PromotedConsT = text "'(:)" +pprType _ StarT = char '*' +pprType _ ConstraintT = text "Constraint" +pprType _ (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k) +pprType _ WildCardT = char '_' +pprType p t@(InfixT {}) = pprInfixT p t +pprType p t@(UInfixT {}) = pprInfixT p t +pprType p t@(PromotedInfixT {}) = pprInfixT p t +pprType p t@(PromotedUInfixT {}) = pprInfixT p t +pprType _ (ParensT t) = parens (pprType noPrec t) +pprType p (ImplicitParamT n ty) = + parensIf (p >= sigPrec) $ text ('?':n) <+> text "::" <+> pprType sigPrec ty +pprType _ EqualityT = text "(~)" +pprType p (ForallT tvars ctxt ty) = + parensIf (p >= funPrec) $ sep [pprForall tvars ctxt, pprType qualPrec ty] +pprType p (ForallVisT tvars ty) = + parensIf (p >= funPrec) $ sep [pprForallVis tvars [], pprType qualPrec ty] +pprType p t at AppT{} = pprTyApp p (split t) +pprType p t at AppKindT{} = pprTyApp p (split t) + +------------------------------ +pprParendType :: Type -> Doc +pprParendType = pprType appPrec + +pprInfixT :: Precedence -> Type -> Doc +pprInfixT p = \case + InfixT x n y -> with x n y "" opPrec + UInfixT x n y -> with x n y "" unopPrec + PromotedInfixT x n y -> with x n y "'" opPrec + PromotedUInfixT x n y -> with x n y "'" unopPrec + t -> pprParendType t where - with x n y prefix ppr' = ppr' x <+> text prefix <> pprName' Infix n <+> ppr' y + with x n y prefix p' = + parensIf + (p >= p') + (pprType opPrec x <+> text prefix <> pprName' Infix n <+> pprType opPrec y) instance Ppr Type where - ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty] - ppr (ForallVisT tvars ty) = sep [pprForallVis tvars [], ppr ty] - ppr ty = pprTyApp (split ty) - -- Works, in a degenerate way, for SigT, and puts parens round (ty :: kind) - -- See Note [Pretty-printing kind signatures] + ppr = pprType noPrec instance Ppr TypeArg where ppr (TANormal ty) = parensIf (isStarT ty) (ppr ty) ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki) @@ -866,38 +871,40 @@ parens around it. E.g. the parens are required here: type instance F Int = (Bool :: *) So we always print a SigT with parens (see #10050). -} -pprTyApp :: (Type, [TypeArg]) -> Doc -pprTyApp (MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2]) - | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", ppr arg2] - | c == manyName = sep [pprFunArgType arg1 <+> text "->", ppr arg2] -pprTyApp (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) = - sep [pprFunArgType arg1 <+> text "%" <> ppr argm <+> text "->", ppr arg2] -pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2] -pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) = - sep [pprFunArgType arg1 <+> text "~", ppr arg2] -pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg) -pprTyApp (TupleT 1, args) = pprTyApp (ConT (tupleTypeName 1), args) -pprTyApp (PromotedTupleT 1, args) = pprTyApp (PromotedT (tupleDataName 1), args) -pprTyApp (TupleT n, args) +pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc +pprTyApp p app@(MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2]) + | p >= funPrec = parens (pprTyApp noPrec app) + | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", pprType qualPrec arg2] + | c == manyName = sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2] +pprTyApp p (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) = + parensIf (p >= funPrec) $ + sep [pprFunArgType arg1 <+> text "%" <> pprType appPrec argm <+> text "->", + pprType qualPrec arg2] +pprTyApp p (ArrowT, [TANormal arg1, TANormal arg2]) = + parensIf (p >= funPrec) $ + sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2] +pprTyApp p (EqualityT, [TANormal arg1, TANormal arg2]) = + parensIf (p >= opPrec) $ + sep [pprType opPrec arg1 <+> text "~", pprType opPrec arg2] +pprTyApp _ (ListT, [TANormal arg]) = brackets (pprType noPrec arg) +pprTyApp p (TupleT 1, args) = pprTyApp p (ConT (tupleTypeName 1), args) +pprTyApp _ (TupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = parens (commaSep args') -pprTyApp (PromotedTupleT n, args) +pprTyApp p (PromotedTupleT 1, args) = pprTyApp p (PromotedT (tupleDataName 1), args) +pprTyApp _ (PromotedTupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = quoteParens (commaSep args') -pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args) +pprTyApp p (fun, args) = + parensIf (p >= appPrec) $ pprParendType fun <+> sep (map pprParendTypeArg args) fromTANormal :: TypeArg -> Maybe Type fromTANormal (TANormal arg) = Just arg fromTANormal (TyArg _) = Nothing -pprFunArgType :: Type -> Doc -- Should really use a precedence argument --- Everything except forall and (->) binds more tightly than (->) -pprFunArgType ty@(ForallT {}) = parens (ppr ty) -pprFunArgType ty@(ForallVisT {}) = parens (ppr ty) -pprFunArgType ty@(((MulArrowT `AppT` _) `AppT` _) `AppT` _) = parens (ppr ty) -pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty) -pprFunArgType ty@(SigT _ _) = parens (ppr ty) -pprFunArgType ty = ppr ty +-- Print the type to the left of @->@. Everything except forall and (->) binds more tightly than (->). +pprFunArgType :: Type -> Doc +pprFunArgType = pprType funPrec data ForallVisFlag = ForallVis -- forall a -> {...} | ForallInvis -- forall a. {...} ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,5 +1,10 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.20.0.0 + + * The `Ppr.pprInfixT` function has gained a `Precedence` argument. + * The values of named precedence levels like `Ppr.appPrec` have changed. + ## 2.19.0.0 * Add `DefaultD` constructor to support Haskell `default` declarations. ===================================== testsuite/tests/th/T15845.stderr ===================================== @@ -1,5 +1,5 @@ data family T15845.F1 (a_0 :: *) (b_1 :: *) :: * -data instance forall (a_2 :: *) (b_3 :: *). T15845.F1 ([a_2]) b_3 +data instance forall (a_2 :: *) (b_3 :: *). T15845.F1 [a_2] b_3 = T15845.MkF1 data family T15845.F2 (a_0 :: *) :: * data instance forall (a_1 :: *). T15845.F2 a_1 = T15845.MkF2 ===================================== testsuite/tests/th/T21723.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import Language.Haskell.TH + +main :: IO () +main = do + putStrLn $ pprint (InfixT (ArrowT `AppT` StarT `AppT` StarT) (mkName ":>:") StarT) + putStrLn $ pprint (InfixT (ParensT $ ArrowT `AppT` StarT `AppT` StarT) (mkName ":>:") StarT) ===================================== testsuite/tests/th/T21723.stdout ===================================== @@ -0,0 +1,2 @@ +(* -> *) :>: * +(* -> *) :>: * ===================================== testsuite/tests/th/T21942.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE LinearTypes, TemplateHaskell #-} + +module Main where + +import Language.Haskell.TH + +main :: IO () +main = runQ [t| forall a m n. a %(m n) -> a |] >>= putStrLn . pprint ===================================== testsuite/tests/th/T21942.stdout ===================================== @@ -0,0 +1 @@ +forall a_0 m_1 n_2 . a_0 %(m_1 n_2) -> a_0 ===================================== testsuite/tests/th/T9262.stderr ===================================== @@ -1 +1 @@ -instance GHC.Classes.Eq a_0 => GHC.Classes.Eq ([a_0]) +instance GHC.Classes.Eq a_0 => GHC.Classes.Eq [a_0] ===================================== testsuite/tests/th/TH_reifyExplicitForAllFams.stderr ===================================== @@ -3,13 +3,13 @@ data instance forall (a_1 :: *). TH_reifyExplicitForAllFams.F (GHC.Maybe.Maybe a = TH_reifyExplicitForAllFams.MkF a_1 class TH_reifyExplicitForAllFams.C (a_0 :: *) where {type TH_reifyExplicitForAllFams.G (a_0 :: *) (b_1 :: *) :: *} -instance TH_reifyExplicitForAllFams.C ([a_2]) +instance TH_reifyExplicitForAllFams.C [a_2] type family TH_reifyExplicitForAllFams.G (a_0 :: *) (b_1 :: *) :: * type instance forall (a_2 :: *) - (b_3 :: *). TH_reifyExplicitForAllFams.G ([a_2]) + (b_3 :: *). TH_reifyExplicitForAllFams.G [a_2] b_3 = Data.Proxy.Proxy b_3 type family TH_reifyExplicitForAllFams.H (a_0 :: *) (b_1 :: *) :: * where - forall (x_2 :: *) (y_3 :: *). TH_reifyExplicitForAllFams.H ([x_2]) + forall (x_2 :: *) (y_3 :: *). TH_reifyExplicitForAllFams.H [x_2] (Data.Proxy.Proxy y_3) = Data.Either.Either x_2 y_3 forall (z_4 :: *). TH_reifyExplicitForAllFams.H z_4 ===================================== testsuite/tests/th/TH_unresolvedInfix.stdout ===================================== @@ -44,5 +44,5 @@ N :+ (N :+ N :+ N) (N) N :+ (N :+ N :+ N) (N) -(Int + (Int + Int + Int)) -Int +Int + (Int + (Int + Int)) +(Int) ===================================== testsuite/tests/th/all.T ===================================== @@ -553,3 +553,5 @@ test('T20711', normal, compile_and_run, ['']) test('T20868', normal, compile_and_run, ['']) test('Lift_ByteArray', normal, compile_and_run, ['']) test('T21920', normal, compile_and_run, ['']) +test('T21723', normal, compile_and_run, ['']) +test('T21942', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fa7e1c02752b6be391c7c76825979e6dc7b969e3...3172c7b0807a8a27b54ac4ff139e1b69d68609cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fa7e1c02752b6be391c7c76825979e6dc7b969e3...3172c7b0807a8a27b54ac4ff139e1b69d68609cf You're receiving 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 23 21:34:46 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 23 Aug 2022 17:34:46 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Append program name in top-level exception handler Message-ID: <630547f6cc6f5_e9d7d323c611c759462@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: f87da962 by Sylvain Henry at 2022-08-23T23:37:32+02:00 Append program name in top-level exception handler - - - - - 1 changed file: - js/environment.js.pp Changes: ===================================== js/environment.js.pp ===================================== @@ -266,9 +266,15 @@ function h$errorMsg(pat) { str = str.replace(/%s/, arguments[i]); } #ifndef GHCJS_BROWSER + // basename that only works on Linux for now... + function basename(path) { + return path.split('/').reverse()[0]; + } if(h$isGHCJSi) { // ignore message } else if(h$isNode) { + // append program name + str = basename(process.argv[1]) + ": " + str; process.stderr.write(str); } else if (h$isJsShell && typeof printErr !== 'undefined') { if(str.length) printErr(stripTrailingNewline(str)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f87da962482797e2a7c902e4fae7348c5914c0a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f87da962482797e2a7c902e4fae7348c5914c0a3 You're receiving 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 23 22:23:00 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 23 Aug 2022 18:23:00 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles Message-ID: <6305534472704_e9d7d2bec860c7622e9@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: a7c161b7 by Simon Peyton Jones at 2022-08-23T23:23:17+01:00 Wibbles - - - - - 6 changed files: - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Id/Make.hs - testsuite/tests/typecheck/should_run/TypeOf.stdout - testsuite/tests/typecheck/should_run/TypeRep.stdout Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1124,6 +1124,7 @@ mkScaledFunTys tys ty = foldr (mkScaledFunTy af) ty tys tcMkScaledFunTys :: [Scaled Type] -> Type -> Type -- All visible args -- Result type must be TypeLike +-- No mkFunTy assert checking; result kind may not be zonked tcMkScaledFunTys tys ty = foldr mk ty tys where mk (Scaled mult arg) res = tcMkVisFunTy mult arg res ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -3970,7 +3970,7 @@ tcHsPartialSigType ctxt sig_ty -- No kind-generalization here: ; kindGeneralizeNone (mkInvisForAllTys outer_tv_bndrs $ - mkPhiTy theta $ + tcMkPhiTy theta $ tau) -- Spit out the wildcards (including the extra-constraints one) ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -3415,8 +3415,8 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map ; let tc_tvs = binderVars tc_bndrs fake_ty = mkSpecForAllTys tc_tvs $ mkInvisForAllTys exp_tvbndrs $ - mkPhiTy ctxt $ - tcMkScaledFunTys arg_tys $ + tcMkPhiTy ctxt $ + tcMkScaledFunTys arg_tys $ unitTy -- That type is a lie, of course. (It shouldn't end in ()!) -- And we could construct a proper result type from the info @@ -3521,8 +3521,8 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map ; tkvs <- kindGeneralizeAll skol_info (mkInvisForAllTys outer_tv_bndrs $ - mkPhiTy ctxt $ - tcMkScaledFunTys arg_tys $ + tcMkPhiTy ctxt $ + tcMkScaledFunTys arg_tys $ res_ty) ; traceTc "tcConDecl:GADT" (ppr names $$ ppr res_ty $$ ppr tkvs) ; reportUnsolvedEqualities skol_info tkvs tclvl wanted ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -310,14 +310,15 @@ for symmetry with the way data instances are handled. Note [Newtype datacons] ~~~~~~~~~~~~~~~~~~~~~~~ -The "data constructor" for a newtype should always be vanilla. At one -point this wasn't true, because the newtype arising from +The "data constructor" for a newtype should have no existentials. It's +not quite a "vanilla" data constructor, because the newtype arising from class C a => D a -looked like - newtype T:D a = D:D (C a) -so the data constructor for T:C had a single argument, namely the -predicate (C a). But now we treat that as an ordinary argument, not -part of the theta-type, so all is well. +looks like + newtype T:D a = C:D (C a) +so the data constructor for T:C has a single argument, namely the +predicate (C a). That ends up in the dcOtherTheta for the data con, +which makes it not vanilla. So the assert just tests for existentials. +The rest is checked by having a singleton arg_tys. Note [Newtype workers] ~~~~~~~~~~~~~~~~~~~~~~ @@ -590,8 +591,10 @@ mkDataConWorkId wkr_name data_con wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con + ex_tcvs = dataConExTyCoVars data_con arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo `setArityInfo` 1 -- Arity 1 @@ -599,8 +602,8 @@ mkDataConWorkId wkr_name data_con `setUnfoldingInfo` newtype_unf id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs - newtype_unf = assertPpr (isVanillaDataCon data_con && isSingleton arg_tys) - (ppr data_con) $ + newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) + (ppr data_con) -- Note [Newtype datacons] mkCompulsoryUnfolding defaultSimpleOpts $ mkLams univ_tvs $ Lam id_arg1 $ ===================================== testsuite/tests/typecheck/should_run/TypeOf.stdout ===================================== @@ -9,7 +9,7 @@ SomeTypeRep Bool Ordering Int -> Int -Proxy Constraint (Eq Int) +Proxy (CONSTRAINT ('BoxedRep 'Lifted)) (Eq Int) Proxy * (Int,Int) Proxy Symbol "hello world" Proxy Natural 1 @@ -24,4 +24,4 @@ Proxy Levity 'Lifted Proxy Levity 'Unlifted Proxy RuntimeRep ('BoxedRep 'Lifted) Proxy (Natural,Symbol) ('(,) Natural Symbol 1 "hello") -Proxy (* -> * -> Constraint) ((~~) * *) +Proxy (* -> * -> CONSTRAINT ('BoxedRep 'Lifted)) ((~~) * *) ===================================== testsuite/tests/typecheck/should_run/TypeRep.stdout ===================================== @@ -14,7 +14,7 @@ Int -> Int Int# (##) (#,#) 'IntRep ('BoxedRep 'Lifted) Int# Int -Proxy Constraint (Eq Int) +Proxy (CONSTRAINT ('BoxedRep 'Lifted)) (Eq Int) Proxy * (Int,Int) Proxy Symbol "hello world" Proxy Natural 1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c161b7d5bb12110204852fdb3fcbb5907cbd17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c161b7d5bb12110204852fdb3fcbb5907cbd17 You're receiving 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 24 00:17:15 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Tue, 23 Aug 2022 20:17:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/extension-ppr-module Message-ID: <63056e0ba91a6_e9d7d36163a747753e@gitlab.mail> Dominik Peteler pushed new branch wip/extension-ppr-module at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/extension-ppr-module You're receiving 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 24 00:19:31 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Tue, 23 Aug 2022 20:19:31 -0400 Subject: [Git][ghc/ghc][wip/js-staging] GHC.JS: Remove FIXMEs Message-ID: <63056e9370e67_e9d7d4d1d4775537@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 9e31bb0f by doyougnu at 2022-08-23T20:19:16-04:00 GHC.JS: Remove FIXMEs JS.Syntax: Remove FIXMEs JS.Make: remove FIXMEs JS.Ppr/Transform: Remove FIXMEs - - - - - 4 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -159,7 +159,6 @@ import GHC.Types.Unique.Map -- Instantiate for any necessary data structures. class ToJExpr a where toJExpr :: a -> JExpr - -- FIXME: Jeff (2022,05): Convert list to Foldable toJExprFromList :: [a] -> JExpr toJExprFromList = ValExpr . JList . map toJExpr @@ -173,8 +172,6 @@ instance ToJExpr () where toJExpr _ = ValExpr $ JList [] instance ToJExpr Bool where - -- FIXME: Jeff (2022,05): these 'var "true"' and 'var "false"' should be - -- constants instead of created on the fly toJExpr True = var "true" toJExpr False = var "false" @@ -231,7 +228,6 @@ class ToStat a where instance ToStat JStat where toStat = id --- FIXME: Jeff (2022,05): Convert list to Foldable instance ToStat [JStat] where toStat = BlockStat @@ -327,7 +323,6 @@ jhSingle k v = jhAdd k v jhEmpty jhAdd :: (Ord k, ToJExpr a) => k -> a -> M.Map k JExpr -> M.Map k JExpr jhAdd k v m = M.insert k (toJExpr v) m --- FIXME: Jeff (2022,05): remove list for foldable and specialize -- | Construct a JS HashMap from a list of key-value pairs jhFromList :: [(FastString, JExpr)] -> JVal jhFromList = JHash . listToUniqMap @@ -418,7 +413,6 @@ if10 e = IfExpr e one_ zero_ if01 :: JExpr -> JExpr if01 e = IfExpr e zero_ one_ --- FIXME: Jeff (2022,05): Shouldn't app take an Ident? -- | an expression application, see related 'appS' -- -- > app f xs ==> f(xs) @@ -633,8 +627,6 @@ instance Fractional JExpr where -- $misc -- Everything else, --- FIXME: Jeff (2022,05): Consider moving these - -- | Cache "dXXX" field names dataFieldCache :: Array Int FastString dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache]) @@ -674,9 +666,6 @@ allocClsA i = toJExpr (TxtI (clsCache ! i)) class ToSat a where toSat_ :: a -> [Ident] -> IdentSupply (JStat, [Ident]) --- FIXME: Jeff (2022,05): Remove list to avoid reversals. Obviously ordering is --- important since we need to reverse so lets use a data structure that produces --- the correct ordering even if that structure is a bankers queue instance ToSat [JStat] where toSat_ f vs = IS $ return $ (BlockStat f, reverse vs) @@ -689,12 +678,8 @@ instance ToSat JExpr where instance ToSat [JExpr] where toSat_ f vs = IS $ return $ (BlockStat $ map expr2stat f, reverse vs) --- FIXME: Jeff (2022,05): Why type equality and not ToExpr? Also why is the type --- signature written like a profunctor lmap? instance (ToSat a, b ~ JExpr) => ToSat (b -> a) where toSat_ f vs = IS $ do - -- FIXME Jeff (2022,05): We pop an Ident just to wrap into a JVar and then - -- push the Ident back onto the Ident stream. Why not just peek? x <- takeOneIdent runIdentSupply $ toSat_ (f (ValExpr $ JVar x)) (x:vs) @@ -707,13 +692,6 @@ expr2stat (IfExpr x y z) = IfStat x (expr2stat y) (expr2stat z) expr2stat (UOpExpr o x) = UOpStat o x expr2stat _ = nullStat --- FIXME: Jeff (2022,05): This function checks for an empty list via the case --- expression. That the empty case produces an error indicates that this list --- should be 'NonEmpty'. The fix is to change this type to a NonEmpty list, then --- when we initialize the environment we /begin/ with a List: [], but once we --- add the very first ident we convert the list to a NonEmpty. If you check the --- definition of 'JS.Syntax.newIdentSupply' you'll see that this error case can --- actually never happen. So we should encode that in the type system! takeOneIdent :: State [Ident] Ident takeOneIdent = do xxs <- get ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -52,7 +52,6 @@ instance Outputable JVal where ($$$) :: Doc -> Doc -> Doc ---x $$$ y = align (nest 2 $ x $+$ y) -- FIXME (Sylvain, 2022/02) x $$$ y = nest 2 $ x $+$ y -- | Render a syntax tree as a pretty-printable document @@ -92,8 +91,6 @@ braceNest x = char '{' <+> nest 2 x $$ char '}' braceNest' :: Doc -> Doc braceNest' x = nest 2 (char '{' $+$ x) $$ char '}' --- FIXME: Jeff (2022,03): better naming of braceNest'' functions. Stop the --- madness! -- somewhat more compact (egyptian style) braces braceNest'' :: Doc -> Doc braceNest'' x = nest 2 (char '{' $$ x) $$ char '}' ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -105,35 +105,6 @@ import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map --- 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 --- will only evaluate to the first cons cell, i.e., we will be spine strict but --- store possible huge thunks. This isn't a problem as long as we use this list --- as a stack, but if we don't then any kind of Functor or Traverse operation --- over this state will yield a lot of thunks. --- --- FIXME: Jeff (2022,05): IdentSupply is quite weird, it is used in --- GHC.JS.Make.ToSat to record new identifiers but uses a list which could be --- empty, even though the empty case has no denotation in the domain (i.e. it is --- a meaningless case!) and sure enough newIdentSupply makes sure we can never --- hit this case! But it is even /more/ weird because it is a wrapper around a --- state monad /that doesn't/ itself instantiate a state monad! So we end up --- with a lot of weird unboxing, boxing, and running of this "monad". It is --- almost as if it wants to redefine 'MonadTransControl'! The situation gets --- even /more/ weird when you look at the 'GHC.JS.Make.ToSat', which has --- numerous problems: it isn't polymorphic over the "IdentSupply" monad, of the --- instances it defines there is only one that is monadic, it has 7 call sites --- in JS.Make and /each one/ is fed to 'runIdentSupply'. Basically we have a --- monad that is never called a monad and so is run all over the place to get --- non-monadic (although still pure) values back out. To make matters worse our --- ASTs embed this monad statically! See the UnsatFoo constuctors in JExpr, --- JStat, and JVal. Why do my ASTs know anything about the state of the --- interpreter!? This is quite the confusion. It confuses the AST with the code --- that interprets the AST. The fix is to just derive the state monad with --- generalized newtype deriving and derivingStrategies, and swap this list out --- for something that is NonEmpty and doesn't need to be reversed all the time! --- And clean up the mess in the ASTs. - -- | A supply of identifiers, possibly empty newtype IdentSupply a = IS {runIdentSupply :: State [Ident] a} @@ -153,8 +124,6 @@ newIdentSupply (Just pfx) = [ TxtI (mconcat [pfx,"_",mkFastString (show x)]) | x <- [(0::Word64)..] ] --- FIXME: Jeff (2022,05): Create note for reason behind pseudoSaturate --- FIXME: Jeff (2022,05): make "<>" a constant -- | Given a Pseudo-saturate a value with garbage @<>@ identifiers. pseudoSaturate :: IdentSupply a -> a pseudoSaturate x = evalState (runIdentSupply x) $ newIdentSupply (Just "<>") @@ -170,19 +139,6 @@ instance Show a => Show (IdentSupply a) where -------------------------------------------------------------------------------- -- Statements -------------------------------------------------------------------------------- --- FIXME: Jeff (2022,05): TryStat only conforms to the largest case of the --- standard. See [try](https://tc39.es/ecma262/#sec-try-statement), notice that --- we only encode the case where we have: try BLOCK IDENT BLOCK BLOCK, where the --- inner IDENT BLOCK is actually the Catch production rule. Because we've opted --- to deeply embed only a single case we are under-specifying the other cases --- and probably have to check for empty JStats to know which case the TryStat --- will be. We should partition this out into its own data type. - --- FIXME: Jeff (2022,05) Remove the Bools in For and While for real data types - --- FIXME: Jeff (2022,05): Why is Application a statement and not an expression? --- Same for Unary Operators. I guess because these are side-effectual in JS? - -- | JavaScript statements, see the [ECMA262 -- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations) -- for details @@ -211,8 +167,6 @@ type JsLabel = LexicalFastString instance Semigroup JStat where (<>) = appendJStat --- FIXME (Sylvain, 2022/03): should we use OrdList instead of lists in --- BlockStat? instance Monoid JStat where mempty = BlockStat [] @@ -234,9 +188,6 @@ appendJStat mx my = case (mx,my) of -------------------------------------------------------------------------------- -- Expressions -------------------------------------------------------------------------------- --- FIXME: annotate expressions with type. This is an EDSL of JS ASTs in Haskell. --- There are many approaches to leveraging the GHCs type system for correctness --- guarentees in EDSLs and we should use them -- | JavaScript Expressions data JExpr = ValExpr JVal -- ^ All values are trivially expressions @@ -458,9 +409,6 @@ jsKeywords = Set.fromList $ TxtI <$> , "null", "true", "false" ] --- FIXME (Jeff, 2022/05): This predicate should be encoded in the type system as --- a newtype over Ident. Basically we should be using nominal typing so that a --- regular Ident can never be confused with a Keyword -- | Predicate which checks if input 'Ident' is a JS keyword or not. isJsKeyword :: Ident -> Bool isJsKeyword = flip Set.member jsKeywords ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -79,7 +79,6 @@ mapIdent f = (map_expr, map_stat) JHash me -> ValExpr $ JHash (fmap map_expr me) JFunc is s -> ValExpr $ JFunc is (map_stat s) UnsatVal v2 -> ValExpr $ UnsatVal v2 - -- FIXME: shouldn't we transform this into `UnsatExpr (map_val v2)`? map_stat s = case s of DeclStat{} -> s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e31bb0fb8fa192b6456ed0ce1fffa3c315c46d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e31bb0fb8fa192b6456ed0ce1fffa3c315c46d4 You're receiving 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 24 00:46:57 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 23 Aug 2022 20:46:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Message-ID: <630575018558d_e9d7d48878777721@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 30c0010e by M Farkas-Dyck at 2022-08-23T20:46:41-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 197c0318 by Cheng Shao at 2022-08-23T20:46:43-04:00 driver: don't actually merge objects when ar -L works - - - - - 41ff6a6f by Ben Gamari at 2022-08-23T20:46:43-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 3 changed files: - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Driver/Pipeline/Execute.hs - rts/Stats.c Changes: ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -136,19 +136,18 @@ the unusable strictness-info into the interfaces. data WwOpts = MkWwOpts - -- | Environment of type/data family instances - { wo_fam_envs :: !FamInstEnvs - -- | Options for the "Simple optimiser" - , wo_simple_opts :: !SimpleOpts - -- | Whether to enable "Constructed Product Result" analysis. - -- (Originally from DOI: 10.1017/S0956796803004751) - , wo_cpr_anal :: !Bool - -- | Used for absent argument error message - , wo_module :: !Module - -- | Generate workers even if the only effect is some args get passed - -- unlifted. See Note [WW for calling convention] - , wo_unlift_strict :: !Bool - } + { -- | Environment of type/data family instances + wo_fam_envs :: !FamInstEnvs + , -- | Options for the "Simple optimiser" + wo_simple_opts :: !SimpleOpts + , -- | Whether to enable "Constructed Product Result" analysis. + -- (Originally from DOI: 10.1017/S0956796803004751) + wo_cpr_anal :: !Bool + , -- | Used for absent argument error message + wo_module :: !Module + , -- | Generate workers even if the only effect is some args get passed + -- unlifted. See Note [WW for calling convention] + wo_unlift_strict :: !Bool } type WwResult = ([Demand], -- Demands for worker (value) args ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -1180,7 +1180,7 @@ via gcc. -- | See Note [Object merging]. joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO () joinObjectFiles hsc_env o_files output_fn - | can_merge_objs = do + | can_merge_objs && not dashLSupported = do 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) ( ===================================== rts/Stats.c ===================================== @@ -839,7 +839,7 @@ static void report_summary(const RTSSummaryStats* sum) statsPrintf("%16s bytes maximum slop\n", temp); statsPrintf("%16" FMT_Word64 " MiB total memory in use (%" - FMT_Word64 " MB lost due to fragmentation)\n\n", + FMT_Word64 " MiB lost due to fragmentation)\n\n", stats.max_mem_in_use_bytes / (1024 * 1024), sum->fragmentation_bytes / (1024 * 1024)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3172c7b0807a8a27b54ac4ff139e1b69d68609cf...41ff6a6f1c9d8b8d23b81a1d3e3a8c195505fb53 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3172c7b0807a8a27b54ac4ff139e1b69d68609cf...41ff6a6f1c9d8b8d23b81a1d3e3a8c195505fb53 You're receiving 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 24 06:37:24 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 Aug 2022 02:37:24 -0400 Subject: [Git][ghc/ghc][master] Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Message-ID: <6305c72481c0a_e9d7d3d103bf48133ca@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 1 changed file: - compiler/GHC/Core/Opt/WorkWrap/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -136,19 +136,18 @@ the unusable strictness-info into the interfaces. data WwOpts = MkWwOpts - -- | Environment of type/data family instances - { wo_fam_envs :: !FamInstEnvs - -- | Options for the "Simple optimiser" - , wo_simple_opts :: !SimpleOpts - -- | Whether to enable "Constructed Product Result" analysis. - -- (Originally from DOI: 10.1017/S0956796803004751) - , wo_cpr_anal :: !Bool - -- | Used for absent argument error message - , wo_module :: !Module - -- | Generate workers even if the only effect is some args get passed - -- unlifted. See Note [WW for calling convention] - , wo_unlift_strict :: !Bool - } + { -- | Environment of type/data family instances + wo_fam_envs :: !FamInstEnvs + , -- | Options for the "Simple optimiser" + wo_simple_opts :: !SimpleOpts + , -- | Whether to enable "Constructed Product Result" analysis. + -- (Originally from DOI: 10.1017/S0956796803004751) + wo_cpr_anal :: !Bool + , -- | Used for absent argument error message + wo_module :: !Module + , -- | Generate workers even if the only effect is some args get passed + -- unlifted. See Note [WW for calling convention] + wo_unlift_strict :: !Bool } type WwResult = ([Demand], -- Demands for worker (value) args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b929063ec5473fc36fe3976ff0eb8064a2d2fc3d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b929063ec5473fc36fe3976ff0eb8064a2d2fc3d You're receiving 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 24 06:37:50 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 Aug 2022 02:37:50 -0400 Subject: [Git][ghc/ghc][master] driver: don't actually merge objects when ar -L works Message-ID: <6305c73ede4dd_e9d7d36163a74816966@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - 1 changed file: - compiler/GHC/Driver/Pipeline/Execute.hs Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -1180,7 +1180,7 @@ via gcc. -- | See Note [Object merging]. joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO () joinObjectFiles hsc_env o_files output_fn - | can_merge_objs = do + | can_merge_objs && not dashLSupported = do 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) ( View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/112e4f9c9c299b460e37a60d8f8d8693aa6ab06a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/112e4f9c9c299b460e37a60d8f8d8693aa6ab06a You're receiving 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 24 06:38:28 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 Aug 2022 02:38:28 -0400 Subject: [Git][ghc/ghc][master] rts: Consistently use MiB in stats output Message-ID: <6305c7649c1c2_e9d7d4d1d48203c5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 1 changed file: - rts/Stats.c Changes: ===================================== rts/Stats.c ===================================== @@ -839,7 +839,7 @@ static void report_summary(const RTSSummaryStats* sum) statsPrintf("%16s bytes maximum slop\n", temp); statsPrintf("%16" FMT_Word64 " MiB total memory in use (%" - FMT_Word64 " MB lost due to fragmentation)\n\n", + FMT_Word64 " MiB lost due to fragmentation)\n\n", stats.max_mem_in_use_bytes / (1024 * 1024), sum->fragmentation_bytes / (1024 * 1024)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9f0e68ede36ad571d32e66a8e49e8c9f3b6a92b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9f0e68ede36ad571d32e66a8e49e8c9f3b6a92b You're receiving 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 24 09:28:22 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 24 Aug 2022 05:28:22 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] Only use needBuilders Message-ID: <6305ef36ab2c8_e9d7d268fc2508580fa@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: f05fbdd6 by Matthew Pickering at 2022-08-24T10:28:14+01:00 Only use needBuilders - - - - - 2 changed files: - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs Changes: ===================================== hadrian/src/Builder.hs ===================================== @@ -6,7 +6,7 @@ module Builder ( TarMode (..), GitMode (..), Builder (..), Win32TarballsMode(..), -- * Builder properties - builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, needBuilders, + builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilders, runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath, builderEnvironment, @@ -266,7 +266,7 @@ instance H.Builder Builder where GhcPkg Dependencies _ -> do let input = fromSingleton msgIn buildInputs msgIn = "[askBuilder] Exactly one input file expected." - needBuilder builder + needBuilders [builder] path <- H.builderPath builder -- we do not depend on bare builders. E.g. we won't depend on `clang` -- or `ld` or `ar`. Unless they are provided with fully qualified paths @@ -484,7 +484,7 @@ isSpecified = fmap (not . null) . systemBuilderPath applyPatch :: FilePath -> FilePath -> Action () applyPatch dir patch = do let file = dir -/- patch - needBuilder Patch + needBuilders [Patch] path <- builderPath Patch putBuild $ "| Apply patch " ++ file quietly $ cmd' [Cwd dir, FileStdin file] [path, "-p0"] ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -12,7 +12,7 @@ -- functions that can be used to invoke builders. ----------------------------------------------------------------------------- module Hadrian.Builder ( - Builder (..), BuildInfo (..), needBuilder, needBuilders, runBuilder, + Builder (..), BuildInfo (..), needBuilders, runBuilder, runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions, getBuilderPath, builderEnvironment, askWithResources ) where @@ -58,16 +58,12 @@ class ShakeValue b => Builder b where runBuilderWith :: b -> BuildInfo -> Action () runBuilderWith builder buildInfo = do let args = buildArgs buildInfo - needBuilder builder + needBuilders [builder] path <- builderPath builder let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")" putBuild $ "| Run " ++ show builder ++ msg quietly $ cmd (buildOptions buildInfo) [path] args --- | Make sure a builder and its runtime dependencies are up-to-date. -needBuilder :: Builder b => b -> Action () -needBuilder builder = needBuilders [builder] - needBuilders :: Builder b => [b] -> Action () needBuilders bs = do paths <- mapM builderPath bs @@ -117,7 +113,7 @@ doWith :: (Builder b, ShakeValue c) -> (Target c b -> Action ()) -> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a doWith f info rs opts target args = do - needBuilder (builder target) + needBuilders [builder target] argList <- interpret target args trackArgsHash target -- Rerun the rule if the hash of argList has changed. info target @@ -163,6 +159,6 @@ getBuilderPath = expr . builderPath -- | Write a builder path into a given environment variable. builderEnvironment :: Builder b => String -> b -> Action CmdOption builderEnvironment variable builder = do - needBuilder builder + needBuilders [builder] path <- builderPath builder return $ AddEnv variable path View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f05fbdd61733b7275ecf8bccf61ebdf8d0e145d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f05fbdd61733b7275ecf8bccf61ebdf8d0e145d0 You're receiving 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 24 09:55:28 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 24 Aug 2022 05:55:28 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] 30 commits: Implement Response File support for HPC Message-ID: <6305f590b0df7_e9d7d4d1d4864716@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final 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 - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 17fad5ce by Matthew Pickering at 2022-08-24T10:42:21+01:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - dfe8ca3c by Matthew Pickering at 2022-08-24T10:47:08+01:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 7a979b27 by Matthew Pickering at 2022-08-24T10:50:44+01:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - 72d0aef8 by Matthew Pickering at 2022-08-24T10:55:17+01:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - 094ed61a by Matthew Pickering at 2022-08-24T10:55:17+01:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 30 changed files: - .gitlab/ci.sh - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap/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/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Var.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Context/Type.hs - hadrian/src/Hadrian/Builder.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f05fbdd61733b7275ecf8bccf61ebdf8d0e145d0...094ed61a860e5f5821cac164fae8a29fc74819d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f05fbdd61733b7275ecf8bccf61ebdf8d0e145d0...094ed61a860e5f5821cac164fae8a29fc74819d3 You're receiving 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 24 10:16:54 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 24 Aug 2022 06:16:54 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Primop: fix timesInt2# Message-ID: <6305fa962c18e_e9d7d4887887144@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 61dadc50 by Sylvain Henry at 2022-08-24T12:19:51+02:00 Primop: fix timesInt2# Pass arith003 test - - - - - 1 changed file: - js/arith.js.pp Changes: ===================================== js/arith.js.pp ===================================== @@ -389,8 +389,6 @@ var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim; function h$hs_timesInt2(a,b) { TRACE_ARITH("timesInt2 " + a + " " + b); - // adapted from Hacker's Delight (p174) - // check for 0 and 1 operands if (a === 0) { RETURN_UBX_TUP3(0,0,0); @@ -405,22 +403,11 @@ function h$hs_timesInt2(a,b) { RETURN_UBX_TUP3(0,a<0?(-1):0,a); } - var cl = h$mulInt32(a,b); - - var ha = a >> 16; - var la = a & 0xFFFF; - - var hb = b >> 16; - var lb = b & 0xFFFF; - - var w0 = la * lb; - var t = (h$mulInt32(ha,lb) + (w0 >>> 16))|0; - var w1 = t & 0xFFFF; - var w2 = t >> 16; - w1 = (h$mulInt32(la,hb) + w1)|0; - - var ch = ((h$mulInt32(ha,hb) + w2)|0 + (w1 >> 16))|0; - var nh = ((ch === 0 && cl >= 0) || (ch === -1 && cl < 0)) ? 0 : 1 + var ha = a < 0 ? (-1) : 0; + var hb = b < 0 ? (-1) : 0; + var ch = h$hs_timesInt64(ha,a,hb,b); + var cl = h$ret1; + 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); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61dadc50b4fe31a3f53e36505e39895c458c516a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61dadc50b4fe31a3f53e36505e39895c458c516a You're receiving 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 24 13:28:56 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Wed, 24 Aug 2022 09:28:56 -0400 Subject: [Git][ghc/ghc][wip/js-staging] JS.Linker.Linker: remove FIXMEs, clean dead code Message-ID: <6306279874829_e9d7d247d11ac93384c@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 57f5ff0c by doyougnu at 2022-08-24T09:28:34-04:00 JS.Linker.Linker: remove FIXMEs, clean dead code - - - - - 1 changed file: - compiler/GHC/StgToJS/Linker/Linker.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -18,39 +18,6 @@ -- GHCJS linker, collects dependencies from the object files (.js_o, js_p_o), -- which contain linkable units with dependency information -- ------------------------------ FIXMEs ------------------------------------------- --- FIXME: Jeff (2022,03): Finish module description. Specifically: --- 1. What are the important modules this module uses --- 2. Who is the consumer for this module (hint: DynamicLinking) --- 3. What features are missing due to the implementation in this module? For --- example, Are we blocked from linking foreign imports due to some code in this --- module? --- --- - add ForeignRefs imports in @link@ --- - factor out helper functions in @link'@ --- - remove @head@ function in @link'@ --- - remove @ue_unsafeHomeUnit@ function in @link'@ --- - use newtypes instead of strings for output directories in @writeRunner@ --- - add support for windows in @writeRunner@ --- - resolve strange unpack call in @writeExterns@ the right thing to do here --- might be to just remove it --- - fix: @collectDeps@ inputs a [UnitId], but [] is unordered yet comments in --- @collectDeps@ indicate a specific ordering is needed. This ordering --- should be enforced in some data structure other than [] which is --- obviously ordered but in an undefined and ad-hoc way --- - fix: For most of the Linker I pass around UnitIds, I (Jeff) am unsure if --- these should really be modules. Or to say this another way is UnitId the --- right abstraction level? Or is Module? Or some other unit thing? --- - fix: Gen2.GHCJS used NFData instances over a lot of types. Replicating --- these instances would mean adding a Generic and NFData instance to some --- internal GHC types. I (Jeff) do not think we want to do that. Instead, we --- should use strict data structures as a default and then implement lazy --- ones where it makes sense and only if it makes sense. IMHO Gen2.GHCJS was --- overly lazy and we should avoid repeating that here. Let profiling be our --- guide during our performance refactoring. --- - Employ the type system more effectively for @readSystemDeps'@, in --- particular get rid of the string literals --- - fix foldl' memory leak in @staticDeps@ ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Linker where @@ -182,13 +149,6 @@ link env lc_cfg cfg logger tmpfs dflags unit_env out include pkgs objFiles jsFil -- dump foreign references file (.frefs) unless (lcOnlyOut lc_cfg) $ do let frefsFile = if genBase then "out.base.frefs" else "out.frefs" - -- FIXME: Jeff (2022,03): GHCJS used Aeson to encode Foreign - -- references as StaticDeps to a Bytestring and then write these out - -- to a tmp file for linking. We do not have access to Aeson so - -- we'll need to find an alternative coding strategy to write these - -- out. See the commented instance for FromJSON StaticDeps below. - -- - this line called out to the FromJSon Instance - -- jsonFrefs = Aeson.encode (linkForeignRefs link_res) jsonFrefs = mempty BL.writeFile (out frefsFile <.> "json") jsonFrefs @@ -239,8 +199,6 @@ link env lc_cfg cfg logger tmpfs dflags unit_env out include pkgs objFiles jsFil writeHtml out writeRunMain out writeRunner lc_cfg out - -- FIXME (Sylvain 2022-05): disabled for now - -- writeWebAppManifest top out writeExterns out -- | link in memory @@ -260,17 +218,12 @@ link' :: GhcjsEnv -> IO LinkResult link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFiles isRootFun extraStaticDeps = do - -- FIXME: Jeff (2022,04): This function has several helpers that should be - -- factored out. In its current condition it is hard to read exactly whats - -- going on and why. (objDepsMap, objRequiredUnits) <- loadObjDeps objFiles let rootSelector | Just baseMod <- lcGenBase lc_cfg = \(ExportedFun m _s) -> m == baseMod | otherwise = isRootFun roots = S.fromList . filter rootSelector $ concatMap (M.keys . depsHaskellExported . fst) (M.elems objDepsMap) - -- FIXME: Jeff (2022,03): Remove head. opt for NonEmptyList. Every - -- head is a time bomb waiting to explode rootMods = map (moduleNameString . moduleName . head) . group . sort . map funModule . S.toList $ roots objPkgs = map moduleUnitId $ nub (M.keys objDepsMap) @@ -289,7 +242,6 @@ link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFil -- c <- newMVar M.empty let preload_units = preloadUnits (ue_units unit_env) - -- FIXME (Sylvain 2022-06): what are these "@rts" units? let rtsPkgs = map stringToUnitId ["@rts", "@rts_" ++ waysTag (targetWays_ $ dflags)] pkgs' :: [UnitId] pkgs' = nub (rtsPkgs ++ preload_units ++ rdPkgs ++ reverse objPkgs ++ reverse pkgs) @@ -305,8 +257,7 @@ link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFil logInfo logger $ hang (text "Linking with archives:") 2 (vcat (fmap text pkgArchs)) -- compute dependencies - -- FIXME (Sylvain 2022-06): why are we appending the home unit here? - let dep_units = pkgs' ++ [homeUnitId (ue_unsafeHomeUnit $ unit_env)] -- FIXME: dont use unsafe + let dep_units = pkgs' ++ [homeUnitId (ue_unsafeHomeUnit $ unit_env)] dep_map = objDepsMap `M.union` archsDepsMap excluded_units = baseUnits base -- already linked units dep_fun_roots = roots `S.union` rds `S.union` extraStaticDeps @@ -326,9 +277,6 @@ link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFil base' = Base compactorState (nub $ basePkgs base ++ pkgs'') (all_deps `S.union` baseUnits base) - -- FIXME: (Sylvain, 2022-05): disabled because it comes from shims. - -- (alreadyLinkedBefore, alreadyLinkedAfter) <- getShims [] (filter (isAlreadyLinked base) pkgs') - -- (shimsBefore, shimsAfter) <- getShims jsFiles pkgs'' return $ LinkResult { linkOut = outJs , linkOutStats = stats @@ -389,8 +337,6 @@ renderLinker settings cfg renamer_state rtsDeps code = rendered_mods = fmap render_js compacted rendered_meta = render_js meta render_js = BC.pack . (<>"\n") . show . pretty - -- FIXME (Sylvain 2022-06): this must be utterly slow. - -- Replace with something faster. rendered_exports = BC.concat . map bytesFS . filter (not . nullFS) $ map mc_exports code meta_length = fromIntegral (BC.length rendered_meta) -- make LinkerStats entry for the given ModuleCode. @@ -403,8 +349,6 @@ linkerStats :: Int64 -- ^ code size of packed metadata -> LinkerStats -- ^ code size per module -> String linkerStats meta s = - -- FIXME (Sylvain 2022-06): this function shouldn't use String. Use faster Doc - -- pretty-printing instead intercalate "\n\n" [meta_stats, package_stats, module_stats] <> "\n\n" where meta_stats = "number of modules: " <> show (length bytes_per_mod) @@ -508,34 +452,16 @@ writeRunMain out = do runMainJS :: B.ByteString runMainJS = "h$main(h$mainZCZCMainzimain);\n" --- FIXME: Jeff (2022,03): Use Newtypes instead of Strings for these directories writeRunner :: JSLinkConfig -- ^ Settings -> FilePath -- ^ Output directory -> IO () -writeRunner _settings out = - -- FIXME: Jeff (2022,03): why was the buildRunner check removed? If we don't - -- need to check then does the flag need to exist? - {-when (lcBuildRunner _settings) $ -} do +writeRunner _settings out = do cd <- getCurrentDirectory let arch_os = hostPlatformArchOS let runner = cd exeFileName arch_os False (Just (dropExtension out)) srcFile = out "all" <.> "js" - -- nodeSettings <- readNodeSettings dflags nodePgm :: B.ByteString - nodePgm = "node" -- XXX we don't read nodeSettings.json anymore, we should somehow know how to find node? - - --------------------------------------------- - -- FIXME: Jeff (2022,03): Add support for windows. Detect it and act on it here: - -- if Platform.isWindows - -- then do - -- copyFile (topDir dflags "bin" "wrapper" <.> "exe") - -- runner - -- writeFile (runner <.> "options") $ unlines - -- [ mkFastString nodePgm -- mkFastString (nodeProgram nodeSettings) - -- , mkFastString ("{{EXEPATH}}" out "all" <.> "js") - -- ] - -- else do - --------------------------------------------- + nodePgm = "node" src <- B.readFile (cd srcFile) B.writeFile runner ("#!/usr/bin/env " <> nodePgm <> "\n" <> src) perms <- getPermissions runner @@ -559,8 +485,7 @@ rtsExterns = writeExterns :: FilePath -> IO () writeExterns out = writeFile (out "all.js.externs") - $ unpackFS rtsExterns -- FIXME: Jeff (2022,03): Why write rtsExterns as - -- FastString just to unpack? + $ unpackFS rtsExterns -- | get all functions in a module modFuns :: Deps -> [ExportedFun] @@ -613,12 +538,6 @@ getDeps loaded_deps base fun startlu = go' S.empty (S.fromList startlu) (S.toLis S.member s base in open `S.union` S.fromList (filter (not . alreadyLinked) newUnits) --- FIXME: Jeff: (2022,03): if the order of the [UnitId] list matters after --- ghc-prim then we should be using an Ordered Set or something --- similar since the implementation of this function uses a lot of --- expensive operations on this list and a lot of --- serialization/deserialization --- FIXME: Jeff (2022,03): Should [UnitId] be [Module]? -- | collect dependencies for a set of roots collectDeps :: Map Module (Deps, DepsLocation) -- ^ Dependency map -> [UnitId] -- ^ packages, code linked in this order @@ -658,15 +577,10 @@ extractDeps ar_state units deps loc = ArchiveFile a -> (collectCode <=< readObjectKeys (a ++ ':':moduleNameString (moduleName mod)) selector) =<< readArObject ar_state mod a - -- error ("Ar.readObject: " ++ a ++ ':' : unpackFS mod)) - -- Ar.readObject (mkModuleName $ unpackFS mod) a) InMemory n b -> collectCode =<< readObjectKeys n selector b - -- evaluate (rnf x) -- See FIXME Re: NFData instance on Safety and - -- ForeignJSRefs below return x where mod = depsModule deps - -- FIXME: Jeff (2022,03): remove this hacky reimplementation of unlines newline = mkFastString "\n" unlines' = intersperse newline . map oiRaw collectCode l = let x = ModuleCode @@ -677,13 +591,6 @@ extractDeps ar_state units deps loc = , mc_statics = concatMap oiStatic l , mc_frefs = concatMap oiFImports l } - -- FIXME: (2022,04): this evaluate and rnf require an NFData - -- instance on ForeignJSRef which in turn requries a NFData - -- instance on Safety. Does this even make sense? We'll skip - -- this for now. - - -- in evaluate (rnf x) >> return (Just x) - in return (Just x) readArObject :: ArchiveState -> Module -> FilePath -> IO BL.ByteString @@ -731,10 +638,9 @@ rtsDeps pkgs = readSystemDeps pkgs "rtsdeps.yaml" thDeps :: [UnitId] -> IO ([UnitId], Set ExportedFun) thDeps pkgs = readSystemDeps pkgs "thdeps.yaml" --- FIXME: Jeff (2022,03): fill in the ? -- | A helper function to read system dependencies that are hardcoded via a file -- path. -readSystemDeps :: [UnitId] -- ^ Packages to ?? +readSystemDeps :: [UnitId] -- ^ Packages that are already Linked -> FilePath -- ^ File to read -> IO ([UnitId], Set ExportedFun) readSystemDeps pkgs file = do @@ -745,9 +651,6 @@ readSystemDeps pkgs file = do ) where - -- FIXME: Jeff (2022,03): Each time we _do not_ use a list like a stack we - -- gain evidence that we should be using a different data structure. @pkgs@ - -- is the list in question here linked_pkgs = S.fromList pkgs @@ -755,9 +658,6 @@ readSystemDeps' :: FilePath -> IO ([UnitId], Set ExportedFun) readSystemDeps' file -- hardcode contents to get rid of yaml dep -- XXX move runTHServer to some suitable wired-in package - -- FIXME: Jeff (2022,03): Use types not string matches, These should be - -- wired-in just like in GHC and thus we should make them top level - -- definitions | file == "thdeps.yaml" = pure ( [ baseUnitId ] , S.fromList $ d baseUnitId "GHC.JS.Prim.TH.Eval" ["runTHServer"]) | file == "rtsdeps.yaml" = pure ( [ baseUnitId @@ -774,9 +674,6 @@ readSystemDeps' file , d baseUnitId "GHC.Ptr" ["Ptr"] , d primUnitId "GHC.Types" [":", "[]"] , d primUnitId "GHC.Tuple" ["(,)", "(,,)", "(,,,)", "(,,,,)", "(,,,,,)","(,,,,,,)", "(,,,,,,,)", "(,,,,,,,,)", "(,,,,,,,,,)"] - -- FIXME Sylvain (2022,05): no longer valid - -- integer constructors - -- , d bignumUnitId "GHC.Integer.Type" ["S#", "Jp#", "Jn#"] , d baseUnitId "GHC.JS.Prim" ["JSVal", "JSException", "$fShowJSException", "$fExceptionJSException", "resolve", "resolveIO", "toIO"] , d baseUnitId "GHC.JS.Prim.Internal" ["wouldBlock", "blockedIndefinitelyOnMVar", "blockedIndefinitelyOnSTM", "ignoreException", "setCurrentThreadResultException", "setCurrentThreadResultValue"] ] @@ -796,25 +693,6 @@ readSystemDeps' file mkJsModule :: UnitId -> FastString -> Module mkJsModule uid mod = mkModule (RealUnit (Definite uid)) (mkModuleNameFS mod) -{- - b <- readBinaryFile (getLibDir dflags file) - wi <- readSystemWiredIn dflags - case Yaml.decodeEither b of - Left err -> panic $ "could not read " ++ depsName ++ - " dependencies from " ++ file ++ ":\n" ++ err - Right sdeps -> - let (StaticDeps unresolved, pkgs, funs) = staticDeps wi sdeps - in case unresolved of - ((p,_,_):_) -> - panic $ "Package `" ++ unpackFS p ++ "' is required for " ++ - requiredFor ++ ", but was not found" - _ -> - -- putStrLn "system dependencies:" - -- print (map installedUnitIdString pkgs, funs) - return (pkgs, funs) - --} - -- | Make JS symbol corresponding to the given Haskell symbol in the given -- module mkJsSymbol :: Module -> FastString -> FastString @@ -824,23 +702,6 @@ mkJsSymbol mod s = mkFastString $ mconcat , zString (zEncodeFS s) ] - -readSystemWiredIn :: HscEnv -> IO [(FastString, UnitId)] -readSystemWiredIn _ = pure [] -- XXX -{- -readSystemWiredIn dflags = do - b <- B.readFile filename - case Yaml.decodeEither b of - Left _err -> error $ "could not read wired-in package keys from " ++ filename - Right m -> return . M.toList - . M.union ghcWiredIn -- GHC wired-in package keys override those in the file - . fmap stringToUnitId $ m - where - filename = getLibDir dflags "wiredinkeys" <.> "yaml" - ghcWiredIn :: Map Text UnitId - ghcWiredIn = M.fromList $ map (\k -> (mkFastString (installedUnitIdString k), k)) - (map toUnitId wiredInUnitIds) - -} {- | read a static dependencies specification and give the roots if dependencies come from a versioned (non-hardwired) package @@ -860,10 +721,6 @@ staticDeps unit_env wiredin sdeps = mkDeps sdeps where u_st = ue_units unit_env mkDeps (StaticDeps ds) = - -- FIXME: Jeff (2022,03): this foldl' will leak memory due to the tuple - -- and in the list in the fst position because the list is neither spine - -- nor value strict. So the WHNF computed by foldl' will by a 3-tuple with - -- 3 thunks and the WHNF for the list will be a cons cell let (u, p, r) = foldl' resolveDep ([], S.empty, S.empty) ds in (StaticDeps u, closePackageDeps u_st p, r) resolveDep :: ([SDep], Set UnitId, Set ExportedFun) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57f5ff0cf5fd8b58b269a55f1693e04c2f1a77cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57f5ff0cf5fd8b58b269a55f1693e04c2f1a77cc You're receiving 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 24 14:54:12 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 24 Aug 2022 10:54:12 -0400 Subject: [Git][ghc/ghc][wip/ghc-with-debug] 124 commits: Fix isEvaldUnfolding and isValueUnfolding Message-ID: <63063b94a169d_e9d7d40d5e59095417@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-with-debug at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 6c50927e by Matthew Pickering at 2022-08-24T15:48:04+01:00 Add support for ghc-debug to ghc executable - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - 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.hs-boot - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d4ba64755b381a9e869d8e4ef18666824552583...6c50927ecae1443f8291133291d166aedde0b6d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d4ba64755b381a9e869d8e4ef18666824552583...6c50927ecae1443f8291133291d166aedde0b6d8 You're receiving 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 24 14:56:14 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 24 Aug 2022 10:56:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/simplifier-fixes Message-ID: <63063c0ebd370_e9d7d36163a74954386@gitlab.mail> Matthew Pickering pushed new branch wip/simplifier-fixes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/simplifier-fixes You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Aug 24 16:05:28 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 24 Aug 2022 12:05:28 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Linker: link platform shim before the others Message-ID: <63064c4862388_e9d7d40d5e5909622da@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 7dbf250e by Sylvain Henry at 2022-08-24T18:08:08+02:00 Linker: link platform shim before the others - - - - - 1 changed file: - compiler/GHC/StgToJS/Linker/Shims.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Shims.hs ===================================== @@ -82,33 +82,36 @@ instance Ord (Shim' a) where -- | A tag to label shim payloads, the ordering dictates the ordering shim files -- are linked. -data ShimLbl = ShStructs - | ShProfiling - | ShRts - | ShGc - | ShArith - | ShCompact - | ShDebug - | ShEnum - | ShEnvironment - | ShErrno - | ShGoog - | ShHsCore - | ShMd5 - | ShMem - | ShNodeExports - | ShObject - | ShPlatform - | ShStablePtr - | ShStaticPtr - | ShStm - | ShString - | ShThread - | ShUnicode - | ShVerify - | ShWeak - | ShBase - deriving (Eq, Ord) +data ShimLbl + -- Platform must be loaded quite early as it sets h$isNode which is used by + -- other shims (e.g. ShEnvironment) + = ShPlatform + | ShStructs + | ShProfiling + | ShRts + | ShGc + | ShArith + | ShCompact + | ShDebug + | ShEnum + | ShEnvironment + | ShErrno + | ShGoog + | ShHsCore + | ShMd5 + | ShMem + | ShNodeExports + | ShObject + | ShStablePtr + | ShStaticPtr + | ShStm + | ShString + | ShThread + | ShUnicode + | ShVerify + | ShWeak + | ShBase + deriving (Eq, Ord) -- | Given a file path, check that the file is a shim file and construct a Shim -- value if so. This is the sole exported constructor for a Shim type. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dbf250ea9e49fa3802da97cd71f5b1118002319 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dbf250ea9e49fa3802da97cd71f5b1118002319 You're receiving 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 24 16:44:19 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 24 Aug 2022 12:44:19 -0400 Subject: [Git][ghc/ghc][wip/kill-make] 9 commits: hadrian: Fix whitespace Message-ID: <630655636d5fe_e9d7d40d5e5909673d2@gitlab.mail> Ben Gamari pushed to branch wip/kill-make at Glasgow Haskell Compiler / GHC Commits: c32960b2 by Ben Gamari at 2022-08-24T10:54:50-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - 48287e5b by Ben Gamari at 2022-08-24T12:42:02-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - d80cf658 by Ben Gamari at 2022-08-24T12:42:42-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 967dcf90 by Ben Gamari at 2022-08-24T12:43:34-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - 926bb549 by Ben Gamari at 2022-08-24T12:43:34-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - b90e83d3 by Ben Gamari at 2022-08-24T12:43:34-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 401f1c38 by Ben Gamari at 2022-08-24T12:43:43-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 14476c99 by Ben Gamari at 2022-08-24T12:43:43-04:00 Drop mk/{build,install,config}.mk.in - - - - - 7e505292 by Ben Gamari at 2022-08-24T12:43:43-04:00 compiler: Drop comment references to make - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/SysTools/BaseDir.hs - − compiler/Makefile - − compiler/ghc.mk - configure.ac - distrib/configure.ac.in - − distrib/hc-build - − docs/users_guide/ghc.mk - − driver/ghc.mk - − driver/ghc/ghc.mk - − driver/ghci/ghc.mk - − driver/haddock/ghc.mk - − ghc.mk - ghc/ghc-bin.cabal.in - − ghc/ghc.mk - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Packages.hs - − libffi/ghc.mk - − libraries/ghc-bignum/gmp/ghc.mk - − libraries/ghc-boot/ghc.mk - − mk/build.mk.sample - − mk/compiler-ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b455176e3de0f0bc53938d8be6d0a26357101c0...7e50529219a4f000a209596a0bd80204500da348 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b455176e3de0f0bc53938d8be6d0a26357101c0...7e50529219a4f000a209596a0bd80204500da348 You're receiving 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 24 16:47:35 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 24 Aug 2022 12:47:35 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Wibbles Message-ID: <6306562786388_e9d7d1ee7674c968740@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: 32ea1c9c by Simon Peyton Jones at 2022-08-24T17:48:51+01:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -1135,25 +1135,15 @@ andArityType env at1 (AT [] div2) = andWithTail env div2 at1 andWithTail :: ArityEnv -> Divergence -> ArityType -> ArityType andWithTail env div1 at2@(AT lams2 _) - | isDeadEndDiv div1 -- case x of { T -> error; F -> \y.e } - = at2 -- Note [ABot branches: max arity wins] - - | pedanticBottoms env -- Note [Combining case branches: andWithTail] + | isDeadEndDiv div1 -- case x of { T -> error; F -> \y.e } + = at2 -- See Note + | pedanticBottoms env -- [Combining case branches: andWithTail] = AT [] topDiv | otherwise -- case x of { T -> plusInt ; F -> \y.e } = AT (map add_work lams2) topDiv -- We know div1 = topDiv -- See Note [Combining case branches: andWithTail] -{- Note [ABot branches: max arity wins] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider case x of - True -> \x. error "urk" - False -> \xy. error "urk2" - -Remember: \o1..on.⊥ means "if you apply to n args, it'll definitely diverge". -So we need \??.⊥ for the whole thing, the /max/ of both arities. - Note [Combining case branches: optimistic one-shot-ness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When combining the ArityTypes for two case branches (with andArityType) @@ -1171,6 +1161,21 @@ of the lattice. Hence the call to `bestOneShot` in `andArityType`. +Here's an example: + go = \x. let z = go e0 + go2 = \x. case x of + True -> z + False -> \s(one-shot). e1 + in go2 x +We *really* want to respect the one-shot annotation provided by the +user and eta-expand go and go2. + +When combining the branches of the case we have + T `andAT` \1.T +and we want to get \1.T. +But if the inner lambda wasn't one-shot (\?.T) we don't want to do this. +(We need a usage analysis to justify that.) + Note [Combining case branches: andWithTail] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When combining the ArityTypes for two case branches (with andArityType) @@ -1178,7 +1183,13 @@ and one side or the other has run out of ATLamInfo; then we get into `andWithTail`. * If one branch is guaranteed bottom (isDeadEndDiv), we just take - the other; see Note [ABot branches: max arity wins] + the other. Consider case x of + True -> \x. error "urk" + False -> \xy. error "urk2" + + Remember: \o1..on.⊥ means "if you apply to n args, it'll definitely + diverge". So we need \??.⊥ for the whole thing, the /max/ of both + arities. * Otherwise, if pedantic-bottoms is on, we just have to return AT [] topDiv. E.g. if we have @@ -1195,20 +1206,6 @@ into `andWithTail`. Note [Combining case branches: optimistic one-shot-ness], we just add work to ever ATLamInfo, keeping the one-shot-ness. -Here's an example: - go = \x. let z = go e0 - go2 = \x. case x of - True -> z - False -> \s(one-shot). e1 - in go2 x -We *really* want to respect the one-shot annotation provided by the -user and eta-expand go and go2. -When combining the branches of the case we have - T `andAT` \1.T -and we want to get \1.T. -But if the inner lambda wasn't one-shot (\?.T) we don't want to do this. -(We need a usage analysis to justify that.) - Note [Eta expanding through CallStacks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Just as it's good to eta-expand through dictionaries, so it is good to @@ -1243,13 +1240,15 @@ dictionary-typed expression, but that's more work. --------------------------- data ArityEnv - = AE { am_opts :: !ArityOpts + = AE { am_opts :: !ArityOpts + + , am_sigs :: !(IdEnv SafeArityType) + -- NB `SafeArityType` so we can use this in myIsCheapApp + -- See Note [Arity analysis] for details about fixed-point iteration. + , am_free_joins :: !Bool -- True <=> free join points allowed - , 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_free_joins: see Note [Arity for recursive join bindings] - -- point 5, in GHC.Core.Opt.Simplify.Utils + -- Used /only/ to support assertion checks + } instance Outputable ArityEnv where ppr (AE { am_sigs = sigs, am_free_joins = free_joins }) @@ -1452,15 +1451,16 @@ cheapArityType :: HasDebugCallStack => CoreExpr -> ArityType -- A fast and cheap version of arityType. -- Returns an ArityType with IsCheap everywhere -- c.f. GHC.Core.Utils.exprIsDeadEnd --- Does not expect to encounter a free join-point Id --- See Note [No free join points in arityType] +-- +-- /Can/ encounter a free join-point Id; e.g. via the call +-- in exprBotStrictness_maybe, which is called in lots +-- of places -- -- Returns ArityType, not SafeArityType. The caller must do -- trimArityType if necessary. cheapArityType e = go e where - go (Var v) = assertPpr( not (isJoinId v) ) (ppr v) $ - idArityType v + go (Var v) = idArityType v go (Cast e _) = go e go (Lam x e) | isId x = arityLam x (go e) | otherwise = go e @@ -1472,12 +1472,15 @@ cheapArityType e = go e -- Null alts: see Note [Empty case alternatives] in GHC.Core go (Case _ _ _ alts) | null alts = botArityType - -- Give up on let, case + -- Give up on let, case. In particular, unlike arityType, + -- we make no attempt to look inside let's. go _ = topArityType -- Specialised version of arityApp; all costs in ArityType are IsCheap -- See Note [exprArity for applications] - -- NB: coercions count as a value argument + -- NB: (1) coercions count as a value argument + -- (2) we use the super-cheap exprIsTrivial rather than the + -- more complicated and expensive exprIsCheap arity_app _ at@(AT [] _) = at arity_app arg at@(AT ((cost,_):lams) div) | assertPpr (cost == IsCheap) (ppr at $$ ppr arg) $ @@ -1487,7 +1490,10 @@ cheapArityType e = go e --------------- exprArity :: CoreExpr -> Arity --- ^ An approximate, fast, version of 'exprEtaExpandArity' +-- ^ An approximate, even faster, version of 'cheapArityType' +-- Roughly exprArity e = arityTypeArity (cheapArityType e) +-- But it's a bit less clever about bottoms +-- -- We do /not/ guarantee that exprArity e <= typeArity e -- You may need to do arity trimming after calling exprArity -- See Note [Arity trimming] @@ -1507,6 +1513,7 @@ exprArity e = go e go _ = 0 +--------------- exprIsDeadEnd :: CoreExpr -> Bool -- See Note [Bottoming expressions] -- This function is, in effect, just a specialised (and hence cheap) ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1949,7 +1949,8 @@ Obviously `f` should get arity 4. But it's a bit tricky: 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` (See Note [arityType for let-bindings] in GHC.Core.Opt.Arity) + for `j` (See Note [arityType for non-recursive let-bindings] + in GHC.Core.Opt.Arity)b - At the occurrence (j 20) that arity-4 ArityType will leave an arity-3 result. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32ea1c9c1eb66ca2dc4c7a86e7c5bee4fa73250a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32ea1c9c1eb66ca2dc4c7a86e7c5bee4fa73250a You're receiving 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 24 19:48:15 2022 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Wed, 24 Aug 2022 15:48:15 -0400 Subject: [Git][ghc/ghc][wip/amg/T21625] Allow imports to reference multiple fields with the same name (#21625) Message-ID: <6306807f7079b_e9d7d4d1d499178a@gitlab.mail> Adam Gundry pushed to branch wip/amg/T21625 at Glasgow Haskell Compiler / GHC Commits: 7b7ec2e2 by Adam Gundry at 2022-08-24T20:46:37+01:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - 7 changed files: - compiler/GHC/Rename/Names.hs - docs/users_guide/exts/duplicate_record_fields.rst - + testsuite/tests/overloadedrecflds/should_compile/T21625.hs - + testsuite/tests/overloadedrecflds/should_compile/T21625B.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/overloadedrecflds/should_fail/T16745.stderr - testsuite/tests/overloadedrecflds/should_fail/T16745A.hs Changes: ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1165,7 +1165,7 @@ Suppose we have: data T = mkT { foo :: Int } module N where - import M (foo) -- this is an ambiguity error (A) + import M (foo) -- this is allowed (A) import M (S(foo)) -- this is allowed (B) Here M exports the OccName 'foo' twice, so we get an imp_occ_env where 'foo' @@ -1176,8 +1176,8 @@ names (see Note [FieldLabel] in GHC.Types.FieldLabel). , $sel:foo:MKT -> (foo, T(foo), Nothing) ] -Then when we look up 'foo' in lookup_name for case (A) we get both entries and -hence report an ambiguity error. Whereas in case (B) we reach the lookup_ie +Then when we look up 'foo' in lookup_names for case (A) we get both entries and +hence two Avails. Whereas in case (B) we reach the lookup_ie case for IEThingWith, which looks up 'S' and then finds the unique 'foo' amongst its children. @@ -1252,13 +1252,21 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) isAvailTC AvailTC{} = True isAvailTC _ = False + -- Look up a RdrName used in an import, failing if it is ambiguous + -- (e.g. because it refers to multiple record fields) lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name) - lookup_name ie rdr + lookup_name ie rdr = do + xs <- lookup_names ie rdr + case xs of + [cax] -> return cax + _ -> failLookupWith (AmbiguousImport rdr (map sndOf3 xs)) + + -- Look up a RdrName used in an import, returning multiple values if there + -- are several fields with the same name exposed by the module + lookup_names :: IE GhcPs -> RdrName -> IELookupM [(Name, AvailInfo, Maybe Name)] + lookup_names ie rdr | isQual rdr = failLookupWith (QualImportError rdr) - | Just succ <- mb_success = case nonDetNameEnvElts succ of - -- See Note [Importing DuplicateRecordFields] - [(c,a,x)] -> return (greNameMangledName c, a, x) - xs -> failLookupWith (AmbiguousImport rdr (map sndOf3 xs)) + | Just succ <- mb_success = return $ map (\ (c,a,x) -> (greNameMangledName c, a, x)) (nonDetNameEnvElts succ) | otherwise = failLookupWith (BadImport ie) where mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr) @@ -1311,9 +1319,11 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) lookup_ie ie = handle_bad_import $ case ie of IEVar _ (L l n) -> do - (name, avail, _) <- lookup_name ie $ ieWrappedName n + -- See Note [Importing DuplicateRecordFields] + xs <- lookup_names ie (ieWrappedName n) return ([(IEVar noExtField (L l (replaceWrappedName n name)), - trimAvail avail name)], []) + trimAvail avail name) + | (name, avail, _) <- xs ], []) IEThingAll _ (L l tc) -> do (name, avail, mb_parent) <- lookup_name ie $ ieWrappedName tc ===================================== docs/users_guide/exts/duplicate_record_fields.rst ===================================== @@ -57,4 +57,11 @@ However, this would not be permitted, because ``x`` is ambiguous: :: module M (x) where ... -The same restrictions apply on imports. +For ``import`` statements, it is possible to import multiple fields with the +same name, as well as importing individual fields as part of their datatypes. +For example, the following imports are allowed: :: + + import M (S(x)) -- imports 'x' field of S, but not the field of T + import M (x) -- imports both 'x' fields + import M hiding (S(x)) -- imports everything except the 'x' field of S + import M hiding (x) -- imports everything except both 'x' fields ===================================== testsuite/tests/overloadedrecflds/should_compile/T21625.hs ===================================== @@ -0,0 +1,5 @@ +module T21625 where + +import T21625B hiding (B, f) + +c = C 'x' ===================================== testsuite/tests/overloadedrecflds/should_compile/T21625B.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module T21625B where + +data B = B {f :: Int} +data C = C {f :: Char} ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -11,3 +11,4 @@ test('T18999_FieldSelectors', normal, compile, ['']) test('T19154', normal, compile, ['']) test('T20723', normal, compile, ['']) test('T20989', normal, compile, ['']) +test('T21625', [], multimod_compile, ['T21625', '-v0']) ===================================== testsuite/tests/overloadedrecflds/should_fail/T16745.stderr ===================================== @@ -3,12 +3,12 @@ [3 of 4] Compiling T16745D ( T16745D.hs, T16745D.o ) [4 of 4] Compiling T16745A ( T16745A.hs, T16745A.o ) -T16745A.hs:3:24: error: - Ambiguous name ‘field’ in import item. It could refer to: - T16745C.field - T16745B.R(field) - -T16745A.hs:4:24: error: - Ambiguous name ‘foo’ in import item. It could refer to: - T16745D.T(foo) - T16745D.S(foo) +T16745A.hs:8:9: error: + Ambiguous occurrence ‘field’ + It could refer to + either the field ‘field’ of record ‘T16745B.R’, + imported from ‘T16745B’ at T16745A.hs:3:24-28 + (and originally defined at T16745B.hs:11:14-18) + or ‘T16745B.field’, + imported from ‘T16745B’ at T16745A.hs:3:24-28 + (and originally defined in ‘T16745C’ at T16745C.hs:2:1-5) ===================================== testsuite/tests/overloadedrecflds/should_fail/T16745A.hs ===================================== @@ -1,6 +1,8 @@ module T16745A where -import T16745B hiding (field) -import T16745D hiding (foo) +import T16745B (field) -- imports both 'field's +import T16745D hiding (foo) -- allowed, hides both 'foo' fields -wrong = foo -- should not be in scope +foo = foo + +wrong = field -- ambiguous which 'field' is meant View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b7ec2e2ff96674c2ae2ae9e6c4866ffe6ba1f1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b7ec2e2ff96674c2ae2ae9e6c4866ffe6ba1f1e You're receiving 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 24 20:27:52 2022 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Wed, 24 Aug 2022 16:27:52 -0400 Subject: [Git][ghc/ghc][wip/amg/T21625] Allow imports to reference multiple fields with the same name (#21625) Message-ID: <630689c8175e0_e9d7d268fc2501009179@gitlab.mail> Adam Gundry pushed to branch wip/amg/T21625 at Glasgow Haskell Compiler / GHC Commits: 7f03aae6 by Adam Gundry at 2022-08-24T21:27:24+01:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - 7 changed files: - compiler/GHC/Rename/Names.hs - docs/users_guide/exts/duplicate_record_fields.rst - + testsuite/tests/overloadedrecflds/should_compile/T21625.hs - + testsuite/tests/overloadedrecflds/should_compile/T21625B.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/overloadedrecflds/should_fail/T16745.stderr - testsuite/tests/overloadedrecflds/should_fail/T16745A.hs Changes: ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1165,7 +1165,7 @@ Suppose we have: data T = mkT { foo :: Int } module N where - import M (foo) -- this is an ambiguity error (A) + import M (foo) -- this is allowed (A) import M (S(foo)) -- this is allowed (B) Here M exports the OccName 'foo' twice, so we get an imp_occ_env where 'foo' @@ -1176,8 +1176,8 @@ names (see Note [FieldLabel] in GHC.Types.FieldLabel). , $sel:foo:MKT -> (foo, T(foo), Nothing) ] -Then when we look up 'foo' in lookup_name for case (A) we get both entries and -hence report an ambiguity error. Whereas in case (B) we reach the lookup_ie +Then when we look up 'foo' in lookup_names for case (A) we get both entries and +hence two Avails. Whereas in case (B) we reach the lookup_ie case for IEThingWith, which looks up 'S' and then finds the unique 'foo' amongst its children. @@ -1252,13 +1252,21 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) isAvailTC AvailTC{} = True isAvailTC _ = False + -- Look up a RdrName used in an import, failing if it is ambiguous + -- (e.g. because it refers to multiple record fields) lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name) - lookup_name ie rdr + lookup_name ie rdr = do + xs <- lookup_names ie rdr + case xs of + [cax] -> return cax + _ -> failLookupWith (AmbiguousImport rdr (map sndOf3 xs)) + + -- Look up a RdrName used in an import, returning multiple values if there + -- are several fields with the same name exposed by the module + lookup_names :: IE GhcPs -> RdrName -> IELookupM [(Name, AvailInfo, Maybe Name)] + lookup_names ie rdr | isQual rdr = failLookupWith (QualImportError rdr) - | Just succ <- mb_success = case nonDetNameEnvElts succ of - -- See Note [Importing DuplicateRecordFields] - [(c,a,x)] -> return (greNameMangledName c, a, x) - xs -> failLookupWith (AmbiguousImport rdr (map sndOf3 xs)) + | Just succ <- mb_success = return $ map (\ (c,a,x) -> (greNameMangledName c, a, x)) (nonDetNameEnvElts succ) | otherwise = failLookupWith (BadImport ie) where mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr) @@ -1311,9 +1319,11 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) lookup_ie ie = handle_bad_import $ case ie of IEVar _ (L l n) -> do - (name, avail, _) <- lookup_name ie $ ieWrappedName n + -- See Note [Importing DuplicateRecordFields] + xs <- lookup_names ie (ieWrappedName n) return ([(IEVar noExtField (L l (replaceWrappedName n name)), - trimAvail avail name)], []) + trimAvail avail name) + | (name, avail, _) <- xs ], []) IEThingAll _ (L l tc) -> do (name, avail, mb_parent) <- lookup_name ie $ ieWrappedName tc ===================================== docs/users_guide/exts/duplicate_record_fields.rst ===================================== @@ -57,4 +57,11 @@ However, this would not be permitted, because ``x`` is ambiguous: :: module M (x) where ... -The same restrictions apply on imports. +For ``import`` statements, it is possible to import multiple fields with the +same name, as well as importing individual fields as part of their datatypes. +For example, the following imports are allowed: :: + + import M (S(x)) -- imports the type S and the 'x' field of S (but not the field of T) + import M (x) -- imports both 'x' fields + import M hiding (S(x)) -- imports everything except the type S and its 'x' field + import M hiding (x) -- imports everything except the two 'x' fields ===================================== testsuite/tests/overloadedrecflds/should_compile/T21625.hs ===================================== @@ -0,0 +1,5 @@ +module T21625 where + +import T21625B hiding (B, f) + +c = C 'x' ===================================== testsuite/tests/overloadedrecflds/should_compile/T21625B.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module T21625B where + +data B = B {f :: Int} +data C = C {f :: Char} ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -11,3 +11,4 @@ test('T18999_FieldSelectors', normal, compile, ['']) test('T19154', normal, compile, ['']) test('T20723', normal, compile, ['']) test('T20989', normal, compile, ['']) +test('T21625', [], multimod_compile, ['T21625', '-v0']) ===================================== testsuite/tests/overloadedrecflds/should_fail/T16745.stderr ===================================== @@ -3,12 +3,12 @@ [3 of 4] Compiling T16745D ( T16745D.hs, T16745D.o ) [4 of 4] Compiling T16745A ( T16745A.hs, T16745A.o ) -T16745A.hs:3:24: error: - Ambiguous name ‘field’ in import item. It could refer to: - T16745C.field - T16745B.R(field) - -T16745A.hs:4:24: error: - Ambiguous name ‘foo’ in import item. It could refer to: - T16745D.T(foo) - T16745D.S(foo) +T16745A.hs:8:9: error: + Ambiguous occurrence ‘field’ + It could refer to + either the field ‘field’ of record ‘T16745B.R’, + imported from ‘T16745B’ at T16745A.hs:3:24-28 + (and originally defined at T16745B.hs:11:14-18) + or ‘T16745B.field’, + imported from ‘T16745B’ at T16745A.hs:3:24-28 + (and originally defined in ‘T16745C’ at T16745C.hs:2:1-5) ===================================== testsuite/tests/overloadedrecflds/should_fail/T16745A.hs ===================================== @@ -1,6 +1,8 @@ module T16745A where -import T16745B hiding (field) -import T16745D hiding (foo) +import T16745B (field) -- imports both 'field's +import T16745D hiding (foo) -- allowed, hides both 'foo' fields -wrong = foo -- should not be in scope +foo = foo + +wrong = field -- ambiguous which 'field' is meant View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f03aae6ca06d8ef304f9a6d70f2f1650b86d69b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f03aae6ca06d8ef304f9a6d70f2f1650b86d69b You're receiving 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 24 23:06:44 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 24 Aug 2022 19:06:44 -0400 Subject: [Git][ghc/ghc][wip/T21694a] 15 commits: tc: warn about lazy annotations on unlifted arguments (fixes #21951) Message-ID: <6306af0452ad8_e9d7d39bc2b3410267bc@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a 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. - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 10ec1d06 by Simon Peyton Jones at 2022-08-25T00:07:00+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% 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% increase in exchange for goodness elsewhere. Metric Decrease: T6048 Metric Increase: T18223 - - - - - 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/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Pipeline/Execute.hs - 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/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/bindist/Makefile - hadrian/src/Settings/Default.hs - libraries/base/tests/T9681.stderr - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - libraries/template-haskell/changelog.md - rts/Stats.c - testsuite/tests/ado/T16628.stderr - testsuite/tests/ado/ado005.stderr - testsuite/tests/annotations/should_fail/annfail05.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32ea1c9c1eb66ca2dc4c7a86e7c5bee4fa73250a...10ec1d06462aa80533ed9912bfda122430d86899 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32ea1c9c1eb66ca2dc4c7a86e7c5bee4fa73250a...10ec1d06462aa80533ed9912bfda122430d86899 You're receiving 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 24 23:27:31 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 24 Aug 2022 19:27:31 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble Message-ID: <6306b3e3974ef_e9d7d36163a741030883@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 84e9968c by Simon Peyton Jones at 2022-08-25T00:27:46+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/Errors/Ppr.hs Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2183,6 +2183,9 @@ pprTcSolverReportMsg ctxt ppr_torc ConstraintLike = text "constraint" describe_rep :: RuntimeRepType -> Maybe SDoc + -- describe_rep IntRep = Just "an IntRep" + -- describe_rep (BoxedRep Lifted) = Just "a lifted" + -- etc describe_rep rep | Just (rr_tc, rr_args) <- splitRuntimeRep_maybe rep = case rr_args of @@ -2192,14 +2195,16 @@ pprTcSolverReportMsg ctxt Lifted -> Just (text "a lifted") Unlifted -> Just (text "a boxed unlifted") [] | rr_tc `hasKey` tupleRepDataConTyConKey -> Just (text "a zero-bit") - | starts_with_vowel rr_tc -> Just (text "an" <+> ppr rr_tc) - | otherwise -> Just (text "a" <+> ppr rr_tc) + | starts_with_vowel rr_occ -> Just (text "an" <+> text rr_occ) + | otherwise -> Just (text "a" <+> text rr_occ) + where + rr_occ = occNameString (getOccName rr_tc) + _ -> Nothing -- Must be TupleRep [r1..rn] | otherwise = Nothing - starts_with_vowel tc - | (c:_) <- occNameString (getOccName tc) = c `elem` "aeiou" - | otherwise = False + starts_with_vowel (c:_) = c `elem` "AEIOU" + starts_with_vowel [] = False pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = vcat (map make_msg frr_origs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84e9968c34cde243944c2bf71555442b0b4174cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84e9968c34cde243944c2bf71555442b0b4174cb You're receiving 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 25 07:01:53 2022 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Thu, 25 Aug 2022 03:01:53 -0400 Subject: [Git][ghc/ghc][wip/amg/T21625] 26 commits: Implement Response File support for HPC Message-ID: <63071e613daf9_e9d7d36163a7410574aa@gitlab.mail> Adam Gundry pushed to branch wip/amg/T21625 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 - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 8c45cd48 by Adam Gundry at 2022-08-25T07:01:50+00:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap/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/Rename/Names.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Var.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/exts/duplicate_record_fields.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.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 - hadrian/src/Settings/Default.hs - libraries/base/tests/T9681.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f03aae6ca06d8ef304f9a6d70f2f1650b86d69b...8c45cd48ee86fae908d8eb1fb85787c61a0a0a3b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f03aae6ca06d8ef304f9a6d70f2f1650b86d69b...8c45cd48ee86fae908d8eb1fb85787c61a0a0a3b You're receiving 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 25 07:39:29 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 03:39:29 -0400 Subject: [Git][ghc/ghc][wip/T21694a] Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <630727317892_e9d7d268fc2501061821@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21694a at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 24 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/WorkWrap.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/arityanal/should_compile/T21755.hs - + testsuite/tests/arityanal/should_compile/T21755.stderr - testsuite/tests/arityanal/should_compile/all.T - + testsuite/tests/arityanal/should_run/T21694a.hs - + testsuite/tests/arityanal/should_run/T21694a.stderr - testsuite/tests/arityanal/should_run/all.T - + testsuite/tests/simplCore/should_compile/T21694.hs - + testsuite/tests/simplCore/should_compile/T21694b.hs - + testsuite/tests/simplCore/should_compile/T21694b.stderr - + testsuite/tests/simplCore/should_compile/T21948.hs - + testsuite/tests/simplCore/should_compile/T21948.stderr - + testsuite/tests/simplCore/should_compile/T21960.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a90298cc7291677fddd9e374e222676306265c17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a90298cc7291677fddd9e374e222676306265c17 You're receiving 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 25 07:45:48 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 03:45:48 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Primops: rework 64-bit and Word32 primops Message-ID: <630728ac30f96_e9d7d268fc250106754f@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 327a144f by Sylvain Henry at 2022-08-25T09:48:10+02:00 Primops: rework 64-bit and Word32 primops - Use BigInt instead of complex and buggy bit twiddling. We'll assess performance later. Let's use a correct and simple implementation for now. - Implement previously missing 64-bit quot and rem - Refactor logical operators and Prim module more generally - - - - - 2 changed files: - compiler/GHC/StgToJS/Prim.hs - js/arith.js.pp Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -54,22 +54,22 @@ genPrim prof ty op = case op of Int16ToWord16Op -> \[r] [x] -> PrimInline $ r |= mask16 x Word16ToInt16Op -> \[r] [x] -> PrimInline $ r |= signExtend16 x Int32ToWord32Op -> \[r] [x] -> PrimInline $ r |= x .>>>. zero_ - Word32ToInt32Op -> \[r] [x] -> PrimInline $ r |= trunc x + Word32ToInt32Op -> \[r] [x] -> PrimInline $ r |= i32 x ------------------------------ Int ---------------------------------------------- - IntAddOp -> \[r] [x,y] -> PrimInline $ r |= trunc (Add x y) - IntSubOp -> \[r] [x,y] -> PrimInline $ r |= trunc (Sub x y) + IntAddOp -> \[r] [x,y] -> PrimInline $ r |= i32 (Add x y) + IntSubOp -> \[r] [x,y] -> PrimInline $ r |= i32 (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] IntMulMayOfloOp -> \[r] [x,y] -> PrimInline $ jVar \tmp -> mconcat [ tmp |= Mul x y - , r |= if01 (tmp .===. trunc tmp) + , r |= if01 (tmp .===. i32 tmp) ] - IntQuotOp -> \[r] [x,y] -> PrimInline $ r |= trunc (Div x y) + IntQuotOp -> \[r] [x,y] -> PrimInline $ r |= i32 (Div x y) IntRemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y IntQuotRemOp -> \[q,r] [x,y] -> PrimInline $ mconcat - [ q |= trunc (Div x y) + [ q |= i32 (Div x y) , r |= x `Sub` (Mul y q) ] IntAndOp -> \[r] [x,y] -> PrimInline $ r |= BAnd x y @@ -77,18 +77,18 @@ genPrim prof ty op = case op of IntXorOp -> \[r] [x,y] -> PrimInline $ r |= BXor x y IntNotOp -> \[r] [x] -> PrimInline $ r |= BNot x - IntNegOp -> \[r] [x] -> PrimInline $ r |= trunc (Negate x) + IntNegOp -> \[r] [x] -> PrimInline $ r |= i32 (Negate x) -- add with carry: overflow == 0 iff no overflow IntAddCOp -> \[r,overf] [x,y] -> PrimInline $ jVar \rt -> mconcat [ rt |= Add x y - , r |= trunc rt + , r |= i32 rt , overf |= if10 (r .!=. rt) ] IntSubCOp -> \[r,overf] [x,y] -> PrimInline $ jVar \rt -> mconcat [ rt |= Sub x y - , r |= trunc rt + , r |= i32 rt , overf |= if10 (r .!=. rt) ] IntGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y) @@ -103,7 +103,7 @@ genPrim prof ty op = case op of IntToDoubleOp -> \[r] [x] -> PrimInline $ r |= x IntSllOp -> \[r] [x,y] -> PrimInline $ r |= x .<<. y IntSraOp -> \[r] [x,y] -> PrimInline $ r |= x .>>. y - IntSrlOp -> \[r] [x,y] -> PrimInline $ r |= trunc (x .>>>. y) + IntSrlOp -> \[r] [x,y] -> PrimInline $ r |= i32 (x .>>>. y) ------------------------------ Int8 --------------------------------------------- @@ -141,7 +141,7 @@ genPrim prof ty op = case op of Word8QuotOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Div x y) Word8RemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y Word8QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat - [ r1 |= trunc (Div x y) + [ r1 |= i32 (Div x y) , r2 |= Mod x y ] Word8EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y) @@ -196,7 +196,7 @@ genPrim prof ty op = case op of Word16QuotOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Div x y) Word16RemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y Word16QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat - [ r1 |= trunc (Div x y) + [ r1 |= i32 (Div x y) , r2 |= Mod x y ] Word16EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y) @@ -271,8 +271,8 @@ genPrim prof ty op = case op of Int64NegOp -> \[r_h,r_l] [h,l] -> PrimInline $ mconcat - [ r_l |= trunc (BNot l + 1) - , r_h |= trunc (BNot h + Not r_l) + [ r_l |= i32 (BNot l + 1) + , r_h |= i32 (BNot h + Not r_l) ] Int64AddOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_plusInt64" [h0,l0,h1,l1] @@ -287,70 +287,70 @@ genPrim prof ty op = case op of Int64ToWord64Op -> \[r1,r2] [x1,x2] -> PrimInline $ mconcat - [ r1 |= x1 .>>>. 0 + [ r1 |= u32 x1 , r2 |= x2 ] IntToInt64Op -> \[r1,r2] [x] -> PrimInline $ mconcat [ r1 |= if_ (x .<. 0) (-1) 0 -- sign-extension - , r2 |= x + , r2 |= u32 x ] Int64EqOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LAnd (l0 .===. l1) (h0 .===. h1)) Int64NeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (l0 .!==. l1) (h0 .!==. h1)) - Int64GeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= app "h$hs_geInt64" [h0,l0,h1,l1] - Int64GtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= app "h$hs_gtInt64" [h0,l0,h1,l1] - Int64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= app "h$hs_leInt64" [h0,l0,h1,l1] - Int64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= app "h$hs_ltInt64" [h0,l0,h1,l1] + Int64GeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>=. l1))) + Int64GtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>. l1))) + Int64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<=. l1))) + Int64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<. l1))) ------------------------------ Word64 ------------------------------------------- Word64ToWordOp -> \[r] [_x1,x2] -> PrimInline $ r |= x2 - WordToWord64Op -> \[r1,r2] [x] -> + WordToWord64Op -> \[rh,rl] [x] -> PrimInline $ mconcat - [ r1 |= 0 - , r2 |= x + [ rh |= 0 + , rl |= x ] Word64ToInt64Op -> \[r1,r2] [x1,x2] -> PrimInline $ mconcat - [ r1 |= trunc x1 + [ r1 |= i32 x1 , 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)) - 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))) + 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_uncheckedShiftLWord64" [h, l, n] - Word64SrlOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftRWord64" [h, l, n] + Word64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftLWord64" [h,l,n] + Word64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRWord64" [h,l,n] Word64OrOp -> \[hr,hl] [h0, l0, h1, l1] -> PrimInline $ mconcat - [ hr |= BOr h0 h1 - , hl |= BOr l0 l1 + [ hr |= u32 (BOr h0 h1) + , hl |= u32 (BOr l0 l1) ] Word64AndOp -> \[hr,hl] [h0, l0, h1, l1] -> PrimInline $ mconcat - [ hr |= BAnd h0 h1 - , hl |= BAnd l0 l1 + [ hr |= u32 (BAnd h0 h1) + , hl |= u32 (BAnd l0 l1) ] Word64XorOp -> \[hr,hl] [h0, l0, h1, l1] -> PrimInline $ mconcat - [ hr |= BXor h0 h1 - , hl |= BXor l0 l1 + [ hr |= u32 (BXor h0 h1) + , hl |= u32 (BXor l0 l1) ] Word64NotOp -> \[hr,hl] [h, l] -> PrimInline $ mconcat - [ hr |= BNot h - , hl |= BNot l + [ hr |= u32 (BNot h) + , hl |= u32 (BNot l) ] Word64AddOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_plusWord64" [h0,l0,h1,l1] @@ -365,29 +365,29 @@ genPrim prof ty op = case op of WordAddCOp -> \[r,c] [x,y] -> PrimInline $ jVar \t -> mconcat [ t |= x `Add` y - , r |= t .>>>. zero_ + , r |= u32 t , c |= if10 (t .!==. r) ] WordSubCOp -> \[r,c] [x,y] -> PrimInline $ mconcat - [ r |= (Sub x y) .>>>. zero_ + [ r |= u32 (Sub x y) , c |= if10 (y .>. x) ] WordAdd2Op -> \[h,l] [x,y] -> PrimInline $ appT [h,l] "h$wordAdd2" [x,y] - WordSubOp -> \ [r] [x,y] -> PrimInline $ r |= (Sub x y) .>>>. zero_ + WordSubOp -> \ [r] [x,y] -> PrimInline $ r |= u32 (Sub x y) WordMulOp -> \ [r] [x,y] -> PrimInline $ r |= app "h$mulWord32" [x, y] WordMul2Op -> \[h,l] [x,y] -> PrimInline $ appT [h,l] "h$mul2Word32" [x,y] WordQuotOp -> \ [q] [x,y] -> PrimInline $ q |= app "h$quotWord32" [x,y] WordRemOp -> \ [r] [x,y] -> PrimInline $ r |= app "h$remWord32" [x,y] WordQuotRemOp -> \[q,r] [x,y] -> PrimInline $ appT [q,r] "h$quotRemWord32" [x,y] WordQuotRem2Op -> \[q,r] [xh,xl,y] -> PrimInline $ appT [q,r] "h$quotRem2Word32" [xh,xl,y] - WordAndOp -> \[r] [x,y] -> PrimInline $ r |= (BAnd x y) .>>>. zero_ - WordOrOp -> \[r] [x,y] -> PrimInline $ r |= (BOr x y) .>>>. zero_ - WordXorOp -> \[r] [x,y] -> PrimInline $ r |= (BXor x y) .>>>. zero_ - WordNotOp -> \[r] [x] -> PrimInline $ r |= (BNot x) .>>>. zero_ - WordSllOp -> \[r] [x,y] -> PrimInline $ r |= (x .<<. y) .>>>. zero_ + WordAndOp -> \[r] [x,y] -> PrimInline $ r |= u32 (BAnd x y) + WordOrOp -> \[r] [x,y] -> PrimInline $ r |= u32 (BOr x y) + WordXorOp -> \[r] [x,y] -> PrimInline $ r |= u32 (BXor x y) + WordNotOp -> \[r] [x] -> PrimInline $ r |= u32 (BNot x) + WordSllOp -> \[r] [x,y] -> PrimInline $ r |= u32 (x .<<. y) WordSrlOp -> \[r] [x,y] -> PrimInline $ r |= x .>>>. y - WordToIntOp -> \[r] [x] -> PrimInline $ r |= trunc x + WordToIntOp -> \[r] [x] -> PrimInline $ r |= i32 x WordGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y) WordGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y) WordEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y) @@ -440,10 +440,10 @@ genPrim prof ty op = case op of Narrow8IntOp -> \[r] [x] -> PrimInline $ r |= (BAnd x (Int 0x7F)) `Sub` (BAnd x (Int 0x80)) Narrow16IntOp -> \[r] [x] -> PrimInline $ r |= (BAnd x (Int 0x7FFF)) `Sub` (BAnd x (Int 0x8000)) - Narrow32IntOp -> \[r] [x] -> PrimInline $ r |= trunc x + Narrow32IntOp -> \[r] [x] -> PrimInline $ r |= i32 x Narrow8WordOp -> \[r] [x] -> PrimInline $ r |= mask8 x Narrow16WordOp -> \[r] [x] -> PrimInline $ r |= mask16 x - Narrow32WordOp -> \[r] [x] -> PrimInline $ r |= trunc x + Narrow32WordOp -> \[r] [x] -> PrimInline $ r |= u32 x ------------------------------ Double ------------------------------------------- @@ -459,7 +459,7 @@ genPrim prof ty op = case op of DoubleDivOp -> \[r] [x,y] -> PrimInline $ r |= Div x y DoubleNegOp -> \[r] [x] -> PrimInline $ r |= Negate x DoubleFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x] - DoubleToIntOp -> \[r] [x] -> PrimInline $ r |= trunc x + DoubleToIntOp -> \[r] [x] -> PrimInline $ r |= i32 x DoubleToFloatOp -> \[r] [x] -> PrimInline $ r |= app "h$fround" [x] DoubleExpOp -> \[r] [x] -> PrimInline $ r |= math_exp [x] DoubleLogOp -> \[r] [x] -> PrimInline $ r |= math_log [x] @@ -494,7 +494,7 @@ genPrim prof ty op = case op of FloatDivOp -> \[r] [x,y] -> PrimInline $ r |= Div x y FloatNegOp -> \[r] [x] -> PrimInline $ r |= Negate x FloatFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x] - FloatToIntOp -> \[r] [x] -> PrimInline $ r |= trunc x + FloatToIntOp -> \[r] [x] -> PrimInline $ r |= i32 x FloatExpOp -> \[r] [x] -> PrimInline $ r |= math_exp [x] FloatLogOp -> \[r] [x] -> PrimInline $ r |= math_log [x] FloatSqrtOp -> \[r] [x] -> PrimInline $ r |= math_sqrt [x] @@ -675,7 +675,7 @@ genPrim prof ty op = case op of WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ u8_ a i |= e WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ i32_ a i |= e WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ i32_ a i |= e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ i32_ a i |= trunc e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ i32_ a i |= i32 e WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> PrimInline $ mconcat [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty @@ -691,15 +691,15 @@ genPrim prof ty op = case op of WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> PrimInline $ mconcat [ i32_ a (Add (i .<<. one_) one_) |= e1 - , i32_ a (i .<<. one_) |= trunc e2 + , i32_ a (i .<<. one_) |= i32 e2 ] WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ u8_ a i |= e WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ u1_ a i |= e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ i32_ a i |= trunc e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ i32_ a i |= i32 e WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ mconcat - [ i32_ a (Add (i .<<. one_) one_) |= trunc h - , i32_ a (i .<<. one_) |= trunc l + [ i32_ a (Add (i .<<. one_) one_) |= i32 h + , i32_ a (i .<<. one_) |= i32 l ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> PrimInline $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] @@ -1242,8 +1242,12 @@ newByteArray tgt len = -- e|0 (32 bit signed integer truncation) -trunc :: JExpr -> JExpr -trunc e = BOr e zero_ +i32 :: JExpr -> JExpr +i32 e = BOr e zero_ + +-- e>>>0 (32 bit unsigned integer truncation) +u32 :: JExpr -> JExpr +u32 e = e .>>>. zero_ quotShortInt :: Int -> JExpr -> JExpr -> JExpr quotShortInt bits x y = BAnd (signed x `Div` signed y) mask ===================================== js/arith.js.pp ===================================== @@ -8,621 +8,277 @@ function h$logArith() { h$log.apply(h$log,arguments); } #endif #define UN(x) ((x)>>>0) - -function h$hs_leInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s < l2s || (l1s === l2s && ((l1&1) <= (l2&1)))) ? 1 : 0; - } else { - return (h1 < h2) ? 1 : 0; - } -} - -function h$hs_ltInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s < l2s || (l1s === l2s && ((l1&1) < (l2&1)))) ? 1 : 0; - } else { - return (h1 < h2) ? 1 : 0; - } -} - -function h$hs_geInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s > l2s || (l1s === l2s && ((l1&1) >= (l2&1)))) ? 1 : 0; - } else { - return (h1 > h2) ? 1 : 0; - } -} - -function h$hs_gtInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s > l2s || (l1s === l2s && ((l1&1) > (l2&1)))) ? 1 : 0; - } else { - return (h1 > h2) ? 1 : 0; - } -} +#define W32(x) (BigInt(x)) +#define W64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0)) +#define W64h(x) (Number(x >> BigInt(32)) >>> 0) +#define W64l(x) (Number(BigInt.asUintN(32, x)) >>> 0) +#define I64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0)) +#define I64h(x) (Number(x >> BigInt(32))|0) +#define I64l(x) (Number(BigInt.asIntN(32,x))|0) +#define RETURN_I64(x) RETURN_UBX_TUP2(I64h(x), I64l(x)) +#define RETURN_W64(x) RETURN_UBX_TUP2(W64h(x), W64l(x)) +#define RETURN_W32(x) return Number(x) 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 - 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); - } + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a / b); + TRACE_ARITH("Word64: " + a + " / " + b + " ==> " + r); + RETURN_W64(r); } 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); - var qvl = h$ret1; - return h$hs_minusWord64(h1,l1,qvh,qvl); + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a % b); + TRACE_ARITH("Word64: " + a + " % " + b + " ==> " + r); + RETURN_W64(r); } 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); + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a * b); + TRACE_ARITH("Word64: " + a + " * " + b + " ==> " + r); + RETURN_W64(r); } 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); - RETURN_UBX_TUP2(rh,rl); + var a = (BigInt(h1) << BigInt(32)) | BigInt(l1>>>0); + var b = (BigInt(h2) << BigInt(32)) | BigInt(l2>>>0); + var r = BigInt.asUintN(64, a - b); + TRACE_ARITH("Word64: " + a + " - " + b + " ==> " + r); + RETURN_W64(r); } 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); - 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); + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a + b); + TRACE_ARITH("Word64: " + a + " + " + b + " ==> " + r); + RETURN_W64(r); } 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) { - RETURN_UBX_TUP2(0,0); - } - if (l1 === 1) { - RETURN_UBX_TUP2(h2,l2); - } - } - if (h2 === 0) { - if (l2 === 0) { - RETURN_UBX_TUP2(0,0); - } - if (l2 === 1) { - RETURN_UBX_TUP2(h1,l1); - } - } - - var a48 = h1 >>> 16; - var a32 = h1 & 0xFFFF; - var a16 = l1 >>> 16; - var a00 = l1 & 0xFFFF; - - var b48 = h2 >>> 16; - var b32 = h2 & 0xFFFF; - var b16 = l2 >>> 16; - var b00 = l2 & 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 += a32 * b00; - c48 += c32 >>> 16; - c32 &= 0xFFFF; - c32 += a16 * b16; - c48 += c32 >>> 16; - c32 &= 0xFFFF; - c32 += a00 * b32; - c48 += c32 >>> 16; - c32 &= 0xFFFF; - c48 += a48 * b00 + a32 * b16 + a16 * b32 + a00 * b48; - c48 &= 0xFFFF; - RETURN_UBX_TUP2((c48 << 16) | c32, (c16 << 16) | c00); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a * b); + TRACE_ARITH("Int64: " + a + " * " + b + " ==> " + r); + RETURN_I64(r); } 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()); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a / b); + TRACE_ARITH("Int64: " + a + " / " + b + " ==> " + r); + RETURN_I64(r); } 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()); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a % b); + TRACE_ARITH("Int64: " + a + " % " + b + " ==> " + r); + RETURN_I64(r); } 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; - const a00 = l1 & 0xFFFF; - - const b48 = h2 >>> 16; - const b32 = h2 & 0xFFFF; - const b16 = l2 >>> 16; - const b00 = l2 & 0xFFFF; - - var c48 = 0, c32 = 0, c16 = 0, c00 = 0; - c00 += a00 + b00; - c16 += c00 >>> 16; - c00 &= 0xFFFF; - c16 += a16 + b16; - c32 += c16 >>> 16; - c16 &= 0xFFFF; - c32 += a32 + b32; - c48 += c32 >>> 16; - c32 &= 0xFFFF; - c48 += a48 + b48; - c48 &= 0xFFFF; - RETURN_UBX_TUP2((c48 << 16) | c32, (c16 << 16) | c00); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a + b); + TRACE_ARITH("Int64: " + a + " + " + b + " ==> " + r); + RETURN_I64(r); } 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; - h$hs_plusInt64(h1,l1,nh2,nl2); -} - -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; - return (l1s < l2s || (l1s === l2s && ((l1&1) <= (l2&1)))) ? 1 : 0; - } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s < h2s || (h1s === h2s && ((h1&1) <= (h2&1)))) ? 1 : 0; - } -} - -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; - return (l1s < l2s || (l1s === l2s && ((l1&1) < (l2&1)))) ? 1 : 0; - } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s < h2s || (h1s === h2s && ((h1&1) < (h2&1)))) ? 1 : 0; - } -} - -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; - return (l1s > l2s || (l1s === l2s && ((l1&1) >= (l2&1)))) ? 1 : 0; - } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s > h2s || (h1s === h2s && ((h1&1) >= (h2&1)))) ? 1 : 0; - } -} - -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; - return (l1s > l2s || (l1s === l2s && ((l1&1) > (l2&1)))) ? 1 : 0; - } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s > h2s || (h1s === h2s && ((h1&1) > (h2&1)))) ? 1 : 0; - } + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a - b); + TRACE_ARITH("Int64: " + a + " - " + b + " ==> " + r); + RETURN_I64(r); } function h$hs_uncheckedShiftLWord64(h,l,n) { - TRACE_ARITH("uncheckedShiftLWord64: " + h + " " + l + " " + n); + var rh, rl; n &= 63; if (n == 0) { - RETURN_UBX_TUP2(h,l); + rh = h; + rl = l; } else if (n === 32) { - RETURN_UBX_TUP2(l,0); + rh = l; + rl = 0; } else if (n < 32) { - RETURN_UBX_TUP2(UN((h << n) | (l >>> (32 - n))), UN(l << n)); + rh = UN((h << n) | (l >>> (32 - n))); + rl = UN(l << n); } else { - RETURN_UBX_TUP2(UN(l << (n - 32)), 0); + rh = UN(l << (n - 32)); + rl = 0; } + + TRACE_ARITH("Word64: " + W64(h,l) + " << " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } function h$hs_uncheckedShiftRWord64(h,l,n) { - TRACE_ARITH("uncheckedShiftRWord64 " + h + " " + l + " " + n); + var rh, rl; n &= 63; if(n == 0) { - RETURN_UBX_TUP2(h, l); + rh = h; + rl = l; } else if(n === 32) { - RETURN_UBX_TUP2(0, h); + rh = 0; + rl = h; } else if(n < 32) { - RETURN_UBX_TUP2(h >>> n, UN((l >>> n ) | (h << (32-n)))); + rh = h >>> n; + rl = UN((l >>> n ) | (h << (32-n))); } else { - RETURN_UBX_TUP2(0, (h >>> (n-32))); + rh = 0; + rl = h >>> (n-32); } + TRACE_ARITH("Word64: " + W64(h,l) + " >>> " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } function h$hs_uncheckedShiftLLInt64(h,l,n) { - TRACE_ARITH("uncheckedShiftLLInt64: " + h + " " + l + " " + n); + var rh,rl; n &= 63; if (n == 0) { - RETURN_UBX_TUP2(h,l); + rh = h; + rl = l; } else if (n === 32) { - RETURN_UBX_TUP2(l|0,0); + rh = l|0; + rl = 0; } else if (n < 32) { - RETURN_UBX_TUP2((h << n) | (l >>> (32 - n)), UN(l << n)); + rh = (h << n) | (l >>> (32 - n)); + rl = UN(l << n); } else { - RETURN_UBX_TUP2(l << (n - 32), 0); + rh = l << (n - 32); + rl = 0; } + + TRACE_ARITH("Int64: " + W64(h,l) + " << " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } function h$hs_uncheckedShiftRAInt64(h,l,n) { - TRACE_ARITH("uncheckedShiftRAInt64: " + h + " " + l + " " + n); + var rh,rl; n &= 63; if (n == 0) { - RETURN_UBX_TUP2(h,l); + rh = h; + rl = l; } else if (n < 32) { - RETURN_UBX_TUP2(h >> n, UN((l >>> n) | (h << (32 - n)))); + rh = h >> n; + rl = UN((l >>> n) | UN(h << (32 - n))); } else { - RETURN_UBX_TUP2(h >= 0 ? 0 : -1, UN(h >> (n - 32))); + rh = h >= 0 ? 0 : -1; + rl = UN(h >> (n - 32)); } + + TRACE_ARITH("Int64: " + W64(h,l) + " >> " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } function h$hs_uncheckedShiftRLInt64(h,l,n) { - TRACE_ARITH("uncheckedShiftRLInt64 " + h + " " + l + " " + n); + var rh,rl; n &= 63; if(n == 0) { - RETURN_UBX_TUP2(h, l); + rh = h; + rl = l; } else if(n == 32) { - RETURN_UBX_TUP2(0, h); + rh = 0; + rl = UN(h); } else if(n < 32) { - RETURN_UBX_TUP2(h >>> n, UN((l >>> n) | (h << (32-n)))); + rh = h >>> n; + rl = UN((l >>> n) | (h << (32-n))); } else { - RETURN_UBX_TUP2(0, (h >>> (n-32))); + rh = 0; + rl = h >>> (n-32); } -} -// fixme this function appears to deoptimize a lot due to smallint overflows -function h$imul_shim(a, b) { - var ah = (a >>> 16) & 0xffff; - var al = a & 0xffff; - var bh = (b >>> 16) & 0xffff; - var bl = b & 0xffff; - // the shift by 0 fixes the sign on the high part - // the final |0 converts the unsigned value into a signed value - return (((al * bl)|0) + (((ah * bl + al * bh) << 16) >>> 0)|0); + TRACE_ARITH("Int64: " + W64(h,l) + " >>> " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } -var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim; +var h$mulInt32 = Math.imul; // 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(a,b) { - TRACE_ARITH("timesInt2 " + a + " " + b); - - // check for 0 and 1 operands - if (a === 0) { - RETURN_UBX_TUP3(0,0,0); - } - if (b === 0) { - RETURN_UBX_TUP3(0,0,0); - } - if (a === 1) { - RETURN_UBX_TUP3(0,b<0?(-1):0,b); - } - if (b === 1) { - RETURN_UBX_TUP3(0,a<0?(-1):0,a); - } +function h$hs_timesInt2(l1,l2) { + var a = I32(l1); + var b = I32(l2); + var r = BigInt.asIntN(64, a * b); + TRACE_ARITH("Int64: " + a + " * " + b + " ==> " + r); - var ha = a < 0 ? (-1) : 0; - var hb = b < 0 ? (-1) : 0; - var ch = h$hs_timesInt64(ha,a,hb,b); - var cl = h$ret1; - 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); + var rh = I64h(r); + var rl = I64l(r); + var nh = ((rh === 0 && rl >= 0) || (rh === -1 && rl < 0)) ? 0 : 1; + RETURN_UBX_TUP3(nh, rh, rl); } function h$mulWord32(l1,l2) { - TRACE_ARITH("mulWord32 " + l1 + " " + l2); - - // check for 0 and 1 operands - if (l1 === 0) { - return 0; - } - if (l1 === 1) { - return l2; - } - if (l2 === 0) { - return 0; - } - if (l2 === 1) { - return l1; - } - - var a16 = l1 >>> 16; - var a00 = l1 & 0xFFFF; - - var b16 = l2 >>> 16; - var b00 = l2 & 0xFFFF; - - var c16 = 0, c00 = 0; - c00 += a00 * b00; - c16 += c00 >>> 16; - c00 &= 0xFFFF; - c16 += a16 * b00; - c16 &= 0xFFFF; - c16 += a00 * b16; - c16 &= 0xFFFF; - return ((c16 << 16) | c00); + var a = W32(l1); + var b = W32(l2); + var r = BigInt.asUintN(32, a * b); + TRACE_ARITH("Word32: " + a + " * " + b + " ==> " + r); + RETURN_W32(r); } function h$mul2Word32(l1,l2) { - TRACE_ARITH("mul2Word32 " + l1 + " " + l2); - - // check for 0 and 1 operands - if (l1 === 0) { - RETURN_UBX_TUP2(0,0); - } - if (l1 === 1) { - RETURN_UBX_TUP2(0,l2); - } - if (l2 === 0) { - RETURN_UBX_TUP2(0,0); - } - if (l2 === 1) { - RETURN_UBX_TUP2(0,l1); - } - - var a16 = l1 >>> 16; - var a00 = l1 & 0xFFFF; - - var b16 = l2 >>> 16; - var b00 = l2 & 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 += a16 * b16; - c48 += c32 >>> 16; - c32 &= 0xFFFF; - c48 &= 0xFFFF; - RETURN_UBX_TUP2(UN((c48 << 16) | c32), UN((c16 << 16) | c00)); + var a = W32(l1); + var b = W32(l2); + var r = BigInt.asUintN(64, a * b); + TRACE_ARITH("Word32: " + a + " * " + b + " ==> " + r + " (Word64)"); + RETURN_W64(r); } function h$quotWord32(n,d) { - TRACE_ARITH("quotWord32 " + n + " " + d); - - // from Hacker's Delight book (p 192) - // adapted for JavaScript - var t = d >> 31; - var n2 = n & ~t; - var q = ((n2 >>> 1) / d) << 1; - var r = (n - h$mulWord32(q,d)) >>> 0; - var c = UN(r) >= UN(d); - return (q + (c ? 1 : 0)) >>> 0; + var a = W32(n); + var b = W32(d); + var r = BigInt.asUintN(32, a / b); + TRACE_ARITH("Word32: " + a + " / " + b + " ==> " + r); + RETURN_W32(r); } function h$remWord32(n,d) { - TRACE_ARITH("remWord32 " + n + " " + d); - - var t = d >> 31; - var n2 = n & ~t; - var q = ((n2 >>> 1) / d) << 1; - var r = (n - h$mulWord32(q,d)) >>> 0; - var c = UN(r) >= UN(d); - return UN(r - (c ? d : 0)); + var a = W32(n); + var b = W32(d); + var r = BigInt.asUintN(32, a % b); + TRACE_ARITH("Word32: " + a + " % " + b + " ==> " + r); + RETURN_W32(r); } function h$quotRemWord32(n,d) { - TRACE_ARITH("quotRemWord32 " + n + " " + d); - - var t = d >> 31; - var n2 = n & ~t; - var q = ((n2 >>> 1) / d) << 1; - 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)); - - TRACE_ARITH("quotRemWord32 results: " + rq + " " + rr); - - RETURN_UBX_TUP2(rq,rr); + var a = W32(n); + var b = W32(d); + var q = BigInt.asUintN(32, a / b); + var r = BigInt.asUintN(32, a % b); + TRACE_ARITH("Word32: " + a + " `quotRem` " + b + " ==> (" + q + ", " + r + ")"); + RETURN_UBX_TUP2(Number(q),Number(r)); } 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); - nl = UN(nl); - d = UN(d); - - if (nh >= d) { - // WordQuotRem2Op requires that high word < divisor - throw "h$quotRem2Word32: unexpected high word > divisor: high word=" + nh + ", divisor=" + d; - } - - if (d === 0) { - // FIXME: raise Haskell exception - throw "h$quotRem2Word32: division by zero"; - } - - var s = Math.clz32(d); // 0 <= s <= 31 - 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 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 - h$mulWord32(q1,dh)); - - //TRACE_ARITH("quotRem2Word32 q1 rhat " + q1 + " " + rhat); - - 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); - - 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 - h$mulWord32(q0,dh)); - - //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; - } - - //TRACE_ARITH("quotRem2Word32 q0' rhat' " + q0 + " " + rhat); - - var rq = UN(q1 << 16 | q0); - var rr = (UN(UN(un21 << 16) | un0) - h$mulWord32(q0,d)) >>> s; - - TRACE_ARITH("quotRem2Word32 results: " + rq + " " + rr); - - RETURN_UBX_TUP2(rq,rr); -} - -function h$wordAdd2(a,b) { - TRACE_ARITH("wordAdd2 " + a + " " + b); - - const a16 = a >>> 16; - const a00 = a & 0xFFFF; - - const b16 = b >>> 16; - const b00 = b & 0xFFFF; - - var c32 = 0, c16 = 0, c00 = 0; - c00 += a00 + b00; - c16 += c00 >>> 16; - c00 &= 0xFFFF; - c16 += a16 + b16; - c32 += c16 >>> 16; - c16 &= 0xFFFF; - RETURN_UBX_TUP2(c32, (c16 << 16) | c00); + var a = W64(nh,nl); + var b = W32(d); + var q = BigInt.asUintN(32, a / b); + var r = BigInt.asUintN(32, a % b); + TRACE_ARITH("Word32: " + a + " `quotRem2` " + b + " ==> (" + q + ", " + r + ")"); + RETURN_UBX_TUP2(Number(q),Number(r)); +} + +function h$wordAdd2(l1,l2) { + var a = W32(l1); + var b = W32(l2); + var r = BigInt.asUintN(64, a * b); + TRACE_ARITH("Word32: " + a + " + " + b + " ==> " + r + " (Word64)"); + RETURN_W64(r); } function h$isDoubleNegativeZero(d) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/327a144f5ff375604a540d58c5879d2aed0576fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/327a144f5ff375604a540d58c5879d2aed0576fe You're receiving 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 25 09:27:39 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 05:27:39 -0400 Subject: [Git][ghc/ghc][wip/js-staging] PrimOp: fixup previous commit... Message-ID: <6307408b4a2d9_e9d7d323c611c1085259@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: ea00b568 by Sylvain Henry at 2022-08-25T11:30:08+02:00 PrimOp: fixup previous commit... - - - - - 1 changed file: - js/arith.js.pp Changes: ===================================== js/arith.js.pp ===================================== @@ -14,7 +14,7 @@ function h$logArith() { h$log.apply(h$log,arguments); } #define W64l(x) (Number(BigInt.asUintN(32, x)) >>> 0) #define I64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0)) #define I64h(x) (Number(x >> BigInt(32))|0) -#define I64l(x) (Number(BigInt.asIntN(32,x))|0) +#define I64l(x) (Number(BigInt.asUintN(32,x)) >>> 0) #define RETURN_I64(x) RETURN_UBX_TUP2(I64h(x), I64l(x)) #define RETURN_W64(x) RETURN_UBX_TUP2(W64h(x), W64l(x)) #define RETURN_W32(x) return Number(x) @@ -214,10 +214,10 @@ function h$hs_timesInt2(l1,l2) { var a = I32(l1); var b = I32(l2); var r = BigInt.asIntN(64, a * b); - TRACE_ARITH("Int64: " + a + " * " + b + " ==> " + r); + TRACE_ARITH("Int32: " + a + " * " + b + " ==> " + r + " (Int64)"); var rh = I64h(r); - var rl = I64l(r); + var rl = I64l(r)|0; var nh = ((rh === 0 && rl >= 0) || (rh === -1 && rl < 0)) ? 0 : 1; RETURN_UBX_TUP3(nh, rh, rl); } @@ -276,7 +276,7 @@ function h$quotRem2Word32(nh,nl,d) { function h$wordAdd2(l1,l2) { var a = W32(l1); var b = W32(l2); - var r = BigInt.asUintN(64, a * b); + var r = BigInt.asUintN(64, a + b); TRACE_ARITH("Word32: " + a + " + " + b + " ==> " + r + " (Word64)"); RETURN_W64(r); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea00b5682c3e3f22d9dc08a77034353716a83f0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea00b5682c3e3f22d9dc08a77034353716a83f0f You're receiving 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 25 10:49:28 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 06:49:28 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21851-rule-win Message-ID: <630753b83591d_e9d7d323c611c109417c@gitlab.mail> Simon Peyton Jones pushed new branch wip/T21851-rule-win at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21851-rule-win You're receiving 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 25 10:49:37 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 06:49:37 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Primop: fixup previous commit Message-ID: <630753c1a03ff_e9d7d4d1d41094352@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 6202f5ff by Sylvain Henry at 2022-08-25T12:52:26+02:00 Primop: fixup previous commit - - - - - 1 changed file: - js/arith.js.pp Changes: ===================================== js/arith.js.pp ===================================== @@ -9,6 +9,7 @@ function h$logArith() { h$log.apply(h$log,arguments); } #define UN(x) ((x)>>>0) #define W32(x) (BigInt(x)) +#define I32(x) (BigInt(x)) #define W64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0)) #define W64h(x) (Number(x >> BigInt(32)) >>> 0) #define W64l(x) (Number(BigInt.asUintN(32, x)) >>> 0) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6202f5ffb567740d073731fa61baa9baf56e2bc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6202f5ffb567740d073731fa61baa9baf56e2bc7 You're receiving 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 25 10:53:05 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 06:53:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Message-ID: <63075491e2cd1_e9d7d4887811019da@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - acc3c739 by Ben Gamari at 2022-08-25T06:52:46-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 7cbe6f02 by M Farkas-Dyck at 2022-08-25T06:52:54-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 29 changed files: - .gitlab/upload_ghc_libs.py - compiler/GHC/Cmm/CommonBlockElim.hs - 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/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Tidy.hs - rts/Stats.c - + testsuite/tests/arityanal/should_compile/T21755.hs - + testsuite/tests/arityanal/should_compile/T21755.stderr - testsuite/tests/arityanal/should_compile/all.T - + testsuite/tests/arityanal/should_run/T21694a.hs - + testsuite/tests/arityanal/should_run/T21694a.stderr - testsuite/tests/arityanal/should_run/all.T - + testsuite/tests/simplCore/should_compile/T21694.hs - + testsuite/tests/simplCore/should_compile/T21694b.hs - + testsuite/tests/simplCore/should_compile/T21694b.stderr - + testsuite/tests/simplCore/should_compile/T21948.hs - + testsuite/tests/simplCore/should_compile/T21948.stderr - + testsuite/tests/simplCore/should_compile/T21960.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41ff6a6f1c9d8b8d23b81a1d3e3a8c195505fb53...7cbe6f02ec882eabc958b7e7fc99384f643a9c66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41ff6a6f1c9d8b8d23b81a1d3e3a8c195505fb53...7cbe6f02ec882eabc958b7e7fc99384f643a9c66 You're receiving 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 25 11:02:21 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 07:02:21 -0400 Subject: [Git][ghc/ghc][wip/T21763] 102 commits: Add a note about about W/W for unlifting strict arguments Message-ID: <630756bd35852_e9d7d247d11ac1111852@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21763 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. - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 46b5ef2a by Simon Peyton Jones at 2022-08-25T12:03:28+01:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. - - - - - 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/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/379b0e084811eb9da50765ca3d8d0d954a3fb27a...46b5ef2affec62a7342384d723d3acd8262a35b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/379b0e084811eb9da50765ca3d8d0d954a3fb27a...46b5ef2affec62a7342384d723d3acd8262a35b7 You're receiving 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 25 13:10:10 2022 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Thu, 25 Aug 2022 09:10:10 -0400 Subject: [Git][ghc/ghc][wip/T22039] DmdAnal: Don't panic in addCaseBndrDmd (#22039) Message-ID: <630774b27471b_e9d7d268fc25011257b0@gitlab.mail> Sebastian Graf pushed to branch wip/T22039 at Glasgow Haskell Compiler / GHC Commits: 14a81b15 by Sebastian Graf at 2022-08-25T15:07:09+02:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. Fixes #22039. - - - - - 3 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - + testsuite/tests/stranal/should_compile/T22039.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -586,7 +586,6 @@ dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs) = -- pprTrace "dmdAnalSumAlt" (ppr con $$ ppr case_bndr $$ ppr dmd $$ ppr alt_ty) $ WithDmdType alt_ty (Alt con new_ids rhs') --- Precondition: The SubDemand is not a Call -- See Note [Demand on the scrutinee of a product case] -- and Note [Demand on case-alternative binders] addCaseBndrDmd :: SubDemand -- On the case binder @@ -598,8 +597,9 @@ addCaseBndrDmd case_sd fld_dmds | Just (_, ds) <- viewProd (length fld_dmds) scrut_sd -- , pprTrace "addCaseBndrDmd" (ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) True = (scrut_sd, ds) - | otherwise - = pprPanic "was a call demand" (ppr case_sd $$ ppr fld_dmds) -- See the Precondition + | otherwise -- Either an arity mismatch or scrut_sd was a call demand. + -- See Note [Untyped demand on case-alternative binders] + = (topSubDmd, map (const topDmd) fld_dmds) where scrut_sd = case_sd `plusSubDmd` mkProd Unboxed fld_dmds @@ -830,6 +830,39 @@ thunk for a let binder that was an an absent case-alt binder during DmdAnal. This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. +Note [Untyped demand on case-alternative binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder +may be a call demand or have a different number of fields than the constructor +of the case alternative it is used in. From T22039: + + blarg :: (Int, Int) -> String + blarg = show + + f :: Either Int Int -> String + f Left{} = "no" + f e = blarg (unsafeCoerce e) + ==> { desugars to } + f = \ (ds_d1nV :: Either Int Int) -> + case ds_d1nV of wild_X1 { + Left ds_d1oV -> lvl_s1Q6; + Right ipv_s1Pl -> + blarg + (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of + { UnsafeRefl co_a1oT -> + wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int)) + }) + } + +The case binder `e`/`wild_X1` has demand 1P(L,L), with two fields, from the call +to `blarg`, but `Right` only has one field. Although the code will crash when +executed, we must be able to analyse it and conservatively approximate with Top +instead of panicking because of the mismatch. +In #22039, this kind of code was guarded behind a safe `cast` and thus dead +code, but nevertheless led to a panic of the compiler. + +See also Note [mkWWstr and unsafeCoerce] for a related issue. + Note [Aggregated demand for cardinality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FIXME: This Note should be named [LetUp vs. LetDown] and probably predates ===================================== testsuite/tests/stranal/should_compile/T22039.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Bug where + +import Control.Exception +import Data.Typeable +import Unsafe.Coerce + +data Error + = Error Int String + | forall e . Exception e => SomeError Int e + deriving (Typeable) + +fromError :: Exception e => Error -> Maybe e +fromError e@(Error _ _) = cast e +fromError (SomeError _ e) = cast e +-- {-# NOINLINE fromError #-} + +instance Eq Error where + Error i s == Error i' s' = i == i' && s == s' + SomeError i e == SomeError i' e' = i == i' && show e == show e' + _ == _ = False + +instance Show Error where + show _ = "" + +instance Exception Error + +-- newtype +data + UniquenessError = UniquenessError [((String, String), Int)] + deriving (Show, Eq) + +instance Exception UniquenessError + +test :: SomeException -> IO () +test e = case fromError =<< fromException e :: Maybe UniquenessError of + Just err -> print err + _ -> pure () + +-- +-- Smaller reproducer by sgraf +-- + +blarg :: (Int,Int) -> String +blarg = show +{-# NOINLINE blarg #-} + +f :: Either Int Int -> String +f Left{} = "no" +f e = blarg (unsafeCoerce e) + +blurg :: (Int -> String) -> String +blurg f = f 42 +{-# NOINLINE blurg #-} + +g :: Either Int Int -> String +g Left{} = "no" +g e = blurg (unsafeCoerce e) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -85,3 +85,4 @@ test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) test('T21265', normal, compile, ['']) test('EtaExpansion', normal, compile, ['']) +test('T22039', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14a81b15c63b563b67fe88d8d99fe492db60be1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14a81b15c63b563b67fe88d8d99fe492db60be1c You're receiving 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 25 13:31:07 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 09:31:07 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: Doc: minor changes Message-ID: <6307799b18cc6_e9d7d323c611c11349cc@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: ae77f624 by Sylvain Henry at 2022-08-25T15:32:26+02:00 Doc: minor changes - - - - - 9e2d99d8 by Sylvain Henry at 2022-08-25T15:33:26+02:00 Add debug option to watch for insertion of undefined/null in the stack - - - - - 3 changed files: - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/Types.hs - js/thread.js.pp Changes: ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -61,9 +61,9 @@ setObjInfoL debug obj rs layout t n a = setObjInfo debug obj t n field_types a size rs where size = case layout of - CILayoutVariable -> (-1) - CILayoutUnknown size -> size - CILayoutFixed size _ -> size + CILayoutVariable -> (-1) + CILayoutUnknown sz -> sz + CILayoutFixed sz _ -> sz field_types = case layout of CILayoutVariable -> [] CILayoutUnknown size -> toTypeList (replicate size ObjV) ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -77,7 +77,7 @@ 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 -- ^ size of the payload (in number of JS values) , 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 ===================================== js/thread.js.pp ===================================== @@ -20,6 +20,9 @@ #define GHCJS_BUSY_YIELD 500 #endif +// Watch for insertion of null or undefined in the stack +//#define GHCJS_DEBUG_STACK + #ifdef GHCJS_TRACE_SCHEDULER function h$logSched() { if(arguments.length == 1) { if(h$currentThread != null) { @@ -66,6 +69,18 @@ function h$Thread() { this.tid = ++h$threadIdN; this.status = THREAD_RUNNING; this.stack = [h$done, 0, h$baseZCGHCziConcziSynczireportError, h$catch_e]; +#ifdef GHCJS_DEBUG_STACK + this.stack = new Proxy(this.stack, { + set(obj,prop,value) { + if (value === undefined || value === null) { + throw new Error("setting stack offset " + prop + " to " + value); + } + else { + return Reflect.set(...arguments); + } + } + }); +#endif this.sp = 3; this.mask = 0; // async exceptions masked (0 unmasked, 1: uninterruptible, 2: interruptible) this.interruptible = false; // currently in an interruptible operation View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6202f5ffb567740d073731fa61baa9baf56e2bc7...9e2d99d800d76d69c64a251803ff3dd96c62b21e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6202f5ffb567740d073731fa61baa9baf56e2bc7...9e2d99d800d76d69c64a251803ff3dd96c62b21e You're receiving 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 25 13:54:49 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 Aug 2022 09:54:49 -0400 Subject: [Git][ghc/ghc][wip/T22077] 16 commits: Recognize file-header pragmas in GHCi (#21507) Message-ID: <63077f296e6f1_e9d7d4d1d41139887@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - f7e86444 by Ben Gamari at 2022-08-25T09:34:44-04:00 rts: Add missing declarations - - - - - de2f1b5f by Ben Gamari at 2022-08-25T09:34:44-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - df75e530 by Ben Gamari at 2022-08-25T09:34:44-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 1b42b0a1 by Ben Gamari at 2022-08-25T09:34:44-04:00 rts: Refactor IPE tracing support - - - - - 1141ef1c by Ben Gamari at 2022-08-25T09:54:44-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. - - - - - 1864cd27 by Ben Gamari at 2022-08-25T09:54: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. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - + compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/ghc.cabal.in - docs/users_guide/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - hadrian/bindist/Makefile - hadrian/src/Settings/Default.hs - 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 - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - libraries/template-haskell/changelog.md - rts/IPE.c - rts/IPE.h - rts/RtsStartup.c - rts/Stats.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/782c6196cc3b0014221a7cb6ba9ce46b99ca114d...1864cd27cb51092d71d21f39e1fef550037ef635 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/782c6196cc3b0014221a7cb6ba9ce46b99ca114d...1864cd27cb51092d71d21f39e1fef550037ef635 You're receiving 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 25 14:01:25 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 10:01:25 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: Apply: fix tag generation Message-ID: <630780b5c17ab_e9d7d1ee7674c1141472@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 19142037 by Sylvain Henry at 2022-08-25T16:03:55+02:00 Apply: fix tag generation - - - - - 6f2659d9 by Sylvain Henry at 2022-08-25T16:04:17+02:00 Remove redundant import - - - - - 2 changed files: - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Linker/Linker.hs Changes: ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -807,7 +807,7 @@ stackApply s fun_name nargs nvars = [ rs |= (arity .>>. 8) , loadRegs rs , sp |= sp - rs - , newAp |= (var "h$apply" .! (toJExpr nargs-arity0.|.((toJExpr nvars-rs).<<.8))) + , newAp |= (var "h$apply" .! ((toJExpr nargs-arity0).|.((toJExpr nvars-rs).<<.8))) , stack .! sp |= newAp , profStat s pushRestoreCCS , traceRts s (toJExpr (fun_name <> ": new stack frame: ") + (newAp .^ "n")) @@ -891,7 +891,7 @@ fastApply s fun_name nargs nvars = func ||= body0 + rsRemain) , saveRegs rs , sp |= sp + rsRemain + 1 - , stack .! sp |= var "h$apply" .! ((rsRemain.<<.8).|. toJExpr nargs - mask8 arity) + , stack .! sp |= var "h$apply" .! ((rsRemain.<<.8).|. (toJExpr nargs - mask8 arity)) , profStat s pushRestoreCCS , returnS c ] ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -50,7 +50,6 @@ import GHC.Unit.Env import GHC.Unit.Home import GHC.Unit.Types import GHC.Utils.Error -import GHC.Driver.Env.Types import GHC.Data.FastString import Control.Concurrent.MVar View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9e2d99d800d76d69c64a251803ff3dd96c62b21e...6f2659d90589a29a1786eca8057fe29ecac6d04e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9e2d99d800d76d69c64a251803ff3dd96c62b21e...6f2659d90589a29a1786eca8057fe29ecac6d04e You're receiving 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 25 14:03:19 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 10:03:19 -0400 Subject: [Git][ghc/ghc][master] Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <63078127172f4_e9d7d323c611c115249c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 24 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/WorkWrap.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Iface/Tidy.hs - + testsuite/tests/arityanal/should_compile/T21755.hs - + testsuite/tests/arityanal/should_compile/T21755.stderr - testsuite/tests/arityanal/should_compile/all.T - + testsuite/tests/arityanal/should_run/T21694a.hs - + testsuite/tests/arityanal/should_run/T21694a.stderr - testsuite/tests/arityanal/should_run/all.T - + testsuite/tests/simplCore/should_compile/T21694.hs - + testsuite/tests/simplCore/should_compile/T21694b.hs - + testsuite/tests/simplCore/should_compile/T21694b.stderr - + testsuite/tests/simplCore/should_compile/T21948.hs - + testsuite/tests/simplCore/should_compile/T21948.stderr - + testsuite/tests/simplCore/should_compile/T21960.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a90298cc7291677fddd9e374e222676306265c17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a90298cc7291677fddd9e374e222676306265c17 You're receiving 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 25 14:03:49 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 10:03:49 -0400 Subject: [Git][ghc/ghc][master] upload_ghc_libs: Add means of passing Hackage credentials Message-ID: <630781456ffb1_e9d7d39bc2b34115599d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 1 changed file: - .gitlab/upload_ghc_libs.py Changes: ===================================== .gitlab/upload_ghc_libs.py ===================================== @@ -17,6 +17,7 @@ There are two modes, preparation and upload. """ from subprocess import run, check_call +from getpass import getpass import shutil from pathlib import Path from typing import NamedTuple, Callable, List, Dict, Optional @@ -36,6 +37,10 @@ class Package(NamedTuple): path: Path prepare_sdist: Callable[[], None] +class Credentials(NamedTuple): + username: str + password: str + def no_prep(): pass @@ -97,11 +102,15 @@ PACKAGES = { } # Dict[str, Package] -def cabal_upload(tarball: Path, publish: bool=False, extra_args=[]): +def cabal_upload(tarball: Path, creds: Credentials, publish: bool=False, extra_args=[]): if publish: extra_args += ['--publish'] - run(['cabal', 'upload'] + extra_args + [tarball], check=True) + creds_args = [ + f'--username={creds.username}', + f'--password={creds.password}' + ] + run(['cabal', 'upload'] + extra_args + [tarball] + creds_args, check=True) def prepare_sdist(pkg: Package): @@ -115,13 +124,13 @@ def prepare_sdist(pkg: Package): res_path = shutil.copy(sdist, OUT_DIR) return os.path.relpath(res_path, OUT_DIR) -def upload_pkg_sdist(sdist : Path, pkg : Package, publish : bool): +def upload_pkg_sdist(sdist : Path, pkg: Package, publish: bool, creds: Credentials): publish_tag = '-publish' if publish else '' stamp = WORK_DIR / f'{pkg.name}-sdist{publish_tag}' if stamp.is_file(): return print(f'Uploading package {pkg.name}...') - cabal_upload(sdist, publish) + cabal_upload(sdist, publish=publish, creds=creds) stamp.write_text('') def get_version(cabal_file: Path) -> Optional[str]: @@ -137,8 +146,8 @@ def prepare_docs(bindist: Path, pkg: Package): """ cabal_file = pkg.path / f'{pkg.name}.cabal' version = get_version(cabal_file) - docdir = bindist / 'doc' / 'html' / 'libraries' / (pkg.name + "-" + version) assert version is not None + docdir = bindist / 'doc' / 'html' / 'libraries' / (pkg.name + "-" + version) # Build the documentation tarball from the bindist documentation stem = f'{pkg.name}-{version}-docs' @@ -148,20 +157,20 @@ def prepare_docs(bindist: Path, pkg: Package): run(['tar', '-czf', OUT_DIR / tarball, '-H', 'ustar', '-C', tmp.name, stem]) return tarball -def upload_docs(tarball : Path, pkg : Package, publish : bool): +def upload_docs(tarball : Path, pkg : Package, publish : bool, creds: Credentials): publish_tag = '-publish' if publish else '' stamp = WORK_DIR / f'{pkg.name}-docs{publish_tag}' if stamp.is_file(): return # Upload the documentation tarball print(f'Uploading documentation for {pkg.name}...') - cabal_upload(tarball, publish=publish, extra_args=['--documentation']) + cabal_upload(tarball, publish=publish, extra_args=['--documentation'], creds=creds) stamp.write_text('') -def upload_pkg(pkg: Package, d : Path, meta, publish : bool): +def upload_pkg(pkg: Package, d : Path, meta, publish : bool, creds: Credentials): print(f'Uploading {pkg.name}...') - upload_pkg_sdist(d / meta['sdist'], pkg, publish=publish) - upload_docs(d / meta['docs'], pkg, publish=publish) + upload_pkg_sdist(d / meta['sdist'], pkg, publish=publish, creds=creds) + upload_docs(d / meta['docs'], pkg, publish=publish, creds=creds) def prepare_pkg(bindist : Path, pkg : Package): if pkg.path.exists(): @@ -172,11 +181,6 @@ def prepare_pkg(bindist : Path, pkg : Package): else: print(f"Package {pkg.name} doesn't exist... skipping") - -def upload_all(bindist: Path): - for pkg in PACKAGES.values(): - upload_pkg(bindist, pkg) - def main() -> None: import argparse @@ -212,13 +216,16 @@ def main() -> None: pickle.dump(manifest, fout) elif args.command == "upload": + username = input('Hackage username: ') + password = getpass('Hackage password: ') + creds = Credentials(username, password) manifest_path = args.docs with open(manifest_path / 'manifest.pickle', 'rb') as fin: manifest = pickle.load(fin) for pkg, item in manifest.items(): if pkg.name in pkgs: print(pkg, item) - upload_pkg(pkg, manifest_path, item, publish=args.publish) + upload_pkg(pkg, manifest_path, item, publish=args.publish, creds=creds) if __name__ == '__main__': main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/909edcfccae6664702384f83b1b5840eb3dc0a10 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/909edcfccae6664702384f83b1b5840eb3dc0a10 You're receiving 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 25 14:04:33 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 10:04:33 -0400 Subject: [Git][ghc/ghc][master] Scrub some partiality in `CommonBlockElim`. Message-ID: <630781719b67_e9d7d488781159544@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 1 changed file: - compiler/GHC/Cmm/CommonBlockElim.hs Changes: ===================================== compiler/GHC/Cmm/CommonBlockElim.hs ===================================== @@ -22,12 +22,12 @@ import Data.Maybe (mapMaybe) import qualified Data.List as List import Data.Word import qualified Data.Map as M -import GHC.Utils.Outputable -import GHC.Utils.Panic import qualified GHC.Data.TrieMap as TM import GHC.Types.Unique.FM import GHC.Types.Unique import Control.Arrow (first, second) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE -- ----------------------------------------------------------------------------- -- Eliminate common blocks @@ -81,7 +81,7 @@ iterate subst blocks | mapNull new_substs = subst | otherwise = iterate subst' updated_blocks where - grouped_blocks :: [[(Key, [DistinctBlocks])]] + grouped_blocks :: [[(Key, NonEmpty DistinctBlocks)]] grouped_blocks = map groupByLabel blocks merged_blocks :: [[(Key, DistinctBlocks)]] @@ -106,9 +106,8 @@ mergeBlocks subst existing new = go new -- This block is not a duplicate, keep it. Nothing -> second (b:) $ go bs -mergeBlockList :: Subst -> [DistinctBlocks] -> (Subst, DistinctBlocks) -mergeBlockList _ [] = pprPanic "mergeBlockList" empty -mergeBlockList subst (b:bs) = go mapEmpty b bs +mergeBlockList :: Subst -> NonEmpty DistinctBlocks -> (Subst, DistinctBlocks) +mergeBlockList subst (b:|bs) = go mapEmpty b bs where go !new_subst1 b [] = (new_subst1, b) go !new_subst1 b1 (b2:bs) = go new_subst b bs @@ -301,15 +300,15 @@ copyTicks env g -- Group by [Label] -- See Note [Compressed TrieMap] in GHC.Core.Map.Expr about the usage of GenMap. -groupByLabel :: [(Key, DistinctBlocks)] -> [(Key, [DistinctBlocks])] +groupByLabel :: [(Key, DistinctBlocks)] -> [(Key, NonEmpty DistinctBlocks)] groupByLabel = - go (TM.emptyTM :: TM.ListMap (TM.GenMap LabelMap) (Key, [DistinctBlocks])) + go (TM.emptyTM :: TM.ListMap (TM.GenMap LabelMap) (Key, NonEmpty DistinctBlocks)) where go !m [] = TM.foldTM (:) m [] go !m ((k,v) : entries) = go (TM.alterTM k adjust m) entries where --k' = map (getKey . getUnique) k - adjust Nothing = Just (k,[v]) - adjust (Just (_,vs)) = Just (k,v:vs) + adjust Nothing = Just (k, pure v) + adjust (Just (_,vs)) = Just (k, v NE.<| vs) groupByInt :: (a -> Int) -> [a] -> [[a]] groupByInt f xs = nonDetEltsUFM $ List.foldl' go emptyUFM xs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28402eed1bd0ec27d1dd5b663304a741de0ce2c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28402eed1bd0ec27d1dd5b663304a741de0ce2c3 You're receiving 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 25 14:08:27 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 Aug 2022 10:08:27 -0400 Subject: [Git][ghc/ghc][wip/T22077] 6 commits: rts: Add missing declaration of stg_noDuplicate Message-ID: <6307825b34ff8_e9d7d3d103bf4116012a@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 3820387b by Ben Gamari at 2022-08-25T10:08:03-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 46101141 by Ben Gamari at 2022-08-25T10:08:11-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - 3b0785ca by Ben Gamari at 2022-08-25T10:08:11-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 2be785d1 by Ben Gamari at 2022-08-25T10:08:11-04:00 rts: Refactor IPE tracing support - - - - - 3650e2a7 by Ben Gamari at 2022-08-25T10:08:11-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. - - - - - 734e4ef2 by Ben Gamari at 2022-08-25T10:08:11-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. - - - - - 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/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/Cmm.h - rts/include/Rts.h - rts/include/rts/IPE.h - rts/include/stg/MiscClosures.h - rts/include/stg/SMP.h - rts/sm/NonMoving.h - testsuite/tests/profiling/should_run/staticcallstack001.hs - testsuite/tests/profiling/should_run/staticcallstack001.stdout - testsuite/tests/profiling/should_run/staticcallstack002.hs - testsuite/tests/profiling/should_run/staticcallstack002.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1864cd27cb51092d71d21f39e1fef550037ef635...734e4ef27fe8108ab888943bcca0d9b03de5de44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1864cd27cb51092d71d21f39e1fef550037ef635...734e4ef27fe8108ab888943bcca0d9b03de5de44 You're receiving 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 25 14:18:36 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 Aug 2022 10:18:36 -0400 Subject: [Git][ghc/ghc][wip/T20155] 323 commits: Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115 Message-ID: <630784bc9a1de_e9d7d1ee7674c117901b@gitlab.mail> Ben Gamari pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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 - - - - - 0ac5b35c by Ben Gamari at 2022-08-24T21:21:40-04:00 Drop ghcPrimIfaceHook - - - - - edafb4cf by Ben Gamari at 2022-08-24T21:21:40-04:00 Rip out hacks surrounding GHC.Prim and primops - - - - - 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/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2169759046846dce7ef2485dc6e0e65f50389c0...edafb4cf0fa45f19bc0296cc114abcacb020dbdf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2169759046846dce7ef2485dc6e0e65f50389c0...edafb4cf0fa45f19bc0296cc114abcacb020dbdf You're receiving 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 25 14:27:02 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 10:27:02 -0400 Subject: [Git][ghc/ghc][wip/T21763] Improve SpecConstr for evals Message-ID: <630786b644500_e9d7d3d103bf4118316b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21763 at Glasgow Haskell Compiler / GHC Commits: 2647bd27 by Simon Peyton Jones at 2022-08-25T15:26:00+01:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 7 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - + testsuite/tests/simplCore/should_compile/T21763.hs - + testsuite/tests/simplCore/should_compile/T21763.stderr - + testsuite/tests/simplCore/should_compile/T21763a.hs - + testsuite/tests/simplCore/should_compile/T21763a.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2185,7 +2185,7 @@ prepareAlts tries these things: case e of x { (a,b) -> rhs } where the type is a single constructor type. This gives better code when rhs also scrutinises x or e. - See CoreUtils Note [Refine DEFAULT case alternatives] + See GHC.Core.Utils Note [Refine DEFAULT case alternatives] 3. combineIdenticalAlts: combine identical alternatives into a DEFAULT. See CoreUtils Note [Combine identical alternatives], which also ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -671,14 +671,16 @@ But regardless, SpecConstr can and should! It's easy: well as constructor applications. Wrinkles: + * This should all work perfectly fine for newtype classes. Mind you, currently newtype classes are inlined fairly agressively, but we may change that. And it would take extra code to exclude them, as well as being unnecessary. -* We (mis-) use LambdaVal for this purpose, because ConVal - requires us to list the data constructor and fields, and that - is (a) inconvenient and (b) unnecessary for class methods. +* In isValue, we (mis-) use LambdaVal for this ($fblah d1 .. dn) + because ConVal requires us to list the data constructor and + fields, and that is (a) inconvenient and (b) unnecessary for + class methods. ----------------------------------------------------- Stuff not yet handled @@ -1227,7 +1229,20 @@ data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument | UnkOcc -- Used in some unknown way | ScrutOcc -- See Note [ScrutOcc] - (DataConEnv [ArgOcc]) -- How the sub-components are used + (DataConEnv [ArgOcc]) + -- [ArgOcc]: how the sub-components are used + +deadArgOcc :: ArgOcc -> Bool +deadArgOcc (ScrutOcc {}) = False +deadArgOcc UnkOcc = False +deadArgOcc NoOcc = True + +specialisableArgOcc :: ArgOcc -> Bool +-- | Does this occurence represent one worth specializing for. +specialisableArgOcc UnkOcc = False +specialisableArgOcc NoOcc = False +specialisableArgOcc (ScrutOcc {}) = True + {- Note [ScrutOcc] ~~~~~~~~~~~~~~~~~~ @@ -1253,6 +1268,9 @@ instance Outputable ArgOcc where ppr NoOcc = text "no-occ" evalScrutOcc :: ArgOcc +-- We use evalScrutOcc for +-- - mkVarUsage: applied functions +-- - scApp: dicts that are the arugment of a classop evalScrutOcc = ScrutOcc emptyUFM -- Experimentally, this version of combineOcc makes ScrutOcc "win", so @@ -1333,26 +1351,29 @@ scExpr' env (Case scrut b ty alts) = do { let (alt_env,b') = extendBndrWith RecArg env b -- Record RecArg for the components - ; (alt_usgs, alt_occs, alts') - <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts + ; (alt_usgs, alt_occs, alts') <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts ; let scrut_occ = foldr combineOcc NoOcc alt_occs scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ -- The combined usage of the scrutinee is given - -- by scrut_occ, which is passed to scScrut, which + -- by scrut_occ, which is passed to setScrutOcc, which -- in turn treats a bare-variable scrutinee specially ; return (foldr combineUsage scrut_usg' alt_usgs, Case scrut' b' (scSubstTy env ty) alts') } + single_alt = isSingleton alts + sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs (env2, bs2) = extendCaseBndrs env1 scrut' b' con bs1 ; (usg, rhs') <- scExpr env2 rhs ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2) scrut_occ = case con of - DataAlt dc -> ScrutOcc (unitUFM dc arg_occs) - _ -> evalScrutOcc + DataAlt dc -- See Note [Do not specialise evals] + | not (single_alt && all deadArgOcc arg_occs) + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } scExpr' env (Let (NonRec bndr rhs) body) @@ -1429,6 +1450,46 @@ recursive function, but that's not essential and might even be harmful. I'm not sure. -} +{- Note [Do not specialise evals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x y = case x of I# _ -> + if y>1 then f x (y-1) else x + +Here `x` is scrutinised by a case, but only in an eval-like way; the +/component/ of the I# is unused. We don't want to specialise this +function, even if we find a call (f (I# z)), because nothing is gained + * No case branches are discarded + * No allocation in removed +The specialised version would take an unboxed Int#, pass it along, +and rebox it at the end. + +In fact this can cause significant regression. In #21763 we had: +like + f = ... case x of x' { I# n -> + join j y = rhs + in ...jump j x'... + +Now if we specialise `j` for the argument `I# n`, we'll end up reboxing +it in `j`, without even removing an allocation from the call site. + +Reboxing is always a worry. But here we can ameliorate the problem as +follows. + +* In scExpr (Case ...), for a /single-alternative/ case expression, in + which the pattern binders are all unused, we build a UnkOcc for + the scrutinee, not one that maps the data constructor; we don't treat + this occurrence as a reason for specialisation. + +* Conveniently, SpecConstr is doing its own occurrence analysis, so + the "unused" bit is just looking for NoOcc + +* Note that if we have + f x = case x of { True -> e1; False -> e2 } + then even though the pattern binders are unused (there are none), it is + still worth specialising on x. Hence the /single-alternative/ guard. +-} + scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) scApp env (Var fn, args) -- Function is a variable @@ -1478,7 +1539,6 @@ mkVarUsage env fn args , scu_occs = unitVarEnv fn arg_occ } Nothing -> nullUsage where - -- I rather think we could use UnkOcc all the time arg_occ | null args = UnkOcc | otherwise = evalScrutOcc @@ -2558,10 +2618,8 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str -- (b) we know what its value is -- In that case it counts as "interesting" argToPat1 env in_scope val_env (Var v) arg_occ arg_str - | sc_force env || case arg_occ of { ScrutOcc {} -> True - ; UnkOcc -> False - ; NoOcc -> False } -- (a) - , is_value -- (b) + | sc_force env || specialisableArgOcc arg_occ -- (a) + , is_value -- (b) -- Ignoring sc_keen here to avoid gratuitously incurring Note [Reboxing] -- So sc_keen focused just on f (I# x), where we have freshly-allocated -- box that we can eliminate in the caller ===================================== testsuite/tests/simplCore/should_compile/T21763.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash #-} +module T21763 where + +import GHC.Exts + +-- We should get ONE SpecConstr-generated rule, for f2, +-- not one for f1 and one for f2 + +f1 :: Int -> [Int] -> (Int, [Int]) +-- This one only seq's x, so SpecConstr should not specialise it +f1 x [] = (x, x `seq` []) +f1 x (_:ys) = f1 x ys + + +f2 :: Int -> [Int] -> (Int, [Int]) +-- This one takes x apart, so SpecConstr should specialise it +f2 x [] = (x+1, x `seq` []) +f2 x (_:ys) = f2 x ys + +foo1 :: [Int] -> (Int, [Int]) +foo1 ys = f1 9 ys + +foo2 :: [Int] -> (Int, [Int]) +foo2 ys = f2 9 ys ===================================== testsuite/tests/simplCore/should_compile/T21763.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf20" [2] forall (sc :: Int#). $wf2 (I# sc) = f2_$s$wf2 sc + + ===================================== testsuite/tests/simplCore/should_compile/T21763a.hs ===================================== @@ -0,0 +1,12 @@ +module T21763a where + +{-# NOINLINE g_imp #-} +g_imp !x = not x + +f3 :: (Bool -> Bool) -> Bool -> [Bool] -> (Bool, [Bool]) +-- We want to specialize for `g` to turn it into a known call. +f3 g x [] = (g x, []) +f3 g x (_:ys) = f3 g x ys + +foo3 :: [Bool] -> (Bool, [Bool]) +foo3 ys = f3 g_imp True ys ===================================== testsuite/tests/simplCore/should_compile/T21763a.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf30" [2] forall. $wf3 g_imp = f3_$s$wf3 + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -420,3 +420,5 @@ test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0 -O']) test('T21801', normal, compile, ['-O -dcore-lint']) test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) +test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2647bd275543fe2d22b6a4f378f7fb3d98973d88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2647bd275543fe2d22b6a4f378f7fb3d98973d88 You're receiving 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 25 14:35:34 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 10:35:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: upload_ghc_libs: Add means of passing Hackage credentials Message-ID: <630788b6a5980_e9d7d36163a7411919b5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 79b3e502 by Ben Gamari at 2022-08-25T10:35:04-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - 692984cc by Ben Gamari at 2022-08-25T10:35:04-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - f8229403 by Ben Gamari at 2022-08-25T10:35:04-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 093024bf by Ben Gamari at 2022-08-25T10:35:04-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - 02e936fc by Ben Gamari at 2022-08-25T10:35:04-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - 27337607 by Ben Gamari at 2022-08-25T10:35:04-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - a35f1f91 by Ben Gamari at 2022-08-25T10:35:04-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 62e70be5 by Ben Gamari at 2022-08-25T10:35:04-04:00 Drop mk/{build,install,config}.mk.in - - - - - 8fba88d0 by Ben Gamari at 2022-08-25T10:35:04-04:00 compiler: Drop comment references to make - - - - - c3d96d64 by Harry Garrood at 2022-08-25T10:35:19-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - c810265e by Harry Garrood at 2022-08-25T10:35:19-04:00 Add since annotations and changelog entries - - - - - bf3d7dd4 by Krzysztof Gogolewski at 2022-08-25T10:35:19-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/SysTools/BaseDir.hs - − compiler/Makefile - − compiler/ghc.mk - configure.ac - distrib/configure.ac.in - − distrib/hc-build - − docs/users_guide/ghc.mk - − driver/ghc.mk - − driver/ghc/ghc.mk - − driver/ghci/ghc.mk - − driver/haddock/ghc.mk - − ghc.mk - ghc/ghc-bin.cabal.in - − ghc/ghc.mk - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Packages.hs - − libffi/ghc.mk - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md - libraries/base/tests/all.T - + libraries/base/tests/inits1tails1.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cbe6f02ec882eabc958b7e7fc99384f643a9c66...bf3d7dd4013db483ee8f3de1a4fc58c88db0a767 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cbe6f02ec882eabc958b7e7fc99384f643a9c66...bf3d7dd4013db483ee8f3de1a4fc58c88db0a767 You're receiving 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 25 14:48:45 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 10:48:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22028 Message-ID: <63078bcd8c2c7_e9d7d323c611c12046d8@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22028 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22028 You're receiving 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 25 14:53:57 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 Aug 2022 10:53:57 -0400 Subject: [Git][ghc/ghc][wip/T22077] 2 commits: Refactor IPE initialization Message-ID: <63078d056ed12_e9d7d36163a74120999b@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 585ff300 by Ben Gamari at 2022-08-25T10:53:52-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. - - - - - c0869845 by Ben Gamari at 2022-08-25T10:53:52-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. - - - - - 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/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/Cmm.h - rts/include/Rts.h - rts/include/rts/IPE.h - rts/include/stg/SMP.h - rts/sm/NonMoving.h - testsuite/tests/profiling/should_run/staticcallstack001.stdout - testsuite/tests/profiling/should_run/staticcallstack002.stdout - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/734e4ef27fe8108ab888943bcca0d9b03de5de44...c0869845f27fd6e1377c7f771a9c842ed769cb0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/734e4ef27fe8108ab888943bcca0d9b03de5de44...c0869845f27fd6e1377c7f771a9c842ed769cb0e You're receiving 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 25 14:57:27 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 10:57:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22084 Message-ID: <63078dd7e9ffc_e9d7d1ee7674c12111a1@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22084 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22084 You're receiving 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 25 15:13:06 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 25 Aug 2022 11:13:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/styled-labels-final Message-ID: <63079182c8ec8_e9d7d247d11ac1216681@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/styled-labels-final at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/styled-labels-final You're receiving 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 25 15:30:21 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 11:30:21 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Testsuite: disable Cmm tests with the JS backend Message-ID: <6307958d2d5c2_e9d7d39bc2b341223188@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: a1971811 by Sylvain Henry at 2022-08-25T17:33:08+02:00 Testsuite: disable Cmm tests with the JS backend - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -137,6 +137,11 @@ def no_deps( name, opts): def skip( name, opts ): opts.skip = True +# disable test on JS arch +def js_skip( name, opts ): + if arch("js"): + skip(name,opts) + def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain # feature, and we don't plan to or can't fix it now or in the @@ -730,6 +735,8 @@ def objcpp_src( name, opts ): def cmm_src( name, opts ): opts.cmm_src = True + # JS backend doesn't support Cmm + js_skip(name, opts) def outputdir( odir ): return lambda name, opts, d=odir: _outputdir(name, opts, d) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a19718112ecf8ad160c8ba88af47491eb1295d8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a19718112ecf8ad160c8ba88af47491eb1295d8a You're receiving 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 25 17:48:20 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 13:48:20 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 3 commits: Base: fix c_interruptible_open Message-ID: <6307b5e4ec863_e9d7d4887812321ea@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 0967ad1e by Sylvain Henry at 2022-08-25T18:12:36+02:00 Base: fix c_interruptible_open - - - - - 501e78d8 by Sylvain Henry at 2022-08-25T18:14:39+02:00 Base: fix typo in long_from_number - - - - - 6e25ffb4 by Sylvain Henry at 2022-08-25T19:51:05+02:00 Env: only add program name to errors, not to traces - - - - - 3 changed files: - js/environment.js.pp - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js.pp Changes: ===================================== js/environment.js.pp ===================================== @@ -246,8 +246,23 @@ function h$errorBelch() { } function h$errorBelch2(buf1, buf_offset1, buf2, buf_offset2) { -// log("### errorBelch2"); - h$errorMsg(h$decodeUtf8z(buf1, buf_offset1), h$decodeUtf8z(buf2, buf_offset2)); + var pat = h$decodeUtf8z(buf1, buf_offset1); + h$errorMsg(h$append_prog_name(pat), h$decodeUtf8z(buf2, buf_offset2)); +} + +// append program name to the given string if possible +function h$append_prog_name(str) { + // basename that only works with Unix paths for now... + function basename(path) { + return path.split('/').reverse()[0]; + } + + // only works for node for now + if(h$isNode) { + return basename(process.argv[1]) + ": " + str; + } + + return str; } function h$debugBelch2(buf1, buf_offset1, buf2, buf_offset2) { @@ -266,15 +281,9 @@ function h$errorMsg(pat) { str = str.replace(/%s/, arguments[i]); } #ifndef GHCJS_BROWSER - // basename that only works on Linux for now... - function basename(path) { - return path.split('/').reverse()[0]; - } if(h$isGHCJSi) { // ignore message } else if(h$isNode) { - // append program name - str = basename(process.argv[1]) + ": " + str; process.stderr.write(str); } else if (h$isJsShell && typeof printErr !== 'undefined') { if(str.length) printErr(stripTrailingNewline(str)); ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -458,7 +458,7 @@ foreign import javascript interruptible "(($1_1,$1_2,$2_1,$2_2,$c) => { return h lstat :: CFilePath -> Ptr CStat -> IO CInt foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" c_open :: CFilePath -> CInt -> CMode -> IO CInt -foreign import javascript interruptible "(($1, $2, $3, $c) => { return h$c_interruptible_open($1,$2,$3,$c); })" +foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" c_interruptible_open_ :: CFilePath -> CInt -> CMode -> IO CInt foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" c_safe_open_ :: CFilePath -> CInt -> CMode -> IO CInt ===================================== libraries/base/jsbits/base.js.pp ===================================== @@ -142,23 +142,23 @@ function h$base_isatty(fd) { * NaN will be returned as zero. * Infinity is converted to max value and * -Infinity to min value. - * @param {f} value The number in question. + * @param {f} The number in question. * @param {c} the continuation taking high and low bits */ function h$long_from_number(f,c) { - if (value > 0) { - if (value >= TWO_PWR_63_DBL_) { + if (f > 0) { + if (f >= TWO_PWR_63_DBL_) { // return max value return c(0x7FFFFFFF,0xFFFFFFFF); } - return c(value / TWO_PWR_32_DBL_, value); - } else if (value < 0) { - if (value <= -TWO_PWR_63_DBL_) { + return c(f / TWO_PWR_32_DBL_, f); + } else if (f < 0) { + if (f <= -TWO_PWR_63_DBL_) { // return min value return c(0x80000000,0); } - var h = -value / TWO_PWR_32_DBL_; - var l = -value; + var h = -f / TWO_PWR_32_DBL_; + var l = -f; // negate h l var nl = (~l + 1) | 0; var nh = (~h + !nl) | 0; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a19718112ecf8ad160c8ba88af47491eb1295d8a...6e25ffb4ebb5782241751eb4d566898fd9d2135f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a19718112ecf8ad160c8ba88af47491eb1295d8a...6e25ffb4ebb5782241751eb4d566898fd9d2135f You're receiving 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 25 17:53:48 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 13:53:48 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Testsuite: disable more Cmm tests Message-ID: <6307b72c2eba9_e9d7d40d5e5901232357@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 5e95d3bf by Sylvain Henry at 2022-08-25T19:55:40+02:00 Testsuite: disable more Cmm tests - - - - - 2 changed files: - testsuite/tests/cmm/should_run/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -6,6 +6,7 @@ test('HooplPostorder', test('cmp64', [ extra_run_opts('"' + config.libdir + '"') , omit_ways(['ghci']) + , js_skip ], multi_compile_and_run, ['cmp64', [('cmp64_cmm.cmm', '')], '-O']) @@ -20,6 +21,7 @@ test('cmp64', test('ByteSwitch', [ extra_run_opts('"' + config.libdir + '"') , omit_ways(['ghci']) + , js_skip ], multi_compile_and_run, ['ByteSwitch', [('ByteSwitch_cmm.cmm', '')], '']) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -74,7 +74,7 @@ test('cgrun065', normal, compile_and_run, ['']) test('cgrun066', normal, compile_and_run, ['']) test('cgrun067', [extra_files(['Cgrun067A.hs'])], compile_and_run, ['']) test('cgrun069', - [ omit_ways(['ghci'])], + [ omit_ways(['ghci']), js_skip], multi_compile_and_run, ['cgrun069', [('cgrun069_cmm.cmm', '')], '']) test('cgrun070', normal, compile_and_run, ['']) @@ -99,7 +99,7 @@ test('T3207', normal, compile_and_run, ['']) test('T3561', normal, compile_and_run, ['']) test('T3677', extra_run_opts('+RTS -K8k -RTS'), compile_and_run, ['']) test('T4441', normal, compile_and_run, ['']) -test('T5149', omit_ways(['ghci']), multi_compile_and_run, +test('T5149', [omit_ways(['ghci']), js_skip], multi_compile_and_run, ['T5149', [('T5149_cmm.cmm', '')], '']) test('T5129', # The bug is in simplifier when run with -O1 and above, so only run it @@ -161,7 +161,7 @@ test('T10414', [only_ways(['threaded2']), extra_ways(['threaded2']), req_smp], test('T10521', normal, compile_and_run, ['']) test('T10521b', normal, compile_and_run, ['']) test('T10870', when(wordsize(32), skip), compile_and_run, ['']) -test('PopCnt', omit_ways(['ghci']), multi_compile_and_run, +test('PopCnt', [omit_ways(['ghci']), js_skip], multi_compile_and_run, ['PopCnt', [('PopCnt_cmm.cmm', '')], '']) test('T12059', normal, compile_and_run, ['']) test('T12433', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e95d3bf969f62fe47369be8bf7a0e5dff53c300 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e95d3bf969f62fe47369be8bf7a0e5dff53c300 You're receiving 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 25 18:10:57 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Thu, 25 Aug 2022 14:10:57 -0400 Subject: [Git][ghc/ghc][wip/js-staging] JS.Linker: removes FIXMEs Message-ID: <6307bb31b8388_e9d7d4d1d412354b3@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 1c44a5a5 by doyougnu at 2022-08-25T14:10:29-04:00 JS.Linker: removes FIXMEs JS.Linker.Linker: remove FIXMEs, clean dead code StgToJS.Linker.Utils: remove FIXMEs Compactor: Remove FIXMEs StgToJS.Linker.Types: Remove FIXMEs JS.Linker.Archive/Dynamic: remove FIXMEs StgToJS.Linker.Shims: remove FIXMEs - - - - - 6 changed files: - compiler/GHC/StgToJS/Linker/Archive.hs - compiler/GHC/StgToJS/Linker/Compactor.hs - compiler/GHC/StgToJS/Linker/Dynamic.hs - compiler/GHC/StgToJS/Linker/Shims.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Linker/Utils.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Archive.hs ===================================== @@ -14,10 +14,6 @@ -- Josh Meredith -- Stability : experimental -- --- FIXME: Jeff(2022,04): Remove this module completely, its only consumer is --- GHC.StgToJS.Linker.Dynamic and is likely no longer necessary with the new --- GHC Api. I simply decided adapting this module was faster/easier than --- removing it and figuring out GHC.StgToJS.Linker.Dynamic with the new API ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Archive ( Entry(..), Index, IndexEntry(..), Meta(..) ===================================== compiler/GHC/StgToJS/Linker/Compactor.hs ===================================== @@ -31,7 +31,6 @@ module GHC.StgToJS.Linker.Compactor ( compact - -- FIXME (Sylvain 2022-04): remove or use these exports , collectGlobals , debugShowStat , packStrings @@ -300,14 +299,8 @@ renameInternals ln_cfg cfg cs0 rtsDeps stats0a = (cs, stats, meta) renamed :: State CompactorState ([JStat], JStat) renamed - -- \| csDebugAlloc cfg || csProf cfg = do -- FIXME: Jeff (2022,03): Move these Way flags into JSLinkConfig - - -- FIXME (Sylvain, 2022-05): forced for now until packStrings creates a - -- proper string table. - -- NOTE (Jeff, 2022-06): I've commented out the block of code for the - -- otherwise case in the below guard. This is to silence warnings about - -- the redundant pattern match. Once packStrings works make sure to - -- re-enable and remove this comment and previous fixme + -- \| csDebugAlloc cfg || csProf cfg = do + | True = do cs <- get let renamedStats = map (identsS' (lookupRenamed cs) . lu_js_code) stats0 @@ -332,7 +325,6 @@ renameInternals ln_cfg cfg cs0 rtsDeps stats0a = (cs, stats, meta) -- sort our entries, store the results -- propagate all renamings throughtout the code cs <- get - -- FIXME: Jeff (2022,03): Is this workaround still needed? -- Safari on iOS 10 (64 bit only?) crashes on very long arrays -- safariCrashWorkaround :: [Ident] -> JExpr -- safariCrashWorkaround xs = @@ -411,19 +403,10 @@ staticDeclStat (StaticInfo si sv _) = ssu (StaticUnboxedDouble d) = app "h$p" [toJExpr (unSaneDouble d)] ssu (StaticUnboxedString str) = ApplExpr (initStr str) [] ssu StaticUnboxedStringOffset {} = 0 - -- FIXME, we shouldn't do h$di, we need to record the statement to init the thunks in maybe (appS "h$di" [toJExpr si']) (\v -> DeclStat si' `mappend` (toJExpr si' |= v)) (ssv sv) initStr :: BS.ByteString -> JExpr initStr str = app "h$str" [ValExpr (JStr . mkFastString . BSC.unpack $! str)] - --TODO: Jeff (2022,03): This function used to call @decodeModifiedUTF8 in - --Gen2.Utils. I've removed the call site and opted to keep the Just case. - --We'll need to double check to see if we indeed do need to decoded the - --UTF8 strings and implement a replace function on bytestrings once the - --Linker is up. - -- Nothing -> app "h$rstr" [toJExpr $ map toInteger (BS.unpack str)] - -- error "initStr" - -- [je| h$rstr(`map toInteger (B.unpack str)`) |] -- | rename a heap object, which means adding it to the -- static init table in addition to the renamer @@ -682,7 +665,6 @@ encodeStatic0 cs (StaticInfo _to sv _) -- encodeArg x = panic ("encodeArg: unexpected: " ++ show x) -- encodeChar = ord -- fixme make characters more readable --- FIXME: Jeff (2022,03): Use FastString or ShortByteString and remove this -- serialization/deserialization encodeString :: FastString -> [Int] encodeString = encodeBinary . BSC.pack . unpackFS @@ -784,7 +766,6 @@ compact ln_cfg cfg cs0 rtsDeps0 input0 let rtsDeps1 = rtsDeps0 ++ map (<> "_e") rtsDeps0 ++ map (<> "_con_e") rtsDeps0 - -- FIXME (Sylvain, 2022-05): disabled (again) -- (cs1, input1) = packStrings ln_cfg cs0 input0 in renameInternals ln_cfg cfg cs0 rtsDeps1 input0 @@ -1143,7 +1124,6 @@ fixHashes hashes = fmap (second (map replaceHash)) hashes sccs = map fromSCC $ G.stronglyConnComp (map (\(k, (_bs, deps)) -> (k, LexicalFastString k, deps)) kvs) kvs = List.sortOn (LexicalFastString . fst) $ nonDetEltsUniqMap hashes -- sort lexically to avoid non-determinism - -- FIXME: Can we make this more efficient by avoiding lists and staying in GHC Unique collections? ks = fst $ unzip kvs invDeps = listToUniqMap_C (++) (concatMap mkInvDeps kvs) mkInvDeps (k, (_, ds)) = map (\(LexicalFastString d) -> (d,[k])) ds @@ -1223,8 +1203,6 @@ fixHashesIter n invDeps allKeys checkKeys sccs hashes finalHashes makeFinalHash :: BS.ByteString -> [BS.ByteString] -> BS.ByteString makeFinalHash b bs = mconcat (b:bs) --- FIXME: Jeff (2022,03): I've removed the SHA256.hash function which would be --- producing this final bytestring. Do we need it? If so how to replace it? -- do not deduplicate thunks ignoreStatic :: StaticInfo -> Bool @@ -1232,7 +1210,6 @@ ignoreStatic (StaticInfo _ StaticThunk {} _) = True ignoreStatic _ = False -- combine hashes from x and y, leaving only those which have an entry in both --- FIXME: Make users of this function consume a UniqMap combineHashes :: [(FastString, HashBuilder)] -> [(FastString, HashBuilder)] -> [(FastString, HashBuilder)] @@ -1315,13 +1292,6 @@ hashSingleDefinition globals (TxtI i) expr = (i, ht 0 <> render st <> mconcat (m render = htxt . mkFastString. show . pretty --- FIXME: Jeff (2022,03): reduce the redundancy between these idents functions --- and the idents functions in GHC.JS.Transform These helper functions also --- exist in non-ticked for, e.g., @identsE@ in GHC.JS.Transform. These are --- essential Functor instances over the JS syntax tree. We rewrite them here for --- consumers like hashSingleDefinition. Had we used the Transform version we'll --- end up with a compiler error in @expr'@ since AssignStat takes an Expr, but --- Transform.IdentsE returns [Ident] identsE' :: (Ident -> Ident) -> JExpr -> JExpr identsE' f (ValExpr v) = ValExpr $! identsV' f v identsE' f (SelExpr e i) = SelExpr (identsE' f e) i -- do not rename properties @@ -1436,8 +1406,6 @@ hashSaneDouble (SaneDouble sd) = hd sd finalizeHash :: HashBuilder -> Hash finalizeHash (HashBuilder hb tt) = --- FIXME: Jeff (2022,03): I've removed the SHA256.hash function which would be --- producing h. Do we need it? If so how to replace it? let h = (BL.toStrict $ BB.toLazyByteString hb) in h `seq` (h, map LexicalFastString tt) @@ -1445,8 +1413,5 @@ finalizeHash' :: HashBuilder -> (Int, BS.ByteString, [FastString]) finalizeHash' (HashBuilder hb tt) = let b = BL.toStrict (BB.toLazyByteString hb) bl = BS.length b --- FIXME: Jeff (2022,03): I've removed the SHA256.hash function which would be --- producing h. So it is purposeful that `h = b` looks unnecessary. Do we need --- it? If so how to replace it? h = b in h `seq` bl `seq` (bl, h, tt) ===================================== compiler/GHC/StgToJS/Linker/Dynamic.hs ===================================== @@ -16,36 +16,6 @@ -- -- Various utilities for building and loading dynamic libraries, to make -- Template Haskell work in GHCJS --- ------------------------------ FIXMEs ------------------------------------------- --- FIXME: Jeff (2022,04): This module may be completely redundant and consist of --- duplicate code. Before we can remove it we must understand how it alters the --- link code in the GHC.Linker directory. Thus for the time being we live with --- it. In particular cases where we have duplicated functions in --- GHC.Driver.Pipeline and GHC.Linker.Static, I've prefixed these with "js" --- except for @link@ and @link'@, for example GHC.Linker.Static.linkStaticLib --- becomes GHC.StgToJS.Linker.Dynamic.jsLinkStaticLib. --- --- FIXME: Jeff (2022,04): In jsLinkBinary I've commented out a line that --- dispatches to different systools based on a boolean flag. This line seems to --- be a relic of the old ghc api but I left it in since it will require --- attention to be verified correct. I suspect that entire function is made --- redundant by the corresponding GHC.Linker.Static.linkBinary anyhow. Please --- see the fixme comment in jsLinkBinary --- --- FIXME: Jeff (2022,04): You'll notice that the APIs for the linking functions, --- @link@, @link'@ etc are quite hairy with lots of inputs, and over half of --- those inputs are environments of some sort including DynFlags. Of course this --- is insanity. The API is forced due a let expression in --- @GHC.StgToJS.Linker.Dynamic.link'@ which requires all linking functions to --- have the same interface as GHC.Linker.Static.linkBinary. To Fix this we --- should begin removing these environments by refining JSLinkConfig. For --- example: --- 1. Move any required flags from StgToJSConfig to JSLinkConfig --- 2. Remove DynFlags by removing any opts needed for linking and add them to --- JSLinkConfig --- 3. Similar for HscEnv, we might need to decouple GHCs Linker from DynFlags in --- order to have a proper api ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Dynamic ===================================== compiler/GHC/StgToJS/Linker/Shims.hs ===================================== @@ -165,8 +165,6 @@ tryReadShimFile :: Logger -> TmpFs -> DynFlags -> UnitEnv -> FilePath -> IO Shim tryReadShimFile logger tmpfs dflags unit_env file = do if needsCpp file then do - -- FIXME (Sylvain 2022-06): we should get profiling from the codegen options - -- (was GHCJS_PROF CPP define) let profiling = False use_cpp_and_not_cc_dash_E = False extra_opts = [] ===================================== compiler/GHC/StgToJS/Linker/Types.hs ===================================== @@ -30,15 +30,6 @@ -- -- The base contains a CompactorState for consistent renaming of private names -- and packed initialization of info tables and static closures. - ------------------------------ FIXMEs ------------------------------------------- --- - Find a better data structure for linkerArchiveDeps --- - Specialize Functor instances for helpers --- - Better name for Base --- - Remove unsafeShowSDoc --- - Better implementation for Monoid JSLinkConfig --- - Should we use (Messages String) or parameterize over (Messages e) in ThRunner? --- - Fix name collision between LinkableUnit type in this module and the LinkableUnit type in StgToJS.Types ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Types where @@ -94,9 +85,6 @@ renamedVars = map (\(TxtI xs) -> TxtI ("h$$"<>xs)) newLocals -- CompactorState -------------------------------------------------------------------------------- --- FIXME: Jeff (2022,03): These maps should be newtyped so we cannot confuse --- them and thus accidently construct hard to understand bugs. When we newtype --- we should use deriving via to avoid boilerplate data CompactorState = CompactorState { csIdentSupply :: [Ident] -- ^ ident supply for new names , csNameMap :: !(UniqMap FastString Ident) -- ^ renaming mapping for internal names @@ -138,8 +126,6 @@ instance DB.Binary StringTable where emptyStringTable :: StringTable emptyStringTable = StringTable (listArray (0,-1) []) M.empty emptyUniqMap --- FIXME: Jeff: (2022,03): Each of these helper functions carry a Functor f --- constraint. We should specialize these once we know how they are used entries :: Functor f => (UniqMap FastString Int -> f (UniqMap FastString Int)) -> CompactorState @@ -298,9 +284,6 @@ addLabel new cs = -- Base -------------------------------------------------------------------------------- --- FIXME: Jeff (2022,03): Pick a better name than Base, and should baseUnits be --- Set UnitId and basePkgs be [PackageId]? I'm unsure if this should hold --- UnitIds or UnitInfos or PackageIds or PackageNames -- | The Base bundle. Used for incremental linking it maintains the compactor -- state the base packages and units. data Base = Base { baseCompactorState :: CompactorState @@ -315,8 +298,7 @@ instance DB.Binary Base where showBase :: Base -> String showBase b = unlines [ "Base:" - , " packages: " ++ showSDocUnsafe (ppr (basePkgs b)) -- FIXME: Jeff (2022,03): Either use the sdoc context in the StgToJS - -- config or find a better way than showSDocUnsafe + , " packages: " ++ showSDocUnsafe (ppr (basePkgs b)) , " number of units: " ++ show (S.size $ baseUnits b) , " renaming table size: " ++ show (sizeUniqMap . csNameMap . baseCompactorState $ b) @@ -338,7 +320,7 @@ putBase (Base cs packages funs) = do pi :: Int -> DB.Put pi = DB.putWord32le . fromIntegral uniq :: Ord a => [a] -> [a] - uniq = S.toList . S.fromList -- FIXME: Ick! Just use the Set in the first place! + uniq = S.toList . S.fromList -- pkgs = uniq (map fst $ S.toList funs) -- pkgsM = M.fromList (zip pkgs [(0::Int)..]) mods = uniq (map fst $ S.toList funs) @@ -477,16 +459,7 @@ generateAllJs s | NoBase <- lcUseBase s = not (lcOnlyOut s) && not (lcNoRts s) | otherwise = False -{- - -- FIXME: Jeff (2022,03): This instance is supposed to capture overriding - -- settings, where one group comes from the environment (env vars, config - -- files) and the other from the command line. (env `mappend` cmdLine) should - -- give the combined settings, but it doesn't work very well. find something - -- better. - -} instance Monoid JSLinkConfig where - -- FIXME: Jeff (2022,03): Adding no hs main to config, should False be default - -- here? mempty = JSLinkConfig False False False False False Nothing Nothing Nothing False False False Nothing NoBase @@ -515,12 +488,9 @@ instance Semigroup JSLinkConfig where -------------------------------------------------------------------------------- -- Linker Environment --- TODO: Jeff: (2022,03): Move to separate module, same as Config? -------------------------------------------------------------------------------- -- | A LinkableUnit is a pair of a module and the index of the block in the -- object file --- FIXME: Jeff: (2022,03): Refactor to avoid name collision between --- StgToJS.Linker.Types.LinkableUnit and StgToJS.Types.LinkableUnit type LinkableUnit = (Module, Int) data LinkedUnit = LinkedUnit @@ -529,7 +499,6 @@ data LinkedUnit = LinkedUnit , lu_statics :: ![StaticInfo] } --- TODO: Jeff: (2022,03): Where to move LinkedObj -- | An object file that's either already in memory (with name) or on disk data LinkedObj = ObjFile FilePath -- ^ load from this file | ObjLoaded String BL.ByteString -- ^ already loaded: description and payload @@ -537,16 +506,8 @@ data LinkedObj = ObjFile FilePath -- ^ load from this file data GhcjsEnv = GhcjsEnv { compiledModules :: MVar (Map Module ByteString) -- ^ keep track of already compiled modules so we don't compile twice for dynamic-too - , thRunners :: MVar THRunnerState -- (Map String ThRunner) -- ^ template haskell runners + , thRunners :: MVar THRunnerState -- ^ template haskell runners , thSplice :: MVar Int - -- FIXME: Jeff a Map keyed on a Set is going to be quite costly. The Eq - -- instance over Sets _can_ be fast if the sets are different sizes, this - -- would be O(1), however if they are equal size then we incur a costly - -- converstion to an Ascending List O(n) and then perform the element wise - -- check hence O(mn) where m is the cost of the element check. Thus, we should - -- fix this data structure and use something more efficient, HashMap if - -- available, IntMap if possible. Nested maps, in particular, seem like a - -- design smell. , linkerArchiveDeps :: MVar (Map (Set FilePath) (Map Module (Deps, DepsLocation) , [LinkableUnit] @@ -572,9 +533,6 @@ data THRunner = , thrHandleIn :: Handle , thrHandleErr :: Handle , thrBase :: MVar Base - -- FIXME: Jeff (2022,03): Is String the right type here? I chose it - -- because it was easy but I am unsure what the needs of its consumer - -- are. , thrRecover :: MVar [Messages String] , thrExceptions :: MVar (I.IntMap E.SomeException) } ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -13,9 +13,6 @@ -- -- Various utilies used in the JS Linker -- ------------------------------ FIXMEs ------------------------------------------- --- - resolve macOS comment in @writeBinaryFile@ --- - remove redundant function @jsExeFileName@ ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Utils where @@ -39,14 +36,6 @@ import Prelude import GHC.Platform import Data.List (isPrefixOf) -{- - macOS has trouble writing more than 2GiB at once to a file - (tested with 10.14.6), and the base library doesn't work around this - problem yet (tested with GHC 8.6), so we work around it here. - - in this workaround we write a binary file in chunks of 1 GiB - FIXME: Jeff (2022,03): Is this still true? - -} writeBinaryFile :: FilePath -> ByteString -> IO () writeBinaryFile file bs = withBinaryFile file WriteMode $ \h -> mapM_ (B.hPut h) (chunks bs) @@ -80,9 +69,6 @@ commonCppDefs_vanilla, commonCppDefs_profiled :: ByteString commonCppDefs_vanilla = genCommonCppDefs False commonCppDefs_profiled = genCommonCppDefs True --- FIXME (Sylvain 2022-06): many of these strings should be derived from --- wired-in names and using the JS dsl (e.g. for field names of JS heap --- objects). genCommonCppDefs :: Bool -> ByteString genCommonCppDefs profiling = mconcat [ @@ -149,8 +135,6 @@ genCommonCppDefs profiling = mconcat else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" -- GHC.Integer.GMP.Internals - -- FIXME (Sylvain 2022-06): this is wrong since ghc-bignum. integer-wired-in - -- is ghc-bignum now , "#define IS_INTEGER_S(cl) ((cl).f === h$integerzmwiredzminZCGHCziIntegerziTypeziSzh_con_e)\n" , "#define IS_INTEGER_Jp(cl) ((cl).f === h$integerzmwiredzminZCGHCziIntegerziTypeziJpzh_con_e)\n" , "#define IS_INTEGER_Jn(cl) ((cl).f === h$integerzmwiredzminZCGHCziIntegerziTypeziJnzh_con_e)\n" @@ -173,7 +157,7 @@ genCommonCppDefs profiling = mconcat , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" , "#define IS_JUST(cl) ((cl).f === h$baseZCGHCziMaybeziJust_con_e)\n" , "#define JUST_VAL(jj) ((jj).d1)\n" - -- "#define HS_NOTHING h$nothing\n" -- FIXME (Sylvain 2022-06): just remove? + -- "#define HS_NOTHING h$nothing\n" , if profiling then "#define MK_JUST(val) (h$c1(h$baseZCGHCziMaybeziJust_con_e, (val), h$CCS_SYSTEM))\n" else "#define MK_JUST(val) (h$c1(h$baseZCGHCziMaybeziJust_con_e, (val)))\n" @@ -262,7 +246,7 @@ genCommonCppDefs profiling = mconcat ] -- unboxed tuple returns - -- , "#define RETURN_UBX_TUP1(x) return x;\n" FIXME (Sylvain 2022-06): remove? + -- , "#define RETURN_UBX_TUP1(x) return x;\n" , "#define RETURN_UBX_TUP2(x1,x2) { h$ret1 = (x2); return (x1); }\n" , "#define RETURN_UBX_TUP3(x1,x2,x3) { h$ret1 = (x2); h$ret2 = (x3); return (x1); }\n" , "#define RETURN_UBX_TUP4(x1,x2,x3,x4) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); return (x1); }\n" @@ -284,15 +268,12 @@ genCommonCppDefs profiling = mconcat , "#define CALL_UBX_TUP10(r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; (r8) = h$ret7; (r9) = h$ret8; (r10) = h$ret9; }\n" ] --- FIXME: Jeff (2022,04): remove this function since it is a duplicate of --- GHC.Linker.Static.Utils.exeFileName jsExeFileName :: DynFlags -> FilePath jsExeFileName dflags | Just s <- outputFile_ dflags = -- unmunge the extension let s' = dropPrefix "js_" (drop 1 $ takeExtension s) - -- FIXME: add this check when support for Windows check is added - in if Prelude.null s' -- \|\| (Platform.isWindows && map toLower s' == "exe") + in if Prelude.null s' then dropExtension s <.> jsexeExtension else dropExtension s <.> s' | otherwise = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c44a5a58e7d1f4610a861f6ff18d5206acc1788 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c44a5a58e7d1f4610a861f6ff18d5206acc1788 You're receiving 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 25 18:43:59 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Thu, 25 Aug 2022 14:43:59 -0400 Subject: [Git][ghc/ghc][wip/js-staging] JS RTS: remove FIXMEs Message-ID: <6307c2ef79f97_e9d7d4d1d412387fd@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: fe4b4f23 by doyougnu at 2022-08-25T14:43:46-04:00 JS RTS: remove FIXMEs StgToJS.Rts.Types: Remove FIXMEs - - - - - 2 changed files: - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Rts/Types.hs Changes: ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -19,12 +19,6 @@ -- Haskell. It assumes the existence of pre-generated JS functions, included as -- js-sources... -- --- FIXME: Jeff (2022,03): Finish module description. Specifically: --- 1. Since this is the top level module for the RTS, what is the architecture --- of the RTS? How does it all hold together? Describe the memory layout, any --- other tricks the RTS plays, and relevant sibling modules --- Sylvain (2022/03): memory layout is described in GHC.StgToJS (WIP) --- ----------------------------------------------------------------------------- module GHC.StgToJS.Rts.Rts where @@ -52,45 +46,6 @@ import Data.Monoid import Data.Char (toLower, toUpper) import qualified Data.Bits as Bits - ------------------------------------------------------------------------------ --- --- Pre-generated RTS for the JS backend --- --- TODO: Jeff (2022,03): - --- 1. There are numerous string literals sprinkled throughout the RTS, these --- should be moved and isolated into a single module and then used throughout --- the RTS and StgToJS Pipeline --- --- 2. The RTS makes a lot of use of the Monoid instances on lists since the --- Haskell portion is essentially building a JavaScript AST for the JS Rts and --- then pretty printing it so it can be used by the js backend. However, all --- this merging on lists is going to be extremely inefficient. (++) is O(n^2) --- and furthermore we have nested list structures. This implies a better data --- structure with an emphasis on fast merging is likely to reduce compile times --- for this RTS. --- --- 3. Similar to (2), most of the RTS is a function foo :: with --- definition foo [......] = mconcat ...... This --- is fine, however it implies a monadic design for this EDSL might lead to more --- readable code. Or in other words, `mconcat` and friends are just boiler --- plate, and what we really have is a monadic EDSL where the monad is a kind of --- Writer monad. Which we have essentially recreated here since bind in the --- Writer monad is mapConcat and you'll notice that most of the functions in the --- RTS do exactly that, i.e., apply a function which generates a list, then --- concats. So we are dealing with a Writer monad but aren't using Haskell's --- language facilities to be explicit about it. Hence all the boilerplate. Side --- note, we might also consider two alternative approaches if we go with a --- monadic design: --- -- a. Continuation passing style so that intermediate lists fuse --- -- b. A writer monad with a difference list, this would essentially be a --- -- zipper but whether it is worth it or not depend on how often children need --- -- to access their siblings, if they do that a lot then we'll have huge --- -- speedups, if not then we likely won't gain anything - ------------------------------------------------------------------------------ - garbageCollector :: JStat garbageCollector = mconcat [ TxtI "h$resetRegisters" ||= jLam (mconcat $ map resetRegister [minBound..maxBound]) @@ -117,7 +72,6 @@ closureConstructors s = BlockStat , clMeta = 0 , clCC = ccVal } - -- FIXME: same as h$c, maybe remove one of them? , declClsConstr "h$c0" ["f"] $ Closure { clEntry = var "f" , clField1 = null_ @@ -205,17 +159,14 @@ closureConstructors s = BlockStat mkClosureCon :: Int -> JStat mkClosureCon n = funName ||= toJExpr fun where - funName = TxtI $ mkFastString ("h$c" ++ show n) -- FIXME (Sylvain 2022-03): cache this + funName = TxtI $ mkFastString ("h$c" ++ show n) -- args are: f x1 x2 .. xn [cc] args = TxtI "f" : addCCArg' (map (TxtI . mkFastString . ('x':) . show) [(1::Int)..n]) fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- - -- FIXME (Sylvain 2022-03): share code and comment with mkDataFill extra_args = ValExpr . JHash . listToUniqMap $ zip - -- FIXME (Sylvain 2002-03): use dataFieldCache and another - -- cache for "xN" names (map (mkFastString . ('d':) . show) [(1::Int)..]) (map (toJExpr . TxtI . mkFastString . ('x':) . show) [2..n]) @@ -236,7 +187,6 @@ closureConstructors s = BlockStat mkDataFill :: Int -> JStat mkDataFill n = funName ||= toJExpr fun where - -- FIXME (Sylvain 2002-03): use dataFieldCache and dataCache funName = TxtI $ mkFastString ("h$d" ++ show n) ds = map (mkFastString . ('d':) . show) [(1::Int)..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds @@ -292,9 +242,7 @@ bhLneStats _s p frameSize = ] --- FIXME move somewhere else declRegs :: JStat --- FIXME prevent holes declRegs = mconcat [ TxtI "h$regs" ||= toJExpr (JList []) , mconcat (map declReg (enumFromTo R1 R32)) @@ -322,13 +270,6 @@ loadRegs = mconcat $ map mkLoad [1..32] mkLoad :: Int -> JStat mkLoad n = let args = map (TxtI . mkFastString . ("x"++) . show) [1..n] assign = zipWith (\a r -> toJExpr r |= toJExpr a) - -- FIXME: Jeff (2022,03) the use of reverse, - -- take, and enumFrom here heavily implies - -- Data.Sequence would be a better data - -- structure to hold the regs. Or perhaps we - -- steal the indices from the registers array? - -- Either way we can avoid allocating this - -- intermediate `regsFromR1` list args (reverse $ take n regsFromR1) fname = TxtI $ mkFastString ("h$l" ++ show n) fun = JFunc args (mconcat assign) @@ -382,11 +323,9 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ , declRegs , declRets] --- FIXME (Sylvain 2022-06): don't use String rtsText :: StgToJSConfig -> String rtsText = show . pretty . rts --- FIXME (Sylvain 2022-06): don't use String rtsDeclsText :: String rtsDeclsText = show . pretty $ rtsDecls @@ -398,17 +337,14 @@ rts' s = mconcat [ closureConstructors s , garbageCollector , stackManip - -- settings (FIXME should be const) , TxtI "h$rts_traceForeign" ||= toJExpr (csTraceForeign s) , TxtI "h$rts_profiling" ||= toJExpr (csProf s) - -- closure types (FIXME should be const) , TxtI "h$ct_fun" ||= toJExpr Fun , TxtI "h$ct_con" ||= toJExpr Con , TxtI "h$ct_thunk" ||= toJExpr Thunk , TxtI "h$ct_pap" ||= toJExpr Pap , TxtI "h$ct_blackhole" ||= toJExpr Blackhole , TxtI "h$ct_stackframe" ||= toJExpr StackFrame - -- var / closure field types (FIXME should be const) , TxtI "h$vt_ptr" ||= toJExpr PtrV , TxtI "h$vt_void" ||= toJExpr VoidV , TxtI "h$vt_double" ||= toJExpr IntV @@ -461,7 +397,7 @@ rts' s = , closure (ClosureInfo "h$ap2_e" (CIRegs 0 [PtrV]) "apply2" (CILayoutFixed 3 [PtrV, PtrV, PtrV]) CIThunk mempty) (jVar $ \d1 d2 d3 -> mconcat [ d1 |= closureField1 r1 - , d2 |= closureField2 r1 .^ "d1" -- FIXME (Sylvain 2022-03): extra args are named like closureFieldN... not so good! Find something else + , d2 |= closureField2 r1 .^ "d1" , d3 |= closureField2 r1 .^ "d2" , appS "h$bh" [] , profStat s enterCostCentreThunk ===================================== compiler/GHC/StgToJS/Rts/Types.hs ===================================== @@ -15,7 +15,6 @@ -- Stability : experimental -- -- Types and utility functions used in the JS RTS. --- FIXME: Jeff (2022,03): Add more details ----------------------------------------------------------------------------- module GHC.StgToJS.Rts.Types where @@ -62,9 +61,7 @@ stackFrameSize :: JExpr -- ^ assign frame size to this -> JStat -- ^ size of the frame, including header stackFrameSize tgt f = ifS (f .===. var "h$ap_gen") -- h$ap_gen is special - (tgt |= (stack .! (sp - 1) .>>. 8) + 2) -- special case, FIXME (Jeff, 2022/03): what and why is - -- it special and how does its - -- special-ness change this code + (tgt |= (stack .! (sp - 1) .>>. 8) + 2) (jVar (\tag -> mconcat [tag |= f .^ "size" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe4b4f23689058ce35dad0d36edc9c86ffd31693 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe4b4f23689058ce35dad0d36edc9c86ffd31693 You're receiving 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 25 19:34:47 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 Aug 2022 15:34:47 -0400 Subject: [Git][ghc/ghc][wip/T22077] 2 commits: Refactor IPE initialization Message-ID: <6307ced78cbb2_e9d7d488781245820@gitlab.mail> Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC Commits: 80f59ae4 by Ben Gamari at 2022-08-25T15:34:35-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. - - - - - f932de0a by Ben Gamari at 2022-08-25T15:34:35-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. - - - - - 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/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/Cmm.h - rts/include/Rts.h - rts/include/rts/IPE.h - rts/include/stg/SMP.h - rts/sm/NonMoving.h - testsuite/tests/profiling/should_run/staticcallstack001.stdout - testsuite/tests/profiling/should_run/staticcallstack002.stdout - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0869845f27fd6e1377c7f771a9c842ed769cb0e...f932de0a2e9734bcac44c6d1eab0274dfba9d55a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0869845f27fd6e1377c7f771a9c842ed769cb0e...f932de0a2e9734bcac44c6d1eab0274dfba9d55a You're receiving 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 25 21:17:34 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 17:17:34 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Primop: fix bswap32/64 (cf cgrun072) Message-ID: <6307e6eeb136_e9d7d4d1d41259897@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 77fcfcd0 by Sylvain Henry at 2022-08-25T23:20:26+02:00 Primop: fix bswap32/64 (cf cgrun072) - - - - - 2 changed files: - compiler/GHC/StgToJS/Prim.hs - js/arith.js.pp Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -429,10 +429,10 @@ genPrim prof ty op = case op of r |= BOr ((mask8 x) .<<. (Int 8)) (mask8 (x .>>>. (Int 8))) BSwap32Op -> \[r] [x] -> PrimInline $ - r |= (x .<<. (Int 24)) + r |= u32 ((x .<<. (Int 24)) `BOr` ((BAnd x (Int 0xFF00)) .<<. (Int 8)) `BOr` ((BAnd x (Int 0xFF0000)) .>>. (Int 8)) - `BOr` (x .>>>. (Int 24)) + `BOr` (x .>>>. (Int 24))) BSwap64Op -> \[r1,r2] [x,y] -> PrimInline $ appT [r1,r2] "h$bswap64" [x,y] BSwapOp -> \[r] [x] -> genPrim prof ty BSwap32Op [r] [x] ===================================== js/arith.js.pp ===================================== @@ -505,8 +505,8 @@ function h$popCnt64(x1,x2) { } function h$bswap64(x1,x2) { - RETURN_UBX_TUP2((x2 >>> 24) | (x2 << 24) | ((x2 & 0xFF00) << 8) | ((x2 & 0xFF0000) >> 8) - ,(x1 >>> 24) | (x1 << 24) | ((x1 & 0xFF00) << 8) | ((x1 & 0xFF0000) >> 8)); + RETURN_UBX_TUP2(UN((x2 >>> 24) | (x2 << 24) | ((x2 & 0xFF00) << 8) | ((x2 & 0xFF0000) >> 8)) + ,UN((x1 >>> 24) | (x1 << 24) | ((x1 & 0xFF00) << 8) | ((x1 & 0xFF0000) >> 8))); } var h$clz32 = Math.clz32 || function(x) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77fcfcd04e42dfbdd420a5664597671ba2cc6865 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77fcfcd04e42dfbdd420a5664597671ba2cc6865 You're receiving 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 25 21:42:28 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 17:42:28 -0400 Subject: [Git][ghc/ghc][wip/T21623] Accept error message changes Message-ID: <6307ecc496169_e9d7d3d103bf412604a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 34d3b5f9 by Simon Peyton Jones at 2022-08-25T22:42:33+01:00 Accept error message changes - - - - - 30 changed files: - testsuite/tests/callarity/unittest/CallArity1.hs - testsuite/tests/dependent/should_fail/T13601.stderr - testsuite/tests/dependent/should_fail/T16391b.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr - testsuite/tests/parser/should_fail/T14740.stderr - testsuite/tests/parser/should_fail/T20654b.stderr - testsuite/tests/partial-sigs/should_compile/SuperCls.stderr - testsuite/tests/partial-sigs/should_compile/T11016.stderr - testsuite/tests/partial-sigs/should_compile/T12845.stderr - testsuite/tests/partial-sigs/should_compile/T14643.stderr - testsuite/tests/partial-sigs/should_compile/T14643a.stderr - testsuite/tests/partial-sigs/should_fail/T11515.stderr - testsuite/tests/rep-poly/RepPolyClassMethod.stderr - testsuite/tests/roles/should_compile/Roles14.stderr - testsuite/tests/roles/should_compile/Roles4.stderr - testsuite/tests/roles/should_compile/T8958.stderr - testsuite/tests/saks/should_fail/saks_fail012.stderr - testsuite/tests/stranal/should_compile/T18982.stderr - testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr - testsuite/tests/typecheck/should_fail/T11112.stderr - testsuite/tests/typecheck/should_fail/T13677.stderr - testsuite/tests/typecheck/should_fail/T3540.stderr - testsuite/tests/typecheck/should_fail/T5570.stderr - testsuite/tests/typecheck/should_fail/T7609.stderr - testsuite/tests/typecheck/should_fail/T7697.stderr - testsuite/tests/typecheck/should_fail/T8806.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFail.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKind.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34d3b5f97a523f994e0ebbc68342e7480794ca25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34d3b5f97a523f994e0ebbc68342e7480794ca25 You're receiving 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 25 21:52:42 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 25 Aug 2022 17:52:42 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Testsuite: normalise ghc program name Message-ID: <6307ef2aa0da8_e9d7d323c611c12608fc@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: bc07b265 by Sylvain Henry at 2022-08-25T23:55:31+02:00 Testsuite: normalise ghc program name - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -2309,6 +2309,8 @@ def normalise_errmsg(s: str) -> str: # The inplace ghc's are called ghc-stage[123] to avoid filename # collisions, so we need to normalise that to just "ghc" s = re.sub('ghc-stage[123]', 'ghc', s) + # Remove platform prefix (e.g. js-unknown-ghcjs) for cross-compiled ghc + s = re.sub('^\\w+-\\w+-\\w+-ghc', 'ghc', s) # On windows error messages can mention versioned executables s = re.sub('ghc-[0-9.]+', 'ghc', s) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc07b26519b595217d966388efe969426329d0e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc07b26519b595217d966388efe969426329d0e1 You're receiving 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 25 22:34:07 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 25 Aug 2022 18:34:07 -0400 Subject: [Git][ghc/ghc][wip/styled-labels-final] 4 commits: Specify style when printing labels Message-ID: <6307f8df28276_e9d7d36163a74126126@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/styled-labels-final at Glasgow Haskell Compiler / GHC Commits: 889a490e by Krzysztof Gogolewski at 2022-08-26T00:31:29+02:00 Specify style when printing labels - - - - - 4aa651b5 by Krzysztof Gogolewski at 2022-08-26T00:31:34+02:00 Fix test T15155 - - - - - baf49542 by Krzysztof Gogolewski at 2022-08-26T00:31:34+02:00 Remove the PprCode parameter, assert OutputableP is used only for dumps - - - - - 0ed62270 by Krzysztof Gogolewski at 2022-08-26T00:31:34+02:00 Fix remaining prints - - - - - 27 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/StgToCmm/Layout.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Utils/Logger.hs - compiler/GHC/Utils/Outputable.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/T15155.stdout-darwin Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -128,6 +128,7 @@ module GHC.Cmm.CLabel ( LabelStyle (..), pprDebugCLabel, pprCLabel, + pprAsmLabel, ppInternalProcLabel, -- * Others @@ -1389,13 +1390,15 @@ allocation. Take care if you want to remove them! -} +pprAsmLabel :: Platform -> CLabel -> SDoc +pprAsmLabel platform lbl = pprCLabel platform AsmStyle lbl + instance OutputableP Platform CLabel where {-# INLINE pdoc #-} -- see Note [Bangs in CLabel] pdoc !platform lbl = getPprStyle $ \pp_sty -> - let !sty = case pp_sty of - PprCode sty -> sty - _ -> CStyle - in pprCLabel platform sty lbl + case pp_sty of + PprDump{} -> pprCLabel platform CStyle lbl + _ -> pprPanic "Labels in code should be printed with pprCLabel" (pprCLabel platform CStyle lbl) pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] @@ -1522,7 +1525,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CC_Label cc -> maybe_underscore $ ppr cc CCS_Label ccs -> maybe_underscore $ ppr ccs - IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe") + IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform CStyle l <> text "_" <> ppr m <> text "_ipe") ModuleLabel mod kind -> maybe_underscore $ ppr mod <> text "_" <> ppr kind CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs ===================================== compiler/GHC/Cmm/DebugBlock.hs ===================================== @@ -77,7 +77,7 @@ data DebugBlock = , dblBlocks :: ![DebugBlock] -- ^ Nested blocks } -instance OutputableP env CLabel => OutputableP env DebugBlock where +instance OutputableP Platform DebugBlock where pdoc env blk = (if | dblProcedure blk == dblLabel blk -> text "proc" @@ -85,7 +85,7 @@ instance OutputableP env CLabel => OutputableP env DebugBlock where -> text "pp-blk" | otherwise -> text "blk") <+> - ppr (dblLabel blk) <+> parens (pdoc env (dblCLabel blk)) <+> + ppr (dblLabel blk) <+> parens (pprAsmLabel env (dblCLabel blk)) <+> (maybe empty ppr (dblSourceTick blk)) <+> (maybe (text "removed") ((text "pos " <>) . ppr) (dblPosition blk)) <+> @@ -495,9 +495,9 @@ LOC this information will end up in is Y. -- | A label associated with an 'UnwindTable' data UnwindPoint = UnwindPoint !CLabel !UnwindTable -instance OutputableP env CLabel => OutputableP env UnwindPoint where +instance OutputableP Platform UnwindPoint where pdoc env (UnwindPoint lbl uws) = - braces $ pdoc env lbl <> colon + braces $ pprAsmLabel env lbl <> colon <+> hsep (punctuate comma $ map pprUw $ Map.toList uws) where pprUw (g, expr) = ppr g <> char '=' <> pdoc env expr @@ -519,16 +519,16 @@ data UnwindExpr = UwConst !Int -- ^ literal value | UwTimes UnwindExpr UnwindExpr deriving (Eq) -instance OutputableP env CLabel => OutputableP env UnwindExpr where +instance OutputableP Platform UnwindExpr where pdoc = pprUnwindExpr 0 -pprUnwindExpr :: OutputableP env CLabel => Rational -> env -> UnwindExpr -> SDoc +pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc pprUnwindExpr p env = \case UwConst i -> ppr i UwReg g 0 -> ppr g UwReg g x -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x)) UwDeref e -> char '*' <> pprUnwindExpr 3 env e - UwLabel l -> pdoc env l + UwLabel l -> pprAsmLabel env l UwPlus e0 e1 | p <= 0 -> pprUnwindExpr 0 env e0 <> char '+' <> pprUnwindExpr 0 env e1 UwMinus e0 e1 ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Cmm.Dataflow.Label import GHC.Cmm import GHC.Cmm.Liveness import GHC.Cmm.Switch (switchTargetsToList) +import GHC.Cmm.CLabel (pprDebugCLabel) import GHC.Utils.Outputable import Control.Monad (ap, unless) @@ -55,7 +56,7 @@ lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint () lintCmmDecl (CmmProc _ lbl _ g) = do platform <- getPlatform - addLintInfo (text "in proc " <> pdoc platform lbl) $ lintCmmGraph g + addLintInfo (text "in proc " <> pprDebugCLabel platform lbl) $ lintCmmGraph g lintCmmDecl (CmmData {}) = return () ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -508,9 +508,9 @@ pprForeignTarget platform (PrimTarget op) -- HACK: We're just using a ForeignLabel to get this printed, the label -- might not really be foreign. = pdoc platform - (CmmLabel (mkForeignLabel + (mkForeignLabel (mkFastString (show op)) - Nothing ForeignLabelInThisPackage IsFunction)) + Nothing ForeignLabelInThisPackage IsFunction) instance Outputable Convention where ppr = pprConvention ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -449,7 +449,7 @@ cmmproc :: { CmmParse () } platform <- getPlatform; ctx <- getContext; formals <- sequence (fromMaybe [] $3); - withName (renderWithContext ctx (pdoc platform entry_ret_label)) + withName (renderWithContext ctx (pprCLabel platform CStyle entry_ret_label)) $4; return (entry_ret_label, info, stk_formals, formals) } let do_layout = isJust $3 ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -396,7 +396,7 @@ cmmNativeGens logger config modLoc ncgImpl h dbgMap = go -- force evaluation all this stuff to avoid space leaks let platform = ncgPlatform config - {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pdoc platform) imports) () + {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pprAsmLabel platform) imports) () let !labels' = if ncgDwarfEnabled config then cmmDebugLabels isMetaInstr native else [] @@ -455,7 +455,7 @@ cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap cmm count let weights = ncgCfgWeights config let proc_name = case cmm of - (CmmProc _ entry_label _ _) -> pdoc platform entry_label + (CmmProc _ entry_label _ _) -> pprAsmLabel platform entry_label _ -> text "DataChunk" -- rewrite assignments to global regs @@ -789,7 +789,7 @@ makeImportsDoc config imports doPpr lbl = (lbl, renderWithContext (ncgAsmContext config) - (pprCLabel platform AsmStyle lbl)) + (pprAsmLabel platform lbl)) -- ----------------------------------------------------------------------------- -- Generate jump tables ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -60,6 +60,7 @@ import GHC.Types.ForeignCall import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Utils.Constants (debugIsOn) -- Note [General layout of an NCG] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -135,10 +136,11 @@ basicBlockCodeGen block = do id = entryLabel block stmts = blockToList nodes - header_comment_instr = unitOL $ MULTILINE_COMMENT ( + header_comment_instr | debugIsOn = unitOL $ MULTILINE_COMMENT ( text "-- --------------------------- basicBlockCodeGen --------------------------- --\n" - $+$ pdoc (ncgPlatform config) block + $+$ withPprStyle defaultDumpStyle (pdoc (ncgPlatform config) block) ) + | otherwise = nilOL -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of ===================================== 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 pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pprAsmLabel 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 pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' + then pprAsmLabel 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 " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -75,7 +75,7 @@ pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeDecl platform lbl - $$ (pdoc platform lbl <> char ':') + $$ (pprAsmLabel platform lbl <> char ':') pprAlign :: Platform -> Alignment -> SDoc pprAlign _platform alignment @@ -105,7 +105,7 @@ pprSectionAlign config sec@(Section seg _) = pprSizeDecl :: Platform -> CLabel -> SDoc pprSizeDecl platform lbl = if osElfTarget (platformOS platform) - then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl + then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl else empty pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr @@ -115,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' + then pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -135,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' + then pprAsmLabel 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] @@ -153,7 +153,7 @@ pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl (ncgPlatform config) alias - $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind' pprDatas config (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData config) dats) @@ -175,7 +175,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text "\t.globl " <> pdoc platform lbl + | otherwise = text "\t.globl " <> pprAsmLabel platform lbl -- Note [Always use objects for info tables] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -201,7 +201,7 @@ pprLabelType' platform lbl = pprTypeDecl :: Platform -> CLabel -> SDoc pprTypeDecl platform lbl = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl - then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl + then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl else empty pprDataItem :: NCGConfig -> CmmLit -> SDoc @@ -230,8 +230,8 @@ pprDataItem config lit pprImm :: Platform -> Imm -> SDoc 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 p (ImmCLbl l) = pprAsmLabel p l +pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! @@ -279,8 +279,8 @@ pprIm platform im = case im of ImmDouble d | d == 0 -> text "xzr" ImmDouble d -> char '#' <> double (fromRational d) -- = pseudo instruction! - ImmCLbl l -> char '=' <> pdoc platform l - ImmIndex l o -> text "[=" <> pdoc platform l <> comma <+> char '#' <> int o <> char ']' + ImmCLbl l -> char '=' <> pprAsmLabel platform l + ImmIndex l o -> text "[=" <> pprAsmLabel platform l <> comma <+> char '#' <> int o <> char ']' _ -> panic "AArch64.pprIm" pprExt :: ExtMode -> SDoc @@ -430,28 +430,28 @@ pprInstr platform instr = case instr of -- 4. Branch Instructions ---------------------------------------------------- J t -> pprInstr platform (B t) - B (TBlock bid) -> text "\tb" <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - B (TLabel lbl) -> text "\tb" <+> pdoc platform lbl + B (TBlock bid) -> text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + B (TLabel lbl) -> text "\tb" <+> pprAsmLabel platform lbl B (TReg r) -> text "\tbr" <+> pprReg W64 r - BL (TBlock bid) _ _ -> text "\tbl" <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - BL (TLabel lbl) _ _ -> text "\tbl" <+> pdoc platform lbl + BL (TBlock bid) _ _ -> text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BL (TLabel lbl) _ _ -> text "\tbl" <+> pprAsmLabel platform lbl BL (TReg r) _ _ -> text "\tblr" <+> pprReg W64 r - BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pdoc platform lbl + BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pprAsmLabel platform lbl BCOND _ (TReg _) -> panic "AArch64.ppr: No conditional branching to registers!" -- 5. Atomic Instructions ---------------------------------------------------- -- 6. Conditional Instructions ----------------------------------------------- CSET o c -> text "\tcset" <+> pprOp platform o <> comma <+> pprCond c - CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform lbl + CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl CBZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbz) branching to registers!" - CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform lbl + CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl CBNZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!" -- 7. Load and Store Instructions -------------------------------------------- @@ -466,58 +466,58 @@ pprInstr platform instr = case instr of #if defined(darwin_HOST_OS) LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" #else LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl #endif LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> ===================================== compiler/GHC/CmmToAsm/Dwarf.hs ===================================== @@ -51,8 +51,8 @@ dwarfGen config modLoc us blocks = do , dwName = fromMaybe "" (ml_hs_file modLoc) , dwCompDir = addTrailingPathSeparator compPath , dwProducer = cProjectName ++ " " ++ cProjectVersion - , dwLowLabel = pdoc platform lowLabel - , dwHighLabel = pdoc platform highLabel + , dwLowLabel = pprAsmLabel platform lowLabel + , dwHighLabel = pprAsmLabel platform highLabel , dwLineLabel = dwarfLineLabel } @@ -109,9 +109,9 @@ mkDwarfARange proc = DwarfARange lbl end compileUnitHeader :: Platform -> Unique -> SDoc compileUnitHeader platform unitU = let cuLabel = mkAsmTempLabel unitU -- sits right before initialLength field - length = pdoc platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pdoc platform cuLabel + length = pprAsmLabel platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pprAsmLabel platform cuLabel <> text "-4" -- length of initialLength field - in vcat [ pdoc platform cuLabel <> colon + in vcat [ pprAsmLabel platform cuLabel <> colon , text "\t.long " <> length -- compilation unit size , pprHalf 3 -- DWARF version , sectionOffset platform dwarfAbbrevLabel dwarfAbbrevLabel @@ -123,7 +123,7 @@ compileUnitHeader platform unitU = compileUnitFooter :: Platform -> Unique -> SDoc compileUnitFooter platform unitU = let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU - in pdoc platform cuEndLabel <> colon + in pprAsmLabel platform cuEndLabel <> colon -- | Splits the blocks by procedures. In the result all nested blocks -- will come from the same procedure as the top-level block. See ===================================== compiler/GHC/CmmToAsm/Dwarf/Types.hs ===================================== @@ -184,14 +184,14 @@ pprDwarfInfoOpen platform haveSrc (DwarfCompileUnit _ name producer compDir lowL then sectionOffset platform lineLbl dwarfLineLabel else empty pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev abbrev $$ pprString name $$ pprLabelString platform label $$ pprFlag (externallyVisibleCLabel label) -- Offset due to Note [Info Offset] - $$ pprWord platform (pdoc platform label <> text "-1") - $$ pprWord platform (pdoc platform $ mkAsmTempProcEndLabel label) + $$ pprWord platform (pprAsmLabel platform label <> text "-1") + $$ pprWord platform (pprAsmLabel platform $ mkAsmTempProcEndLabel label) $$ pprByte 1 $$ pprByte dW_OP_call_frame_cfa $$ parentValue @@ -199,17 +199,17 @@ pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) = abbrev = case parent of Nothing -> DwAbbrSubprogram Just _ -> DwAbbrSubprogramWithParent parentValue = maybe empty pprParentDie parent - pprParentDie sym = sectionOffset platform (pdoc platform sym) dwarfInfoLabel + pprParentDie sym = sectionOffset platform (pprAsmLabel platform sym) dwarfInfoLabel pprDwarfInfoOpen platform _ (DwarfBlock _ label Nothing) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev DwAbbrBlockWithoutCode $$ pprLabelString platform label pprDwarfInfoOpen platform _ (DwarfBlock _ label (Just marker)) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev DwAbbrBlock $$ pprLabelString platform label - $$ pprWord platform (pdoc platform marker) - $$ pprWord platform (pdoc platform $ mkAsmTempEndLabel marker) + $$ pprWord platform (pprAsmLabel platform marker) + $$ pprWord platform (pprAsmLabel platform $ mkAsmTempEndLabel marker) pprDwarfInfoOpen _ _ (DwarfSrcNote ss) = pprAbbrev DwAbbrGhcSrcNote $$ pprString' (ftext $ srcSpanFile ss) @@ -245,7 +245,7 @@ pprDwarfARanges platform arngs unitU = initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize in pprDwWord (ppr initialLength) $$ pprHalf 2 - $$ sectionOffset platform (pdoc platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel + $$ sectionOffset platform (pprAsmLabel platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel $$ pprByte (fromIntegral wordSize) $$ pprByte 0 $$ pad paddingSize @@ -258,11 +258,11 @@ pprDwarfARanges platform arngs unitU = pprDwarfARange :: Platform -> DwarfARange -> SDoc pprDwarfARange platform arng = -- Offset due to Note [Info Offset]. - pprWord platform (pdoc platform (dwArngStartLabel arng) <> text "-1") + pprWord platform (pprAsmLabel platform (dwArngStartLabel arng) <> text "-1") $$ pprWord platform length where - length = pdoc platform (dwArngEndLabel arng) - <> char '-' <> pdoc platform (dwArngStartLabel arng) + length = pprAsmLabel platform (dwArngEndLabel arng) + <> char '-' <> pprAsmLabel platform (dwArngStartLabel arng) -- | Information about unwind instructions for a procedure. This -- corresponds to a "Common Information Entry" (CIE) in DWARF. @@ -293,7 +293,7 @@ data DwarfFrameBlock -- in the block } -instance OutputableP env CLabel => OutputableP env DwarfFrameBlock where +instance OutputableP Platform DwarfFrameBlock where pdoc env (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> pdoc env unwinds -- | Header for the @.debug_frame@ section. Here we emit the "Common @@ -303,7 +303,7 @@ pprDwarfFrame :: Platform -> DwarfFrame -> SDoc pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs} = let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit "_start") cieEndLabel = mkAsmTempEndLabel cieLabel - length = pdoc platform cieEndLabel <> char '-' <> pdoc platform cieStartLabel + length = pprAsmLabel platform cieEndLabel <> char '-' <> pprAsmLabel platform cieStartLabel spReg = dwarfGlobalRegNo platform Sp retReg = dwarfReturnRegNo platform wordSize = platformWordSizeInBytes platform @@ -316,9 +316,9 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro ArchX86 -> pprByte dW_CFA_same_value $$ pprLEBWord 4 ArchX86_64 -> pprByte dW_CFA_same_value $$ pprLEBWord 7 _ -> empty - in vcat [ pdoc platform cieLabel <> colon + in vcat [ pprAsmLabel platform cieLabel <> colon , pprData4' length -- Length of CIE - , pdoc platform cieStartLabel <> colon + , pprAsmLabel platform cieStartLabel <> colon , pprData4' (text "-1") -- Common Information Entry marker (-1 = 0xf..f) , pprByte 3 -- CIE version (we require DWARF 3) @@ -346,7 +346,7 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro , pprLEBWord 0 ] $$ wordAlign platform $$ - pdoc platform cieEndLabel <> colon $$ + pprAsmLabel platform cieEndLabel <> colon $$ -- Procedure unwind tables vcat (map (pprFrameProc platform cieLabel cieInit) procs) @@ -360,17 +360,17 @@ pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks) procEnd = mkAsmTempProcEndLabel procLbl ifInfo str = if hasInfo then text str else empty -- see Note [Info Offset] - in vcat [ whenPprDebug $ text "# Unwinding for" <+> pdoc platform procLbl <> colon - , pprData4' (pdoc platform fdeEndLabel <> char '-' <> pdoc platform fdeLabel) - , pdoc platform fdeLabel <> colon - , pprData4' (pdoc platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE - , pprWord platform (pdoc platform procLbl <> ifInfo "-1") -- Code pointer - , pprWord platform (pdoc platform procEnd <> char '-' <> - pdoc platform procLbl <> ifInfo "+1") -- Block byte length + in vcat [ whenPprDebug $ text "# Unwinding for" <+> pprAsmLabel platform procLbl <> colon + , pprData4' (pprAsmLabel platform fdeEndLabel <> char '-' <> pprAsmLabel platform fdeLabel) + , pprAsmLabel platform fdeLabel <> colon + , pprData4' (pprAsmLabel platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE + , pprWord platform (pprAsmLabel platform procLbl <> ifInfo "-1") -- Code pointer + , pprWord platform (pprAsmLabel platform procEnd <> char '-' <> + pprAsmLabel platform procLbl <> ifInfo "+1") -- Block byte length ] $$ vcat (S.evalState (mapM (pprFrameBlock platform) blocks) initUw) $$ wordAlign platform $$ - pdoc platform fdeEndLabel <> colon + pprAsmLabel platform fdeEndLabel <> colon -- | Generates unwind information for a block. We only generate -- instructions where unwind information actually changes. This small @@ -402,7 +402,7 @@ pprFrameBlock platform (DwarfFrameBlock hasInfo uws0) = then (empty, oldUws) else let -- see Note [Info Offset] needsOffset = firstDecl && hasInfo - lblDoc = pdoc platform lbl <> + lblDoc = pprAsmLabel platform lbl <> if needsOffset then text "-1" else empty doc = pprByte dW_CFA_set_loc $$ pprWord platform lblDoc $$ vcat (map (uncurry $ pprSetUnwind platform) changed) @@ -513,7 +513,7 @@ pprUnwindExpr platform spIsCFA expr pprE (UwReg g i) = pprByte (dW_OP_breg0+dwarfGlobalRegNo platform g) $$ pprLEBInt i pprE (UwDeref u) = pprE u $$ pprByte dW_OP_deref - pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pdoc platform l) + pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pprAsmLabel platform l) pprE (UwPlus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus pprE (UwMinus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus pprE (UwTimes u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul ===================================== compiler/GHC/CmmToAsm/PIC.hs ===================================== @@ -729,7 +729,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of _ -> panic "PIC.pprImportedSymbol: no match" where platform = ncgPlatform config - ppr_lbl = pprCLabel platform AsmStyle + ppr_lbl = pprAsmLabel platform arch = platformArch platform os = platformOS platform pic = ncgPIC config ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -63,7 +63,7 @@ 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) $$ - ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel lbl) + ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':' $$ pprProcEndLabel platform lbl) $$ pprSizeDecl platform lbl @@ -71,7 +71,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ (if platformHasSubsectionsViaSymbols platform - then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' + then pprAsmLabel 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 @@ -80,9 +80,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = then -- See Note [Subsections Via Symbols] in X86/Ppr.hs text "\t.long " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -93,7 +93,7 @@ pprSizeDecl platform lbl then text "\t.size" <+> prettyLbl <> text ", .-" <> codeLbl else empty where - prettyLbl = pdoc platform lbl + prettyLbl = pprAsmLabel platform lbl codeLbl | platformArch platform == ArchPPC_64 ELF_V1 = char '.' <> prettyLbl | otherwise = prettyLbl @@ -102,33 +102,33 @@ pprFunctionDescriptor :: Platform -> CLabel -> SDoc pprFunctionDescriptor platform lab = pprGloblDecl platform lab $$ text "\t.section \".opd\", \"aw\"" $$ text "\t.align 3" - $$ pdoc platform lab <> char ':' + $$ pprAsmLabel platform lab <> char ':' $$ text "\t.quad ." - <> pdoc platform lab + <> pprAsmLabel platform lab <> text ",.TOC. at tocbase,0" $$ text "\t.previous" $$ text "\t.type" - <+> pdoc platform lab + <+> pprAsmLabel platform lab <> text ", @function" - $$ char '.' <> pdoc platform lab <> char ':' + $$ char '.' <> pprAsmLabel platform lab <> char ':' pprFunctionPrologue :: Platform -> CLabel ->SDoc pprFunctionPrologue platform lab = pprGloblDecl platform lab $$ text ".type " - <> pdoc platform lab + <> pprAsmLabel platform lab <> text ", @function" - $$ pdoc platform lab <> char ':' + $$ pprAsmLabel platform lab <> char ':' $$ text "0:\taddis\t" <> pprReg toc <> text ",12,.TOC.-0b at ha" $$ text "\taddi\t" <> pprReg toc <> char ',' <> pprReg toc <> text ",.TOC.-0b at l" - $$ text "\t.localentry\t" <> pdoc platform lab - <> text ",.-" <> pdoc platform lab + $$ text "\t.localentry\t" <> pprAsmLabel platform lab + <> text ",.-" <> pprAsmLabel platform lab pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name -> SDoc pprProcEndLabel platform lbl = - pdoc platform (mkAsmTempProcEndLabel lbl) <> char ':' + pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> char ':' pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc @@ -137,7 +137,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) instrs) $$ ppWhen (ncgDwarfEnabled config) ( - pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' + pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':' <> pprProcEndLabel platform asmLbl ) where @@ -162,7 +162,7 @@ pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLi , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl platform alias - $$ text ".equiv" <+> pdoc platform alias <> comma <> pdoc platform (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind' pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats) pprData :: Platform -> CmmStatic -> SDoc @@ -175,20 +175,20 @@ pprData platform d = case d of pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text ".globl " <> pdoc platform lbl + | otherwise = text ".globl " <> pprAsmLabel platform lbl pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc pprTypeAndSizeDecl platform lbl = if platformOS platform == OSLinux && externallyVisibleCLabel lbl then text ".type " <> - pdoc platform lbl <> text ", @object" + pprAsmLabel platform lbl <> text ", @object" else empty pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeAndSizeDecl platform lbl - $$ (pdoc platform lbl <> char ':') + $$ (pprAsmLabel platform lbl <> char ':') -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' @@ -238,8 +238,8 @@ pprImm :: Platform -> Imm -> SDoc pprImm platform = \case ImmInt i -> int i ImmInteger i -> integer i - ImmCLbl l -> pdoc platform l - ImmIndex l i -> pdoc platform l <> char '+' <> int i + ImmCLbl l -> pprAsmLabel platform l + ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d @@ -559,7 +559,7 @@ pprInstr platform instr = case instr of pprCond cond, pprPrediction prediction, char '\t', - pdoc platform lbl + pprAsmLabel platform lbl ] where lbl = mkLocalBlockLabel (getUnique blockid) pprPrediction p = case p of @@ -577,7 +577,7 @@ pprInstr platform instr = case instr of ], hcat [ text "\tb\t", - pdoc platform lbl + pprAsmLabel platform lbl ] ] where lbl = mkLocalBlockLabel (getUnique blockid) @@ -594,7 +594,7 @@ pprInstr platform instr = case instr of char '\t', text "b", char '\t', - pdoc platform lbl + pprAsmLabel platform lbl ] MTCTR reg @@ -625,12 +625,12 @@ pprInstr platform instr = case instr of -- they'd technically be more like 'ForeignLabel's. hcat [ text "\tbl\t.", - pdoc platform lbl + pprAsmLabel platform lbl ] _ -> hcat [ text "\tbl\t", - pdoc platform lbl + pprAsmLabel platform lbl ] BCTRL _ ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -210,7 +210,7 @@ pprGNUSectionHeader config t suffix = platform = ncgPlatform config splitSections = ncgSplitSections config subsection - | splitSections = sep <> pdoc platform suffix + | splitSections = sep <> pprAsmLabel platform suffix | otherwise = empty header = case t of Text -> text ".text" ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -93,7 +93,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprProcAlignment config $$ pprProcLabel config lbl $$ (if platformHasSubsectionsViaSymbols platform - then pdoc platform (mkDeadStripPreventer info_lbl) <> colon + then pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> colon else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ ppWhen (ncgDwarfEnabled config) (pprProcEndLabel platform info_lbl) $$ @@ -102,9 +102,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -120,18 +120,18 @@ pprProcLabel config lbl pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name -> SDoc pprProcEndLabel platform lbl = - pdoc platform (mkAsmTempProcEndLabel lbl) <> colon + pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon pprBlockEndLabel :: Platform -> CLabel -- ^ Block name -> SDoc pprBlockEndLabel platform lbl = - pdoc platform (mkAsmTempEndLabel lbl) <> colon + pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon -- | Output the ELF .size directive. pprSizeDecl :: Platform -> CLabel -> SDoc pprSizeDecl platform lbl = if osElfTarget (platformOS platform) - then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl + then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl else empty pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc @@ -156,7 +156,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) vcat (map (pprData config) info) $$ pprLabel platform infoLbl $$ c $$ - ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel infoLbl) <> colon) + ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel infoLbl) <> colon) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -175,7 +175,7 @@ pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticL , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl (ncgPlatform config) alias - $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind' pprDatas config (align, (CmmStaticsRaw lbl dats)) = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats) @@ -197,7 +197,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text ".globl " <> pdoc platform lbl + | otherwise = text ".globl " <> pprAsmLabel platform lbl pprLabelType' :: Platform -> CLabel -> SDoc pprLabelType' platform lbl = @@ -260,14 +260,14 @@ pprLabelType' platform lbl = pprTypeDecl :: Platform -> CLabel -> SDoc pprTypeDecl platform lbl = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl - then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl + then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl else empty pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeDecl platform lbl - $$ (pdoc platform lbl <> colon) + $$ (pprAsmLabel platform lbl <> colon) pprAlign :: Platform -> Alignment -> SDoc pprAlign platform alignment @@ -430,8 +430,8 @@ pprImm :: Platform -> Imm -> SDoc pprImm platform = \case ImmInt i -> int i ImmInteger i -> integer i - ImmCLbl l -> pdoc platform l - ImmIndex l i -> pdoc platform l <> char '+' <> int i + ImmCLbl l -> pprAsmLabel platform l + ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d @@ -576,7 +576,7 @@ pprInstr platform i = case i of UNWIND lbl d -> asmComment (text "\tunwind = " <> pdoc platform d) - $$ pdoc platform lbl <> colon + $$ pprAsmLabel platform lbl <> colon LDATA _ _ -> panic "pprInstr: LDATA" @@ -818,7 +818,7 @@ pprInstr platform i = case i of -> pprFormatOpReg (text "xchg") format src val JXX cond blockid - -> pprCondInstr (text "j") cond (pdoc platform lab) + -> pprCondInstr (text "j") cond (pprAsmLabel platform lab) where lab = blockLbl blockid JXX_GBL cond imm ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -1705,7 +1705,6 @@ genMachOp_slow opt op [x, y] = case op of where binLlvmOp ty binOp allow_y_cast = do - cfg <- getConfig platform <- getPlatform runExprData $ do vx <- exprToVarW x @@ -1721,13 +1720,7 @@ genMachOp_slow opt op [x, y] = case op of doExprW (ty vx) $ binOp vx vy' | otherwise - -> do - -- Error. Continue anyway so we can debug the generated ll file. - let render = renderWithContext (llvmCgContext cfg) - cmmToStr = (lines . render . pdoc platform) - statement $ Comment $ map fsLit $ cmmToStr x - statement $ Comment $ map fsLit $ cmmToStr y - doExprW (ty vx) $ binOp vx vy + -> pprPanic "binLlvmOp types" (pdoc platform x $$ pdoc platform y) binCastLlvmOp ty binOp = runExprData $ do vx <- exprToVarW x ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -173,7 +173,7 @@ outputC logger dflags filenm cmm_stream unit_deps = "C backend output" FormatC doc - let ctx = initSDocContext dflags (PprCode CStyle) + let ctx = initSDocContext dflags PprCode printSDocLn ctx LeftMode h doc Stream.consume cmm_stream id writeC @@ -253,11 +253,11 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs ForeignStubs (CHeader h_code) (CStub c_code _ _) -> do let - stub_c_output_d = pprCode CStyle c_code + stub_c_output_d = pprCode c_code stub_c_output_w = showSDoc dflags stub_c_output_d -- Header file protos for "foreign export"ed functions. - stub_h_output_d = pprCode CStyle h_code + stub_h_output_d = pprCode h_code stub_h_output_w = showSDoc dflags stub_h_output_d createDirectoryIfMissing True (takeDirectory stub_h) @@ -330,6 +330,7 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) = {-# SCC profilingInitCode #-} initializerCStub platform fn_name decls body where + pdocC = pprCLabel platform CStyle fn_name = mkInitializerStubLabel this_mod "prof_init" decls = vcat $ map emit_cc_decl local_CCs @@ -342,22 +343,22 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) ] emit_cc_decl cc = text "extern CostCentre" <+> cc_lbl <> text "[];" - where cc_lbl = pdoc platform (mkCCLabel cc) + where cc_lbl = pdocC (mkCCLabel cc) local_cc_list_label = text "local_cc_" <> ppr this_mod emit_cc_list ccs = text "static CostCentre *" <> local_cc_list_label <> text "[] =" - <+> braces (vcat $ [ pdoc platform (mkCCLabel cc) <> comma + <+> braces (vcat $ [ pdocC (mkCCLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi emit_ccs_decl ccs = text "extern CostCentreStack" <+> ccs_lbl <> text "[];" - where ccs_lbl = pdoc platform (mkCCSLabel ccs) + where ccs_lbl = pdocC (mkCCSLabel ccs) singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod emit_ccs_list ccs = text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] =" - <+> braces (vcat $ [ pdoc platform (mkCCSLabel cc) <> comma + <+> braces (vcat $ [ pdocC (mkCCSLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi ===================================== compiler/GHC/Driver/Config/CmmToAsm.hs ===================================== @@ -18,7 +18,7 @@ initNCGConfig :: DynFlags -> Module -> NCGConfig initNCGConfig dflags this_mod = NCGConfig { ncgPlatform = targetPlatform dflags , ncgThisModule = this_mod - , ncgAsmContext = initSDocContext dflags (PprCode AsmStyle) + , ncgAsmContext = initSDocContext dflags PprCode , ncgProcAlignment = cmmProcAlignment dflags , ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags , ncgPIC = positionIndependent dflags ===================================== compiler/GHC/Driver/Config/CmmToLlvm.hs ===================================== @@ -20,7 +20,7 @@ initLlvmCgConfig logger config_cache dflags = do llvm_config <- readLlvmConfigCache config_cache pure $! LlvmCgConfig { llvmCgPlatform = targetPlatform dflags - , llvmCgContext = initSDocContext dflags (PprCode CStyle) + , llvmCgContext = initSDocContext dflags PprCode , llvmCgFillUndefWithGarbage = gopt Opt_LlvmFillUndefWithGarbage dflags , llvmCgSplitSection = gopt Opt_SplitSections dflags , llvmCgBmiVersion = case platformArch (targetPlatform dflags) of ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -606,7 +606,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" 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)) + writeFile empty_stub (showSDoc dflags (pprCode src)) 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 ===================================== compiler/GHC/HsToCore/Foreign/C.hs ===================================== @@ -333,7 +333,7 @@ dsFCall fn_id co fcall mDeclHeader = do toCName :: Id -> String -toCName i = renderWithContext defaultSDocContext (pprCode CStyle (ppr (idName i))) +toCName i = renderWithContext defaultSDocContext (pprCode (ppr (idName i))) toCType :: Type -> (Maybe Header, SDoc) toCType = f False ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -249,11 +249,11 @@ sptModuleInitCode platform this_mod entries = [ text "static StgWord64 k" <> int i <> text "[2] = " <> pprFingerprint fp <> semi $$ text "extern StgPtr " - <> (pdoc platform $ mkClosureLabel (idName n) (idCafInfo n)) <> semi + <> (pprCLabel platform CStyle $ mkClosureLabel (idName n) (idCafInfo n)) <> semi $$ text "hs_spt_insert" <> parens (hcat $ punctuate comma [ char 'k' <> int i - , char '&' <> pdoc platform (mkClosureLabel (idName n) (idCafInfo n)) + , char '&' <> pprCLabel platform CStyle (mkClosureLabel (idName n) (idCafInfo n)) ] ) <> semi ===================================== compiler/GHC/StgToCmm/Layout.hs ===================================== @@ -297,7 +297,7 @@ direct_call caller call_conv lbl arity args platform <- getPlatform pprPanic "direct_call" $ text caller <+> ppr arity <+> - pdoc platform lbl <+> ppr (length args) <+> + pprDebugCLabel platform lbl <+> ppr (length args) <+> pdoc platform (map snd args) <+> ppr (map fst args) | null rest_args -- Precisely the right number of arguments ===================================== 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 <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pprDebugCLabel (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -332,7 +332,7 @@ jsonLogAction _ (MCDiagnostic SevIgnore _) _ _ = return () -- suppress the messa jsonLogAction logflags msg_class srcSpan msg = defaultLogActionHPutStrDoc logflags True stdout - (withPprStyle (PprCode CStyle) (doc $$ text "")) + (withPprStyle PprCode (doc $$ text "")) where str = renderWithContext (log_default_user_context logflags) msg doc = renderJSON $ ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -96,7 +96,7 @@ module GHC.Utils.Outputable ( defaultSDocContext, traceSDocContext, getPprStyle, withPprStyle, setStyleColoured, pprDeeper, pprDeeperList, pprSetDepth, - codeStyle, userStyle, dumpStyle, asmStyle, + codeStyle, userStyle, dumpStyle, qualName, qualModule, qualPackage, mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle, mkUserStyle, cmdlineParserStyle, Depth(..), @@ -170,7 +170,7 @@ data PprStyle -- Does not assume tidied code: non-external names -- are printed with uniques. - | PprCode !LabelStyle -- ^ Print code; either C or assembler + | PprCode -- ^ Print code; either C or assembler -- | Style of label pretty-printing. -- @@ -550,12 +550,8 @@ queryQual s = QueryQualify (qualName s) (qualPackage s) codeStyle :: PprStyle -> Bool -codeStyle (PprCode _) = True -codeStyle _ = False - -asmStyle :: PprStyle -> Bool -asmStyle (PprCode AsmStyle) = True -asmStyle _other = False +codeStyle PprCode = True +codeStyle _ = False dumpStyle :: PprStyle -> Bool dumpStyle (PprDump {}) = True @@ -603,9 +599,9 @@ bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO () bufLeftRenderSDoc ctx bufHandle doc = Pretty.bufLeftRender bufHandle (runSDoc doc ctx) -pprCode :: LabelStyle -> SDoc -> SDoc +pprCode :: SDoc -> SDoc {-# INLINE CONLIKE pprCode #-} -pprCode cs d = withPprStyle (PprCode cs) d +pprCode d = withPprStyle PprCode d renderWithContext :: SDocContext -> SDoc -> String renderWithContext ctx sdoc ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -48,9 +48,11 @@ T15723: '$(TEST_HC)' $(TEST_HC_OPTS) -dynamic -shared T15723B.o -o T15723B.so # Check that the static indirection b is compiled to an equiv directive +# This will be .equiv T15155_b_closure,T15155_a_closure +# or .equiv _T15155_b_closure,_T15155_a_closure on Darwin T15155: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 -ddump-asm T15155l.hs | \ - grep -F ".equiv T15155.b_closure,T15155.a_closure" + grep -F ".equiv" # Same as above, but in LLVM. Check that the static indirection b is compiled to # an alias. ===================================== testsuite/tests/codeGen/should_compile/T15155.stdout-darwin ===================================== @@ -0,0 +1 @@ +.equiv _T15155.b_closure,_T15155.a_closure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7094f35e49af5bd2b7033440b909a7b19ac354af...0ed622700c7ebf8cbaee0f0eb6931bae7d6a9de4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7094f35e49af5bd2b7033440b909a7b19ac354af...0ed622700c7ebf8cbaee0f0eb6931bae7d6a9de4 You're receiving 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 25 22:54:38 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Thu, 25 Aug 2022 18:54:38 -0400 Subject: [Git][ghc/ghc][wip/js-staging] StgToJS.Apply: Remove FIXMEs Message-ID: <6307fdaee6c57_e9d7d1ee7674c1268382@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 13fe0a11 by doyougnu at 2022-08-25T18:54:13-04:00 StgToJS.Apply: Remove FIXMEs StgToJS.FFI: remove FIXMEs StgToJS.Expr: remove FIXMEs StgToJS: Remove FIXMEs StgToJS: Remove FIXMEs - - - - - 18 changed files: - compiler/GHC/StgToJS.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/ExprCtx.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Profiling.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/Utils.hs Changes: ===================================== compiler/GHC/StgToJS.hs ===================================== @@ -70,13 +70,6 @@ import GHC.StgToJS.CodeGen -- 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 @@ -128,8 +121,8 @@ import GHC.StgToJS.CodeGen -- , 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 +-- , r -- ?? +-- , s -- static references? -- , m -- GC mark? -- } -- ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -107,7 +107,6 @@ genApp ctx i args , [top] <- concatMap typex_expr (ctxTarget ctx) , getUnique i == unpackCStringAppendIdKey , d <- utf8DecodeByteString bs - -- FIXME (Sylvain, 2022/02): we assume that it decodes but it may not (e.g. embedded file) = do prof <- csProf <$> getSettings let profArg = if prof then [jCafCCS] else [] @@ -222,7 +221,7 @@ genApp ctx i args | n <- length args , n /= 0 , idFunRepArity i == n - , not (isLocalId i) -- FIXME (Sylvain 2022-08): why are we testing this here and not in the oversaturated case below? + , not (isLocalId i) , isStrictId i = do as' <- concatMapM genArg args @@ -550,9 +549,6 @@ genericStackApply cfg = closure info body , ifS (newAp .===. var "h$ap_gen") ((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 @@ -760,17 +756,12 @@ stackApply s fun_name nargs nvars = (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? + <> mkPap s pap r1 (toJExpr nargs) stackArgs <> (sp |= sp - toJExpr (nvars + 1)) <> (r1 |= toJExpr pap) <> returnStack)) ] - _ -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive - -- patterns. That the code wants to do this - -- means we should be encoding that funCase is - -- only callable on ValExpr (JVar pap)'s in - -- the type system, perhaps with a GADT or - -- phantom + _ -> mempty funCase :: JExpr -> JStat @@ -789,12 +780,7 @@ stackApply s fun_name nargs nvars = <> (r1 |= toJExpr pap) <> returnStack)) ] - _ -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive - -- patterns. That the code wants to do this - -- means we should be encoding that funCase is - -- only callable on ValExpr (JVar pap)'s in - -- the type system, perhaps with a GADT or - -- phantom + _ -> mempty -- oversat: call the function but keep enough on the stack for the next @@ -843,7 +829,6 @@ fastApply s fun_name nargs nvars = func ||= body0 jVar \c farity arity -> [ c |= closureEntry r1 , 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 (fun_name <> ": ") + clName c @@ -872,12 +857,7 @@ fastApply s fun_name nargs nvars = func ||= body0 <> (r1 |= toJExpr pap) <> returnStack)) ] - _ -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive - -- patterns. That the code wants to do this - -- means we should be encoding that funCase is - -- only callable on ValExpr (JVar pap)'s in - -- the type system, perhaps with a GADT or - -- phantom + _ -> mempty oversatCase :: JExpr -> JExpr -> JStat oversatCase c arity = @@ -1130,13 +1110,11 @@ papGen cfg = -- general utilities -- move the first n registers, starting at R2, m places up (do not use with negative m) --- FIXME (Jeff, 2022/03): pick a better name, e.g., `r2moveRegs` moveRegs2 :: JStat moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch where moveSwitch n m = SwitchStat ((n .<<. 8) .|. m) switchCases (defaultCase n m) -- fast cases - -- TODO: tune the parameteters for performance and size switchCases = [switchCase n m | n <- [1..5], m <- [1..4]] switchCase :: Int -> Int -> (JExpr, JStat) switchCase n m = (toJExpr $ ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -158,7 +158,7 @@ genArg a = case a of as <- concat <$> mapM genArg args e <- varForDataConWorker dc inl_alloc <- csInlineAlloc <$> getSettings - return [allocDynamicE inl_alloc e as Nothing] -- FIXME: ccs + return [allocDynamicE inl_alloc e as Nothing] x -> pprPanic "genArg: unexpected unfloated expression" (pprStgExpr panicStgPprOpts x) genIdArg :: HasDebugCallStack => Id -> G [JExpr] @@ -258,7 +258,6 @@ 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 jsStaticArg args) Nothing -- | Generate JS code corresponding to a list of static args ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -138,7 +138,7 @@ genUnits m ss spt_entries foreign_stubs staticInit <- initStaticPtrs spt_entries (st', _, bs) <- serializeLinkableUnit m st [] [] [] - ( -- FIXME (Sylvain, 2022/02): optimizer disabled: O.optimize . + ( -- O.optimize . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) "" [] [] return ( st' @@ -218,8 +218,7 @@ genUnits m ss spt_entries foreign_stubs let allDeps = collectIds unf decl topDeps = collectTopIds decl required = hasExport decl - stat = -- FIXME (Sylvain 2022/02): optimizer disabled: - -- {-decl -} Opt.optimize . + stat = -- Opt.optimize . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl (st', _ss, bs) <- serializeLinkableUnit m st topDeps ci si stat mempty [] fRefs ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -203,9 +203,9 @@ primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of | tc == mutVarPrimTyCon -> RtsObjV | tc == mVarPrimTyCon -> RtsObjV | tc == tVarPrimTyCon -> RtsObjV - | tc == bcoPrimTyCon -> RtsObjV -- fixme what do we need here? + | tc == bcoPrimTyCon -> RtsObjV -- unsupported? | tc == stackSnapshotPrimTyCon -> RtsObjV - | tc == ioPortPrimTyCon -> RtsObjV -- FIXME: Jeff (2022, 05) IOPort, how to handle in JS? + | tc == ioPortPrimTyCon -> RtsObjV -- unsupported? | tc == anyTyCon -> PtrV | tc == compactPrimTyCon -> ObjV -- unsupported? | tc == eqPrimTyCon -> VoidV -- coercion token? ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -43,9 +43,6 @@ genCon ctx con args | [ValExpr (JVar ctxi)] <- concatMap typex_expr (ctxTarget ctx) = allocCon ctxi con currentCCS args - -- FIXME: (Sylvain 2022-03-11) Do we support e.g. "data T = MkT Word64"? It - -- would return two JExprs - | xs <- concatMap typex_expr (ctxTarget ctx) = pprPanic "genCon: unhandled DataCon" (ppr (con, args, xs)) ===================================== compiler/GHC/StgToJS/Deps.hs ===================================== @@ -39,7 +39,7 @@ import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.State -data DependencyDataCache = DDC -- FIXME Sylvain 2022-02: use UniqFM +data DependencyDataCache = DDC { ddcModule :: !(IntMap Unit) -- ^ Unique Module -> Object.Package , ddcId :: !(IntMap Object.ExportedFun) -- ^ Unique Id -> Object.ExportedFun (only to other modules) , ddcOther :: !(Map OtherSymb Object.ExportedFun) ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -331,18 +331,10 @@ resultSize xxs@(_:xs) t | otherwise = [(LiftedRep, 1)] -- possibly newtype family, must be boxed resultSize [] t - -- FIXME: Jeff (2022,05): Is this check actually needed? If we have a runtime - -- rep kinded type can't we just call typePrimReps to get the PrimReps and - -- then primRep size just like in the catchall case? I don't see why this - -- doesn't work. | isRuntimeRepKindedTy t' = pprPanic "resultSize: Type was RuntimeRepKinded don't know the size! " (ppr t') - -- Note that RuntimeRep from Builtins.Types hits this case. A singleton of -- (LiftedRep, 1) is exactly what's returned by the otherwise case for -- 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)] | otherwise = fmap (\p -> (p, slotCount (primRepSize p))) (typePrimReps t) where t' = unwrapType t @@ -403,9 +395,6 @@ popLneFrame inEntry size ctx = do let ctx' = ctxLneShrinkStack ctx size 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) @@ -698,8 +687,6 @@ genAlts ctx e at me alts = do return (s, r) _ -> error "genAlts: invalid branches for Bool" - -- FIXME: add all alts - AlgAlt _tc -> do ei <- varForId e (r, brs) <- normalizeBranches ctx <$> @@ -923,11 +910,7 @@ allocDynAll haveDecl middle cls = do fillObjs = mconcat $ map fillObj cls fillObj (i,_,es,_) - | csInlineAlloc settings || length es > 24 = -- FIXME (Jeff, 2022/03): the call to length means `es` - -- should be something other than - -- a list. Also why is 24 - -- important? And 24 should be a - -- constant such as `fooThreshold` + | csInlineAlloc settings || length es > 24 = case es of [] -> mempty [ex] -> toJExpr i .^ closureField1_ |= toJExpr ex ===================================== compiler/GHC/StgToJS/ExprCtx.hs ===================================== @@ -127,7 +127,6 @@ ctxUpdateLneFrame new_spilled_vars new_lne_ids ctx = { ctxLneFrameBs = addListToUFM (ctxLneFrameBs ctx) (map (,new_frame_size) new_lne_ids) , ctxLneFrameSize = new_frame_size , ctxLneFrameVars = ctxLneFrameVars ctx ++ new_spilled_vars - -- FIXME: could we use a stack? (i.e. cons new variables) } -- | Remove information about the current LNE frame ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -50,7 +50,6 @@ import Control.Monad import Control.Applicative import qualified Text.ParserCombinators.ReadP as P --- FIXME: what if the call returns a thunk? genPrimCall :: ExprCtx -> PrimCall -> [StgArg] -> Type -> G (JStat, ExprResult) genPrimCall ctx (PrimCall lbl _) args t = do j <- parseFFIPattern False False False ("h$" ++ unpackFS lbl) t (concatMap typex_expr $ ctxTarget ctx) args @@ -140,8 +139,7 @@ parseFFIPattern' :: Maybe JExpr -- ^ Nothing for sync, Just callback for async parseFFIPattern' callback javascriptCc pat t ret args | not javascriptCc = mkApply pat | otherwise = - if True -- FIXME (Sylvain 2022-03): we don't support parsing of JS imports. - -- So we assume that we can directly apply to them... + if True then mkApply pat else do u <- freshUnique @@ -278,13 +276,9 @@ callbackPlaceholders (Just e) = [((TxtI "$c"), e)] parseFfiJME :: String -> Int -> Either String JExpr parseFfiJME _xs _u = Left "parseFfiJME not yet implemented" - -- FIXME (Sylvain 2022-02): removed temporarily for the codegen merge. Need to - -- decide which syntax we support parseFfiJM :: String -> Int -> Either String JStat parseFfiJM _xs _u = Left "parseFfiJM not yet implemented" - -- FIXME (Sylvain 2022-02): removed temporarily for the codegen merge. Need to - -- decide which syntax we support saturateFFI :: JMacro a => Int -> a -> a saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) ===================================== compiler/GHC/StgToJS/Literal.hs ===================================== @@ -73,12 +73,6 @@ genStaticLit = \case LitChar c -> return [ IntLit (fromIntegral $ ord c) ] LitString str | True -> return [ StringLit (mkFastStringByteString str), IntLit 0] - -- FIXME: documentation for LitString says it's always UTF8 encoded but it's - -- not true (e.g. for embedded files). - -- 1) We should add a decoding function that detects errors in - -- GHC.Utils.Encoding - -- 2) We should perhaps add a different LitBin constructor that would - -- benefit other backends? -- \| invalid UTF8 -> return [ BinLit str, IntLit 0] LitNullAddr -> return [ NullLit, IntLit 0 ] LitNumber nt v -> case nt of @@ -97,7 +91,6 @@ genStaticLit = \case LitDouble r -> return [ DoubleLit . SaneDouble . r2d $ r ] LitLabel name _size fod -> return [ LabelLit (fod == IsFunction) (mkFastString $ "h$" ++ unpackFS name) , IntLit 0 ] - -- FIXME: handle other LitRubbish, etc. l -> pprPanic "genStaticLit" (ppr l) -- make an unsigned 32 bit number from this unsigned one, lower 32 bits ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} --- only for DB.Binary instances on Module see FIXME below +-- only for DB.Binary instances on Module {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- @@ -36,16 +36,7 @@ -- - dependency info -- - closureinfo index -- - closureinfo data (offsets described by index) - --- FIXME: Jeff (2022,03): There are orphan instances for DB.Binary Module and --- ModuleName. These are needed in StgToJS.Linker.Types for @Base@ serialization --- in @putBase at . We end up in this situation because Base now holds a @Module@ --- type instead of GHCJS's previous @Package@ type. In addition to this GHC uses --- GHC.Utils.Binary for binary instances rather than Data.Binary (even though --- Data.Binary is a boot lib) so to fix the situation we must: --- - 1. Choose to use GHC.Utils.Binary or Data.Binary --- - 2. Remove Binary since this is redundant --- - 3. Adapt the Linker types, like Base to the new Binary methods +-- ----------------------------------------------------------------------------- module GHC.StgToJS.Object @@ -174,7 +165,6 @@ trim = let f = dropWhile isSpace . reverse in f . f isGlobalUnit :: Int -> Bool isGlobalUnit n = n == 0 --- fixme document, exports unit is always linked isExportsUnit :: Int -> Bool isExportsUnit n = n == 1 @@ -492,9 +482,6 @@ putSymbolTable (SymbolTable _ hm) = st st = DB.runPut $ do DB.putWord32le (fromIntegral $ length xs) mapM_ DB.put xs - -- fixme: this is a workaround for some weird issue sometimes causing zero-length - -- strings when using the Data.Text instance directly - -- mapM_ (DB.put . TE.encodeUtf8) xs xs :: [FastString] xs = map fst . sortBy (compare `on` snd) . nonDetEltsUniqMap $ hm -- We can use `nonDetEltsUniqMap` because the paired `Int`s introduce ordering. ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -578,7 +578,6 @@ genPrim prof ty op = case op of , a .! i |= new , s |= zero_ ] - -- fixme both new? [ s |= one_ , o |= x ] @@ -705,7 +704,6 @@ genPrim prof ty op = case op of PrimInline $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - -- FIXME: we can do faster by copying 32 bit ints or doubles PrimInline $ loopBlockS (Sub n one_) (.>=. zero_) \i -> [ u8_ a2 (Add i o2) |= u8_ a1 (Add i o1) , postDecrS i @@ -742,7 +740,7 @@ genPrim prof ty op = case op of AddrSubOp -> \[i] [_a1,o1,_a2,o2] -> PrimInline $ i |= Sub o1 o2 AddrRemOp -> \[r] [_a,o,i] -> PrimInline $ r |= Mod o i AddrToIntOp -> \[i] [_a,o] -> PrimInline $ i |= o -- only usable for comparisons within one range - IntToAddrOp -> \[a,o] [i] -> PrimInline $ mconcat [a |= null_, o |= i] -- FIXME: unsupported + IntToAddrOp -> \[a,o] [i] -> PrimInline $ mconcat [a |= null_, o |= i] AddrGtOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>. zero_) AddrGeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>=. zero_) AddrEqOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .===. zero_) @@ -920,13 +918,13 @@ genPrim prof ty op = case op of MkWeakOp -> \[r] [o,b,c] -> PrimInline $ r |= app "h$makeWeak" [o,b,c] MkWeakNoFinalizerOp -> \[r] [o,b] -> PrimInline $ r |= app "h$makeWeakNoFinalizer" [o,b] - AddCFinalizerToWeakOp -> \[r] [_a1,_a1o,_a2,_a2o,_i,_a3,_a3o,_w] -> PrimInline $ r |= one_ -- fixme + AddCFinalizerToWeakOp -> \[r] [_a1,_a1o,_a2,_a2o,_i,_a3,_a3o,_w] -> PrimInline $ r |= one_ DeRefWeakOp -> \[f,v] [w] -> PrimInline $ mconcat [ v |= w .^ "val" , f |= if01 (v .===. null_) ] FinalizeWeakOp -> \[fl,fin] [w] -> PrimInline $ appT [fin, fl] "h$finalizeWeak" [w] - TouchOp -> \[] [_e] -> PrimInline mempty -- fixme what to do? + TouchOp -> \[] [_e] -> PrimInline mempty KeepAliveOp -> \[_r] [x, f] -> PRPrimCall $ ReturnStat (app "h$keepAlive" [x, f]) ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -63,8 +63,6 @@ ghcjsRenderJsV r (JHash m) quoteIfRequired x | isUnquotedKey x' = text x' | otherwise = PP.squotes (text x') - -- FIXME: Jeff (2022,03): remove the deserialization to String. We are only - -- converting from ShortText to String here to call @all@ and @tail at . where x' = unpackFS x isUnquotedKey :: String -> Bool @@ -74,7 +72,6 @@ ghcjsRenderJsV r (JHash m) && all validOtherIdent (tail x) - -- fixme, this will quote some idents that don't really need to be quoted validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c ghcjsRenderJsV r v = renderJsV defaultRenderJs r v @@ -119,7 +116,7 @@ prettyBlock' r ( (DeclStat i) ) | i == i' = (text "var" <+> jsToDocR r i <+> char '=' <+> jsToDocR r v) : prettyBlock' r xs --- modify/assign operators (fixme this should be more general, but beware of side effects like PPostExpr) +-- modify/assign operators prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) : xs ) ===================================== compiler/GHC/StgToJS/Profiling.hs ===================================== @@ -88,7 +88,6 @@ enterCostCentreThunk :: JStat enterCostCentreThunk = ApplStat (var "h$enterThunkCCS") [r1 .^ "cc"] setCC :: CostCentre -> Bool -> Bool -> G JStat --- FIXME: ignoring tick flags for now setCC cc _tick True = do ccI@(TxtI _ccLbl) <- costCentreLbl cc addDependency $ OtherSymb (cc_mod cc) @@ -147,7 +146,7 @@ costCentreStackLbl' :: CostCentreStack -> G (Maybe String) costCentreStackLbl' ccs = do ifProfilingM f where - f | isCurrentCCS ccs = return $ Just "h$currentThread.ccs" -- FIXME + f | isCurrentCCS ccs = return $ Just "h$currentThread.ccs" | dontCareCCS == ccs = return $ Just "h$CCS_DONT_CARE" | otherwise = case maybeSingletonCCS ccs of ===================================== compiler/GHC/StgToJS/Regs.hs ===================================== @@ -29,18 +29,6 @@ import GHC.Data.FastString import Data.Array import Data.Char --- FIXME: Perf: Jeff (2022,03): as far as I can tell, we never pattern match on --- these registers and make heavy use of the Enum, Bounded, and Ix, instances. --- This heavily implies to me that we should be using something like: StgReg = --- StgReg { unStgReg :: Int8# } and then store two nibbles in a single byte. Not --- only would this be more memory efficient, but it would also allow for --- optimizations such as pointer tagging and avoiding chasing the info table, --- although I'm not sure if this would really benefit the backend as currently --- written. Other than that a newtype wrapper with a custom bounded instance --- (hand written or deriving via) would be better. In almost all functions that --- take an StgReg we use either the Bounded or the Enum methods, thus we likely --- don't gain anything from having these registers explicitly represented in --- data constructors. -- | General purpose "registers" -- -- The JS backend arbitrarily supports 128 registers @@ -103,8 +91,6 @@ r3 = toJExpr R3 r4 = toJExpr R4 --- FIXME: Jeff (2022,03): remove these serialization functions after adding a --- StgReg type with a proper bounded and enum instance jsRegToInt :: StgReg -> Int jsRegToInt = (+1) . fromEnum ===================================== compiler/GHC/StgToJS/Stack.hs ===================================== @@ -182,9 +182,6 @@ pushOptimized' xs = do 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) ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -52,7 +52,6 @@ assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr UnliftedRep [sptr]) = , a_off |= sptr ] assignCoerce (TypedExpr UnliftedRep [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = - -- FIXME: (Sylvain 2022-03-11): why can we ignore a_val? sptr |= a_off assignCoerce p1 p2 = assignTypedExprs [p1] [p2] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13fe0a1148e9c9410739422b3f80cd0778b6b7ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13fe0a1148e9c9410739422b3f80cd0778b6b7ba You're receiving 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 25 22:56:29 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Thu, 25 Aug 2022 18:56:29 -0400 Subject: [Git][ghc/ghc][wip/js-staging] JS Backend: Remove FIXMEs Message-ID: <6307fe1dd16a5_e9d7d40d5e5901268511@gitlab.mail> doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 4a9c9af1 by doyougnu at 2022-08-25T18:56:07-04:00 JS Backend: Remove FIXMEs StgToJS.Apply: Remove FIXMEs StgToJS.FFI: remove FIXMEs StgToJS.Expr: remove FIXMEs StgToJS: Remove FIXMEs - - - - - 19 changed files: - compiler/GHC/StgToJS.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/ExprCtx.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Heap.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Profiling.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/Utils.hs Changes: ===================================== compiler/GHC/StgToJS.hs ===================================== @@ -70,13 +70,6 @@ import GHC.StgToJS.CodeGen -- 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 @@ -128,8 +121,8 @@ import GHC.StgToJS.CodeGen -- , 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 +-- , r -- ?? +-- , s -- static references? -- , m -- GC mark? -- } -- ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -107,7 +107,6 @@ genApp ctx i args , [top] <- concatMap typex_expr (ctxTarget ctx) , getUnique i == unpackCStringAppendIdKey , d <- utf8DecodeByteString bs - -- FIXME (Sylvain, 2022/02): we assume that it decodes but it may not (e.g. embedded file) = do prof <- csProf <$> getSettings let profArg = if prof then [jCafCCS] else [] @@ -222,7 +221,7 @@ genApp ctx i args | n <- length args , n /= 0 , idFunRepArity i == n - , not (isLocalId i) -- FIXME (Sylvain 2022-08): why are we testing this here and not in the oversaturated case below? + , not (isLocalId i) , isStrictId i = do as' <- concatMapM genArg args @@ -550,9 +549,6 @@ genericStackApply cfg = closure info body , ifS (newAp .===. var "h$ap_gen") ((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 @@ -760,17 +756,12 @@ stackApply s fun_name nargs nvars = (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? + <> mkPap s pap r1 (toJExpr nargs) stackArgs <> (sp |= sp - toJExpr (nvars + 1)) <> (r1 |= toJExpr pap) <> returnStack)) ] - _ -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive - -- patterns. That the code wants to do this - -- means we should be encoding that funCase is - -- only callable on ValExpr (JVar pap)'s in - -- the type system, perhaps with a GADT or - -- phantom + _ -> mempty funCase :: JExpr -> JStat @@ -789,12 +780,7 @@ stackApply s fun_name nargs nvars = <> (r1 |= toJExpr pap) <> returnStack)) ] - _ -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive - -- patterns. That the code wants to do this - -- means we should be encoding that funCase is - -- only callable on ValExpr (JVar pap)'s in - -- the type system, perhaps with a GADT or - -- phantom + _ -> mempty -- oversat: call the function but keep enough on the stack for the next @@ -843,7 +829,6 @@ fastApply s fun_name nargs nvars = func ||= body0 jVar \c farity arity -> [ c |= closureEntry r1 , 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 (fun_name <> ": ") + clName c @@ -872,12 +857,7 @@ fastApply s fun_name nargs nvars = func ||= body0 <> (r1 |= toJExpr pap) <> returnStack)) ] - _ -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive - -- patterns. That the code wants to do this - -- means we should be encoding that funCase is - -- only callable on ValExpr (JVar pap)'s in - -- the type system, perhaps with a GADT or - -- phantom + _ -> mempty oversatCase :: JExpr -> JExpr -> JStat oversatCase c arity = @@ -1130,13 +1110,11 @@ papGen cfg = -- general utilities -- move the first n registers, starting at R2, m places up (do not use with negative m) --- FIXME (Jeff, 2022/03): pick a better name, e.g., `r2moveRegs` moveRegs2 :: JStat moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch where moveSwitch n m = SwitchStat ((n .<<. 8) .|. m) switchCases (defaultCase n m) -- fast cases - -- TODO: tune the parameteters for performance and size switchCases = [switchCase n m | n <- [1..5], m <- [1..4]] switchCase :: Int -> Int -> (JExpr, JStat) switchCase n m = (toJExpr $ ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -158,7 +158,7 @@ genArg a = case a of as <- concat <$> mapM genArg args e <- varForDataConWorker dc inl_alloc <- csInlineAlloc <$> getSettings - return [allocDynamicE inl_alloc e as Nothing] -- FIXME: ccs + return [allocDynamicE inl_alloc e as Nothing] x -> pprPanic "genArg: unexpected unfloated expression" (pprStgExpr panicStgPprOpts x) genIdArg :: HasDebugCallStack => Id -> G [JExpr] @@ -258,7 +258,6 @@ 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 jsStaticArg args) Nothing -- | Generate JS code corresponding to a list of static args ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -138,7 +138,7 @@ genUnits m ss spt_entries foreign_stubs staticInit <- initStaticPtrs spt_entries (st', _, bs) <- serializeLinkableUnit m st [] [] [] - ( -- FIXME (Sylvain, 2022/02): optimizer disabled: O.optimize . + ( -- O.optimize . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) "" [] [] return ( st' @@ -218,8 +218,7 @@ genUnits m ss spt_entries foreign_stubs let allDeps = collectIds unf decl topDeps = collectTopIds decl required = hasExport decl - stat = -- FIXME (Sylvain 2022/02): optimizer disabled: - -- {-decl -} Opt.optimize . + stat = -- Opt.optimize . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl (st', _ss, bs) <- serializeLinkableUnit m st topDeps ci si stat mempty [] fRefs ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -203,9 +203,9 @@ primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of | tc == mutVarPrimTyCon -> RtsObjV | tc == mVarPrimTyCon -> RtsObjV | tc == tVarPrimTyCon -> RtsObjV - | tc == bcoPrimTyCon -> RtsObjV -- fixme what do we need here? + | tc == bcoPrimTyCon -> RtsObjV -- unsupported? | tc == stackSnapshotPrimTyCon -> RtsObjV - | tc == ioPortPrimTyCon -> RtsObjV -- FIXME: Jeff (2022, 05) IOPort, how to handle in JS? + | tc == ioPortPrimTyCon -> RtsObjV -- unsupported? | tc == anyTyCon -> PtrV | tc == compactPrimTyCon -> ObjV -- unsupported? | tc == eqPrimTyCon -> VoidV -- coercion token? ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -43,9 +43,6 @@ genCon ctx con args | [ValExpr (JVar ctxi)] <- concatMap typex_expr (ctxTarget ctx) = allocCon ctxi con currentCCS args - -- FIXME: (Sylvain 2022-03-11) Do we support e.g. "data T = MkT Word64"? It - -- would return two JExprs - | xs <- concatMap typex_expr (ctxTarget ctx) = pprPanic "genCon: unhandled DataCon" (ppr (con, args, xs)) ===================================== compiler/GHC/StgToJS/Deps.hs ===================================== @@ -39,7 +39,7 @@ import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.State -data DependencyDataCache = DDC -- FIXME Sylvain 2022-02: use UniqFM +data DependencyDataCache = DDC { ddcModule :: !(IntMap Unit) -- ^ Unique Module -> Object.Package , ddcId :: !(IntMap Object.ExportedFun) -- ^ Unique Id -> Object.ExportedFun (only to other modules) , ddcOther :: !(Map OtherSymb Object.ExportedFun) ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -331,18 +331,10 @@ resultSize xxs@(_:xs) t | otherwise = [(LiftedRep, 1)] -- possibly newtype family, must be boxed resultSize [] t - -- FIXME: Jeff (2022,05): Is this check actually needed? If we have a runtime - -- rep kinded type can't we just call typePrimReps to get the PrimReps and - -- then primRep size just like in the catchall case? I don't see why this - -- doesn't work. | isRuntimeRepKindedTy t' = pprPanic "resultSize: Type was RuntimeRepKinded don't know the size! " (ppr t') - -- Note that RuntimeRep from Builtins.Types hits this case. A singleton of -- (LiftedRep, 1) is exactly what's returned by the otherwise case for -- 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)] | otherwise = fmap (\p -> (p, slotCount (primRepSize p))) (typePrimReps t) where t' = unwrapType t @@ -403,9 +395,6 @@ popLneFrame inEntry size ctx = do let ctx' = ctxLneShrinkStack ctx size 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) @@ -698,8 +687,6 @@ genAlts ctx e at me alts = do return (s, r) _ -> error "genAlts: invalid branches for Bool" - -- FIXME: add all alts - AlgAlt _tc -> do ei <- varForId e (r, brs) <- normalizeBranches ctx <$> @@ -923,11 +910,7 @@ allocDynAll haveDecl middle cls = do fillObjs = mconcat $ map fillObj cls fillObj (i,_,es,_) - | csInlineAlloc settings || length es > 24 = -- FIXME (Jeff, 2022/03): the call to length means `es` - -- should be something other than - -- a list. Also why is 24 - -- important? And 24 should be a - -- constant such as `fooThreshold` + | csInlineAlloc settings || length es > 24 = case es of [] -> mempty [ex] -> toJExpr i .^ closureField1_ |= toJExpr ex ===================================== compiler/GHC/StgToJS/ExprCtx.hs ===================================== @@ -127,7 +127,6 @@ ctxUpdateLneFrame new_spilled_vars new_lne_ids ctx = { ctxLneFrameBs = addListToUFM (ctxLneFrameBs ctx) (map (,new_frame_size) new_lne_ids) , ctxLneFrameSize = new_frame_size , ctxLneFrameVars = ctxLneFrameVars ctx ++ new_spilled_vars - -- FIXME: could we use a stack? (i.e. cons new variables) } -- | Remove information about the current LNE frame ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -50,7 +50,6 @@ import Control.Monad import Control.Applicative import qualified Text.ParserCombinators.ReadP as P --- FIXME: what if the call returns a thunk? genPrimCall :: ExprCtx -> PrimCall -> [StgArg] -> Type -> G (JStat, ExprResult) genPrimCall ctx (PrimCall lbl _) args t = do j <- parseFFIPattern False False False ("h$" ++ unpackFS lbl) t (concatMap typex_expr $ ctxTarget ctx) args @@ -140,8 +139,7 @@ parseFFIPattern' :: Maybe JExpr -- ^ Nothing for sync, Just callback for async parseFFIPattern' callback javascriptCc pat t ret args | not javascriptCc = mkApply pat | otherwise = - if True -- FIXME (Sylvain 2022-03): we don't support parsing of JS imports. - -- So we assume that we can directly apply to them... + if True then mkApply pat else do u <- freshUnique @@ -278,13 +276,9 @@ callbackPlaceholders (Just e) = [((TxtI "$c"), e)] parseFfiJME :: String -> Int -> Either String JExpr parseFfiJME _xs _u = Left "parseFfiJME not yet implemented" - -- FIXME (Sylvain 2022-02): removed temporarily for the codegen merge. Need to - -- decide which syntax we support parseFfiJM :: String -> Int -> Either String JStat parseFfiJM _xs _u = Left "parseFfiJM not yet implemented" - -- FIXME (Sylvain 2022-02): removed temporarily for the codegen merge. Need to - -- decide which syntax we support saturateFFI :: JMacro a => Int -> a -> a saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) ===================================== compiler/GHC/StgToJS/Heap.hs ===================================== @@ -43,21 +43,6 @@ import GHC.JS.Make import GHC.StgToJS.Types import GHC.Data.FastString --- FIXME: Jeff (2022,03): These helpers are a classic case of using a newtype --- over a type synonym to leverage GHC's type checker. Basically we never want --- to mix these up, and so we should have: --------------------------------------- --- newtype ClosureEntry = ClosureEntry { unClosureEntry :: FastString } --- newtype ClosureExtra1 = ClosureExtra1 { unClosureExtra1 :: FastString } --- newtype ClosureExtra2 = ClosureExtra2 { unClosureExtra2 :: FastString } --- newtype ClosureMeta = ClosureMeta { unClosureMeta :: FastString } --------------------------------------- --- especially since any bugs which result from confusing these will be catastrophic and hard to debug --- also NOTE: if ClosureExtra is truly unbounded then we should have: --- newtype ClosureExtras = ClosureExtras { unClosureExtras :: [FastString] } --- or use an Array and amortize increasing the arrays size when needed; depending --- on its use case in the RTS of course - closureEntry_ :: FastString closureEntry_ = "f" ===================================== compiler/GHC/StgToJS/Literal.hs ===================================== @@ -73,12 +73,6 @@ genStaticLit = \case LitChar c -> return [ IntLit (fromIntegral $ ord c) ] LitString str | True -> return [ StringLit (mkFastStringByteString str), IntLit 0] - -- FIXME: documentation for LitString says it's always UTF8 encoded but it's - -- not true (e.g. for embedded files). - -- 1) We should add a decoding function that detects errors in - -- GHC.Utils.Encoding - -- 2) We should perhaps add a different LitBin constructor that would - -- benefit other backends? -- \| invalid UTF8 -> return [ BinLit str, IntLit 0] LitNullAddr -> return [ NullLit, IntLit 0 ] LitNumber nt v -> case nt of @@ -97,7 +91,6 @@ genStaticLit = \case LitDouble r -> return [ DoubleLit . SaneDouble . r2d $ r ] LitLabel name _size fod -> return [ LabelLit (fod == IsFunction) (mkFastString $ "h$" ++ unpackFS name) , IntLit 0 ] - -- FIXME: handle other LitRubbish, etc. l -> pprPanic "genStaticLit" (ppr l) -- make an unsigned 32 bit number from this unsigned one, lower 32 bits ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} --- only for DB.Binary instances on Module see FIXME below +-- only for DB.Binary instances on Module {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- @@ -36,16 +36,7 @@ -- - dependency info -- - closureinfo index -- - closureinfo data (offsets described by index) - --- FIXME: Jeff (2022,03): There are orphan instances for DB.Binary Module and --- ModuleName. These are needed in StgToJS.Linker.Types for @Base@ serialization --- in @putBase at . We end up in this situation because Base now holds a @Module@ --- type instead of GHCJS's previous @Package@ type. In addition to this GHC uses --- GHC.Utils.Binary for binary instances rather than Data.Binary (even though --- Data.Binary is a boot lib) so to fix the situation we must: --- - 1. Choose to use GHC.Utils.Binary or Data.Binary --- - 2. Remove Binary since this is redundant --- - 3. Adapt the Linker types, like Base to the new Binary methods +-- ----------------------------------------------------------------------------- module GHC.StgToJS.Object @@ -174,7 +165,6 @@ trim = let f = dropWhile isSpace . reverse in f . f isGlobalUnit :: Int -> Bool isGlobalUnit n = n == 0 --- fixme document, exports unit is always linked isExportsUnit :: Int -> Bool isExportsUnit n = n == 1 @@ -492,9 +482,6 @@ putSymbolTable (SymbolTable _ hm) = st st = DB.runPut $ do DB.putWord32le (fromIntegral $ length xs) mapM_ DB.put xs - -- fixme: this is a workaround for some weird issue sometimes causing zero-length - -- strings when using the Data.Text instance directly - -- mapM_ (DB.put . TE.encodeUtf8) xs xs :: [FastString] xs = map fst . sortBy (compare `on` snd) . nonDetEltsUniqMap $ hm -- We can use `nonDetEltsUniqMap` because the paired `Int`s introduce ordering. ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -578,7 +578,6 @@ genPrim prof ty op = case op of , a .! i |= new , s |= zero_ ] - -- fixme both new? [ s |= one_ , o |= x ] @@ -705,7 +704,6 @@ genPrim prof ty op = case op of PrimInline $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - -- FIXME: we can do faster by copying 32 bit ints or doubles PrimInline $ loopBlockS (Sub n one_) (.>=. zero_) \i -> [ u8_ a2 (Add i o2) |= u8_ a1 (Add i o1) , postDecrS i @@ -742,7 +740,7 @@ genPrim prof ty op = case op of AddrSubOp -> \[i] [_a1,o1,_a2,o2] -> PrimInline $ i |= Sub o1 o2 AddrRemOp -> \[r] [_a,o,i] -> PrimInline $ r |= Mod o i AddrToIntOp -> \[i] [_a,o] -> PrimInline $ i |= o -- only usable for comparisons within one range - IntToAddrOp -> \[a,o] [i] -> PrimInline $ mconcat [a |= null_, o |= i] -- FIXME: unsupported + IntToAddrOp -> \[a,o] [i] -> PrimInline $ mconcat [a |= null_, o |= i] AddrGtOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>. zero_) AddrGeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>=. zero_) AddrEqOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .===. zero_) @@ -920,13 +918,13 @@ genPrim prof ty op = case op of MkWeakOp -> \[r] [o,b,c] -> PrimInline $ r |= app "h$makeWeak" [o,b,c] MkWeakNoFinalizerOp -> \[r] [o,b] -> PrimInline $ r |= app "h$makeWeakNoFinalizer" [o,b] - AddCFinalizerToWeakOp -> \[r] [_a1,_a1o,_a2,_a2o,_i,_a3,_a3o,_w] -> PrimInline $ r |= one_ -- fixme + AddCFinalizerToWeakOp -> \[r] [_a1,_a1o,_a2,_a2o,_i,_a3,_a3o,_w] -> PrimInline $ r |= one_ DeRefWeakOp -> \[f,v] [w] -> PrimInline $ mconcat [ v |= w .^ "val" , f |= if01 (v .===. null_) ] FinalizeWeakOp -> \[fl,fin] [w] -> PrimInline $ appT [fin, fl] "h$finalizeWeak" [w] - TouchOp -> \[] [_e] -> PrimInline mempty -- fixme what to do? + TouchOp -> \[] [_e] -> PrimInline mempty KeepAliveOp -> \[_r] [x, f] -> PRPrimCall $ ReturnStat (app "h$keepAlive" [x, f]) ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -63,8 +63,6 @@ ghcjsRenderJsV r (JHash m) quoteIfRequired x | isUnquotedKey x' = text x' | otherwise = PP.squotes (text x') - -- FIXME: Jeff (2022,03): remove the deserialization to String. We are only - -- converting from ShortText to String here to call @all@ and @tail at . where x' = unpackFS x isUnquotedKey :: String -> Bool @@ -74,7 +72,6 @@ ghcjsRenderJsV r (JHash m) && all validOtherIdent (tail x) - -- fixme, this will quote some idents that don't really need to be quoted validFirstIdent c = c == '_' || c == '$' || isAlpha c validOtherIdent c = isAlpha c || isDigit c ghcjsRenderJsV r v = renderJsV defaultRenderJs r v @@ -119,7 +116,7 @@ prettyBlock' r ( (DeclStat i) ) | i == i' = (text "var" <+> jsToDocR r i <+> char '=' <+> jsToDocR r v) : prettyBlock' r xs --- modify/assign operators (fixme this should be more general, but beware of side effects like PPostExpr) +-- modify/assign operators prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) : xs ) ===================================== compiler/GHC/StgToJS/Profiling.hs ===================================== @@ -88,7 +88,6 @@ enterCostCentreThunk :: JStat enterCostCentreThunk = ApplStat (var "h$enterThunkCCS") [r1 .^ "cc"] setCC :: CostCentre -> Bool -> Bool -> G JStat --- FIXME: ignoring tick flags for now setCC cc _tick True = do ccI@(TxtI _ccLbl) <- costCentreLbl cc addDependency $ OtherSymb (cc_mod cc) @@ -147,7 +146,7 @@ costCentreStackLbl' :: CostCentreStack -> G (Maybe String) costCentreStackLbl' ccs = do ifProfilingM f where - f | isCurrentCCS ccs = return $ Just "h$currentThread.ccs" -- FIXME + f | isCurrentCCS ccs = return $ Just "h$currentThread.ccs" | dontCareCCS == ccs = return $ Just "h$CCS_DONT_CARE" | otherwise = case maybeSingletonCCS ccs of ===================================== compiler/GHC/StgToJS/Regs.hs ===================================== @@ -29,18 +29,6 @@ import GHC.Data.FastString import Data.Array import Data.Char --- FIXME: Perf: Jeff (2022,03): as far as I can tell, we never pattern match on --- these registers and make heavy use of the Enum, Bounded, and Ix, instances. --- This heavily implies to me that we should be using something like: StgReg = --- StgReg { unStgReg :: Int8# } and then store two nibbles in a single byte. Not --- only would this be more memory efficient, but it would also allow for --- optimizations such as pointer tagging and avoiding chasing the info table, --- although I'm not sure if this would really benefit the backend as currently --- written. Other than that a newtype wrapper with a custom bounded instance --- (hand written or deriving via) would be better. In almost all functions that --- take an StgReg we use either the Bounded or the Enum methods, thus we likely --- don't gain anything from having these registers explicitly represented in --- data constructors. -- | General purpose "registers" -- -- The JS backend arbitrarily supports 128 registers @@ -103,8 +91,6 @@ r3 = toJExpr R3 r4 = toJExpr R4 --- FIXME: Jeff (2022,03): remove these serialization functions after adding a --- StgReg type with a proper bounded and enum instance jsRegToInt :: StgReg -> Int jsRegToInt = (+1) . fromEnum ===================================== compiler/GHC/StgToJS/Stack.hs ===================================== @@ -182,9 +182,6 @@ pushOptimized' xs = do 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) ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -52,7 +52,6 @@ assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr UnliftedRep [sptr]) = , a_off |= sptr ] assignCoerce (TypedExpr UnliftedRep [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = - -- FIXME: (Sylvain 2022-03-11): why can we ignore a_val? sptr |= a_off assignCoerce p1 p2 = assignTypedExprs [p1] [p2] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a9c9af11f79586037b6f7dfd2560e4b1587cdf2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a9c9af11f79586037b6f7dfd2560e4b1587cdf2 You're receiving 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 25 23:19:33 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 25 Aug 2022 19:19:33 -0400 Subject: [Git][ghc/ghc][wip/T21623] Refactoring... Message-ID: <63080385230e_e9d7d36163a7412689d1@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: c455ad5e by Simon Peyton Jones at 2022-08-26T00:19:02+01:00 Refactoring... Remove tc functions like tcKind, tcGetTyVar. Move tyConsOfType, occCheckExpand to TyCo.FVs. - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c455ad5e5be9e458ddc67e614d3af91c3e995535 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c455ad5e5be9e458ddc67e614d3af91c3e995535 You're receiving 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 26 00:05:56 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 20:05:56 -0400 Subject: [Git][ghc/ghc][master] 9 commits: hadrian: Fix whitespace Message-ID: <63080e6434620_e9d7d3d103bf412777f7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/SysTools/BaseDir.hs - − compiler/Makefile - − compiler/ghc.mk - configure.ac - distrib/configure.ac.in - − distrib/hc-build - − docs/users_guide/ghc.mk - − driver/ghc.mk - − driver/ghc/ghc.mk - − driver/ghci/ghc.mk - − driver/haddock/ghc.mk - − ghc.mk - ghc/ghc-bin.cabal.in - − ghc/ghc.mk - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Settings/Packages.hs - − libffi/ghc.mk - − libraries/ghc-bignum/gmp/ghc.mk - − libraries/ghc-boot/ghc.mk - − mk/build.mk.sample - − mk/compiler-ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28402eed1bd0ec27d1dd5b663304a741de0ce2c3...46924b75c78c2fcb92cba91796bc22986c796ed3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28402eed1bd0ec27d1dd5b663304a741de0ce2c3...46924b75c78c2fcb92cba91796bc22986c796ed3 You're receiving 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 26 00:06:24 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 20:06:24 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add inits1 and tails1 to Data.List.NonEmpty Message-ID: <63080e808ebca_e9d7d3d103bf41283072@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 4 changed files: - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md - libraries/base/tests/all.T - + libraries/base/tests/inits1tails1.hs Changes: ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -47,7 +47,9 @@ module Data.List.NonEmpty ( , sort -- :: NonEmpty a -> NonEmpty a , reverse -- :: NonEmpty a -> NonEmpty a , inits -- :: Foldable f => f a -> NonEmpty a + , inits1 -- :: NonEmpty a -> NonEmpty (NonEmpty a) , tails -- :: Foldable f => f a -> NonEmpty a + , tails1 -- :: NonEmpty a -> NonEmpty (NonEmpty a) , append -- :: NonEmpty a -> NonEmpty a -> NonEmpty a , appendList -- :: NonEmpty a -> [a] -> NonEmpty a , prependList -- :: [a] -> NonEmpty a -> NonEmpty a @@ -215,15 +217,62 @@ map :: (a -> b) -> NonEmpty a -> NonEmpty b map f ~(a :| as) = f a :| fmap f as -- | The 'inits' function takes a stream @xs@ and returns all the --- finite prefixes of @xs at . +-- finite prefixes of @xs@, starting with the shortest. The result is +-- 'NonEmpty' because the result always contains the empty list as the first +-- element. +-- +-- > inits [1,2,3] == [] :| [[1], [1,2], [1,2,3]] +-- > inits [1] == [] :| [[1]] +-- > inits [] == [] :| [] inits :: Foldable f => f a -> NonEmpty [a] inits = fromList . List.inits . Foldable.toList +-- | The 'inits1' function takes a 'NonEmpty' stream @xs@ and returns all the +-- 'NonEmpty' finite prefixes of @xs@, starting with the shortest. +-- +-- > inits1 (1 :| [2,3]) == (1 :| []) :| [1 :| [2], 1 :| [2,3]] +-- > inits1 (1 :| []) == (1 :| []) :| [] +-- +-- @since 4.18 +inits1 :: NonEmpty a -> NonEmpty (NonEmpty a) +inits1 = + -- fromList is an unsafe function, but this usage should be safe, since: + -- * `inits xs = [[], ..., init (init xs), init xs, xs]` + -- * If `xs` is nonempty, it follows that `inits xs` contains at least one nonempty + -- list, since `last (inits xs) = xs`. + -- * The only empty element of `inits xs` is the first one (by the definition of `inits`) + -- * Therefore, if we take all but the first element of `inits xs` i.e. + -- `tail (inits xs)`, we have a nonempty list of nonempty lists + fromList . Prelude.map fromList . List.tail . List.inits . Foldable.toList + -- | The 'tails' function takes a stream @xs@ and returns all the --- suffixes of @xs at . +-- suffixes of @xs@, starting with the longest. The result is 'NonEmpty' +-- because the result always contains the empty list as the last element. +-- +-- > tails [1,2,3] == [1,2,3] :| [[2,3], [3], []] +-- > tails [1] == [1] :| [[]] +-- > tails [] == [] :| [] tails :: Foldable f => f a -> NonEmpty [a] tails = fromList . List.tails . Foldable.toList +-- | The 'tails1' function takes a 'NonEmpty' stream @xs@ and returns all the +-- non-empty suffixes of @xs@, starting with the longest. +-- +-- > tails1 (1 :| [2,3]) == (1 :| [2,3]) :| [2 :| [3], 3 :| []] +-- > tails1 (1 :| []) == (1 :| []) :| [] +-- +-- @since 4.18 +tails1 :: NonEmpty a -> NonEmpty (NonEmpty a) +tails1 = + -- fromList is an unsafe function, but this usage should be safe, since: + -- * `tails xs = [xs, tail xs, tail (tail xs), ..., []]` + -- * If `xs` is nonempty, it follows that `tails xs` contains at least one nonempty + -- list, since `head (tails xs) = xs`. + -- * The only empty element of `tails xs` is the last one (by the definition of `tails`) + -- * Therefore, if we take all but the last element of `tails xs` i.e. + -- `init (tails xs)`, we have a nonempty list of nonempty lists + fromList . Prelude.map fromList . List.init . List.tails . Foldable.toList + -- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it -- is still less than or equal to the next element. In particular, if the -- list is sorted beforehand, the result will also be sorted. ===================================== libraries/base/changelog.md ===================================== @@ -21,6 +21,7 @@ function. * `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label of a given `ThreadId`. + * Add `inits1` and `tails1` to `Data.List.NonEmpty`. ## 4.17.0.0 *August 2022* ===================================== libraries/base/tests/all.T ===================================== @@ -274,3 +274,4 @@ test('T19719', normal, compile_and_run, ['']) test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring']) test('trace', normal, compile_and_run, ['']) test('listThreads', normal, compile_and_run, ['']) +test('inits1tails1', normal, compile_and_run, ['']) ===================================== libraries/base/tests/inits1tails1.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE RankNTypes #-} +module Main (main) where + +import Data.List qualified as List +import Data.List.NonEmpty (NonEmpty(..)) +import Data.List.NonEmpty qualified as NEL + +-- The inits implementation added in 7.10 uses a queue rotated around +-- powers of 2, starting the rotation only at size 255, so we want to check +-- around powers of 2 and around the switch. +ranges :: [Int] +ranges = [1..20] ++ [252..259] ++ [508..515] + +nonEmptyUpTo :: Int -> NonEmpty Int +nonEmptyUpTo n | n >= 1 = NEL.fromList [1..n] +nonEmptyUpTo n = error $ "nonEmptyUpTo: invalid argument: " ++ show n + +simple :: (forall a . NonEmpty a -> [[a]]) -> [[[Int]]] +simple impl = [impl (nonEmptyUpTo n) | n <- ranges] + +nonEmptyInits1 :: NonEmpty a -> [[a]] +nonEmptyInits1 = map NEL.toList . NEL.toList . NEL.inits1 + +-- inits1 should be the same as inits on nonempty lists, except that the first +-- element should not be included +alternativeInits1 :: NonEmpty a -> [[a]] +alternativeInits1 = tail . List.inits . NEL.toList + +nonEmptyTails1 :: NonEmpty a -> [[a]] +nonEmptyTails1 = map NEL.toList . NEL.toList . NEL.tails1 + +-- tails1 should be the same as tails on nonempty lists, except that the last +-- element should not be included +alternativeTails1 :: NonEmpty a -> [[a]] +alternativeTails1 = init . List.tails . NEL.toList + +-- We want inits1 (xs <> undefined) = inits1 xs <> undefined +-- (there's no similar property for tails1 because that function starts with the +-- longest suffix) +lazinessInits1 :: Bool +lazinessInits1 = [take n (nonEmptyInits1 (nonEmptyUpTo n <> undefined)) | n <- ranges] + == simple nonEmptyInits1 + +main :: IO () +main | simple nonEmptyInits1 /= simple alternativeInits1 = error "inits1 failed simple test" + | simple nonEmptyTails1 /= simple alternativeTails1 = error "tails1 failed simple test" + | not lazinessInits1 = error "inits1 failed laziness test" + | otherwise = return () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46924b75c78c2fcb92cba91796bc22986c796ed3...8603c92113c49557f8632675a01f3b3874b819d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46924b75c78c2fcb92cba91796bc22986c796ed3...8603c92113c49557f8632675a01f3b3874b819d1 You're receiving 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 26 00:06:58 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 Aug 2022 20:06:58 -0400 Subject: [Git][ghc/ghc][master] Fix redundant import Message-ID: <63080ea21989b_e9d7d40d5e590128662d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 1 changed file: - compiler/GHC/Driver/Plugins.hs Changes: ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_INTERNAL_INTERPRETER) && defined(CAN_LOAD_DLL) {-# LANGUAGE MagicHash #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE UnboxedTuples #-} @@ -103,7 +103,7 @@ import qualified Data.Semigroup import Control.Monad -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_INTERNAL_INTERPRETER) && defined(CAN_LOAD_DLL) import GHCi.ObjLink import GHC.Exts (addrToAny#, Ptr(..)) import GHC.Utils.Encoding View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b47aa1cc87426db4fe7d805af69894de05780ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b47aa1cc87426db4fe7d805af69894de05780ff You're receiving 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 26 08:12:23 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 Aug 2022 04:12:23 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Enable RTS args filtering (cf cgrun025) Message-ID: <630880676325d_e9d7d4d1d413336ad@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 6e8d292b by Sylvain Henry at 2022-08-26T10:14:41+02:00 Enable RTS args filtering (cf cgrun025) - - - - - 1 changed file: - js/environment.js.pp Changes: ===================================== js/environment.js.pp ===================================== @@ -90,6 +90,47 @@ if(h$isNode) { } #endif +//filter RTS arguments +var h$rtsArgs = []; +{ + var prog_args = []; + var rts_args = []; + var in_rts = false; + var i = 0; + for(i=0;i From gitlab at gitlab.haskell.org Fri Aug 26 09:58:22 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 Aug 2022 05:58:22 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 5 commits: Remove trailing whitespaces (whitespace test) Message-ID: <6308993ec9be4_e9d7d3d103bf41370976@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: c7b7a333 by Sylvain Henry at 2022-08-26T11:27:38+02:00 Remove trailing whitespaces (whitespace test) - - - - - 494f7971 by Sylvain Henry at 2022-08-26T11:34:08+02:00 Testsuite: remove platform prefix for unlit tool - - - - - d6bfe499 by Sylvain Henry at 2022-08-26T11:36:20+02:00 Primop: fix Int64 conversion/negate (integerConversions test) - - - - - f7a03eff by Sylvain Henry at 2022-08-26T11:59:37+02:00 Linker: remove message with default verbosity - - - - - 8764ef83 by Sylvain Henry at 2022-08-26T12:00:09+02:00 Testsuite: normalise .jsexe suffix - - - - - 4 changed files: - compiler/GHC/StgToJS.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Prim.hs - testsuite/driver/testlib.py Changes: ===================================== compiler/GHC/StgToJS.hs ===================================== @@ -60,7 +60,7 @@ import GHC.StgToJS.CodeGen -- > plus :: Int -> Int -> Int -- -- 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 ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -226,10 +226,11 @@ link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFil rootMods = map (moduleNameString . moduleName . head) . group . sort . map funModule . S.toList $ roots objPkgs = map moduleUnitId $ nub (M.keys objDepsMap) - _ <- compilationProgressMsg logger . text $ - case lcGenBase lc_cfg of - Just baseMod -> "Linking base bundle " ++ target ++ " (" ++ moduleNameString (moduleName baseMod) ++ ")" - _ -> "Linking " ++ target ++ " (" ++ intercalate "," rootMods ++ ")" + when (logVerbAtLeast logger 2) $ void $ + compilationProgressMsg logger . text $ + case lcGenBase lc_cfg of + Just baseMod -> "Linking base bundle " ++ target ++ " (" ++ moduleNameString (moduleName baseMod) ++ ")" + _ -> "Linking " ++ target ++ " (" ++ intercalate "," rootMods ++ ")" base <- case lcUseBase lc_cfg of NoBase -> return emptyBase @@ -608,7 +609,7 @@ readArObject ar_state mod ar_file = do | otherwise = False - -- XXX this shouldn't be an exception probably + -- XXX this shouldn't be an exception probably pure $! maybe (error $ "could not find object for module " ++ moduleNameString (moduleName mod) ++ " in " ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -267,11 +267,11 @@ genPrim prof ty op = case op of ------------------------------ Int64 -------------------------------------------- - Int64ToIntOp -> \[r] [_h,l] -> PrimInline $ r |= l + Int64ToIntOp -> \[r] [_h,l] -> PrimInline $ r |= i32 l Int64NegOp -> \[r_h,r_l] [h,l] -> PrimInline $ mconcat - [ r_l |= i32 (BNot l + 1) + [ r_l |= u32 (BNot l + 1) , r_h |= i32 (BNot h + Not r_l) ] ===================================== testsuite/driver/testlib.py ===================================== @@ -2302,6 +2302,8 @@ def normalise_errmsg(s: str) -> str: # hacky solution is used in place of more sophisticated filename # mangling s = re.sub('([^\\s])\\.exe', '\\1', s) + # Same thing for .jsexe directories generated by the JS backend + s = re.sub('([^\\s])\\.jsexe', '\\1', s) # normalise slashes, minimise Windows/Unix filename differences s = re.sub('\\\\', '/', s) @@ -2311,6 +2313,7 @@ def normalise_errmsg(s: str) -> str: s = re.sub('ghc-stage[123]', 'ghc', s) # Remove platform prefix (e.g. js-unknown-ghcjs) for cross-compiled ghc s = re.sub('^\\w+-\\w+-\\w+-ghc', 'ghc', s) + s = re.sub('^\\w+-\\w+-\\w+-unlit', 'unlit', s) # On windows error messages can mention versioned executables s = re.sub('ghc-[0-9.]+', 'ghc', s) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e8d292b596f719e66fd6c8f5dddda5701ba7c1e...8764ef83d8d04b92299b3109ceba2a00efcf8b03 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e8d292b596f719e66fd6c8f5dddda5701ba7c1e...8764ef83d8d04b92299b3109ceba2a00efcf8b03 You're receiving 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 26 10:12:38 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 Aug 2022 06:12:38 -0400 Subject: [Git][ghc/ghc][wip/simplifier-fixes] 3 commits: Avoid retaining bindings via ModGuts held on the stack Message-ID: <63089c9670ad1_e9d7d36163a741375925@gitlab.mail> Matthew Pickering pushed to branch wip/simplifier-fixes at Glasgow Haskell Compiler / GHC Commits: b27d95ce by Matthew Pickering at 2022-08-26T10:53:08+01:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 01e9b9f0 by Matthew Pickering at 2022-08-26T10:53:08+01:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - 0dfaf303 by Matthew Pickering at 2022-08-26T11:03:58+01:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3437,24 +3437,26 @@ lintAnnots pname pass guts = {-# SCC "lintAnnots" #-} do logger <- getLogger when (gopt Opt_DoAnnotationLinting dflags) $ liftIO $ Err.showPass logger "Annotation linting - first run" - nguts <- pass guts -- If appropriate re-run it without debug annotations to make sure -- that they made no difference. - when (gopt Opt_DoAnnotationLinting dflags) $ do - liftIO $ Err.showPass logger "Annotation linting - second run" - nguts' <- withoutAnnots pass guts - -- Finally compare the resulting bindings - liftIO $ Err.showPass logger "Annotation linting - comparison" - let binds = flattenBinds $ mg_binds nguts - binds' = flattenBinds $ mg_binds nguts' - (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' - when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat - [ lint_banner "warning" pname - , text "Core changes with annotations:" - , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs - ] - -- Return actual new guts - return nguts + if gopt Opt_DoAnnotationLinting dflags + then do + nguts <- pass guts + liftIO $ Err.showPass logger "Annotation linting - second run" + nguts' <- withoutAnnots pass guts + -- Finally compare the resulting bindings + liftIO $ Err.showPass logger "Annotation linting - comparison" + let binds = flattenBinds $ mg_binds nguts + binds' = flattenBinds $ mg_binds nguts' + (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' + when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat + [ lint_banner "warning" pname + , text "Core changes with annotations:" + , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs + ] + return nguts + else + pass guts -- | Run the given pass without annotations. This means that we both -- set the debugLevel setting to 0 in the environment as well as all ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -152,8 +152,10 @@ simplifyPgm logger unit_env opts , mg_deps = deps , mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) - = do { (termination_msg, it_count, counts_out, guts') - <- do_iteration 1 [] binds rules + = do { -- If you don't do this then all the old bindings are retained until + -- the end of the simplifier pass. + ; (termination_msg, it_count, counts_out, guts') + <- do_iteration 1 [] binds rules ; when (logHasDumpFlag logger Opt_D_verbose_core2core && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ @@ -175,6 +177,7 @@ simplifyPgm logger unit_env opts print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode + !guts_no_binds = guts { mg_binds = [], mg_rules = [] } do_iteration :: Int -- Counts iterations -> [SimplCount] -- Counts from earlier iterations, reversed @@ -198,7 +201,7 @@ simplifyPgm logger unit_env opts -- number of iterations we actually completed return ( "Simplifier baled out", iteration_no - 1 , totalise counts_so_far - , guts { mg_binds = binds, mg_rules = rules } ) + , guts_no_binds { mg_binds = binds, mg_rules = rules } ) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -253,7 +256,7 @@ simplifyPgm logger unit_env opts if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks - , guts { mg_binds = binds1, mg_rules = rules1 } ) + , guts_no_binds { mg_binds = binds1, mg_rules = rules1 } ) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -79,6 +79,7 @@ import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) +import Data.Tuple {- ----------------------------------------------------- @@ -971,8 +972,16 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v -scSubstTy :: ScEnv -> InType -> OutType -scSubstTy env ty = substTyUnchecked (sc_subst env) ty +-- The use of Solo here allows us to force the selection (sc_subst env) that extracts +-- the substitution from the ScEnv but without forcing the substitution +-- to be applied to the type. The resulting thunk +-- is placed into a lazy field (either a Type argument or the type field of a Case) +-- which is rarely forced, so forcing it reemptively regresses peformance. +-- See #22102 +scSubstTy :: ScEnv -> InType -> Solo OutType +scSubstTy env ty = + let !subst = sc_subst env + in Solo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co @@ -1407,7 +1416,9 @@ scExpr' env (Var v) = case scSubstId env v of Var v' -> return (mkVarUsage env v' [], Var v') e' -> scExpr (zapScSubst env) e' -scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) +scExpr' env (Type t) = + let !(Solo ty') = scSubstTy env t + in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e @@ -1451,9 +1462,10 @@ scExpr' env (Case scrut b ty alts) -- The combined usage of the scrutinee is given -- by scrut_occ, which is passed to scScrut, which -- in turn treats a bare-variable scrutinee specially + ; let !(Solo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, - Case scrut' b' (scSubstTy env ty) alts') } + Case scrut' b' ty' alts') } sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -706,7 +706,11 @@ filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (us -- in a "case" statement then they will need to manually add a dummy case branch that just -- calls "error" or similar. filterAlts _tycon inst_tys imposs_cons alts - = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + = imposs_deflt_cons `seqList` + (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which + -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter + -- leads to a huge space leak (see !8896) where (alts_wo_default, maybe_deflt) = findDefault alts alt_cons = [con | Alt con _ _ <- alts_wo_default] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/396818e733cfc96cef39cc6f0db94f920c069374...0dfaf3034ae207651b0a85a12c5cdf330f66399d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/396818e733cfc96cef39cc6f0db94f920c069374...0dfaf3034ae207651b0a85a12c5cdf330f66399d You're receiving 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 26 10:14:22 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 Aug 2022 06:14:22 -0400 Subject: [Git][ghc/ghc][wip/simplifier-fixes] 19 commits: Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <63089cfea6989_e9d7d268fc25013764bf@gitlab.mail> Matthew Pickering pushed to branch wip/simplifier-fixes at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 478c374e by Matthew Pickering at 2022-08-26T11:13:19+01:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - fc51f26f by Matthew Pickering at 2022-08-26T11:13:19+01:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 466eadff by Matthew Pickering at 2022-08-26T11:13:19+01:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - 1d17d955 by Matthew Pickering at 2022-08-26T11:13:19+01:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 25 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CommonBlockElim.hs - 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.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/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/SysTools/BaseDir.hs - − compiler/Makefile The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0dfaf3034ae207651b0a85a12c5cdf330f66399d...1d17d955474e8d6d6bbd4408e52cb2504c98bc3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0dfaf3034ae207651b0a85a12c5cdf330f66399d...1d17d955474e8d6d6bbd4408e52cb2504c98bc3f You're receiving 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 26 10:17:19 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 Aug 2022 06:17:19 -0400 Subject: [Git][ghc/ghc][wip/simplifier-fixes] 3 commits: Avoid retaining bindings via ModGuts held on the stack Message-ID: <63089daf4bd43_e9d7d268fc25013789c3@gitlab.mail> Matthew Pickering pushed to branch wip/simplifier-fixes at Glasgow Haskell Compiler / GHC Commits: d84cd485 by Matthew Pickering at 2022-08-26T11:17:05+01:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 216a7361 by Matthew Pickering at 2022-08-26T11:17:05+01:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - 13ee72bc by Matthew Pickering at 2022-08-26T11:17:05+01:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3437,24 +3437,26 @@ lintAnnots pname pass guts = {-# SCC "lintAnnots" #-} do logger <- getLogger when (gopt Opt_DoAnnotationLinting dflags) $ liftIO $ Err.showPass logger "Annotation linting - first run" - nguts <- pass guts -- If appropriate re-run it without debug annotations to make sure -- that they made no difference. - when (gopt Opt_DoAnnotationLinting dflags) $ do - liftIO $ Err.showPass logger "Annotation linting - second run" - nguts' <- withoutAnnots pass guts - -- Finally compare the resulting bindings - liftIO $ Err.showPass logger "Annotation linting - comparison" - let binds = flattenBinds $ mg_binds nguts - binds' = flattenBinds $ mg_binds nguts' - (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' - when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat - [ lint_banner "warning" pname - , text "Core changes with annotations:" - , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs - ] - -- Return actual new guts - return nguts + if gopt Opt_DoAnnotationLinting dflags + then do + nguts <- pass guts + liftIO $ Err.showPass logger "Annotation linting - second run" + nguts' <- withoutAnnots pass guts + -- Finally compare the resulting bindings + liftIO $ Err.showPass logger "Annotation linting - comparison" + let binds = flattenBinds $ mg_binds nguts + binds' = flattenBinds $ mg_binds nguts' + (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' + when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat + [ lint_banner "warning" pname + , text "Core changes with annotations:" + , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs + ] + return nguts + else + pass guts -- | Run the given pass without annotations. This means that we both -- set the debugLevel setting to 0 in the environment as well as all ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -153,7 +153,7 @@ simplifyPgm logger unit_env opts , mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) = do { (termination_msg, it_count, counts_out, guts') - <- do_iteration 1 [] binds rules + <- do_iteration 1 [] binds rules ; when (logHasDumpFlag logger Opt_D_verbose_core2core && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ @@ -175,6 +175,9 @@ simplifyPgm logger unit_env opts print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode + -- If you don't do this then all the old bindings are retained until + -- the end of the simplifier pass. + !guts_no_binds = guts { mg_binds = [], mg_rules = [] } do_iteration :: Int -- Counts iterations -> [SimplCount] -- Counts from earlier iterations, reversed @@ -198,7 +201,7 @@ simplifyPgm logger unit_env opts -- number of iterations we actually completed return ( "Simplifier baled out", iteration_no - 1 , totalise counts_so_far - , guts { mg_binds = binds, mg_rules = rules } ) + , guts_no_binds { mg_binds = binds, mg_rules = rules } ) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -253,7 +256,7 @@ simplifyPgm logger unit_env opts if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks - , guts { mg_binds = binds1, mg_rules = rules1 } ) + , guts_no_binds { mg_binds = binds1, mg_rules = rules1 } ) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -79,6 +79,7 @@ import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) +import Data.Tuple {- ----------------------------------------------------- @@ -971,8 +972,16 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v -scSubstTy :: ScEnv -> InType -> OutType -scSubstTy env ty = substTyUnchecked (sc_subst env) ty +-- The use of Solo here allows us to force the selection (sc_subst env) that extracts +-- the substitution from the ScEnv but without forcing the substitution +-- to be applied to the type. The resulting thunk +-- is placed into a lazy field (either a Type argument or the type field of a Case) +-- which is rarely forced, so forcing it reemptively regresses peformance. +-- See #22102 +scSubstTy :: ScEnv -> InType -> Solo OutType +scSubstTy env ty = + let !subst = sc_subst env + in Solo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co @@ -1407,7 +1416,9 @@ scExpr' env (Var v) = case scSubstId env v of Var v' -> return (mkVarUsage env v' [], Var v') e' -> scExpr (zapScSubst env) e' -scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) +scExpr' env (Type t) = + let !(Solo ty') = scSubstTy env t + in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e @@ -1451,9 +1462,10 @@ scExpr' env (Case scrut b ty alts) -- The combined usage of the scrutinee is given -- by scrut_occ, which is passed to scScrut, which -- in turn treats a bare-variable scrutinee specially + ; let !(Solo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, - Case scrut' b' (scSubstTy env ty) alts') } + Case scrut' b' ty' alts') } sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -706,7 +706,11 @@ filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (us -- in a "case" statement then they will need to manually add a dummy case branch that just -- calls "error" or similar. filterAlts _tycon inst_tys imposs_cons alts - = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + = imposs_deflt_cons `seqList` + (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which + -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter + -- leads to a huge space leak (see !8896) where (alts_wo_default, maybe_deflt) = findDefault alts alt_cons = [con | Alt con _ _ <- alts_wo_default] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d17d955474e8d6d6bbd4408e52cb2504c98bc3f...13ee72bc44e72d3817609e9973bfe5cc4b060443 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d17d955474e8d6d6bbd4408e52cb2504c98bc3f...13ee72bc44e72d3817609e9973bfe5cc4b060443 You're receiving 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 26 11:15:59 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 26 Aug 2022 07:15:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22112 Message-ID: <6308ab6f32a49_e9d7d1ee7674c1384911@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22112 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22112 You're receiving 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 26 12:08:01 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Fri, 26 Aug 2022 08:08:01 -0400 Subject: [Git][ghc/ghc][wip/styled-labels-final] Remove label style from printing context Message-ID: <6308b7a17f868_e9d7d323c611c14087a7@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/styled-labels-final at Glasgow Haskell Compiler / GHC Commits: 97218009 by Krzysztof Gogolewski at 2022-08-26T14:07:29+02:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 27 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/StgToCmm/Layout.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Utils/Logger.hs - compiler/GHC/Utils/Outputable.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/T15155.stdout-darwin Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -128,6 +128,7 @@ module GHC.Cmm.CLabel ( LabelStyle (..), pprDebugCLabel, pprCLabel, + pprAsmLabel, ppInternalProcLabel, -- * Others @@ -1389,13 +1390,15 @@ allocation. Take care if you want to remove them! -} +pprAsmLabel :: Platform -> CLabel -> SDoc +pprAsmLabel platform lbl = pprCLabel platform AsmStyle lbl + instance OutputableP Platform CLabel where {-# INLINE pdoc #-} -- see Note [Bangs in CLabel] pdoc !platform lbl = getPprStyle $ \pp_sty -> - let !sty = case pp_sty of - PprCode sty -> sty - _ -> CStyle - in pprCLabel platform sty lbl + case pp_sty of + PprDump{} -> pprCLabel platform CStyle lbl + _ -> pprPanic "Labels in code should be printed with pprCLabel" (pprCLabel platform CStyle lbl) pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] @@ -1522,7 +1525,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CC_Label cc -> maybe_underscore $ ppr cc CCS_Label ccs -> maybe_underscore $ ppr ccs - IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe") + IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform CStyle l <> text "_" <> ppr m <> text "_ipe") ModuleLabel mod kind -> maybe_underscore $ ppr mod <> text "_" <> ppr kind CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs ===================================== compiler/GHC/Cmm/DebugBlock.hs ===================================== @@ -77,7 +77,7 @@ data DebugBlock = , dblBlocks :: ![DebugBlock] -- ^ Nested blocks } -instance OutputableP env CLabel => OutputableP env DebugBlock where +instance OutputableP Platform DebugBlock where pdoc env blk = (if | dblProcedure blk == dblLabel blk -> text "proc" @@ -85,7 +85,7 @@ instance OutputableP env CLabel => OutputableP env DebugBlock where -> text "pp-blk" | otherwise -> text "blk") <+> - ppr (dblLabel blk) <+> parens (pdoc env (dblCLabel blk)) <+> + ppr (dblLabel blk) <+> parens (pprAsmLabel env (dblCLabel blk)) <+> (maybe empty ppr (dblSourceTick blk)) <+> (maybe (text "removed") ((text "pos " <>) . ppr) (dblPosition blk)) <+> @@ -495,9 +495,9 @@ LOC this information will end up in is Y. -- | A label associated with an 'UnwindTable' data UnwindPoint = UnwindPoint !CLabel !UnwindTable -instance OutputableP env CLabel => OutputableP env UnwindPoint where +instance OutputableP Platform UnwindPoint where pdoc env (UnwindPoint lbl uws) = - braces $ pdoc env lbl <> colon + braces $ pprAsmLabel env lbl <> colon <+> hsep (punctuate comma $ map pprUw $ Map.toList uws) where pprUw (g, expr) = ppr g <> char '=' <> pdoc env expr @@ -519,16 +519,16 @@ data UnwindExpr = UwConst !Int -- ^ literal value | UwTimes UnwindExpr UnwindExpr deriving (Eq) -instance OutputableP env CLabel => OutputableP env UnwindExpr where +instance OutputableP Platform UnwindExpr where pdoc = pprUnwindExpr 0 -pprUnwindExpr :: OutputableP env CLabel => Rational -> env -> UnwindExpr -> SDoc +pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc pprUnwindExpr p env = \case UwConst i -> ppr i UwReg g 0 -> ppr g UwReg g x -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x)) UwDeref e -> char '*' <> pprUnwindExpr 3 env e - UwLabel l -> pdoc env l + UwLabel l -> pprAsmLabel env l UwPlus e0 e1 | p <= 0 -> pprUnwindExpr 0 env e0 <> char '+' <> pprUnwindExpr 0 env e1 UwMinus e0 e1 ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Cmm.Dataflow.Label import GHC.Cmm import GHC.Cmm.Liveness import GHC.Cmm.Switch (switchTargetsToList) +import GHC.Cmm.CLabel (pprDebugCLabel) import GHC.Utils.Outputable import Control.Monad (ap, unless) @@ -55,7 +56,7 @@ lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint () lintCmmDecl (CmmProc _ lbl _ g) = do platform <- getPlatform - addLintInfo (text "in proc " <> pdoc platform lbl) $ lintCmmGraph g + addLintInfo (text "in proc " <> pprDebugCLabel platform lbl) $ lintCmmGraph g lintCmmDecl (CmmData {}) = return () ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -508,9 +508,9 @@ pprForeignTarget platform (PrimTarget op) -- HACK: We're just using a ForeignLabel to get this printed, the label -- might not really be foreign. = pdoc platform - (CmmLabel (mkForeignLabel + (mkForeignLabel (mkFastString (show op)) - Nothing ForeignLabelInThisPackage IsFunction)) + Nothing ForeignLabelInThisPackage IsFunction) instance Outputable Convention where ppr = pprConvention ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -449,7 +449,7 @@ cmmproc :: { CmmParse () } platform <- getPlatform; ctx <- getContext; formals <- sequence (fromMaybe [] $3); - withName (renderWithContext ctx (pdoc platform entry_ret_label)) + withName (renderWithContext ctx (pprCLabel platform CStyle entry_ret_label)) $4; return (entry_ret_label, info, stk_formals, formals) } let do_layout = isJust $3 ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -396,7 +396,7 @@ cmmNativeGens logger config modLoc ncgImpl h dbgMap = go -- force evaluation all this stuff to avoid space leaks let platform = ncgPlatform config - {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pdoc platform) imports) () + {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pprAsmLabel platform) imports) () let !labels' = if ncgDwarfEnabled config then cmmDebugLabels isMetaInstr native else [] @@ -455,7 +455,7 @@ cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap cmm count let weights = ncgCfgWeights config let proc_name = case cmm of - (CmmProc _ entry_label _ _) -> pdoc platform entry_label + (CmmProc _ entry_label _ _) -> pprAsmLabel platform entry_label _ -> text "DataChunk" -- rewrite assignments to global regs @@ -789,7 +789,7 @@ makeImportsDoc config imports doPpr lbl = (lbl, renderWithContext (ncgAsmContext config) - (pprCLabel platform AsmStyle lbl)) + (pprAsmLabel platform lbl)) -- ----------------------------------------------------------------------------- -- Generate jump tables ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -60,6 +60,7 @@ import GHC.Types.ForeignCall import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Utils.Constants (debugIsOn) -- Note [General layout of an NCG] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -135,10 +136,11 @@ basicBlockCodeGen block = do id = entryLabel block stmts = blockToList nodes - header_comment_instr = unitOL $ MULTILINE_COMMENT ( + header_comment_instr | debugIsOn = unitOL $ MULTILINE_COMMENT ( text "-- --------------------------- basicBlockCodeGen --------------------------- --\n" - $+$ pdoc (ncgPlatform config) block + $+$ withPprStyle defaultDumpStyle (pdoc (ncgPlatform config) block) ) + | otherwise = nilOL -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of ===================================== 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 pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pprAsmLabel 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 pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' + then pprAsmLabel 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 " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -75,7 +75,7 @@ pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeDecl platform lbl - $$ (pdoc platform lbl <> char ':') + $$ (pprAsmLabel platform lbl <> char ':') pprAlign :: Platform -> Alignment -> SDoc pprAlign _platform alignment @@ -105,7 +105,7 @@ pprSectionAlign config sec@(Section seg _) = pprSizeDecl :: Platform -> CLabel -> SDoc pprSizeDecl platform lbl = if osElfTarget (platformOS platform) - then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl + then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl else empty pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr @@ -115,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' + then pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -135,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' + then pprAsmLabel 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] @@ -153,7 +153,7 @@ pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl (ncgPlatform config) alias - $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind' pprDatas config (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData config) dats) @@ -175,7 +175,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text "\t.globl " <> pdoc platform lbl + | otherwise = text "\t.globl " <> pprAsmLabel platform lbl -- Note [Always use objects for info tables] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -201,7 +201,7 @@ pprLabelType' platform lbl = pprTypeDecl :: Platform -> CLabel -> SDoc pprTypeDecl platform lbl = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl - then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl + then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl else empty pprDataItem :: NCGConfig -> CmmLit -> SDoc @@ -230,8 +230,8 @@ pprDataItem config lit pprImm :: Platform -> Imm -> SDoc 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 p (ImmCLbl l) = pprAsmLabel p l +pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! @@ -279,8 +279,8 @@ pprIm platform im = case im of ImmDouble d | d == 0 -> text "xzr" ImmDouble d -> char '#' <> double (fromRational d) -- = pseudo instruction! - ImmCLbl l -> char '=' <> pdoc platform l - ImmIndex l o -> text "[=" <> pdoc platform l <> comma <+> char '#' <> int o <> char ']' + ImmCLbl l -> char '=' <> pprAsmLabel platform l + ImmIndex l o -> text "[=" <> pprAsmLabel platform l <> comma <+> char '#' <> int o <> char ']' _ -> panic "AArch64.pprIm" pprExt :: ExtMode -> SDoc @@ -430,28 +430,28 @@ pprInstr platform instr = case instr of -- 4. Branch Instructions ---------------------------------------------------- J t -> pprInstr platform (B t) - B (TBlock bid) -> text "\tb" <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - B (TLabel lbl) -> text "\tb" <+> pdoc platform lbl + B (TBlock bid) -> text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + B (TLabel lbl) -> text "\tb" <+> pprAsmLabel platform lbl B (TReg r) -> text "\tbr" <+> pprReg W64 r - BL (TBlock bid) _ _ -> text "\tbl" <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - BL (TLabel lbl) _ _ -> text "\tbl" <+> pdoc platform lbl + BL (TBlock bid) _ _ -> text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BL (TLabel lbl) _ _ -> text "\tbl" <+> pprAsmLabel platform lbl BL (TReg r) _ _ -> text "\tblr" <+> pprReg W64 r - BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pdoc platform lbl + BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pprAsmLabel platform lbl BCOND _ (TReg _) -> panic "AArch64.ppr: No conditional branching to registers!" -- 5. Atomic Instructions ---------------------------------------------------- -- 6. Conditional Instructions ----------------------------------------------- CSET o c -> text "\tcset" <+> pprOp platform o <> comma <+> pprCond c - CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform lbl + CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl CBZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbz) branching to registers!" - CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform lbl + CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl CBNZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!" -- 7. Load and Store Instructions -------------------------------------------- @@ -466,58 +466,58 @@ pprInstr platform instr = case instr of #if defined(darwin_HOST_OS) LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" #else LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl #endif LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> ===================================== compiler/GHC/CmmToAsm/Dwarf.hs ===================================== @@ -51,8 +51,8 @@ dwarfGen config modLoc us blocks = do , dwName = fromMaybe "" (ml_hs_file modLoc) , dwCompDir = addTrailingPathSeparator compPath , dwProducer = cProjectName ++ " " ++ cProjectVersion - , dwLowLabel = pdoc platform lowLabel - , dwHighLabel = pdoc platform highLabel + , dwLowLabel = pprAsmLabel platform lowLabel + , dwHighLabel = pprAsmLabel platform highLabel , dwLineLabel = dwarfLineLabel } @@ -109,9 +109,9 @@ mkDwarfARange proc = DwarfARange lbl end compileUnitHeader :: Platform -> Unique -> SDoc compileUnitHeader platform unitU = let cuLabel = mkAsmTempLabel unitU -- sits right before initialLength field - length = pdoc platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pdoc platform cuLabel + length = pprAsmLabel platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pprAsmLabel platform cuLabel <> text "-4" -- length of initialLength field - in vcat [ pdoc platform cuLabel <> colon + in vcat [ pprAsmLabel platform cuLabel <> colon , text "\t.long " <> length -- compilation unit size , pprHalf 3 -- DWARF version , sectionOffset platform dwarfAbbrevLabel dwarfAbbrevLabel @@ -123,7 +123,7 @@ compileUnitHeader platform unitU = compileUnitFooter :: Platform -> Unique -> SDoc compileUnitFooter platform unitU = let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU - in pdoc platform cuEndLabel <> colon + in pprAsmLabel platform cuEndLabel <> colon -- | Splits the blocks by procedures. In the result all nested blocks -- will come from the same procedure as the top-level block. See ===================================== compiler/GHC/CmmToAsm/Dwarf/Types.hs ===================================== @@ -184,14 +184,14 @@ pprDwarfInfoOpen platform haveSrc (DwarfCompileUnit _ name producer compDir lowL then sectionOffset platform lineLbl dwarfLineLabel else empty pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev abbrev $$ pprString name $$ pprLabelString platform label $$ pprFlag (externallyVisibleCLabel label) -- Offset due to Note [Info Offset] - $$ pprWord platform (pdoc platform label <> text "-1") - $$ pprWord platform (pdoc platform $ mkAsmTempProcEndLabel label) + $$ pprWord platform (pprAsmLabel platform label <> text "-1") + $$ pprWord platform (pprAsmLabel platform $ mkAsmTempProcEndLabel label) $$ pprByte 1 $$ pprByte dW_OP_call_frame_cfa $$ parentValue @@ -199,17 +199,17 @@ pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) = abbrev = case parent of Nothing -> DwAbbrSubprogram Just _ -> DwAbbrSubprogramWithParent parentValue = maybe empty pprParentDie parent - pprParentDie sym = sectionOffset platform (pdoc platform sym) dwarfInfoLabel + pprParentDie sym = sectionOffset platform (pprAsmLabel platform sym) dwarfInfoLabel pprDwarfInfoOpen platform _ (DwarfBlock _ label Nothing) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev DwAbbrBlockWithoutCode $$ pprLabelString platform label pprDwarfInfoOpen platform _ (DwarfBlock _ label (Just marker)) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev DwAbbrBlock $$ pprLabelString platform label - $$ pprWord platform (pdoc platform marker) - $$ pprWord platform (pdoc platform $ mkAsmTempEndLabel marker) + $$ pprWord platform (pprAsmLabel platform marker) + $$ pprWord platform (pprAsmLabel platform $ mkAsmTempEndLabel marker) pprDwarfInfoOpen _ _ (DwarfSrcNote ss) = pprAbbrev DwAbbrGhcSrcNote $$ pprString' (ftext $ srcSpanFile ss) @@ -245,7 +245,7 @@ pprDwarfARanges platform arngs unitU = initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize in pprDwWord (ppr initialLength) $$ pprHalf 2 - $$ sectionOffset platform (pdoc platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel + $$ sectionOffset platform (pprAsmLabel platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel $$ pprByte (fromIntegral wordSize) $$ pprByte 0 $$ pad paddingSize @@ -258,11 +258,11 @@ pprDwarfARanges platform arngs unitU = pprDwarfARange :: Platform -> DwarfARange -> SDoc pprDwarfARange platform arng = -- Offset due to Note [Info Offset]. - pprWord platform (pdoc platform (dwArngStartLabel arng) <> text "-1") + pprWord platform (pprAsmLabel platform (dwArngStartLabel arng) <> text "-1") $$ pprWord platform length where - length = pdoc platform (dwArngEndLabel arng) - <> char '-' <> pdoc platform (dwArngStartLabel arng) + length = pprAsmLabel platform (dwArngEndLabel arng) + <> char '-' <> pprAsmLabel platform (dwArngStartLabel arng) -- | Information about unwind instructions for a procedure. This -- corresponds to a "Common Information Entry" (CIE) in DWARF. @@ -293,7 +293,7 @@ data DwarfFrameBlock -- in the block } -instance OutputableP env CLabel => OutputableP env DwarfFrameBlock where +instance OutputableP Platform DwarfFrameBlock where pdoc env (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> pdoc env unwinds -- | Header for the @.debug_frame@ section. Here we emit the "Common @@ -303,7 +303,7 @@ pprDwarfFrame :: Platform -> DwarfFrame -> SDoc pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs} = let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit "_start") cieEndLabel = mkAsmTempEndLabel cieLabel - length = pdoc platform cieEndLabel <> char '-' <> pdoc platform cieStartLabel + length = pprAsmLabel platform cieEndLabel <> char '-' <> pprAsmLabel platform cieStartLabel spReg = dwarfGlobalRegNo platform Sp retReg = dwarfReturnRegNo platform wordSize = platformWordSizeInBytes platform @@ -316,9 +316,9 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro ArchX86 -> pprByte dW_CFA_same_value $$ pprLEBWord 4 ArchX86_64 -> pprByte dW_CFA_same_value $$ pprLEBWord 7 _ -> empty - in vcat [ pdoc platform cieLabel <> colon + in vcat [ pprAsmLabel platform cieLabel <> colon , pprData4' length -- Length of CIE - , pdoc platform cieStartLabel <> colon + , pprAsmLabel platform cieStartLabel <> colon , pprData4' (text "-1") -- Common Information Entry marker (-1 = 0xf..f) , pprByte 3 -- CIE version (we require DWARF 3) @@ -346,7 +346,7 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro , pprLEBWord 0 ] $$ wordAlign platform $$ - pdoc platform cieEndLabel <> colon $$ + pprAsmLabel platform cieEndLabel <> colon $$ -- Procedure unwind tables vcat (map (pprFrameProc platform cieLabel cieInit) procs) @@ -360,17 +360,17 @@ pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks) procEnd = mkAsmTempProcEndLabel procLbl ifInfo str = if hasInfo then text str else empty -- see Note [Info Offset] - in vcat [ whenPprDebug $ text "# Unwinding for" <+> pdoc platform procLbl <> colon - , pprData4' (pdoc platform fdeEndLabel <> char '-' <> pdoc platform fdeLabel) - , pdoc platform fdeLabel <> colon - , pprData4' (pdoc platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE - , pprWord platform (pdoc platform procLbl <> ifInfo "-1") -- Code pointer - , pprWord platform (pdoc platform procEnd <> char '-' <> - pdoc platform procLbl <> ifInfo "+1") -- Block byte length + in vcat [ whenPprDebug $ text "# Unwinding for" <+> pprAsmLabel platform procLbl <> colon + , pprData4' (pprAsmLabel platform fdeEndLabel <> char '-' <> pprAsmLabel platform fdeLabel) + , pprAsmLabel platform fdeLabel <> colon + , pprData4' (pprAsmLabel platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE + , pprWord platform (pprAsmLabel platform procLbl <> ifInfo "-1") -- Code pointer + , pprWord platform (pprAsmLabel platform procEnd <> char '-' <> + pprAsmLabel platform procLbl <> ifInfo "+1") -- Block byte length ] $$ vcat (S.evalState (mapM (pprFrameBlock platform) blocks) initUw) $$ wordAlign platform $$ - pdoc platform fdeEndLabel <> colon + pprAsmLabel platform fdeEndLabel <> colon -- | Generates unwind information for a block. We only generate -- instructions where unwind information actually changes. This small @@ -402,7 +402,7 @@ pprFrameBlock platform (DwarfFrameBlock hasInfo uws0) = then (empty, oldUws) else let -- see Note [Info Offset] needsOffset = firstDecl && hasInfo - lblDoc = pdoc platform lbl <> + lblDoc = pprAsmLabel platform lbl <> if needsOffset then text "-1" else empty doc = pprByte dW_CFA_set_loc $$ pprWord platform lblDoc $$ vcat (map (uncurry $ pprSetUnwind platform) changed) @@ -513,7 +513,7 @@ pprUnwindExpr platform spIsCFA expr pprE (UwReg g i) = pprByte (dW_OP_breg0+dwarfGlobalRegNo platform g) $$ pprLEBInt i pprE (UwDeref u) = pprE u $$ pprByte dW_OP_deref - pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pdoc platform l) + pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pprAsmLabel platform l) pprE (UwPlus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus pprE (UwMinus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus pprE (UwTimes u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul ===================================== compiler/GHC/CmmToAsm/PIC.hs ===================================== @@ -729,7 +729,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of _ -> panic "PIC.pprImportedSymbol: no match" where platform = ncgPlatform config - ppr_lbl = pprCLabel platform AsmStyle + ppr_lbl = pprAsmLabel platform arch = platformArch platform os = platformOS platform pic = ncgPIC config ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -63,7 +63,7 @@ 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) $$ - ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel lbl) + ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':' $$ pprProcEndLabel platform lbl) $$ pprSizeDecl platform lbl @@ -71,7 +71,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ (if platformHasSubsectionsViaSymbols platform - then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' + then pprAsmLabel 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 @@ -80,9 +80,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = then -- See Note [Subsections Via Symbols] in X86/Ppr.hs text "\t.long " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -93,7 +93,7 @@ pprSizeDecl platform lbl then text "\t.size" <+> prettyLbl <> text ", .-" <> codeLbl else empty where - prettyLbl = pdoc platform lbl + prettyLbl = pprAsmLabel platform lbl codeLbl | platformArch platform == ArchPPC_64 ELF_V1 = char '.' <> prettyLbl | otherwise = prettyLbl @@ -102,33 +102,33 @@ pprFunctionDescriptor :: Platform -> CLabel -> SDoc pprFunctionDescriptor platform lab = pprGloblDecl platform lab $$ text "\t.section \".opd\", \"aw\"" $$ text "\t.align 3" - $$ pdoc platform lab <> char ':' + $$ pprAsmLabel platform lab <> char ':' $$ text "\t.quad ." - <> pdoc platform lab + <> pprAsmLabel platform lab <> text ",.TOC. at tocbase,0" $$ text "\t.previous" $$ text "\t.type" - <+> pdoc platform lab + <+> pprAsmLabel platform lab <> text ", @function" - $$ char '.' <> pdoc platform lab <> char ':' + $$ char '.' <> pprAsmLabel platform lab <> char ':' pprFunctionPrologue :: Platform -> CLabel ->SDoc pprFunctionPrologue platform lab = pprGloblDecl platform lab $$ text ".type " - <> pdoc platform lab + <> pprAsmLabel platform lab <> text ", @function" - $$ pdoc platform lab <> char ':' + $$ pprAsmLabel platform lab <> char ':' $$ text "0:\taddis\t" <> pprReg toc <> text ",12,.TOC.-0b at ha" $$ text "\taddi\t" <> pprReg toc <> char ',' <> pprReg toc <> text ",.TOC.-0b at l" - $$ text "\t.localentry\t" <> pdoc platform lab - <> text ",.-" <> pdoc platform lab + $$ text "\t.localentry\t" <> pprAsmLabel platform lab + <> text ",.-" <> pprAsmLabel platform lab pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name -> SDoc pprProcEndLabel platform lbl = - pdoc platform (mkAsmTempProcEndLabel lbl) <> char ':' + pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> char ':' pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc @@ -137,7 +137,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) instrs) $$ ppWhen (ncgDwarfEnabled config) ( - pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' + pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':' <> pprProcEndLabel platform asmLbl ) where @@ -162,7 +162,7 @@ pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLi , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl platform alias - $$ text ".equiv" <+> pdoc platform alias <> comma <> pdoc platform (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind' pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats) pprData :: Platform -> CmmStatic -> SDoc @@ -175,20 +175,20 @@ pprData platform d = case d of pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text ".globl " <> pdoc platform lbl + | otherwise = text ".globl " <> pprAsmLabel platform lbl pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc pprTypeAndSizeDecl platform lbl = if platformOS platform == OSLinux && externallyVisibleCLabel lbl then text ".type " <> - pdoc platform lbl <> text ", @object" + pprAsmLabel platform lbl <> text ", @object" else empty pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeAndSizeDecl platform lbl - $$ (pdoc platform lbl <> char ':') + $$ (pprAsmLabel platform lbl <> char ':') -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' @@ -238,8 +238,8 @@ pprImm :: Platform -> Imm -> SDoc pprImm platform = \case ImmInt i -> int i ImmInteger i -> integer i - ImmCLbl l -> pdoc platform l - ImmIndex l i -> pdoc platform l <> char '+' <> int i + ImmCLbl l -> pprAsmLabel platform l + ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d @@ -559,7 +559,7 @@ pprInstr platform instr = case instr of pprCond cond, pprPrediction prediction, char '\t', - pdoc platform lbl + pprAsmLabel platform lbl ] where lbl = mkLocalBlockLabel (getUnique blockid) pprPrediction p = case p of @@ -577,7 +577,7 @@ pprInstr platform instr = case instr of ], hcat [ text "\tb\t", - pdoc platform lbl + pprAsmLabel platform lbl ] ] where lbl = mkLocalBlockLabel (getUnique blockid) @@ -594,7 +594,7 @@ pprInstr platform instr = case instr of char '\t', text "b", char '\t', - pdoc platform lbl + pprAsmLabel platform lbl ] MTCTR reg @@ -625,12 +625,12 @@ pprInstr platform instr = case instr of -- they'd technically be more like 'ForeignLabel's. hcat [ text "\tbl\t.", - pdoc platform lbl + pprAsmLabel platform lbl ] _ -> hcat [ text "\tbl\t", - pdoc platform lbl + pprAsmLabel platform lbl ] BCTRL _ ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -210,7 +210,7 @@ pprGNUSectionHeader config t suffix = platform = ncgPlatform config splitSections = ncgSplitSections config subsection - | splitSections = sep <> pdoc platform suffix + | splitSections = sep <> pprAsmLabel platform suffix | otherwise = empty header = case t of Text -> text ".text" ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -93,7 +93,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprProcAlignment config $$ pprProcLabel config lbl $$ (if platformHasSubsectionsViaSymbols platform - then pdoc platform (mkDeadStripPreventer info_lbl) <> colon + then pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> colon else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ ppWhen (ncgDwarfEnabled config) (pprProcEndLabel platform info_lbl) $$ @@ -102,9 +102,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -120,18 +120,18 @@ pprProcLabel config lbl pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name -> SDoc pprProcEndLabel platform lbl = - pdoc platform (mkAsmTempProcEndLabel lbl) <> colon + pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon pprBlockEndLabel :: Platform -> CLabel -- ^ Block name -> SDoc pprBlockEndLabel platform lbl = - pdoc platform (mkAsmTempEndLabel lbl) <> colon + pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon -- | Output the ELF .size directive. pprSizeDecl :: Platform -> CLabel -> SDoc pprSizeDecl platform lbl = if osElfTarget (platformOS platform) - then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl + then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl else empty pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc @@ -156,7 +156,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) vcat (map (pprData config) info) $$ pprLabel platform infoLbl $$ c $$ - ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel infoLbl) <> colon) + ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel infoLbl) <> colon) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -175,7 +175,7 @@ pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticL , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl (ncgPlatform config) alias - $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind' pprDatas config (align, (CmmStaticsRaw lbl dats)) = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats) @@ -197,7 +197,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text ".globl " <> pdoc platform lbl + | otherwise = text ".globl " <> pprAsmLabel platform lbl pprLabelType' :: Platform -> CLabel -> SDoc pprLabelType' platform lbl = @@ -260,14 +260,14 @@ pprLabelType' platform lbl = pprTypeDecl :: Platform -> CLabel -> SDoc pprTypeDecl platform lbl = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl - then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl + then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl else empty pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeDecl platform lbl - $$ (pdoc platform lbl <> colon) + $$ (pprAsmLabel platform lbl <> colon) pprAlign :: Platform -> Alignment -> SDoc pprAlign platform alignment @@ -430,8 +430,8 @@ pprImm :: Platform -> Imm -> SDoc pprImm platform = \case ImmInt i -> int i ImmInteger i -> integer i - ImmCLbl l -> pdoc platform l - ImmIndex l i -> pdoc platform l <> char '+' <> int i + ImmCLbl l -> pprAsmLabel platform l + ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d @@ -576,7 +576,7 @@ pprInstr platform i = case i of UNWIND lbl d -> asmComment (text "\tunwind = " <> pdoc platform d) - $$ pdoc platform lbl <> colon + $$ pprAsmLabel platform lbl <> colon LDATA _ _ -> panic "pprInstr: LDATA" @@ -818,7 +818,7 @@ pprInstr platform i = case i of -> pprFormatOpReg (text "xchg") format src val JXX cond blockid - -> pprCondInstr (text "j") cond (pdoc platform lab) + -> pprCondInstr (text "j") cond (pprAsmLabel platform lab) where lab = blockLbl blockid JXX_GBL cond imm ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -1705,7 +1705,6 @@ genMachOp_slow opt op [x, y] = case op of where binLlvmOp ty binOp allow_y_cast = do - cfg <- getConfig platform <- getPlatform runExprData $ do vx <- exprToVarW x @@ -1721,13 +1720,7 @@ genMachOp_slow opt op [x, y] = case op of doExprW (ty vx) $ binOp vx vy' | otherwise - -> do - -- Error. Continue anyway so we can debug the generated ll file. - let render = renderWithContext (llvmCgContext cfg) - cmmToStr = (lines . render . pdoc platform) - statement $ Comment $ map fsLit $ cmmToStr x - statement $ Comment $ map fsLit $ cmmToStr y - doExprW (ty vx) $ binOp vx vy + -> pprPanic "binLlvmOp types" (pdoc platform x $$ pdoc platform y) binCastLlvmOp ty binOp = runExprData $ do vx <- exprToVarW x ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -173,7 +173,7 @@ outputC logger dflags filenm cmm_stream unit_deps = "C backend output" FormatC doc - let ctx = initSDocContext dflags (PprCode CStyle) + let ctx = initSDocContext dflags PprCode printSDocLn ctx LeftMode h doc Stream.consume cmm_stream id writeC @@ -253,11 +253,11 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs ForeignStubs (CHeader h_code) (CStub c_code _ _) -> do let - stub_c_output_d = pprCode CStyle c_code + stub_c_output_d = pprCode c_code stub_c_output_w = showSDoc dflags stub_c_output_d -- Header file protos for "foreign export"ed functions. - stub_h_output_d = pprCode CStyle h_code + stub_h_output_d = pprCode h_code stub_h_output_w = showSDoc dflags stub_h_output_d createDirectoryIfMissing True (takeDirectory stub_h) @@ -330,6 +330,7 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) = {-# SCC profilingInitCode #-} initializerCStub platform fn_name decls body where + pdocC = pprCLabel platform CStyle fn_name = mkInitializerStubLabel this_mod "prof_init" decls = vcat $ map emit_cc_decl local_CCs @@ -342,22 +343,22 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) ] emit_cc_decl cc = text "extern CostCentre" <+> cc_lbl <> text "[];" - where cc_lbl = pdoc platform (mkCCLabel cc) + where cc_lbl = pdocC (mkCCLabel cc) local_cc_list_label = text "local_cc_" <> ppr this_mod emit_cc_list ccs = text "static CostCentre *" <> local_cc_list_label <> text "[] =" - <+> braces (vcat $ [ pdoc platform (mkCCLabel cc) <> comma + <+> braces (vcat $ [ pdocC (mkCCLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi emit_ccs_decl ccs = text "extern CostCentreStack" <+> ccs_lbl <> text "[];" - where ccs_lbl = pdoc platform (mkCCSLabel ccs) + where ccs_lbl = pdocC (mkCCSLabel ccs) singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod emit_ccs_list ccs = text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] =" - <+> braces (vcat $ [ pdoc platform (mkCCSLabel cc) <> comma + <+> braces (vcat $ [ pdocC (mkCCSLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi ===================================== compiler/GHC/Driver/Config/CmmToAsm.hs ===================================== @@ -18,7 +18,7 @@ initNCGConfig :: DynFlags -> Module -> NCGConfig initNCGConfig dflags this_mod = NCGConfig { ncgPlatform = targetPlatform dflags , ncgThisModule = this_mod - , ncgAsmContext = initSDocContext dflags (PprCode AsmStyle) + , ncgAsmContext = initSDocContext dflags PprCode , ncgProcAlignment = cmmProcAlignment dflags , ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags , ncgPIC = positionIndependent dflags ===================================== compiler/GHC/Driver/Config/CmmToLlvm.hs ===================================== @@ -20,7 +20,7 @@ initLlvmCgConfig logger config_cache dflags = do llvm_config <- readLlvmConfigCache config_cache pure $! LlvmCgConfig { llvmCgPlatform = targetPlatform dflags - , llvmCgContext = initSDocContext dflags (PprCode CStyle) + , llvmCgContext = initSDocContext dflags PprCode , llvmCgFillUndefWithGarbage = gopt Opt_LlvmFillUndefWithGarbage dflags , llvmCgSplitSection = gopt Opt_SplitSections dflags , llvmCgBmiVersion = case platformArch (targetPlatform dflags) of ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -606,7 +606,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" 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)) + writeFile empty_stub (showSDoc dflags (pprCode src)) 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 ===================================== compiler/GHC/HsToCore/Foreign/C.hs ===================================== @@ -333,7 +333,7 @@ dsFCall fn_id co fcall mDeclHeader = do toCName :: Id -> String -toCName i = renderWithContext defaultSDocContext (pprCode CStyle (ppr (idName i))) +toCName i = renderWithContext defaultSDocContext (pprCode (ppr (idName i))) toCType :: Type -> (Maybe Header, SDoc) toCType = f False ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -249,11 +249,11 @@ sptModuleInitCode platform this_mod entries = [ text "static StgWord64 k" <> int i <> text "[2] = " <> pprFingerprint fp <> semi $$ text "extern StgPtr " - <> (pdoc platform $ mkClosureLabel (idName n) (idCafInfo n)) <> semi + <> (pprCLabel platform CStyle $ mkClosureLabel (idName n) (idCafInfo n)) <> semi $$ text "hs_spt_insert" <> parens (hcat $ punctuate comma [ char 'k' <> int i - , char '&' <> pdoc platform (mkClosureLabel (idName n) (idCafInfo n)) + , char '&' <> pprCLabel platform CStyle (mkClosureLabel (idName n) (idCafInfo n)) ] ) <> semi ===================================== compiler/GHC/StgToCmm/Layout.hs ===================================== @@ -297,7 +297,7 @@ direct_call caller call_conv lbl arity args platform <- getPlatform pprPanic "direct_call" $ text caller <+> ppr arity <+> - pdoc platform lbl <+> ppr (length args) <+> + pprDebugCLabel platform lbl <+> ppr (length args) <+> pdoc platform (map snd args) <+> ppr (map fst args) | null rest_args -- Precisely the right number of arguments ===================================== 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 <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pprDebugCLabel (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -332,7 +332,7 @@ jsonLogAction _ (MCDiagnostic SevIgnore _) _ _ = return () -- suppress the messa jsonLogAction logflags msg_class srcSpan msg = defaultLogActionHPutStrDoc logflags True stdout - (withPprStyle (PprCode CStyle) (doc $$ text "")) + (withPprStyle PprCode (doc $$ text "")) where str = renderWithContext (log_default_user_context logflags) msg doc = renderJSON $ ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -96,7 +96,7 @@ module GHC.Utils.Outputable ( defaultSDocContext, traceSDocContext, getPprStyle, withPprStyle, setStyleColoured, pprDeeper, pprDeeperList, pprSetDepth, - codeStyle, userStyle, dumpStyle, asmStyle, + codeStyle, userStyle, dumpStyle, qualName, qualModule, qualPackage, mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle, mkUserStyle, cmdlineParserStyle, Depth(..), @@ -170,7 +170,7 @@ data PprStyle -- Does not assume tidied code: non-external names -- are printed with uniques. - | PprCode !LabelStyle -- ^ Print code; either C or assembler + | PprCode -- ^ Print code; either C or assembler -- | Style of label pretty-printing. -- @@ -550,12 +550,8 @@ queryQual s = QueryQualify (qualName s) (qualPackage s) codeStyle :: PprStyle -> Bool -codeStyle (PprCode _) = True -codeStyle _ = False - -asmStyle :: PprStyle -> Bool -asmStyle (PprCode AsmStyle) = True -asmStyle _other = False +codeStyle PprCode = True +codeStyle _ = False dumpStyle :: PprStyle -> Bool dumpStyle (PprDump {}) = True @@ -603,9 +599,9 @@ bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO () bufLeftRenderSDoc ctx bufHandle doc = Pretty.bufLeftRender bufHandle (runSDoc doc ctx) -pprCode :: LabelStyle -> SDoc -> SDoc +pprCode :: SDoc -> SDoc {-# INLINE CONLIKE pprCode #-} -pprCode cs d = withPprStyle (PprCode cs) d +pprCode d = withPprStyle PprCode d renderWithContext :: SDocContext -> SDoc -> String renderWithContext ctx sdoc ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -48,9 +48,11 @@ T15723: '$(TEST_HC)' $(TEST_HC_OPTS) -dynamic -shared T15723B.o -o T15723B.so # Check that the static indirection b is compiled to an equiv directive +# This will be .equiv T15155_b_closure,T15155_a_closure +# or .equiv _T15155_b_closure,_T15155_a_closure on Darwin T15155: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 -ddump-asm T15155l.hs | \ - grep -F ".equiv T15155.b_closure,T15155.a_closure" + grep -F ".equiv" # Same as above, but in LLVM. Check that the static indirection b is compiled to # an alias. ===================================== testsuite/tests/codeGen/should_compile/T15155.stdout-darwin ===================================== @@ -0,0 +1 @@ +.equiv _T15155.b_closure,_T15155.a_closure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9721800921351ec5eaa2e116e5fe9b7cb8b5f8eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9721800921351ec5eaa2e116e5fe9b7cb8b5f8eb You're receiving 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 26 12:50:50 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 Aug 2022 08:50:50 -0400 Subject: [Git][ghc/ghc][wip/simplifier-fixes] 3 commits: Avoid retaining bindings via ModGuts held on the stack Message-ID: <6308c1aa9b6e0_e9d7d39bc2b34141611@gitlab.mail> Matthew Pickering pushed to branch wip/simplifier-fixes at Glasgow Haskell Compiler / GHC Commits: 808b4716 by Matthew Pickering at 2022-08-26T13:50:39+01:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - ebe1cb23 by Matthew Pickering at 2022-08-26T13:50:39+01:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - 8ecdf0ac by Matthew Pickering at 2022-08-26T13:50:39+01:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3437,24 +3437,26 @@ lintAnnots pname pass guts = {-# SCC "lintAnnots" #-} do logger <- getLogger when (gopt Opt_DoAnnotationLinting dflags) $ liftIO $ Err.showPass logger "Annotation linting - first run" - nguts <- pass guts -- If appropriate re-run it without debug annotations to make sure -- that they made no difference. - when (gopt Opt_DoAnnotationLinting dflags) $ do - liftIO $ Err.showPass logger "Annotation linting - second run" - nguts' <- withoutAnnots pass guts - -- Finally compare the resulting bindings - liftIO $ Err.showPass logger "Annotation linting - comparison" - let binds = flattenBinds $ mg_binds nguts - binds' = flattenBinds $ mg_binds nguts' - (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' - when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat - [ lint_banner "warning" pname - , text "Core changes with annotations:" - , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs - ] - -- Return actual new guts - return nguts + if gopt Opt_DoAnnotationLinting dflags + then do + nguts <- pass guts + liftIO $ Err.showPass logger "Annotation linting - second run" + nguts' <- withoutAnnots pass guts + -- Finally compare the resulting bindings + liftIO $ Err.showPass logger "Annotation linting - comparison" + let binds = flattenBinds $ mg_binds nguts + binds' = flattenBinds $ mg_binds nguts' + (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' + when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat + [ lint_banner "warning" pname + , text "Core changes with annotations:" + , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs + ] + return nguts + else + pass guts -- | Run the given pass without annotations. This means that we both -- set the debugLevel setting to 0 in the environment as well as all ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -153,7 +153,7 @@ simplifyPgm logger unit_env opts , mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) = do { (termination_msg, it_count, counts_out, guts') - <- do_iteration 1 [] binds rules + <- do_iteration 1 [] binds rules ; when (logHasDumpFlag logger Opt_D_verbose_core2core && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ @@ -175,6 +175,9 @@ simplifyPgm logger unit_env opts print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode + -- Note the bang in !guts_no_binds. If you don't force `guts_no_binds` + -- the old bindings are retained until the end of all simplifier iterations + !guts_no_binds = guts { mg_binds = [], mg_rules = [] } do_iteration :: Int -- Counts iterations -> [SimplCount] -- Counts from earlier iterations, reversed @@ -198,7 +201,7 @@ simplifyPgm logger unit_env opts -- number of iterations we actually completed return ( "Simplifier baled out", iteration_no - 1 , totalise counts_so_far - , guts { mg_binds = binds, mg_rules = rules } ) + , guts_no_binds { mg_binds = binds, mg_rules = rules } ) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -253,7 +256,7 @@ simplifyPgm logger unit_env opts if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks - , guts { mg_binds = binds1, mg_rules = rules1 } ) + , guts_no_binds { mg_binds = binds1, mg_rules = rules1 } ) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -79,6 +79,7 @@ import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) +import Data.Tuple {- ----------------------------------------------------- @@ -971,8 +972,18 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v -scSubstTy :: ScEnv -> InType -> OutType -scSubstTy env ty = substTyUnchecked (sc_subst env) ty +-- The !subst ensures that we force the selection `(sc_subst env)`, which avoids +-- retaining all of `env` when we only need `subst`. The `Solo` means that the +-- substitution itself is lazy, because that type is often discarded. +-- The callers of `scSubstTy` always force the result (to unpack the `Solo`) +-- so we get the desired effect: we leave a thunk, but retain only the subst, +-- not the whole env. +-- +-- Fully forcing the result of `scSubstTy` regresses performance (#22102) +scSubstTy :: ScEnv -> InType -> Solo OutType +scSubstTy env ty = + let !subst = sc_subst env + in Solo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co @@ -1407,7 +1418,9 @@ scExpr' env (Var v) = case scSubstId env v of Var v' -> return (mkVarUsage env v' [], Var v') e' -> scExpr (zapScSubst env) e' -scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) +scExpr' env (Type t) = + let !(Solo ty') = scSubstTy env t + in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e @@ -1451,9 +1464,10 @@ scExpr' env (Case scrut b ty alts) -- The combined usage of the scrutinee is given -- by scrut_occ, which is passed to scScrut, which -- in turn treats a bare-variable scrutinee specially + ; let !(Solo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, - Case scrut' b' (scSubstTy env ty) alts') } + Case scrut' b' ty' alts') } sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -706,7 +706,11 @@ filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (us -- in a "case" statement then they will need to manually add a dummy case branch that just -- calls "error" or similar. filterAlts _tycon inst_tys imposs_cons alts - = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + = imposs_deflt_cons `seqList` + (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which + -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter + -- leads to a huge space leak (see #22102 and !8896) where (alts_wo_default, maybe_deflt) = findDefault alts alt_cons = [con | Alt con _ _ <- alts_wo_default] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13ee72bc44e72d3817609e9973bfe5cc4b060443...8ecdf0ac2f1cf8a3b335da0d950243d57345fdc6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13ee72bc44e72d3817609e9973bfe5cc4b060443...8ecdf0ac2f1cf8a3b335da0d950243d57345fdc6 You're receiving 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 26 13:02:22 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Fri, 26 Aug 2022 09:02:22 -0400 Subject: [Git][ghc/ghc][wip/T22028] 16 commits: Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <6308c45ebd26b_e9d7d323c611c1420128@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T22028 at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 3d061941 by Simon Peyton Jones at 2022-08-26T15:01:51+02:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CommonBlockElim.hs - 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/WorkWrap.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/SysTools/BaseDir.hs - compiler/GHC/Types/Var/Env.hs - − compiler/Makefile - − compiler/ghc.mk - configure.ac - distrib/configure.ac.in - − distrib/hc-build - − docs/users_guide/ghc.mk - − driver/ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de20c6d477f02eceaf120b4793d83a0204f862f9...3d061941ce09cafae64fec462f3592db79336d9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de20c6d477f02eceaf120b4793d83a0204f862f9...3d061941ce09cafae64fec462f3592db79336d9d You're receiving 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 26 13:35:35 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 26 Aug 2022 09:35:35 -0400 Subject: [Git][ghc/ghc][wip/T20155] 24 commits: Recognize file-header pragmas in GHCi (#21507) Message-ID: <6308cc27b3dc4_e9d7d488781430243@gitlab.mail> Ben Gamari pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - 32288f1a by Ben Gamari at 2022-08-25T17:28:01-04:00 Drop ghcPrimIfaceHook - - - - - c4f70c9a by Ben Gamari at 2022-08-25T17:28:01-04:00 Rip out hacks surrounding GHC.Prim and primops - - - - - 9c74037d by Ben Gamari at 2022-08-25T17:32:12-04:00 voidArg: not sure why - - - - - d509aae8 by Ben Gamari at 2022-08-25T17:32:12-04:00 Fix wired-in occurrences - - - - - b1364717 by Ben Gamari at 2022-08-25T17:32:12-04:00 newLetBndr - - - - - ccfe6027 by Ben Gamari at 2022-08-25T17:32:12-04:00 mkLocalId - - - - - 107f76a9 by Ben Gamari at 2022-08-25T17:32:12-04:00 hasNoBinding - - - - - ba354343 by Ben Gamari at 2022-08-25T17:32:12-04:00 tcApp - - - - - 66222c8b by Ben Gamari at 2022-08-25T17:32:12-04:00 Revert "newLetBndr" This reverts commit f6e7e9e998c76dc3de56701541627555d8122274. - - - - - 4002e111 by Ben Gamari at 2022-08-25T17:33:08-04:00 Revert "tcApp" This reverts commit ba354343170cf9072a390b3b03c4d5e2d12c8f85. - - - - - 442e7652 by Ben Gamari at 2022-08-26T09:07:38-04:00 tcLookup - - - - - dfe65e95 by Ben Gamari at 2022-08-26T09:07:45-04:00 genprimopcode - - - - - 3c9d1f33 by Ben Gamari at 2022-08-26T09:28:09-04:00 tcLookupId - - - - - d6c28bb1 by Ben Gamari at 2022-08-26T09:29:48-04:00 Revert "Fix wired-in occurrences" This reverts commit d509aae8c99e9c2c3143c3831d19e2a5d76dbbdf. - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/TyThing.hs-boot - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/ModSummary.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/ghci.rst - ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/edafb4cf0fa45f19bc0296cc114abcacb020dbdf...d6c28bb13b7d83c1516e5820268adcfe28f4996f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/edafb4cf0fa45f19bc0296cc114abcacb020dbdf...d6c28bb13b7d83c1516e5820268adcfe28f4996f You're receiving 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 26 14:24:17 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 Aug 2022 10:24:17 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 3 commits: Remove warning about orphan instance Message-ID: <6308d791de16c_e9d7d247d11ac14423bd@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 1c6d843a by Sylvain Henry at 2022-08-26T15:28:55+02:00 Remove warning about orphan instance - - - - - cdd94dd0 by Sylvain Henry at 2022-08-26T15:37:09+02:00 Compactor: disable dead code - - - - - 542c87ac by Sylvain Henry at 2022-08-26T15:46:45+02:00 Exception: implement raiseUnderflow etc. as primops - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Compactor.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Prim.hs - js/rts.js.pp - libraries/ghc-prim/GHC/Prim/Exception.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2573,6 +2573,27 @@ primop RaiseOp "raise#" GenPrimOp out_of_line = True can_fail = True +primop RaiseUnderflowOp "raiseUnderflow#" GenPrimOp + (# #) -> p + with + strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } + out_of_line = True + can_fail = True + +primop RaiseOverflowOp "raiseOverflow#" GenPrimOp + (# #) -> p + with + strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } + out_of_line = True + can_fail = True + +primop RaiseDivZeroOp "raiseDivZero#" GenPrimOp + (# #) -> p + with + strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } + out_of_line = True + can_fail = True + primop RaiseIOOp "raiseIO#" GenPrimOp v -> State# RealWorld -> (# State# RealWorld, p #) with ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1563,6 +1563,9 @@ emitPrimOp cfg primop = CasMutVarOp -> alwaysExternal CatchOp -> alwaysExternal RaiseOp -> alwaysExternal + RaiseUnderflowOp -> alwaysExternal + RaiseOverflowOp -> alwaysExternal + RaiseDivZeroOp -> alwaysExternal RaiseIOOp -> alwaysExternal MaskAsyncExceptionsOp -> alwaysExternal MaskUninterruptibleOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Linker/Compactor.hs ===================================== @@ -49,14 +49,11 @@ import Control.Applicative import GHC.Utils.Monad.State.Strict import Data.Function -import qualified Data.Bits as Bits -import Data.Bits (shiftL, shiftR) import Data.Bifunctor (second) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Builder as BB -import Data.Char (chr) import qualified Data.Graph as G import qualified Data.Map.Strict as M import Data.Map (Map) @@ -64,7 +61,6 @@ import Data.Int import qualified Data.List as List import Data.Maybe import qualified Data.Set as S -import Data.Set (Set) import GHC.Data.FastString import GHC.JS.Syntax @@ -73,7 +69,6 @@ import GHC.JS.Transform import GHC.StgToJS.Printer (pretty) import GHC.StgToJS.Types import GHC.StgToJS.Linker.Types -import GHC.StgToJS.CoreUtils import GHC.StgToJS.Closure import GHC.StgToJS.Arg @@ -417,6 +412,7 @@ renameObj xs = do modify (addStaticEntry xs') -- and now the table return xs' +{- renameEntry :: Ident -> State CompactorState Ident renameEntry i = do @@ -436,6 +432,7 @@ collectLabels si = mapM_ go (labelsV . siVal $ si) labelsA _ = [] labelsL (LabelLit _ lbl) = [lbl] labelsL _ = [] +-} lookupRenamed :: CompactorState -> Ident -> Ident lookupRenamed cs i@(TxtI t) = @@ -502,6 +499,7 @@ staticIdentsA f (StaticObjArg t) = StaticObjArg $! f t staticIdentsA _ x = x +{- {- simple encoding of naturals using only printable low char points, rely on gzip to compress repeating sequences, @@ -731,6 +729,8 @@ encodeDouble (SaneDouble d) encodeMax :: Integer encodeMax = 737189 +-} + {- | The Base data structure contains the information we need to do incremental linking against a base bundle. @@ -953,6 +953,7 @@ findLocals (BlockStat ss) = concatMap findLocals ss findLocals (DeclStat (TxtI i)) = [i] findLocals _ = [] +{- nub' :: Ord a => [a] -> [a] nub' = go S.empty where @@ -960,6 +961,7 @@ nub' = go S.empty go s (x:xs) | x `S.member` s = go s xs | otherwise = x : go (S.insert x s) xs +-} data HashIdx = HashIdx (UniqMap FastString Hash) (Map Hash FastString) ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -662,12 +662,16 @@ readSystemDeps' file , S.fromList $ d baseUnitId "GHC.JS.Prim.TH.Eval" ["runTHServer"]) | file == "rtsdeps.yaml" = pure ( [ baseUnitId , primUnitId - , bignumUnitId ] , S.fromList $ concat [ d baseUnitId "GHC.Conc.Sync" ["reportError"] , d baseUnitId "Control.Exception.Base" ["nonTermination"] - , d baseUnitId "GHC.Exception.Type" ["SomeException"] + , d baseUnitId "GHC.Exception.Type" + [ "SomeException" + , "underflowException" + , "overflowException" + , "divZeroException" + ] , d baseUnitId "GHC.TopHandler" ["runMainIO", "topHandler"] , d baseUnitId "GHC.Base" ["$fMonadIO"] , d baseUnitId "GHC.Maybe" ["Nothing", "Just"] ===================================== compiler/GHC/StgToJS/Linker/Types.hs ===================================== @@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- for Ident's Binary instance + ----------------------------------------------------------------------------- -- | -- Module : GHC.StgToJS.Linker.Types ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -866,6 +866,9 @@ genPrim prof ty op = case op of -- slots, depending on the return type. RaiseOp -> \_r [a] -> PRPrimCall $ returnS (app "h$throw" [a, false_]) RaiseIOOp -> \_r [a] -> PRPrimCall $ returnS (app "h$throw" [a, false_]) + RaiseUnderflowOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypeziunderflowException", false_]) + RaiseOverflowOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezioverflowException", false_]) + RaiseDivZeroOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezidivZZeroException", false_]) MaskAsyncExceptionsOp -> \_r [a] -> PRPrimCall $ returnS (app "h$maskAsync" [a]) MaskUninterruptibleOp -> \_r [a] -> PRPrimCall $ returnS (app "h$maskUnintAsync" [a]) UnmaskAsyncExceptionsOp -> \_r [a] -> PRPrimCall $ returnS (app "h$unmaskAsync" [a]) ===================================== js/rts.js.pp ===================================== @@ -710,4 +710,4 @@ function h$keepAlive(x, f) { h$stack[h$sp] = h$keepAlive_e; h$r1 = f; return h$ap_1_0_fast(); -} \ No newline at end of file +} ===================================== libraries/ghc-prim/GHC/Prim/Exception.hs ===================================== @@ -1,9 +1,6 @@ -{-# LANGUAGE GHCForeignImportPrim #-} -{-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE EmptyCase #-} -- | Primitive exceptions. module GHC.Prim.Exception @@ -14,7 +11,7 @@ module GHC.Prim.Exception where import GHC.Prim -import GHC.Magic +import GHC.Types () default () -- Double and Integer aren't available yet @@ -29,10 +26,6 @@ default () -- Double and Integer aren't available yet -- -- See also: Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. -foreign import prim "stg_raiseOverflowzh" raiseOverflow# :: State# RealWorld -> (# State# RealWorld, (# #) #) -foreign import prim "stg_raiseUnderflowzh" raiseUnderflow# :: State# RealWorld -> (# State# RealWorld, (# #) #) -foreign import prim "stg_raiseDivZZerozh" raiseDivZero# :: State# RealWorld -> (# State# RealWorld, (# #) #) - -- We give a bottoming demand signature to 'raiseOverflow', 'raiseUnderflow' and -- 'raiseDivZero' in "GHC.Core.Make". NOINLINE pragmas are necessary because if -- we ever inlined them we would lose that information. @@ -40,14 +33,14 @@ foreign import prim "stg_raiseDivZZerozh" raiseDivZero# :: State# RealWorld -> ( -- | Raise 'GHC.Exception.Type.overflowException' raiseOverflow :: a {-# NOINLINE raiseOverflow #-} -raiseOverflow = runRW# (\s -> case raiseOverflow# s of (# _, _ #) -> let x = x in x) +raiseOverflow = raiseOverflow# (# #) -- | Raise 'GHC.Exception.Type.underflowException' raiseUnderflow :: a {-# NOINLINE raiseUnderflow #-} -raiseUnderflow = runRW# (\s -> case raiseUnderflow# s of (# _, _ #) -> let x = x in x) +raiseUnderflow = raiseUnderflow# (# #) -- | Raise 'GHC.Exception.Type.divZeroException' raiseDivZero :: a {-# NOINLINE raiseDivZero #-} -raiseDivZero = runRW# (\s -> case raiseDivZero# s of (# _, _ #) -> let x = x in x) +raiseDivZero = raiseDivZero# (# #) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8764ef83d8d04b92299b3109ceba2a00efcf8b03...542c87acae7d0e0a6e7e4d2b8b4d91a080c4809f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8764ef83d8d04b92299b3109ceba2a00efcf8b03...542c87acae7d0e0a6e7e4d2b8b4d91a080c4809f You're receiving 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 26 14:54:31 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 Aug 2022 10:54:31 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Primop: fix Int8/18 quot/rem Message-ID: <6308dea73535a_e9d7d247d11ac1451589@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 9f0d5c4e by Sylvain Henry at 2022-08-26T16:57:21+02:00 Primop: fix Int8/18 quot/rem - - - - - 1 changed file: - compiler/GHC/StgToJS/Prim.hs Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -113,11 +113,11 @@ genPrim prof ty op = case op of Int8AddOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Add x y) Int8SubOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Sub x y) Int8MulOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Mul x y) - Int8QuotOp -> \[r] [x,y] -> PrimInline $ r |= quotShortInt 8 x y - Int8RemOp -> \[r] [x,y] -> PrimInline $ r |= remShortInt 8 x y + Int8QuotOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (quotShortInt 8 x y) + Int8RemOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (remShortInt 8 x y) Int8QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat - [ r1 |= quotShortInt 8 x y - , r2 |= remShortInt 8 x y + [ r1 |= signExtend8 (quotShortInt 8 x y) + , r2 |= signExtend8 (remShortInt 8 x y) ] Int8EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y) Int8GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .>=. (y .<<. (Int 24))) @@ -168,11 +168,11 @@ genPrim prof ty op = case op of Int16AddOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Add x y) Int16SubOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Sub x y) Int16MulOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Mul x y) - Int16QuotOp -> \[r] [x,y] -> PrimInline $ r |= quotShortInt 16 x y - Int16RemOp -> \[r] [x,y] -> PrimInline $ r |= remShortInt 16 x y + Int16QuotOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (quotShortInt 16 x y) + Int16RemOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (remShortInt 16 x y) Int16QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat - [ r1 |= quotShortInt 16 x y - , r2 |= remShortInt 16 x y + [ r1 |= signExtend16 (quotShortInt 16 x y) + , r2 |= signExtend16 (remShortInt 16 x y) ] Int16EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y) Int16GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .>=. (y .<<. (Int 16))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f0d5c4e9e4b01508e32ea7660744b36e4f90e56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f0d5c4e9e4b01508e32ea7660744b36e4f90e56 You're receiving 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 26 15:15:23 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 Aug 2022 11:15:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: hadrian: Fix whitespace Message-ID: <6308e38b55523_e9d7d4887814643bf@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - ea9f68a9 by sheaf at 2022-08-26T11:15:03-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - 69648611 by Krzysztof Gogolewski at 2022-08-26T11:15:06-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 93b5733a by Cheng Shao at 2022-08-26T11:15:08-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf3d7dd4013db483ee8f3de1a4fc58c88db0a767...93b5733a5f8996da728e3d18f41a46266c556d9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf3d7dd4013db483ee8f3de1a4fc58c88db0a767...93b5733a5f8996da728e3d18f41a46266c556d9d You're receiving 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 26 15:28:11 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 Aug 2022 11:28:11 -0400 Subject: [Git][ghc/ghc][wip/T21763] 16 commits: Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <6308e68b61ebe_e9d7d247d11ac147352e@gitlab.mail> Matthew Pickering pushed to branch wip/T21763 at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 469b76ce by Simon Peyton Jones at 2022-08-26T16:27:48+01:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CommonBlockElim.hs - 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/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/SysTools/BaseDir.hs - − compiler/Makefile - − compiler/ghc.mk - configure.ac - distrib/configure.ac.in - − distrib/hc-build - − docs/users_guide/ghc.mk - − driver/ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2647bd275543fe2d22b6a4f378f7fb3d98973d88...469b76ce6a92c004777aab16d1dc40723feddbbb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2647bd275543fe2d22b6a4f378f7fb3d98973d88...469b76ce6a92c004777aab16d1dc40723feddbbb You're receiving 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 26 15:38:17 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 Aug 2022 11:38:17 -0400 Subject: [Git][ghc/ghc][wip/T22112] 16 commits: Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <6308e8e9e2208_e9d7d39bc2b341478338@gitlab.mail> Matthew Pickering pushed to branch wip/T22112 at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 49459538 by Simon Peyton Jones at 2022-08-26T16:36:09+01:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CommonBlockElim.hs - 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/WorkWrap.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/SysTools/BaseDir.hs - compiler/GHC/Types/Id/Info.hs - − compiler/Makefile - − compiler/ghc.mk - configure.ac - distrib/configure.ac.in - − distrib/hc-build - − docs/users_guide/ghc.mk - − driver/ghc.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0635d8461d20a5a3a732aaaec3ec80c8ad527fe9...4945953823620b223a0b51b2b1275a1de8f4a851 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0635d8461d20a5a3a732aaaec3ec80c8ad527fe9...4945953823620b223a0b51b2b1275a1de8f4a851 You're receiving 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 26 15:39:48 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 26 Aug 2022 11:39:48 -0400 Subject: [Git][ghc/ghc][wip/T20155] 2 commits: Revert "mkLocalId" Message-ID: <6308e9445927c_e9d7d36163a7414789b6@gitlab.mail> Ben Gamari pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: e1e4d8bf by Ben Gamari at 2022-08-26T09:35:33-04:00 Revert "mkLocalId" This reverts commit ccfe60272dee0f01844d2a2569626bfffc772770. - - - - - 54d30066 by Ben Gamari at 2022-08-26T11:39:30-04:00 genprimops - - - - - 3 changed files: - compiler/GHC/Types/Id.hs - compiler/GHC/Types/TyThing.hs-boot - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -150,7 +150,6 @@ import GHC.Types.Name import GHC.Unit.Module import GHC.Core.Class import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) -import {-# SOURCE #-} GHC.Types.TyThing (tyThingId) import GHC.Types.ForeignCall import GHC.Data.Maybe import GHC.Types.SrcLoc @@ -305,7 +304,6 @@ mkVanillaGlobalWithInfo = mkGlobalId VanillaId -- | For an explanation of global vs. local 'Id's, see "GHC.Types.Var#globalvslocal" mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id -mkLocalId name _ _ | Just thing <- wiredInNameTyThing_maybe name = tyThingId thing mkLocalId name w ty = mkLocalIdWithInfo name w (assert (not (isCoVarType ty)) ty) vanillaIdInfo -- | Make a local CoVar ===================================== compiler/GHC/Types/TyThing.hs-boot ===================================== @@ -2,9 +2,7 @@ module GHC.Types.TyThing where import {-# SOURCE #-} GHC.Core.TyCon import {-# SOURCE #-} GHC.Types.Var -import GHC.Utils.Misc data TyThing mkATyCon :: TyCon -> TyThing mkAnId :: Id -> TyThing -tyThingId :: HasDebugCallStack => TyThing -> Id ===================================== utils/genprimopcode/Main.hs ===================================== @@ -339,7 +339,13 @@ gen_hs_source (Info defaults entries) = prim_func :: String -> Ty -> Bool -> [String] prim_func n t llvm_only - | isRepPolyType t = [] + | not (argsHaveFixedRuntimeRep t) = + [ "-- No wrapper due to RuntimeRep polymorphism:" + , "-- " ++ wrapOp n ++ " :: " ++ pprTy t + ] + -- Representationally polymorphic functions cannot be wrapped; we + -- instead eta expand them. + | llvm_only = [] -- We can't assume that GHC.Prim will be compiled via LLVM, therefore -- we generate bottoming wrappers for LLVM-only primops. @@ -678,21 +684,34 @@ ppTyVarBinders names = case go names of { (infs, bndrs) -> (nub infs, nub bndrs) , (other_infs, bndrs) <- ppTyVarBinders tvs = (infs ++ other_infs, bndr : bndrs) --- | Is a type representationally polymorphic? -isRepPolyType :: Ty -> Bool -isRepPolyType (TyF a b) = isRepPolyType a || isRepPolyType b -isRepPolyType (TyC a b) = isRepPolyType a || isRepPolyType b -isRepPolyType (TyApp _ as) = any isRepPolyType as -isRepPolyType (TyVar v) = isRepPolyTyVar v -isRepPolyType (TyUTup as) = any isRepPolyType as +-- | Split a function type into its arguments and result types. +splitFunTy :: Ty -> ([Ty], Ty) +splitFunTy = go [] + where + go acc (TyF arg res) = go (arg:acc) res + go acc (TyC arg res) = go (arg:acc) res + go acc ty = (reverse acc, ty) + +argsHaveFixedRuntimeRep :: Ty -> Bool +argsHaveFixedRuntimeRep ty = + let (args, _res) = splitFunTy ty + in all typeHasFixedRuntimeRep args + +-- | Is a type representationally monomorphic? +typeHasFixedRuntimeRep :: Ty -> Bool +typeHasFixedRuntimeRep (TyF a b) = True +typeHasFixedRuntimeRep (TyC a b) = True +typeHasFixedRuntimeRep (TyApp _ as) = all typeHasFixedRuntimeRep as +typeHasFixedRuntimeRep (TyVar v) = tyVarHasFixedRuntimeRep v +typeHasFixedRuntimeRep (TyUTup as) = all typeHasFixedRuntimeRep as -- | Does a tyvar have a representationally polymorphic kind? -isRepPolyTyVar :: TyVar -> Bool -isRepPolyTyVar "o" = True -isRepPolyTyVar "p" = True -isRepPolyTyVar "v" = True -isRepPolyTyVar "w" = True -isRepPolyTyVar _ = False +tyVarHasFixedRuntimeRep :: TyVar -> Bool +tyVarHasFixedRuntimeRep "o" = True +tyVarHasFixedRuntimeRep "p" = True +tyVarHasFixedRuntimeRep "v" = True +tyVarHasFixedRuntimeRep "w" = True +tyVarHasFixedRuntimeRep _ = False ppTyVar :: TyVar -> PrimOpTyVarBinder ppTyVar "a" = nonDepTyVarBinder "alphaTyVarSpec" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6c28bb13b7d83c1516e5820268adcfe28f4996f...54d300661d4bfa132afcb6c40538390b8d4f4b5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6c28bb13b7d83c1516e5820268adcfe28f4996f...54d300661d4bfa132afcb6c40538390b8d4f4b5c You're receiving 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 26 15:53:43 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 26 Aug 2022 11:53:43 -0400 Subject: [Git][ghc/ghc][wip/T21623] 99 commits: typo Message-ID: <6308ec87af250_e9d7d36163a7414795b7@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 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. - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - da051a9f by Simon Peyton Jones at 2022-08-26T16:39:01+01:00 Start work Not ready for review - - - - - 9d4cdcb8 by Simon Peyton Jones at 2022-08-26T16:39:01+01:00 More progress - - - - - 3cd05b61 by Simon Peyton Jones at 2022-08-26T16:39:01+01:00 Wibbles - - - - - f8a363e8 by Simon Peyton Jones at 2022-08-26T16:41:47+01:00 Stage1 compiles - - - - - b2f7da59 by Simon Peyton Jones at 2022-08-26T16:41:47+01:00 More wibbles - - - - - 9fb5030e by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 More wibbles - - - - - 6a8085f3 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 More -- almost working - - - - - 9c7172ff by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Comments - - - - - ddf3cb90 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibbles - - - - - e71effa8 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibbles - - - - - 0265abfb by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble inlineId - - - - - a25e80f1 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibbles - - - - - 1958b42b by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Infinite loop somewhere - - - - - 83e50be7 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 More wibbles. Maybe can build stage2 - - - - - effe65ed by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Make FuNCo a thing by itself - - - - - cc224a81 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble - - - - - b353e467 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble - - - - - 3b2aac4e by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibbles - - - - - 9aea0813 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Fix OptCoercion - - - - - 7027b82d by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble - - - - - 40393e79 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble to optCoercion - - - - - a1f254bb by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Replace SORT with TYPE and CONSTRAINT - - - - - cfb506d4 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble - - - - - 1cc272d9 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Delete unused import - - - - - 640a3b0e by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Delete TypeOrConstraint from ghc-prim:GHC.Types - - - - - d9fc6e26 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Move from NthCo to SelCo - - - - - 33a9fd3d by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibbles - - - - - 527a8c75 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibbles in RepType - - - - - 5216bc0c by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble - - - - - 3f88961b by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Add mkWpEta - - - - - 70522aec by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Really add mkWpEta - - - - - d69ade2b by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Wibble Typeable binds etc - - - - - f8cacb30 by Simon Peyton Jones at 2022-08-26T16:42:04+01:00 Improve error messages - - - - - 6b226c3c by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 More wibbles, mainly to error messages - - - - - 1250d931 by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 Wibbles - - - - - 564bcc8f by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 Wibbles to errors - - - - - 624bf4b7 by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 Wibbles But especially: treat Constraint as Typeable - - - - - 3c4bfa6f by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 More wibbles - - - - - c093613d by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 More changes * Move role into SelTyCon * Get rid of mkTcSymCo and friends - - - - - cdb770d2 by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 Unused variable - - - - - 8ae53ee9 by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 Wibbles - - - - - bf0bd029 by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 Wibble - - - - - d34a521e by Simon Peyton Jones at 2022-08-26T16:43:00+01:00 Accept error message changes - - - - - 2a4ef41d by Simon Peyton Jones at 2022-08-26T16:43:52+01:00 Refactoring... Remove tc functions like tcKind, tcGetTyVar. Move tyConsOfType, occCheckExpand to TyCo.FVs. - - - - - 96f44534 by Simon Peyton Jones at 2022-08-26T16:45:06+01:00 Introduce GHC.Core.TyCo.Compare Lots of import changes! - - - - - 5725f5fb by Simon Peyton Jones at 2022-08-26T16:54:45+01:00 Update haddock submodule (I hope) - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/Types/Prim.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c455ad5e5be9e458ddc67e614d3af91c3e995535...5725f5fb18329c74773ba704eabea9efa7f11e3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c455ad5e5be9e458ddc67e614d3af91c3e995535...5725f5fb18329c74773ba704eabea9efa7f11e3a You're receiving 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 26 16:32:31 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 26 Aug 2022 12:32:31 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles (notably: actually add GHC.Core.TyCo.Compare) Message-ID: <6308f59fc1353_e9d7d268fc250149313f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: d4b10479 by Simon Peyton Jones at 2022-08-26T17:33:29+01:00 Wibbles (notably: actually add GHC.Core.TyCo.Compare) - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - + compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Tc/Gen/Bind.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2189,7 +2189,7 @@ rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) ; return (Lam s' body') } -- Important: do not try to eta-expand this lambda -- See Note [No eta-expansion in runRW#] - _ -> do { s' <- newId (fsLit "s") Many realWorldStatePrimTy + _ -> do { s' <- newId (fsLit "s") ManyTy realWorldStatePrimTy ; let (m,_,_) = splitFunTy fun_ty env' = arg_env `addNewInScopeIds` [s'] cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s' ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -0,0 +1,544 @@ +-- (c) The University of Glasgow 2006 +-- (c) The GRASP/AQUA Project, Glasgow University, 1998 +-- +-- Type - public interface + +{-# LANGUAGE FlexibleContexts, PatternSynonyms, ViewPatterns, MultiWayIf #-} + +-- | Main functions for manipulating types and type-related things +module GHC.Core.TyCo.Compare ( + + -- * Type comparison + eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX, + nonDetCmpTypesX, nonDetCmpTc, + eqVarBndrs, + + pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis, + tcEqTyConApps, + + -- * Visiblity comparision + eqForAllVis, cmpForAllVis + + ) where + +import GHC.Prelude + +import GHC.Core.Type( typeKind, coreView, tcRepSplitAppTy_maybe, repSplitAppTy_maybe ) + +import GHC.Core.TyCo.Rep +import GHC.Core.TyCo.FVs +import GHC.Core.TyCon + +import GHC.Types.Var +import GHC.Types.Unique +import GHC.Types.Var.Env + +import GHC.Utils.Outputable +import GHC.Utils.Misc +import GHC.Utils.Panic + +{- Note [Comparision of types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This module implements type comparison, notably `eqType`. + +* It uses a few functions from GHC.Core.Type, notably `typeKind`, so it + currently sits "on top of" GHC.Core.Type. + +-} + + +{- ********************************************************************* +* * + Type equalities +* * +********************************************************************* -} + +tcEqKind :: HasDebugCallStack => Kind -> Kind -> Bool +tcEqKind = tcEqType + +tcEqType :: HasDebugCallStack => Type -> Type -> Bool +-- ^ tcEqType implements typechecker equality, as described in +-- @Note [Typechecker equality vs definitional equality]@. +tcEqType ty1 ty2 + = tcEqTypeNoSyns ki1 ki2 + && tcEqTypeNoSyns ty1 ty2 + where + ki1 = typeKind ty1 + ki2 = typeKind ty2 + +-- | Just like 'tcEqType', but will return True for types of different kinds +-- as long as their non-coercion structure is identical. +tcEqTypeNoKindCheck :: Type -> Type -> Bool +tcEqTypeNoKindCheck ty1 ty2 + = tcEqTypeNoSyns ty1 ty2 + +-- | Check whether two TyConApps are the same; if the number of arguments +-- are different, just checks the common prefix of arguments. +tcEqTyConApps :: TyCon -> [Type] -> TyCon -> [Type] -> Bool +tcEqTyConApps tc1 args1 tc2 args2 + = tc1 == tc2 && + and (zipWith tcEqTypeNoKindCheck args1 args2) + -- No kind check necessary: if both arguments are well typed, then + -- any difference in the kinds of later arguments would show up + -- as differences in earlier (dependent) arguments + +{- +Note [Specialising tc_eq_type] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The type equality predicates in Type are hit pretty hard during typechecking. +Consequently we take pains to ensure that these paths are compiled to +efficient, minimally-allocating code. + +To this end we place an INLINE on tc_eq_type, ensuring that it is inlined into +its publicly-visible interfaces (e.g. tcEqType). In addition to eliminating +some dynamic branches, this allows the simplifier to eliminate the closure +allocations that would otherwise be necessary to capture the two boolean "mode" +flags. This reduces allocations by a good fraction of a percent when compiling +Cabal. + +See #19226. +-} + +-- | Type equality comparing both visible and invisible arguments and expanding +-- type synonyms. +tcEqTypeNoSyns :: Type -> Type -> Bool +tcEqTypeNoSyns ta tb = tc_eq_type False False ta tb + +-- | Like 'tcEqType', but returns True if the /visible/ part of the types +-- are equal, even if they are really unequal (in the invisible bits) +tcEqTypeVis :: Type -> Type -> Bool +tcEqTypeVis ty1 ty2 = tc_eq_type False True ty1 ty2 + +-- | Like 'pickyEqTypeVis', but returns a Bool for convenience +pickyEqType :: Type -> Type -> Bool +-- Check when two types _look_ the same, _including_ synonyms. +-- So (pickyEqType String [Char]) returns False +-- This ignores kinds and coercions, because this is used only for printing. +pickyEqType ty1 ty2 = tc_eq_type True False ty1 ty2 + +-- | Real worker for 'tcEqType'. No kind check! +tc_eq_type :: Bool -- ^ True <=> do not expand type synonyms + -> Bool -- ^ True <=> compare visible args only + -> Type -> Type + -> Bool +-- Flags False, False is the usual setting for tc_eq_type +-- See Note [Computing equality on types] in Type +tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 + = go orig_env orig_ty1 orig_ty2 + where + go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + + go env t1 t2 | not keep_syns, Just t1' <- coreView t1 = go env t1' t2 + go env t1 t2 | not keep_syns, Just t2' <- coreView t2 = go env t1 t2' + + go env (TyVarTy tv1) (TyVarTy tv2) + = rnOccL env tv1 == rnOccR env tv2 + + go _ (LitTy lit1) (LitTy lit2) + = lit1 == lit2 + + go env (ForAllTy (Bndr tv1 vis1) ty1) + (ForAllTy (Bndr tv2 vis2) ty2) + = vis1 == vis2 + && (vis_only || go env (varType tv1) (varType tv2)) + && go (rnBndr2 env tv1 tv2) ty1 ty2 + + -- Make sure we handle all FunTy cases since falling through to the + -- AppTy case means that tcRepSplitAppTy_maybe may see an unzonked + -- kind variable, which causes things to blow up. + -- See Note [Equality on FunTys] in GHC.Core.TyCo.Rep: we must check + -- kinds here + go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2) + = kinds_eq && go env arg1 arg2 && go env res1 res2 && go env w1 w2 + where + kinds_eq | vis_only = True + | otherwise = go env (typeKind arg1) (typeKind arg2) && + go env (typeKind res1) (typeKind res2) + + -- See Note [Equality on AppTys] in GHC.Core.Type + go env (AppTy s1 t1) ty2 + | Just (s2, t2) <- tcRepSplitAppTy_maybe ty2 + = go env s1 s2 && go env t1 t2 + go env ty1 (AppTy s2 t2) + | Just (s1, t1) <- tcRepSplitAppTy_maybe ty1 + = go env s1 s2 && go env t1 t2 + + go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) + = tc1 == tc2 && gos env (tc_vis tc1) ts1 ts2 + + go env (CastTy t1 _) t2 = go env t1 t2 + go env t1 (CastTy t2 _) = go env t1 t2 + go _ (CoercionTy {}) (CoercionTy {}) = True + + go _ _ _ = False + + gos _ _ [] [] = True + gos env (ig:igs) (t1:ts1) (t2:ts2) = (ig || go env t1 t2) + && gos env igs ts1 ts2 + gos _ _ _ _ = False + + tc_vis :: TyCon -> [Bool] -- True for the fields we should ignore + tc_vis tc | vis_only = inviss ++ repeat False -- Ignore invisibles + | otherwise = repeat False -- Ignore nothing + -- The repeat False is necessary because tycons + -- can legitimately be oversaturated + where + bndrs = tyConBinders tc + inviss = map isInvisibleTyConBinder bndrs + + orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2] + +{-# INLINE tc_eq_type #-} -- See Note [Specialising tc_eq_type]. + + +-- | Do these denote the same level of visibility? 'Required' +-- arguments are visible, others are not. So this function +-- equates 'Specified' and 'Inferred'. Used for printing. +eqForAllVis :: ArgFlag -> ArgFlag -> Bool +-- See Note [ForAllTy and type equality] +eqForAllVis Required Required = True +eqForAllVis (Invisible _) (Invisible _) = True +eqForAllVis _ _ = False + +-- | Do these denote the same level of visibility? 'Required' +-- arguments are visible, others are not. So this function +-- equates 'Specified' and 'Inferred'. Used for printing. +cmpForAllVis :: ArgFlag -> ArgFlag -> Ordering +-- See Note [ForAllTy and type equality] +cmpForAllVis Required Required = EQ +cmpForAllVis Required (Invisible {}) = LT +cmpForAllVis (Invisible _) Required = GT +cmpForAllVis (Invisible _) (Invisible _) = EQ + + +{- Note [Typechecker equality vs definitional equality] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC has two notions of equality over Core types: + +* Definitional equality, as implemented by GHC.Core.Type.eqType. + See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep. +* Typechecker equality, as implemented by tcEqType (in GHC.Tc.Utils.TcType). + GHC.Tc.Solver.Canonical.canEqNC also respects typechecker equality. + +Typechecker equality implies definitional equality: if two types are equal +according to typechecker equality, then they are also equal according to +definitional equality. The converse is not always true, as typechecker equality +is more finer-grained than definitional equality in two places: + +* Unlike definitional equality, which equates Type and Constraint, typechecker + treats them as distinct types. See Note [Kind Constraint and kind Type] in + GHC.Core.Type. +* Unlike definitional equality, which does not care about the ArgFlag of a + ForAllTy, typechecker equality treats Required type variable binders as + distinct from Invisible type variable binders. + See Note [ForAllTy and type equality] + +Note [ForAllTy and type equality] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we compare (ForAllTy (Bndr tv1 vis1) ty1) + and (ForAllTy (Bndr tv2 vis2) ty2) +what should we do about `vis1` vs `vis2`. + +First, we always compare with `eqForAllVis` and `cmpForAllVis`. +But what decision do we make? + +Should GHC type-check the following program (adapted from #15740)? + + {-# LANGUAGE PolyKinds, ... #-} + data D a + type family F :: forall k. k -> Type + type instance F = D + +Due to the way F is declared, any instance of F must have a right-hand side +whose kind is equal to `forall k. k -> Type`. The kind of D is +`forall {k}. k -> Type`, which is very close, but technically uses distinct +Core: + + ----------------------------------------------------------- + | Source Haskell | Core | + ----------------------------------------------------------- + | forall k. <...> | ForAllTy (Bndr k Specified) (<...>) | + | forall {k}. <...> | ForAllTy (Bndr k Inferred) (<...>) | + ----------------------------------------------------------- + +We could deem these kinds to be unequal, but that would imply rejecting +programs like the one above. Whether a kind variable binder ends up being +specified or inferred can be somewhat subtle, however, especially for kinds +that aren't explicitly written out in the source code (like in D above). + +For now, we decide to not make the specified/inferred status of an invisible +type variable binder affect GHC's notion of typechecker equality +(see Note [Typechecker equality vs definitional equality] in +GHC.Tc.Utils.TcType). That is, we have the following: + + -------------------------------------------------- + | Type 1 | Type 2 | Equal? | + --------------------|----------------------------- + | forall k. <...> | forall k. <...> | Yes | + | | forall {k}. <...> | Yes | + | | forall k -> <...> | No | + -------------------------------------------------- + | forall {k}. <...> | forall k. <...> | Yes | + | | forall {k}. <...> | Yes | + | | forall k -> <...> | No | + -------------------------------------------------- + | forall k -> <...> | forall k. <...> | No | + | | forall {k}. <...> | No | + | | forall k -> <...> | Yes | + -------------------------------------------------- + + +************************************************************************ +* * + Comparison for types + (We don't use instances so that we know where it happens) +* * +************************************************************************ + +Note [Equality on AppTys] +~~~~~~~~~~~~~~~~~~~~~~~~~ +In our cast-ignoring equality, we want to say that the following two +are equal: + + (Maybe |> co) (Int |> co') ~? Maybe Int + +But the left is an AppTy while the right is a TyConApp. The solution is +to use repSplitAppTy_maybe to break up the TyConApp into its pieces and +then continue. Easy to do, but also easy to forget to do. + +Note [Comparing nullary type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of testing equality between two 'Type's of the form + + TyConApp tc [] + +where @tc@ is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of @tc@ may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. Of course, if we find +that the TyCons are *not* equal then we still need to perform the expansion as +their RHSs may still be equal. + +We perform this optimisation in a number of places: + + * GHC.Core.Types.eqType + * GHC.Core.Types.nonDetCmpType + * GHC.Core.Unify.unify_ty + * TcCanonical.can_eq_nc' + * TcUnify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See Note [Using synonyms to compress types] in +GHC.Core.Type for details. + +-} + +eqType :: Type -> Type -> Bool +-- ^ Type equality on source types. Does not look through @newtypes@, +-- 'PredType's or type families, but it does look through type synonyms. +-- This first checks that the kinds of the types are equal and then +-- checks whether the types are equal, ignoring casts and coercions. +-- (The kind check is a recursive call, but since all kinds have type +-- @Type@, there is no need to check the types of kinds.) +-- See also Note [Non-trivial definitional equality] in "GHC.Core.TyCo.Rep". +eqType t1 t2 = isEqual $ nonDetCmpType t1 t2 + -- It's OK to use nonDetCmpType here and eqType is deterministic, + -- nonDetCmpType does equality deterministically + +-- | Compare types with respect to a (presumably) non-empty 'RnEnv2'. +eqTypeX :: RnEnv2 -> Type -> Type -> Bool +eqTypeX env t1 t2 = isEqual $ nonDetCmpTypeX env t1 t2 + -- It's OK to use nonDetCmpType here and eqTypeX is deterministic, + -- nonDetCmpTypeX does equality deterministically + +-- | Type equality on lists of types, looking through type synonyms +-- but not newtypes. +eqTypes :: [Type] -> [Type] -> Bool +eqTypes tys1 tys2 = isEqual $ nonDetCmpTypes tys1 tys2 + -- It's OK to use nonDetCmpType here and eqTypes is deterministic, + -- nonDetCmpTypes does equality deterministically + +eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2 +-- Check that the var lists are the same length +-- and have matching kinds; if so, extend the RnEnv2 +-- Returns Nothing if they don't match +eqVarBndrs env [] [] + = Just env +eqVarBndrs env (tv1:tvs1) (tv2:tvs2) + | eqTypeX env (varType tv1) (varType tv2) + = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2 +eqVarBndrs _ _ _= Nothing + +-- Now here comes the real worker + +{- +Note [nonDetCmpType nondeterminism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +nonDetCmpType is implemented in terms of nonDetCmpTypeX. nonDetCmpTypeX +uses nonDetCmpTc which compares TyCons by their Unique value. Using Uniques for +ordering leads to nondeterminism. We hit the same problem in the TyVarTy case, +comparing type variables is nondeterministic, note the call to nonDetCmpVar in +nonDetCmpTypeX. +See Note [Unique Determinism] for more details. + +Note [Computing equality on types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are several places within GHC that depend on the precise choice of +definitional equality used. If we change that definition, all these places +must be updated. This Note merely serves as a place for all these places +to refer to, so searching for references to this Note will find every place +that needs to be updated. + +See also Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep. + +-} + +nonDetCmpType :: Type -> Type -> Ordering +nonDetCmpType (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 + = EQ +nonDetCmpType t1 t2 + -- we know k1 and k2 have the same kind, because they both have kind *. + = nonDetCmpTypeX rn_env t1 t2 + where + rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes [t1, t2])) +{-# INLINE nonDetCmpType #-} + +nonDetCmpTypes :: [Type] -> [Type] -> Ordering +nonDetCmpTypes ts1 ts2 = nonDetCmpTypesX rn_env ts1 ts2 + where + rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2))) + +-- | An ordering relation between two 'Type's (known below as @t1 :: k1@ +-- and @t2 :: k2@) +data TypeOrdering = TLT -- ^ @t1 < t2@ + | TEQ -- ^ @t1 ~ t2@ and there are no casts in either, + -- therefore we can conclude @k1 ~ k2@ + | TEQX -- ^ @t1 ~ t2@ yet one of the types contains a cast so + -- they may differ in kind. + | TGT -- ^ @t1 > t2@ + deriving (Eq, Ord, Enum, Bounded) + +nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse + -- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep + -- See Note [Computing equality on types] +nonDetCmpTypeX env orig_t1 orig_t2 = + case go env orig_t1 orig_t2 of + -- If there are casts then we also need to do a comparison of + -- the kinds of the types being compared + TEQX -> toOrdering $ go env k1 k2 + ty_ordering -> toOrdering ty_ordering + where + k1 = typeKind orig_t1 + k2 = typeKind orig_t2 + + toOrdering :: TypeOrdering -> Ordering + toOrdering TLT = LT + toOrdering TEQ = EQ + toOrdering TEQX = EQ + toOrdering TGT = GT + + liftOrdering :: Ordering -> TypeOrdering + liftOrdering LT = TLT + liftOrdering EQ = TEQ + liftOrdering GT = TGT + + thenCmpTy :: TypeOrdering -> TypeOrdering -> TypeOrdering + thenCmpTy TEQ rel = rel + thenCmpTy TEQX rel = hasCast rel + thenCmpTy rel _ = rel + + hasCast :: TypeOrdering -> TypeOrdering + hasCast TEQ = TEQX + hasCast rel = rel + + -- Returns both the resulting ordering relation between + -- the two types and whether either contains a cast. + go :: RnEnv2 -> Type -> Type -> TypeOrdering + -- See Note [Comparing nullary type synonyms]. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = TEQ + go env t1 t2 + | Just t1' <- coreView t1 = go env t1' t2 + | Just t2' <- coreView t2 = go env t1 t2' + + go env (TyVarTy tv1) (TyVarTy tv2) + = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2 + go env (ForAllTy (Bndr tv1 vis1) t1) (ForAllTy (Bndr tv2 vis2) t2) + = liftOrdering (vis1 `cmpForAllVis` vis2) + `thenCmpTy` go env (varType tv1) (varType tv2) + `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2 + + -- See Note [Equality on AppTys] + go env (AppTy s1 t1) ty2 + | Just (s2, t2) <- repSplitAppTy_maybe ty2 + = go env s1 s2 `thenCmpTy` go env t1 t2 + go env ty1 (AppTy s2 t2) + | Just (s1, t1) <- repSplitAppTy_maybe ty1 + = go env s1 s2 `thenCmpTy` go env t1 t2 + + go env (FunTy _ w1 s1 t1) (FunTy _ w2 s2 t2) + -- NB: nonDepCmpTypeX does the kind check requested by + -- Note [Equality on FunTys] in GHC.Core.TyCo.Rep + = liftOrdering (nonDetCmpTypeX env s1 s2 `thenCmp` nonDetCmpTypeX env t1 t2) + `thenCmpTy` go env w1 w2 + -- Comparing multiplicities last because the test is usually true + + go env (TyConApp tc1 tys1) (TyConApp tc2 tys2) + = liftOrdering (tc1 `nonDetCmpTc` tc2) `thenCmpTy` gos env tys1 tys2 + + go _ (LitTy l1) (LitTy l2) = liftOrdering (nonDetCmpTyLit l1 l2) + go env (CastTy t1 _) t2 = hasCast $ go env t1 t2 + go env t1 (CastTy t2 _) = hasCast $ go env t1 t2 + + go _ (CoercionTy {}) (CoercionTy {}) = TEQ + + -- Deal with the rest: TyVarTy < CoercionTy < AppTy < LitTy < TyConApp < ForAllTy + go _ ty1 ty2 + = liftOrdering $ (get_rank ty1) `compare` (get_rank ty2) + where get_rank :: Type -> Int + get_rank (CastTy {}) + = pprPanic "nonDetCmpTypeX.get_rank" (ppr [ty1,ty2]) + get_rank (TyVarTy {}) = 0 + get_rank (CoercionTy {}) = 1 + get_rank (AppTy {}) = 3 + get_rank (LitTy {}) = 4 + get_rank (TyConApp {}) = 5 + get_rank (FunTy {}) = 6 + get_rank (ForAllTy {}) = 7 + + gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering + gos _ [] [] = TEQ + gos _ [] _ = TLT + gos _ _ [] = TGT + gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2 + +------------- +nonDetCmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering +nonDetCmpTypesX _ [] [] = EQ +nonDetCmpTypesX env (t1:tys1) (t2:tys2) = nonDetCmpTypeX env t1 t2 + `thenCmp` + nonDetCmpTypesX env tys1 tys2 +nonDetCmpTypesX _ [] _ = LT +nonDetCmpTypesX _ _ [] = GT + +------------- +-- | Compare two 'TyCon's. +-- See Note [nonDetCmpType nondeterminism] +nonDetCmpTc :: TyCon -> TyCon -> Ordering +nonDetCmpTc tc1 tc2 + = u1 `nonDetCmpUnique` u2 + where + u1 = tyConUnique tc1 + u2 = tyConUnique tc2 + + + ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1046,7 +1046,7 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs , 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 ] + , Just lhs_tv <- [ getTyVar_maybe lhs ] , lhs_tv == tv ] chooseInferredQuantifiers _ _ _ _ (Just (TISI { sig_inst_sig = sig@(CompleteSig {}) })) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4b10479cdfe45e0b1314dfc58e54e7a18f0196a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4b10479cdfe45e0b1314dfc58e54e7a18f0196a You're receiving 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 26 16:38:37 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 Aug 2022 12:38:37 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: Linker: refactor wired-in deps Message-ID: <6308f70dde75f_e9d7d40d5e590149362f@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: b343306c by Sylvain Henry at 2022-08-26T18:20:41+02:00 Linker: refactor wired-in deps - - - - - cea5c8c5 by Sylvain Henry at 2022-08-26T18:37:07+02:00 Ppr: remove useless left padding for functions in JS dumps - - - - - 2 changed files: - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/Linker/Linker.hs Changes: ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -137,7 +137,17 @@ defRenderJsS r = \case | otherwise = text "catch" <> parens (jsToDocR r i) $$ braceNest' (jsToDocR r s1) mbFinally | s2 == BlockStat [] = PP.empty | otherwise = text "finally" $$ braceNest' (jsToDocR r s2) - AssignStat i x -> jsToDocR r i <+> char '=' <+> jsToDocR r x + AssignStat i x -> case x of + -- special treatment for functions, otherwise there is too much left padding + -- (more than the length of the expression assigned to). E.g. + -- + -- var long_variable_name = (function() + -- { + -- ... + -- }); + -- + ValExpr (JFunc is b) -> sep [jsToDocR r i <+> text "= function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] + _ -> jsToDocR r i <+> char '=' <+> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <> optParens r x ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -237,7 +237,7 @@ link' env lc_cfg cfg dflags logger unit_env target _include pkgs objFiles _jsFil BaseFile file -> loadBase file BaseState b -> return b - (rdPkgs, rds) <- rtsDeps pkgs + let (rdPkgs, rds) = rtsDeps pkgs -- c <- newMVar M.empty let preload_units = preloadUnits (ue_units unit_env) @@ -629,73 +629,103 @@ noStaticDeps :: StaticDeps noStaticDeps = StaticDeps [] +-- | A helper function to read system dependencies that are hardcoded via a file +-- path. +diffDeps + :: [UnitId] -- ^ Packages that are already Linked + -> ([UnitId], Set ExportedFun) -- ^ New units and functions to link + -> ([UnitId], Set ExportedFun) -- ^ Diff +diffDeps pkgs (deps_pkgs,deps_funs) = + ( filter linked_pkg deps_pkgs + , S.filter linked_fun deps_funs + ) + where + linked_fun f = moduleUnitId (funModule f) `S.member` linked_pkgs + linked_pkg p = S.member p linked_pkgs + linked_pkgs = S.fromList pkgs + -- | dependencies for the RTS, these need to be always linked -rtsDeps :: [UnitId] -> IO ([UnitId], Set ExportedFun) -rtsDeps pkgs = readSystemDeps pkgs "rtsdeps.yaml" +rtsDeps :: [UnitId] -> ([UnitId], Set ExportedFun) +rtsDeps pkgs = diffDeps pkgs $ + ( [baseUnitId, primUnitId] + , S.fromList $ concat + [ mkBaseFuns "GHC.Conc.Sync" + ["reportError"] + , mkBaseFuns "Control.Exception.Base" + ["nonTermination"] + , mkBaseFuns "GHC.Exception.Type" + [ "SomeException" + , "underflowException" + , "overflowException" + , "divZeroException" + ] + , mkBaseFuns "GHC.TopHandler" + [ "runMainIO" + , "topHandler" + ] + , mkBaseFuns "GHC.Base" + ["$fMonadIO"] + , mkBaseFuns "GHC.Maybe" + [ "Nothing" + , "Just" + ] + , mkBaseFuns "GHC.Ptr" + ["Ptr"] + , mkBaseFuns "GHC.JS.Prim" + [ "JSVal" + , "JSException" + , "$fShowJSException" + , "$fExceptionJSException" + , "resolve" + , "resolveIO" + , "toIO" + ] + , mkBaseFuns "GHC.JS.Prim.Internal" + [ "wouldBlock" + , "blockedIndefinitelyOnMVar" + , "blockedIndefinitelyOnSTM" + , "ignoreException" + , "setCurrentThreadResultException" + , "setCurrentThreadResultValue" + ] + , mkPrimFuns "GHC.Types" + [ ":" + , "[]" + ] + , mkPrimFuns "GHC.Tuple" + [ "(,)" + , "(,,)" + , "(,,,)" + , "(,,,,)" + , "(,,,,,)" + , "(,,,,,,)" + , "(,,,,,,,)" + , "(,,,,,,,,)" + , "(,,,,,,,,,)" + ] + ] + ) -- | dependencies for the Template Haskell, these need to be linked when running -- Template Haskell (in addition to the RTS deps) -thDeps :: [UnitId] -> IO ([UnitId], Set ExportedFun) -thDeps pkgs = readSystemDeps pkgs "thdeps.yaml" +thDeps :: [UnitId] -> ([UnitId], Set ExportedFun) +thDeps pkgs = diffDeps pkgs $ + ( [ baseUnitId ] + , S.fromList $ mkBaseFuns "GHC.JS.Prim.TH.Eval" ["runTHServer"] + ) --- | A helper function to read system dependencies that are hardcoded via a file --- path. -readSystemDeps :: [UnitId] -- ^ Packages that are already Linked - -> FilePath -- ^ File to read - -> IO ([UnitId], Set ExportedFun) -readSystemDeps pkgs file = do - (deps_pkgs, deps_funs) <- readSystemDeps' file - pure ( filter (`S.member` linked_pkgs) deps_pkgs - , S.filter (\fun -> - moduleUnitId (funModule fun) `S.member` linked_pkgs) deps_funs - ) - where - linked_pkgs = S.fromList pkgs - - -readSystemDeps' :: FilePath -> IO ([UnitId], Set ExportedFun) -readSystemDeps' file - -- hardcode contents to get rid of yaml dep - -- XXX move runTHServer to some suitable wired-in package - | file == "thdeps.yaml" = pure ( [ baseUnitId ] - , S.fromList $ d baseUnitId "GHC.JS.Prim.TH.Eval" ["runTHServer"]) - | file == "rtsdeps.yaml" = pure ( [ baseUnitId - , primUnitId - ] - , S.fromList $ concat - [ d baseUnitId "GHC.Conc.Sync" ["reportError"] - , d baseUnitId "Control.Exception.Base" ["nonTermination"] - , d baseUnitId "GHC.Exception.Type" - [ "SomeException" - , "underflowException" - , "overflowException" - , "divZeroException" - ] - , d baseUnitId "GHC.TopHandler" ["runMainIO", "topHandler"] - , d baseUnitId "GHC.Base" ["$fMonadIO"] - , d baseUnitId "GHC.Maybe" ["Nothing", "Just"] - , d baseUnitId "GHC.Ptr" ["Ptr"] - , d primUnitId "GHC.Types" [":", "[]"] - , d primUnitId "GHC.Tuple" ["(,)", "(,,)", "(,,,)", "(,,,,)", "(,,,,,)","(,,,,,,)", "(,,,,,,,)", "(,,,,,,,,)", "(,,,,,,,,,)"] - , 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) - where +mkBaseFuns :: FastString -> [FastString] -> [ExportedFun] +mkBaseFuns = mkExportedFuns baseUnitId + +mkPrimFuns :: FastString -> [FastString] -> [ExportedFun] +mkPrimFuns = mkExportedFuns primUnitId - 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) +mkExportedFuns :: UnitId -> FastString -> [FastString] -> [ExportedFun] +mkExportedFuns uid mod_name symbols = map mk_fun symbols + where + mod = mkModule (RealUnit (Definite uid)) (mkModuleNameFS mod_name) + mk_fun sym = ExportedFun mod (LexicalFastString (mkJsSymbol mod sym)) -- | Make JS symbol corresponding to the given Haskell symbol in the given -- module View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f0d5c4e9e4b01508e32ea7660744b36e4f90e56...cea5c8c5b76ab76631fe0d1521334858051faea8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f0d5c4e9e4b01508e32ea7660744b36e4f90e56...cea5c8c5b76ab76631fe0d1521334858051faea8 You're receiving 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 26 19:05:42 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 Aug 2022 15:05:42 -0400 Subject: [Git][ghc/ghc][master] Pmc: consider any 2 dicts of the same type equal Message-ID: <6309198666a53_e9d7d36163a741504688@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - 6 changed files: - compiler/GHC/Core/Predicate.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - libraries/unix - testsuite/tests/pmcheck/should_compile/T11822.stderr - + testsuite/tests/pmcheck/should_compile/T21662.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -243,7 +243,6 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) - {- ********************************************************************* * * Implicit parameters ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -58,9 +58,10 @@ import GHC.Types.Var.Set import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.Map.Expr +import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) import GHC.Core.Utils (exprType) -import GHC.Core.Make (mkListExpr, mkCharExpr) +import GHC.Core.Make (mkListExpr, mkCharExpr, mkRuntimeErrorApp, rUNTIME_ERROR_ID) import GHC.Types.Unique.Supply import GHC.Data.FastString import GHC.Types.SrcLoc @@ -941,22 +942,121 @@ addCoreCt nabla x e = do pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Nabla (MaybeT DsM) () pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args +-- | Like 'modify', but with an effectful modifier action +modifyT :: Monad m => (s -> m s) -> StateT s m () +modifyT f = StateT $ fmap ((,) ()) . f + -- | Finds a representant of the semantic equality class of the given @e at . -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps e = pure (rep, nabla) + | Just rep <- lookupCoreMap reps key = pure (rep, nabla) | otherwise = do rep <- mkPmId (exprType e) - let reps' = extendCoreMap reps e rep + let reps' = extendCoreMap reps key rep let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } pure (rep, nabla') + where + key = makeDictsCoherent e + -- Use a key in which dictionaries for the same type become equal. + -- See Note [Unique dictionaries in the TmOracle CoreMap] --- | Like 'modify', but with an effectful modifier action -modifyT :: Monad m => (s -> m s) -> StateT s m () -modifyT f = StateT $ fmap ((,) ()) . f +-- | Change out 'Id's which are uniquely determined by their type to a +-- common value, so that different names for dictionaries of the same type +-- are considered equal when building a 'CoreMap'. +-- +-- See Note [Unique dictionaries in the TmOracle CoreMap] +makeDictsCoherent :: CoreExpr -> CoreExpr +makeDictsCoherent var@(Var v) + | let ty = idType v + , typeDeterminesValue ty + = mkRuntimeErrorApp rUNTIME_ERROR_ID ty "dictionary" + | otherwise + = var +makeDictsCoherent lit@(Lit {}) + = lit +makeDictsCoherent (App f a) + = App (makeDictsCoherent f) (makeDictsCoherent a) +makeDictsCoherent (Lam f body) + = Lam f (makeDictsCoherent body) +makeDictsCoherent (Let bndr body) + = Let + (go_bndr bndr) + (makeDictsCoherent body) + where + go_bndr (NonRec bndr expr) = NonRec bndr (makeDictsCoherent expr) + go_bndr (Rec bndrs) = Rec (map ( \(b, expr) -> (b, makeDictsCoherent expr) ) bndrs) +makeDictsCoherent (Case scrut bndr ty alts) + = Case scrut bndr ty + [ Alt con bndr expr' + | Alt con bndr expr <- alts + , let expr' = makeDictsCoherent expr ] +makeDictsCoherent (Cast expr co) + = Cast (makeDictsCoherent expr) co +makeDictsCoherent (Tick tick expr) + = Tick tick (makeDictsCoherent expr) +makeDictsCoherent ty@(Type {}) + = ty +makeDictsCoherent co@(Coercion {}) + = co + +{- Note [Unique dictionaries in the TmOracle CoreMap] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Any two dictionaries for a coherent typeclass should be considered equal +in the TmOracle CoreMap, as this allows us to report better pattern-match +warnings. + +Consider for example T21662: + + view_fn :: forall (n :: Nat). KnownNat n => Int -> Bool + + foo :: Int -> Int + foo (view_fn @12 -> True ) = 0 + foo (view_fn @12 -> False) = 1 + +In this example, the pattern match is exhaustive because we have covered +the range of the view pattern function. However, we may fail to recognise +the fact that the two cases use the same view function if the KnownNat +dictionaries aren't syntactically equal: + + eqn 1: [let ds_d1p0 = view_fn @12 $dKnownNat_a1ny ds_d1oR, True <- ds_d1p0] + eqn 2: [let ds_d1p6 = view_fn @12 $dKnownNat_a1nC ds_d1oR, False <- ds_d1p6] + +Note that the uniques of the KnownNat 12 dictionary differ. If we fail to utilise +the coherence of the KnownNat constraint, then we have to pessimistically assume +that we have two function calls with different arguments: + + foo (fn arg1 -> True ) = ... + foo (fn arg2 -> False) = ... + +In this case we can't determine whether the pattern matches are complete, so we +emit a pattern match warning. + +Solution: replace all 'Id's whose type uniquely determines its value with +a common value, e.g. in the above example we would replace both +$dKnownNat_a1ny and $dKnownNat_a1nC with error @(KnownNat 12). + +Why did we choose this solution? Here are some alternatives that were considered: + + 1. Perform CSE first. This would common up the dictionaries before we compare + using the CoreMap. + However, this is architecturally difficult as it would require threading + a CSEnv through to desugarPat. + 2. Directly modify CoreMap so that any two dictionaries of the same type are + considered equal. + The problem is that this affects all users of CoreMap. For example, CSE + would now assume that any two dictionaries of the same type are equal, + but this isn't necessarily true in the presence of magicDict, which + violates coherence by design. It seems more prudent to limit the changes + to the pattern-match checker only, to avoid undesirable consequences. + +In the end, replacing dictionaries with an error value in the pattern-match +checker was the most self-contained, although we might want to revisit once +we implement a more robust approach to computing equality in the pattern-match +checker (see #19272). +-} {- Note [The Pos/Neg invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit 23edd4537e9051824a5683b324e6fb8abed5d6b3 +Subproject commit 2a6079a2b76adf29d3e3ff213dffe66cabcb76c3 ===================================== testsuite/tests/pmcheck/should_compile/T11822.stderr ===================================== @@ -12,11 +12,3 @@ T11822.hs:33:1: warning: [-Wincomplete-patterns (in -Wextra)] _ _ _ (Data.Sequence.Internal.Seq Data.Sequence.Internal.EmptyT) _ _ ... - -T11822.hs:33:1: warning: - Pattern match checker ran into -fmax-pmcheck-models=30 limit, so - • Redundant clauses might not be reported at all - • Redundant clauses might be reported as inaccessible - • Patterns reported as unmatched might actually be matched - Suggested fix: - Increase the limit or resolve the warnings to suppress this message. ===================================== testsuite/tests/pmcheck/should_compile/T21662.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeApplications #-} + +module T21662 where + +import GHC.TypeNats (Nat, KnownNat) + +view_fn :: forall (n :: Nat). KnownNat n => Int -> Bool +view_fn i = i > 0 + +foo :: Int -> Int +foo (view_fn @12 -> True) = 0 +foo (view_fn @12 -> False) = 0 + + -- The point is that the two view pattern functions "view_fn" + -- may get different uniques for the KnownNat 12 dictionary, + -- which leads to a spurious pattern match warning. ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -111,6 +111,7 @@ test('CyclicSubst', [], compile, [overlapping_incomplete]) test('CaseOfKnownCon', [], compile, [overlapping_incomplete]) test('TooManyDeltas', [], compile, [overlapping_incomplete+'-fmax-pmcheck-models=0']) test('LongDistanceInfo', [], compile, [overlapping_incomplete]) +test('T21662', [], compile, [overlapping_incomplete]) # Series (inspired) by Luke Maranget View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4786acf758ef064d3b79593774d1672e294b0afb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4786acf758ef064d3b79593774d1672e294b0afb You're receiving 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 26 19:06:25 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 Aug 2022 15:06:25 -0400 Subject: [Git][ghc/ghc][master] Remove label style from printing context Message-ID: <630919b14c2ea_e9d7d4d1d4150802f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 27 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/StgToCmm/Layout.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Utils/Logger.hs - compiler/GHC/Utils/Outputable.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/T15155.stdout-darwin Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -128,6 +128,7 @@ module GHC.Cmm.CLabel ( LabelStyle (..), pprDebugCLabel, pprCLabel, + pprAsmLabel, ppInternalProcLabel, -- * Others @@ -1389,13 +1390,15 @@ allocation. Take care if you want to remove them! -} +pprAsmLabel :: Platform -> CLabel -> SDoc +pprAsmLabel platform lbl = pprCLabel platform AsmStyle lbl + instance OutputableP Platform CLabel where {-# INLINE pdoc #-} -- see Note [Bangs in CLabel] pdoc !platform lbl = getPprStyle $ \pp_sty -> - let !sty = case pp_sty of - PprCode sty -> sty - _ -> CStyle - in pprCLabel platform sty lbl + case pp_sty of + PprDump{} -> pprCLabel platform CStyle lbl + _ -> pprPanic "Labels in code should be printed with pprCLabel" (pprCLabel platform CStyle lbl) pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] @@ -1522,7 +1525,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] CC_Label cc -> maybe_underscore $ ppr cc CCS_Label ccs -> maybe_underscore $ ppr ccs - IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe") + IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform CStyle l <> text "_" <> ppr m <> text "_ipe") ModuleLabel mod kind -> maybe_underscore $ ppr mod <> text "_" <> ppr kind CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs ===================================== compiler/GHC/Cmm/DebugBlock.hs ===================================== @@ -77,7 +77,7 @@ data DebugBlock = , dblBlocks :: ![DebugBlock] -- ^ Nested blocks } -instance OutputableP env CLabel => OutputableP env DebugBlock where +instance OutputableP Platform DebugBlock where pdoc env blk = (if | dblProcedure blk == dblLabel blk -> text "proc" @@ -85,7 +85,7 @@ instance OutputableP env CLabel => OutputableP env DebugBlock where -> text "pp-blk" | otherwise -> text "blk") <+> - ppr (dblLabel blk) <+> parens (pdoc env (dblCLabel blk)) <+> + ppr (dblLabel blk) <+> parens (pprAsmLabel env (dblCLabel blk)) <+> (maybe empty ppr (dblSourceTick blk)) <+> (maybe (text "removed") ((text "pos " <>) . ppr) (dblPosition blk)) <+> @@ -495,9 +495,9 @@ LOC this information will end up in is Y. -- | A label associated with an 'UnwindTable' data UnwindPoint = UnwindPoint !CLabel !UnwindTable -instance OutputableP env CLabel => OutputableP env UnwindPoint where +instance OutputableP Platform UnwindPoint where pdoc env (UnwindPoint lbl uws) = - braces $ pdoc env lbl <> colon + braces $ pprAsmLabel env lbl <> colon <+> hsep (punctuate comma $ map pprUw $ Map.toList uws) where pprUw (g, expr) = ppr g <> char '=' <> pdoc env expr @@ -519,16 +519,16 @@ data UnwindExpr = UwConst !Int -- ^ literal value | UwTimes UnwindExpr UnwindExpr deriving (Eq) -instance OutputableP env CLabel => OutputableP env UnwindExpr where +instance OutputableP Platform UnwindExpr where pdoc = pprUnwindExpr 0 -pprUnwindExpr :: OutputableP env CLabel => Rational -> env -> UnwindExpr -> SDoc +pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc pprUnwindExpr p env = \case UwConst i -> ppr i UwReg g 0 -> ppr g UwReg g x -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x)) UwDeref e -> char '*' <> pprUnwindExpr 3 env e - UwLabel l -> pdoc env l + UwLabel l -> pprAsmLabel env l UwPlus e0 e1 | p <= 0 -> pprUnwindExpr 0 env e0 <> char '+' <> pprUnwindExpr 0 env e1 UwMinus e0 e1 ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Cmm.Dataflow.Label import GHC.Cmm import GHC.Cmm.Liveness import GHC.Cmm.Switch (switchTargetsToList) +import GHC.Cmm.CLabel (pprDebugCLabel) import GHC.Utils.Outputable import Control.Monad (ap, unless) @@ -55,7 +56,7 @@ lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint () lintCmmDecl (CmmProc _ lbl _ g) = do platform <- getPlatform - addLintInfo (text "in proc " <> pdoc platform lbl) $ lintCmmGraph g + addLintInfo (text "in proc " <> pprDebugCLabel platform lbl) $ lintCmmGraph g lintCmmDecl (CmmData {}) = return () ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -508,9 +508,9 @@ pprForeignTarget platform (PrimTarget op) -- HACK: We're just using a ForeignLabel to get this printed, the label -- might not really be foreign. = pdoc platform - (CmmLabel (mkForeignLabel + (mkForeignLabel (mkFastString (show op)) - Nothing ForeignLabelInThisPackage IsFunction)) + Nothing ForeignLabelInThisPackage IsFunction) instance Outputable Convention where ppr = pprConvention ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -449,7 +449,7 @@ cmmproc :: { CmmParse () } platform <- getPlatform; ctx <- getContext; formals <- sequence (fromMaybe [] $3); - withName (renderWithContext ctx (pdoc platform entry_ret_label)) + withName (renderWithContext ctx (pprCLabel platform CStyle entry_ret_label)) $4; return (entry_ret_label, info, stk_formals, formals) } let do_layout = isJust $3 ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -396,7 +396,7 @@ cmmNativeGens logger config modLoc ncgImpl h dbgMap = go -- force evaluation all this stuff to avoid space leaks let platform = ncgPlatform config - {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pdoc platform) imports) () + {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pprAsmLabel platform) imports) () let !labels' = if ncgDwarfEnabled config then cmmDebugLabels isMetaInstr native else [] @@ -455,7 +455,7 @@ cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap cmm count let weights = ncgCfgWeights config let proc_name = case cmm of - (CmmProc _ entry_label _ _) -> pdoc platform entry_label + (CmmProc _ entry_label _ _) -> pprAsmLabel platform entry_label _ -> text "DataChunk" -- rewrite assignments to global regs @@ -789,7 +789,7 @@ makeImportsDoc config imports doPpr lbl = (lbl, renderWithContext (ncgAsmContext config) - (pprCLabel platform AsmStyle lbl)) + (pprAsmLabel platform lbl)) -- ----------------------------------------------------------------------------- -- Generate jump tables ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -60,6 +60,7 @@ import GHC.Types.ForeignCall import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Utils.Constants (debugIsOn) -- Note [General layout of an NCG] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -135,10 +136,11 @@ basicBlockCodeGen block = do id = entryLabel block stmts = blockToList nodes - header_comment_instr = unitOL $ MULTILINE_COMMENT ( + header_comment_instr | debugIsOn = unitOL $ MULTILINE_COMMENT ( text "-- --------------------------- basicBlockCodeGen --------------------------- --\n" - $+$ pdoc (ncgPlatform config) block + $+$ withPprStyle defaultDumpStyle (pdoc (ncgPlatform config) block) ) + | otherwise = nilOL -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of ===================================== 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 pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ + then pprAsmLabel 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 pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' + then pprAsmLabel 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 " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -75,7 +75,7 @@ pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeDecl platform lbl - $$ (pdoc platform lbl <> char ':') + $$ (pprAsmLabel platform lbl <> char ':') pprAlign :: Platform -> Alignment -> SDoc pprAlign _platform alignment @@ -105,7 +105,7 @@ pprSectionAlign config sec@(Section seg _) = pprSizeDecl :: Platform -> CLabel -> SDoc pprSizeDecl platform lbl = if osElfTarget (platformOS platform) - then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl + then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl else empty pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr @@ -115,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ (if ncgDwarfEnabled config - then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' + then pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) where @@ -135,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform info_lbl $$ c $$ (if ncgDwarfEnabled config - then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':' + then pprAsmLabel 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] @@ -153,7 +153,7 @@ pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl (ncgPlatform config) alias - $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind' pprDatas config (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData config) dats) @@ -175,7 +175,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text "\t.globl " <> pdoc platform lbl + | otherwise = text "\t.globl " <> pprAsmLabel platform lbl -- Note [Always use objects for info tables] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -201,7 +201,7 @@ pprLabelType' platform lbl = pprTypeDecl :: Platform -> CLabel -> SDoc pprTypeDecl platform lbl = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl - then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl + then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl else empty pprDataItem :: NCGConfig -> CmmLit -> SDoc @@ -230,8 +230,8 @@ pprDataItem config lit pprImm :: Platform -> Imm -> SDoc 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 p (ImmCLbl l) = pprAsmLabel p l +pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i pprImm _ (ImmLit s) = text s -- TODO: See pprIm below for why this is a bad idea! @@ -279,8 +279,8 @@ pprIm platform im = case im of ImmDouble d | d == 0 -> text "xzr" ImmDouble d -> char '#' <> double (fromRational d) -- = pseudo instruction! - ImmCLbl l -> char '=' <> pdoc platform l - ImmIndex l o -> text "[=" <> pdoc platform l <> comma <+> char '#' <> int o <> char ']' + ImmCLbl l -> char '=' <> pprAsmLabel platform l + ImmIndex l o -> text "[=" <> pprAsmLabel platform l <> comma <+> char '#' <> int o <> char ']' _ -> panic "AArch64.pprIm" pprExt :: ExtMode -> SDoc @@ -430,28 +430,28 @@ pprInstr platform instr = case instr of -- 4. Branch Instructions ---------------------------------------------------- J t -> pprInstr platform (B t) - B (TBlock bid) -> text "\tb" <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - B (TLabel lbl) -> text "\tb" <+> pdoc platform lbl + B (TBlock bid) -> text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + B (TLabel lbl) -> text "\tb" <+> pprAsmLabel platform lbl B (TReg r) -> text "\tbr" <+> pprReg W64 r - BL (TBlock bid) _ _ -> text "\tbl" <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - BL (TLabel lbl) _ _ -> text "\tbl" <+> pdoc platform lbl + BL (TBlock bid) _ _ -> text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BL (TLabel lbl) _ _ -> text "\tbl" <+> pprAsmLabel platform lbl BL (TReg r) _ _ -> text "\tblr" <+> pprReg W64 r - BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pdoc platform lbl + BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pprAsmLabel platform lbl BCOND _ (TReg _) -> panic "AArch64.ppr: No conditional branching to registers!" -- 5. Atomic Instructions ---------------------------------------------------- -- 6. Conditional Instructions ----------------------------------------------- CSET o c -> text "\tcset" <+> pprOp platform o <> comma <+> pprCond c - CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform lbl + CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl CBZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbz) branching to registers!" - CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid)) - CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform lbl + CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl CBNZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!" -- 7. Load and Store Instructions -------------------------------------------- @@ -466,58 +466,58 @@ pprInstr platform instr = case instr of #if defined(darwin_HOST_OS) LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" #else LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl $$ + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl $$ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$ - text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" + text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$ + text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" LDR _f o1 (OpImm (ImmCLbl lbl)) -> - text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$ - text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl + text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$ + text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl #endif LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> ===================================== compiler/GHC/CmmToAsm/Dwarf.hs ===================================== @@ -51,8 +51,8 @@ dwarfGen config modLoc us blocks = do , dwName = fromMaybe "" (ml_hs_file modLoc) , dwCompDir = addTrailingPathSeparator compPath , dwProducer = cProjectName ++ " " ++ cProjectVersion - , dwLowLabel = pdoc platform lowLabel - , dwHighLabel = pdoc platform highLabel + , dwLowLabel = pprAsmLabel platform lowLabel + , dwHighLabel = pprAsmLabel platform highLabel , dwLineLabel = dwarfLineLabel } @@ -109,9 +109,9 @@ mkDwarfARange proc = DwarfARange lbl end compileUnitHeader :: Platform -> Unique -> SDoc compileUnitHeader platform unitU = let cuLabel = mkAsmTempLabel unitU -- sits right before initialLength field - length = pdoc platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pdoc platform cuLabel + length = pprAsmLabel platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pprAsmLabel platform cuLabel <> text "-4" -- length of initialLength field - in vcat [ pdoc platform cuLabel <> colon + in vcat [ pprAsmLabel platform cuLabel <> colon , text "\t.long " <> length -- compilation unit size , pprHalf 3 -- DWARF version , sectionOffset platform dwarfAbbrevLabel dwarfAbbrevLabel @@ -123,7 +123,7 @@ compileUnitHeader platform unitU = compileUnitFooter :: Platform -> Unique -> SDoc compileUnitFooter platform unitU = let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU - in pdoc platform cuEndLabel <> colon + in pprAsmLabel platform cuEndLabel <> colon -- | Splits the blocks by procedures. In the result all nested blocks -- will come from the same procedure as the top-level block. See ===================================== compiler/GHC/CmmToAsm/Dwarf/Types.hs ===================================== @@ -184,14 +184,14 @@ pprDwarfInfoOpen platform haveSrc (DwarfCompileUnit _ name producer compDir lowL then sectionOffset platform lineLbl dwarfLineLabel else empty pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev abbrev $$ pprString name $$ pprLabelString platform label $$ pprFlag (externallyVisibleCLabel label) -- Offset due to Note [Info Offset] - $$ pprWord platform (pdoc platform label <> text "-1") - $$ pprWord platform (pdoc platform $ mkAsmTempProcEndLabel label) + $$ pprWord platform (pprAsmLabel platform label <> text "-1") + $$ pprWord platform (pprAsmLabel platform $ mkAsmTempProcEndLabel label) $$ pprByte 1 $$ pprByte dW_OP_call_frame_cfa $$ parentValue @@ -199,17 +199,17 @@ pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) = abbrev = case parent of Nothing -> DwAbbrSubprogram Just _ -> DwAbbrSubprogramWithParent parentValue = maybe empty pprParentDie parent - pprParentDie sym = sectionOffset platform (pdoc platform sym) dwarfInfoLabel + pprParentDie sym = sectionOffset platform (pprAsmLabel platform sym) dwarfInfoLabel pprDwarfInfoOpen platform _ (DwarfBlock _ label Nothing) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev DwAbbrBlockWithoutCode $$ pprLabelString platform label pprDwarfInfoOpen platform _ (DwarfBlock _ label (Just marker)) = - pdoc platform (mkAsmTempDieLabel label) <> colon + pprAsmLabel platform (mkAsmTempDieLabel label) <> colon $$ pprAbbrev DwAbbrBlock $$ pprLabelString platform label - $$ pprWord platform (pdoc platform marker) - $$ pprWord platform (pdoc platform $ mkAsmTempEndLabel marker) + $$ pprWord platform (pprAsmLabel platform marker) + $$ pprWord platform (pprAsmLabel platform $ mkAsmTempEndLabel marker) pprDwarfInfoOpen _ _ (DwarfSrcNote ss) = pprAbbrev DwAbbrGhcSrcNote $$ pprString' (ftext $ srcSpanFile ss) @@ -245,7 +245,7 @@ pprDwarfARanges platform arngs unitU = initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize in pprDwWord (ppr initialLength) $$ pprHalf 2 - $$ sectionOffset platform (pdoc platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel + $$ sectionOffset platform (pprAsmLabel platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel $$ pprByte (fromIntegral wordSize) $$ pprByte 0 $$ pad paddingSize @@ -258,11 +258,11 @@ pprDwarfARanges platform arngs unitU = pprDwarfARange :: Platform -> DwarfARange -> SDoc pprDwarfARange platform arng = -- Offset due to Note [Info Offset]. - pprWord platform (pdoc platform (dwArngStartLabel arng) <> text "-1") + pprWord platform (pprAsmLabel platform (dwArngStartLabel arng) <> text "-1") $$ pprWord platform length where - length = pdoc platform (dwArngEndLabel arng) - <> char '-' <> pdoc platform (dwArngStartLabel arng) + length = pprAsmLabel platform (dwArngEndLabel arng) + <> char '-' <> pprAsmLabel platform (dwArngStartLabel arng) -- | Information about unwind instructions for a procedure. This -- corresponds to a "Common Information Entry" (CIE) in DWARF. @@ -293,7 +293,7 @@ data DwarfFrameBlock -- in the block } -instance OutputableP env CLabel => OutputableP env DwarfFrameBlock where +instance OutputableP Platform DwarfFrameBlock where pdoc env (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> pdoc env unwinds -- | Header for the @.debug_frame@ section. Here we emit the "Common @@ -303,7 +303,7 @@ pprDwarfFrame :: Platform -> DwarfFrame -> SDoc pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs} = let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit "_start") cieEndLabel = mkAsmTempEndLabel cieLabel - length = pdoc platform cieEndLabel <> char '-' <> pdoc platform cieStartLabel + length = pprAsmLabel platform cieEndLabel <> char '-' <> pprAsmLabel platform cieStartLabel spReg = dwarfGlobalRegNo platform Sp retReg = dwarfReturnRegNo platform wordSize = platformWordSizeInBytes platform @@ -316,9 +316,9 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro ArchX86 -> pprByte dW_CFA_same_value $$ pprLEBWord 4 ArchX86_64 -> pprByte dW_CFA_same_value $$ pprLEBWord 7 _ -> empty - in vcat [ pdoc platform cieLabel <> colon + in vcat [ pprAsmLabel platform cieLabel <> colon , pprData4' length -- Length of CIE - , pdoc platform cieStartLabel <> colon + , pprAsmLabel platform cieStartLabel <> colon , pprData4' (text "-1") -- Common Information Entry marker (-1 = 0xf..f) , pprByte 3 -- CIE version (we require DWARF 3) @@ -346,7 +346,7 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro , pprLEBWord 0 ] $$ wordAlign platform $$ - pdoc platform cieEndLabel <> colon $$ + pprAsmLabel platform cieEndLabel <> colon $$ -- Procedure unwind tables vcat (map (pprFrameProc platform cieLabel cieInit) procs) @@ -360,17 +360,17 @@ pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks) procEnd = mkAsmTempProcEndLabel procLbl ifInfo str = if hasInfo then text str else empty -- see Note [Info Offset] - in vcat [ whenPprDebug $ text "# Unwinding for" <+> pdoc platform procLbl <> colon - , pprData4' (pdoc platform fdeEndLabel <> char '-' <> pdoc platform fdeLabel) - , pdoc platform fdeLabel <> colon - , pprData4' (pdoc platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE - , pprWord platform (pdoc platform procLbl <> ifInfo "-1") -- Code pointer - , pprWord platform (pdoc platform procEnd <> char '-' <> - pdoc platform procLbl <> ifInfo "+1") -- Block byte length + in vcat [ whenPprDebug $ text "# Unwinding for" <+> pprAsmLabel platform procLbl <> colon + , pprData4' (pprAsmLabel platform fdeEndLabel <> char '-' <> pprAsmLabel platform fdeLabel) + , pprAsmLabel platform fdeLabel <> colon + , pprData4' (pprAsmLabel platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE + , pprWord platform (pprAsmLabel platform procLbl <> ifInfo "-1") -- Code pointer + , pprWord platform (pprAsmLabel platform procEnd <> char '-' <> + pprAsmLabel platform procLbl <> ifInfo "+1") -- Block byte length ] $$ vcat (S.evalState (mapM (pprFrameBlock platform) blocks) initUw) $$ wordAlign platform $$ - pdoc platform fdeEndLabel <> colon + pprAsmLabel platform fdeEndLabel <> colon -- | Generates unwind information for a block. We only generate -- instructions where unwind information actually changes. This small @@ -402,7 +402,7 @@ pprFrameBlock platform (DwarfFrameBlock hasInfo uws0) = then (empty, oldUws) else let -- see Note [Info Offset] needsOffset = firstDecl && hasInfo - lblDoc = pdoc platform lbl <> + lblDoc = pprAsmLabel platform lbl <> if needsOffset then text "-1" else empty doc = pprByte dW_CFA_set_loc $$ pprWord platform lblDoc $$ vcat (map (uncurry $ pprSetUnwind platform) changed) @@ -513,7 +513,7 @@ pprUnwindExpr platform spIsCFA expr pprE (UwReg g i) = pprByte (dW_OP_breg0+dwarfGlobalRegNo platform g) $$ pprLEBInt i pprE (UwDeref u) = pprE u $$ pprByte dW_OP_deref - pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pdoc platform l) + pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pprAsmLabel platform l) pprE (UwPlus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus pprE (UwMinus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus pprE (UwTimes u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul ===================================== compiler/GHC/CmmToAsm/PIC.hs ===================================== @@ -729,7 +729,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of _ -> panic "PIC.pprImportedSymbol: no match" where platform = ncgPlatform config - ppr_lbl = pprCLabel platform AsmStyle + ppr_lbl = pprAsmLabel platform arch = platformArch platform os = platformOS platform pic = ncgPIC config ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -63,7 +63,7 @@ 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) $$ - ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel lbl) + ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':' $$ pprProcEndLabel platform lbl) $$ pprSizeDecl platform lbl @@ -71,7 +71,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = Just (CmmStaticsRaw info_lbl _) -> pprSectionAlign config (Section Text info_lbl) $$ (if platformHasSubsectionsViaSymbols platform - then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':' + then pprAsmLabel 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 @@ -80,9 +80,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = then -- See Note [Subsections Via Symbols] in X86/Ppr.hs text "\t.long " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -93,7 +93,7 @@ pprSizeDecl platform lbl then text "\t.size" <+> prettyLbl <> text ", .-" <> codeLbl else empty where - prettyLbl = pdoc platform lbl + prettyLbl = pprAsmLabel platform lbl codeLbl | platformArch platform == ArchPPC_64 ELF_V1 = char '.' <> prettyLbl | otherwise = prettyLbl @@ -102,33 +102,33 @@ pprFunctionDescriptor :: Platform -> CLabel -> SDoc pprFunctionDescriptor platform lab = pprGloblDecl platform lab $$ text "\t.section \".opd\", \"aw\"" $$ text "\t.align 3" - $$ pdoc platform lab <> char ':' + $$ pprAsmLabel platform lab <> char ':' $$ text "\t.quad ." - <> pdoc platform lab + <> pprAsmLabel platform lab <> text ",.TOC. at tocbase,0" $$ text "\t.previous" $$ text "\t.type" - <+> pdoc platform lab + <+> pprAsmLabel platform lab <> text ", @function" - $$ char '.' <> pdoc platform lab <> char ':' + $$ char '.' <> pprAsmLabel platform lab <> char ':' pprFunctionPrologue :: Platform -> CLabel ->SDoc pprFunctionPrologue platform lab = pprGloblDecl platform lab $$ text ".type " - <> pdoc platform lab + <> pprAsmLabel platform lab <> text ", @function" - $$ pdoc platform lab <> char ':' + $$ pprAsmLabel platform lab <> char ':' $$ text "0:\taddis\t" <> pprReg toc <> text ",12,.TOC.-0b at ha" $$ text "\taddi\t" <> pprReg toc <> char ',' <> pprReg toc <> text ",.TOC.-0b at l" - $$ text "\t.localentry\t" <> pdoc platform lab - <> text ",.-" <> pdoc platform lab + $$ text "\t.localentry\t" <> pprAsmLabel platform lab + <> text ",.-" <> pprAsmLabel platform lab pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name -> SDoc pprProcEndLabel platform lbl = - pdoc platform (mkAsmTempProcEndLabel lbl) <> char ':' + pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> char ':' pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc @@ -137,7 +137,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) pprLabel platform asmLbl $$ vcat (map (pprInstr platform) instrs) $$ ppWhen (ncgDwarfEnabled config) ( - pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':' + pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':' <> pprProcEndLabel platform asmLbl ) where @@ -162,7 +162,7 @@ pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLi , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl platform alias - $$ text ".equiv" <+> pdoc platform alias <> comma <> pdoc platform (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind' pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats) pprData :: Platform -> CmmStatic -> SDoc @@ -175,20 +175,20 @@ pprData platform d = case d of pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text ".globl " <> pdoc platform lbl + | otherwise = text ".globl " <> pprAsmLabel platform lbl pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc pprTypeAndSizeDecl platform lbl = if platformOS platform == OSLinux && externallyVisibleCLabel lbl then text ".type " <> - pdoc platform lbl <> text ", @object" + pprAsmLabel platform lbl <> text ", @object" else empty pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeAndSizeDecl platform lbl - $$ (pdoc platform lbl <> char ':') + $$ (pprAsmLabel platform lbl <> char ':') -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' @@ -238,8 +238,8 @@ pprImm :: Platform -> Imm -> SDoc pprImm platform = \case ImmInt i -> int i ImmInteger i -> integer i - ImmCLbl l -> pdoc platform l - ImmIndex l i -> pdoc platform l <> char '+' <> int i + ImmCLbl l -> pprAsmLabel platform l + ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d @@ -559,7 +559,7 @@ pprInstr platform instr = case instr of pprCond cond, pprPrediction prediction, char '\t', - pdoc platform lbl + pprAsmLabel platform lbl ] where lbl = mkLocalBlockLabel (getUnique blockid) pprPrediction p = case p of @@ -577,7 +577,7 @@ pprInstr platform instr = case instr of ], hcat [ text "\tb\t", - pdoc platform lbl + pprAsmLabel platform lbl ] ] where lbl = mkLocalBlockLabel (getUnique blockid) @@ -594,7 +594,7 @@ pprInstr platform instr = case instr of char '\t', text "b", char '\t', - pdoc platform lbl + pprAsmLabel platform lbl ] MTCTR reg @@ -625,12 +625,12 @@ pprInstr platform instr = case instr of -- they'd technically be more like 'ForeignLabel's. hcat [ text "\tbl\t.", - pdoc platform lbl + pprAsmLabel platform lbl ] _ -> hcat [ text "\tbl\t", - pdoc platform lbl + pprAsmLabel platform lbl ] BCTRL _ ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -210,7 +210,7 @@ pprGNUSectionHeader config t suffix = platform = ncgPlatform config splitSections = ncgSplitSections config subsection - | splitSections = sep <> pdoc platform suffix + | splitSections = sep <> pprAsmLabel platform suffix | otherwise = empty header = case t of Text -> text ".text" ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -93,7 +93,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprProcAlignment config $$ pprProcLabel config lbl $$ (if platformHasSubsectionsViaSymbols platform - then pdoc platform (mkDeadStripPreventer info_lbl) <> colon + then pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> colon else empty) $$ vcat (map (pprBasicBlock config top_info) blocks) $$ ppWhen (ncgDwarfEnabled config) (pprProcEndLabel platform info_lbl) $$ @@ -102,9 +102,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = (if platformHasSubsectionsViaSymbols platform then -- See Note [Subsections Via Symbols] text "\t.long " - <+> pdoc platform info_lbl + <+> pprAsmLabel platform info_lbl <+> char '-' - <+> pdoc platform (mkDeadStripPreventer info_lbl) + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -120,18 +120,18 @@ pprProcLabel config lbl pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name -> SDoc pprProcEndLabel platform lbl = - pdoc platform (mkAsmTempProcEndLabel lbl) <> colon + pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon pprBlockEndLabel :: Platform -> CLabel -- ^ Block name -> SDoc pprBlockEndLabel platform lbl = - pdoc platform (mkAsmTempEndLabel lbl) <> colon + pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon -- | Output the ELF .size directive. pprSizeDecl :: Platform -> CLabel -> SDoc pprSizeDecl platform lbl = if osElfTarget (platformOS platform) - then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl + then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl else empty pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc @@ -156,7 +156,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) vcat (map (pprData config) info) $$ pprLabel platform infoLbl $$ c $$ - ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel infoLbl) <> colon) + ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel infoLbl) <> colon) -- Make sure the info table has the right .loc for the block -- coming right after it. See Note [Info Offset] @@ -175,7 +175,7 @@ pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticL , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' = pprGloblDecl (ncgPlatform config) alias - $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind') + $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind' pprDatas config (align, (CmmStaticsRaw lbl dats)) = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats) @@ -197,7 +197,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit pprGloblDecl :: Platform -> CLabel -> SDoc pprGloblDecl platform lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = text ".globl " <> pdoc platform lbl + | otherwise = text ".globl " <> pprAsmLabel platform lbl pprLabelType' :: Platform -> CLabel -> SDoc pprLabelType' platform lbl = @@ -260,14 +260,14 @@ pprLabelType' platform lbl = pprTypeDecl :: Platform -> CLabel -> SDoc pprTypeDecl platform lbl = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl - then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl + then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl else empty pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl platform lbl $$ pprTypeDecl platform lbl - $$ (pdoc platform lbl <> colon) + $$ (pprAsmLabel platform lbl <> colon) pprAlign :: Platform -> Alignment -> SDoc pprAlign platform alignment @@ -430,8 +430,8 @@ pprImm :: Platform -> Imm -> SDoc pprImm platform = \case ImmInt i -> int i ImmInteger i -> integer i - ImmCLbl l -> pdoc platform l - ImmIndex l i -> pdoc platform l <> char '+' <> int i + ImmCLbl l -> pprAsmLabel platform l + ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i ImmLit s -> text s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d @@ -576,7 +576,7 @@ pprInstr platform i = case i of UNWIND lbl d -> asmComment (text "\tunwind = " <> pdoc platform d) - $$ pdoc platform lbl <> colon + $$ pprAsmLabel platform lbl <> colon LDATA _ _ -> panic "pprInstr: LDATA" @@ -818,7 +818,7 @@ pprInstr platform i = case i of -> pprFormatOpReg (text "xchg") format src val JXX cond blockid - -> pprCondInstr (text "j") cond (pdoc platform lab) + -> pprCondInstr (text "j") cond (pprAsmLabel platform lab) where lab = blockLbl blockid JXX_GBL cond imm ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -1705,7 +1705,6 @@ genMachOp_slow opt op [x, y] = case op of where binLlvmOp ty binOp allow_y_cast = do - cfg <- getConfig platform <- getPlatform runExprData $ do vx <- exprToVarW x @@ -1721,13 +1720,7 @@ genMachOp_slow opt op [x, y] = case op of doExprW (ty vx) $ binOp vx vy' | otherwise - -> do - -- Error. Continue anyway so we can debug the generated ll file. - let render = renderWithContext (llvmCgContext cfg) - cmmToStr = (lines . render . pdoc platform) - statement $ Comment $ map fsLit $ cmmToStr x - statement $ Comment $ map fsLit $ cmmToStr y - doExprW (ty vx) $ binOp vx vy + -> pprPanic "binLlvmOp types" (pdoc platform x $$ pdoc platform y) binCastLlvmOp ty binOp = runExprData $ do vx <- exprToVarW x ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -173,7 +173,7 @@ outputC logger dflags filenm cmm_stream unit_deps = "C backend output" FormatC doc - let ctx = initSDocContext dflags (PprCode CStyle) + let ctx = initSDocContext dflags PprCode printSDocLn ctx LeftMode h doc Stream.consume cmm_stream id writeC @@ -253,11 +253,11 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs ForeignStubs (CHeader h_code) (CStub c_code _ _) -> do let - stub_c_output_d = pprCode CStyle c_code + stub_c_output_d = pprCode c_code stub_c_output_w = showSDoc dflags stub_c_output_d -- Header file protos for "foreign export"ed functions. - stub_h_output_d = pprCode CStyle h_code + stub_h_output_d = pprCode h_code stub_h_output_w = showSDoc dflags stub_h_output_d createDirectoryIfMissing True (takeDirectory stub_h) @@ -330,6 +330,7 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) = {-# SCC profilingInitCode #-} initializerCStub platform fn_name decls body where + pdocC = pprCLabel platform CStyle fn_name = mkInitializerStubLabel this_mod "prof_init" decls = vcat $ map emit_cc_decl local_CCs @@ -342,22 +343,22 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) ] emit_cc_decl cc = text "extern CostCentre" <+> cc_lbl <> text "[];" - where cc_lbl = pdoc platform (mkCCLabel cc) + where cc_lbl = pdocC (mkCCLabel cc) local_cc_list_label = text "local_cc_" <> ppr this_mod emit_cc_list ccs = text "static CostCentre *" <> local_cc_list_label <> text "[] =" - <+> braces (vcat $ [ pdoc platform (mkCCLabel cc) <> comma + <+> braces (vcat $ [ pdocC (mkCCLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi emit_ccs_decl ccs = text "extern CostCentreStack" <+> ccs_lbl <> text "[];" - where ccs_lbl = pdoc platform (mkCCSLabel ccs) + where ccs_lbl = pdocC (mkCCSLabel ccs) singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod emit_ccs_list ccs = text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] =" - <+> braces (vcat $ [ pdoc platform (mkCCSLabel cc) <> comma + <+> braces (vcat $ [ pdocC (mkCCSLabel cc) <> comma | cc <- ccs ] ++ [text "NULL"]) <> semi ===================================== compiler/GHC/Driver/Config/CmmToAsm.hs ===================================== @@ -18,7 +18,7 @@ initNCGConfig :: DynFlags -> Module -> NCGConfig initNCGConfig dflags this_mod = NCGConfig { ncgPlatform = targetPlatform dflags , ncgThisModule = this_mod - , ncgAsmContext = initSDocContext dflags (PprCode AsmStyle) + , ncgAsmContext = initSDocContext dflags PprCode , ncgProcAlignment = cmmProcAlignment dflags , ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags , ncgPIC = positionIndependent dflags ===================================== compiler/GHC/Driver/Config/CmmToLlvm.hs ===================================== @@ -20,7 +20,7 @@ initLlvmCgConfig logger config_cache dflags = do llvm_config <- readLlvmConfigCache config_cache pure $! LlvmCgConfig { llvmCgPlatform = targetPlatform dflags - , llvmCgContext = initSDocContext dflags (PprCode CStyle) + , llvmCgContext = initSDocContext dflags PprCode , llvmCgFillUndefWithGarbage = gopt Opt_LlvmFillUndefWithGarbage dflags , llvmCgSplitSection = gopt Opt_SplitSections dflags , llvmCgBmiVersion = case platformArch (targetPlatform dflags) of ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -606,7 +606,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" 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)) + writeFile empty_stub (showSDoc dflags (pprCode src)) 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 ===================================== compiler/GHC/HsToCore/Foreign/C.hs ===================================== @@ -333,7 +333,7 @@ dsFCall fn_id co fcall mDeclHeader = do toCName :: Id -> String -toCName i = renderWithContext defaultSDocContext (pprCode CStyle (ppr (idName i))) +toCName i = renderWithContext defaultSDocContext (pprCode (ppr (idName i))) toCType :: Type -> (Maybe Header, SDoc) toCType = f False ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -249,11 +249,11 @@ sptModuleInitCode platform this_mod entries = [ text "static StgWord64 k" <> int i <> text "[2] = " <> pprFingerprint fp <> semi $$ text "extern StgPtr " - <> (pdoc platform $ mkClosureLabel (idName n) (idCafInfo n)) <> semi + <> (pprCLabel platform CStyle $ mkClosureLabel (idName n) (idCafInfo n)) <> semi $$ text "hs_spt_insert" <> parens (hcat $ punctuate comma [ char 'k' <> int i - , char '&' <> pdoc platform (mkClosureLabel (idName n) (idCafInfo n)) + , char '&' <> pprCLabel platform CStyle (mkClosureLabel (idName n) (idCafInfo n)) ] ) <> semi ===================================== compiler/GHC/StgToCmm/Layout.hs ===================================== @@ -297,7 +297,7 @@ direct_call caller call_conv lbl arity args platform <- getPlatform pprPanic "direct_call" $ text caller <+> ppr arity <+> - pdoc platform lbl <+> ppr (length args) <+> + pprDebugCLabel platform lbl <+> ppr (length args) <+> pdoc platform (map snd args) <+> ppr (map fst args) | null rest_args -- Precisely the right number of arguments ===================================== 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 <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) + _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pprDebugCLabel (profilePlatform profile) (mkInfoTableLabel name NoCafRefs)) return $! zeroCLit platform TickyLNE {} -> return $! zeroCLit platform ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -332,7 +332,7 @@ jsonLogAction _ (MCDiagnostic SevIgnore _) _ _ = return () -- suppress the messa jsonLogAction logflags msg_class srcSpan msg = defaultLogActionHPutStrDoc logflags True stdout - (withPprStyle (PprCode CStyle) (doc $$ text "")) + (withPprStyle PprCode (doc $$ text "")) where str = renderWithContext (log_default_user_context logflags) msg doc = renderJSON $ ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -96,7 +96,7 @@ module GHC.Utils.Outputable ( defaultSDocContext, traceSDocContext, getPprStyle, withPprStyle, setStyleColoured, pprDeeper, pprDeeperList, pprSetDepth, - codeStyle, userStyle, dumpStyle, asmStyle, + codeStyle, userStyle, dumpStyle, qualName, qualModule, qualPackage, mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle, mkUserStyle, cmdlineParserStyle, Depth(..), @@ -170,7 +170,7 @@ data PprStyle -- Does not assume tidied code: non-external names -- are printed with uniques. - | PprCode !LabelStyle -- ^ Print code; either C or assembler + | PprCode -- ^ Print code; either C or assembler -- | Style of label pretty-printing. -- @@ -550,12 +550,8 @@ queryQual s = QueryQualify (qualName s) (qualPackage s) codeStyle :: PprStyle -> Bool -codeStyle (PprCode _) = True -codeStyle _ = False - -asmStyle :: PprStyle -> Bool -asmStyle (PprCode AsmStyle) = True -asmStyle _other = False +codeStyle PprCode = True +codeStyle _ = False dumpStyle :: PprStyle -> Bool dumpStyle (PprDump {}) = True @@ -603,9 +599,9 @@ bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO () bufLeftRenderSDoc ctx bufHandle doc = Pretty.bufLeftRender bufHandle (runSDoc doc ctx) -pprCode :: LabelStyle -> SDoc -> SDoc +pprCode :: SDoc -> SDoc {-# INLINE CONLIKE pprCode #-} -pprCode cs d = withPprStyle (PprCode cs) d +pprCode d = withPprStyle PprCode d renderWithContext :: SDocContext -> SDoc -> String renderWithContext ctx sdoc ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -48,9 +48,11 @@ T15723: '$(TEST_HC)' $(TEST_HC_OPTS) -dynamic -shared T15723B.o -o T15723B.so # Check that the static indirection b is compiled to an equiv directive +# This will be .equiv T15155_b_closure,T15155_a_closure +# or .equiv _T15155_b_closure,_T15155_a_closure on Darwin T15155: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 -ddump-asm T15155l.hs | \ - grep -F ".equiv T15155.b_closure,T15155.a_closure" + grep -F ".equiv" # Same as above, but in LLVM. Check that the static indirection b is compiled to # an alias. ===================================== testsuite/tests/codeGen/should_compile/T15155.stdout-darwin ===================================== @@ -0,0 +1 @@ +.equiv _T15155.b_closure,_T15155.a_closure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5e0f086a43c4e830f3fec343917daf3cc24b73a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5e0f086a43c4e830f3fec343917daf3cc24b73a You're receiving 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 26 19:06:51 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 Aug 2022 15:06:51 -0400 Subject: [Git][ghc/ghc][master] boot: cleanup legacy args Message-ID: <630919cbd4b17_e9d7d4d1d415104e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 2 changed files: - boot - validate Changes: ===================================== boot ===================================== @@ -4,19 +4,11 @@ import glob import os import os.path import sys -import argparse from textwrap import dedent import subprocess import re import shutil -cwd = os.getcwd() - -parser = argparse.ArgumentParser() -parser.add_argument('--validate', action='store_true', help='Run in validate mode') -parser.add_argument('--hadrian', action='store_true', help='Do not assume the make base build system') -args = parser.parse_args() - # Packages whose libraries aren't in the submodule root EXCEPTIONS = { 'libraries/containers/': 'libraries/containers/containers/' ===================================== validate ===================================== @@ -259,7 +259,7 @@ if [ $build_only -eq 1 ] || if [ $no_clean -eq 0 ]; then $hadrian clean && rm -rf $hadrian_build_root - python3 ./boot --validate + python3 ./boot $configure_cmd --enable-tarballs-autodownload $CONFIG_ARGS fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1007829bfb18708dda77b4eb6106fce9cb05f908 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1007829bfb18708dda77b4eb6106fce9cb05f908 You're receiving 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 26 19:37:43 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 Aug 2022 15:37:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Pmc: consider any 2 dicts of the same type equal Message-ID: <63092107cc4b7_e9d7d268fc250151826@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 6b530b46 by Simon Peyton Jones at 2022-08-26T15:37:27-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 7965d609 by Matthew Pickering at 2022-08-26T15:37:29-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - c8da1684 by Matthew Pickering at 2022-08-26T15:37:29-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - cd20fefa by Matthew Pickering at 2022-08-26T15:37:29-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - 4d6ae3e9 by Matthew Pickering at 2022-08-26T15:37:29-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 30 changed files: - boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/StgToCmm/Layout.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/93b5733a5f8996da728e3d18f41a46266c556d9d...4d6ae3e91997b56ebfe129e97ed4f58657993814 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/93b5733a5f8996da728e3d18f41a46266c556d9d...4d6ae3e91997b56ebfe129e97ed4f58657993814 You're receiving 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 26 20:42:49 2022 From: gitlab at gitlab.haskell.org (doyougnu (@doyougnu)) Date: Fri, 26 Aug 2022 16:42:49 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 211 commits: Print constraints in quotes (#21167) Message-ID: <6309304996daf_e9d7d48878152603d@gitlab.mail> doyougnu pushed to branch wip/js-staging 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 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - de5ecdd2 by Josh Meredith at 2022-08-26T13:56:41-04:00 Add ghcjs changes to deriveConstants: - change String targetOS option in deriveConstants to an enum - separate out getWantedGHSJS, removing generated c file in this path - - - - - 9457d21f by doyougnu at 2022-08-26T13:56:44-04:00 Add JavaScript code generator Adapt code generator of GHCJS to GHC head. Currently it is only enabled with the hidden -fjavascript flag. It produces .o files that can't be used yet except by GHCJS's linker. Codegen: doc Codegen: correctly return linkable object Now we can build a static library (-staticlib) Codegen: doc genLit Codegen: use assignAll Codegen: introduce TypedExpr Refactor assignAll et al, add documentation Codegen: minor changes Doc - - - - - 757cad7e by doyougnu at 2022-08-26T13:56:44-04:00 Add JS.Rts JS.Rts: compiles reword: progress on RtsTypes StgToJS.Config: add SDoc Context JSRts: move ppr, workaround def type JSRts.Types: compiles JS.Rts: closer to compiling JS.Rts: move jsIdIdent' to StgToJS.Monad JS.Rts: remove unused predicates JS: cleanup, comment sections, math funcs to Make JS.Rts.Types: compiles StgToJS.Expr: fix compilation errors StgToJS.DataCon: move initClosure JS.Rts: remove Alloc module JS.Rts: initalize Rts module, remove redundant fs JS: init Rts.Alloc move initClosure JS.Apply: unwinding combinators in progress JS: add helpers and fixmes JS.Rts.Apply: no more e's, add closure, reg helper StgToJS: add ToStat instance ClosureInfo JS.Rts.Apply: closer to compiling JS.Rts.Apply: more removal of # JS.Rts.Apply: (#) removed JS.Rts.Apply: compiles JS.Rts.Rts: just pretty printing left JS.Rts: Add Notes JS.Rts: add file headers and notes JS.Rts.Rts: fixing stringy issues JS.Rts.Rts: compiles JS.Rts.Rts: fix non-exhaustive patterns warnings - - - - - ca7676d4 by Sylvain Henry at 2022-08-26T13:56:44-04:00 Doc has been moved into GHC.StgToJs top-level module - - - - - 0f199ed0 by Sylvain Henry at 2022-08-26T13:56:44-04:00 JS.Rts; refactoring and move to StgToJS * add closure manipulation helpers and use them in Apply * add cache (Array) for pre-generated PAP names * reduce line length: * use BlockArguments instead of parens * remove implicit mconcat in jVar's body Rts: more refactorings Rts: move into StgToJS hierarchy - - - - - 7069d8d8 by Sylvain Henry at 2022-08-26T13:56:44-04:00 JS: cleanup, renaming, better module layout Various degrees of cleanup adapting GHCJS to GHC. We move several functions to CoreUtils, remove duplication between the JS.Rts.Apply and Apply module and factor out closure related code into a Closure module for cohesion. Deduplicate code between Rts.Apply and Apply Move might_be_a_function into CoreUtils Factorize closure stuff into Closure module Rename closureExtra into closureField Minor renamings, comments... - - - - - 2c35ea8a by Sylvain Henry at 2022-08-26T13:56:45-04:00 JS.Backend: add FFI code but don't implement yet FFI: don't crash on JavaScript foreign imports Note that they are still not desugared properly!! But the following cmd doesn't crash anymore: ghc -fjavascript Test.hs -fforce-recomp -ddump-tc -fno-code -ddump-ds FFI: adapt GHCJS desugarer FFI: support direct application The following example: foo :: Int# -> Int# foo = add 50000# foreign import javascript "(function(x,y) { return (x + y) })" add :: Int# -> Int# -> Int# is compiled into an application like this: var h$mainZCMzifoozur2_e; h$mainZCMzifoozur2_e = (function() { var h$mainZCMziaddzur1; h$mainZCMziaddzur1 = h$r1.d1; var h$$mainZCMzietazuB0_8KXnScrCjF5; h$$mainZCMzietazuB0_8KXnScrCjF5 = h$r2; h$r3 = h$$mainZCMzietazuB0_8KXnScrCjF5; h$r2 = 50000; h$r1 = h$mainZCMziaddzur1; return h$ap_2_2_fast(); return h$rs(); }); var h$mainZCMziaddzur1_e; h$mainZCMziaddzur1_e = (function() { var h$$mainZCMzidszusAk_236l8r0P8S9; h$$mainZCMzidszusAk_236l8r0P8S9 = h$r2; var h$$mainZCMzids1zusAl_336l8r0P8S9; h$$mainZCMzids1zusAl_336l8r0P8S9 = h$r3; var h$$mainZCM_2; var h$$mainZCMziwildzusAn_536l8r0P8S9; try { h$$mainZCMziwildzusAn_536l8r0P8S9 = (function(x,y) { return (x + y) })(h$$mainZCMzidszusAk_236l8r0P8S9, h$$mainZCMzids1zusAl_336l8r0P8S9) } catch(except) { return h$throwJSException(except) }; var h$$mainZCMzids3zusAp_736l8r0P8S9; h$$mainZCMzids3zusAp_736l8r0P8S9 = h$$mainZCMziwildzusAn_536l8r0P8S9; h$r1 = h$$mainZCMzids3zusAp_736l8r0P8S9; return h$rs(); }); FFI: correctly dispatch for foreign exports too FFI: move C FFI desugaring into its own module FFI: avoid DynFlags in toJsName (copy of toCName) - - - - - ffa99577 by Sylvain Henry at 2022-08-26T13:56:45-04:00 Configure: preliminary support for triple js-unknown-ghcjs - - - - - 69d1e9a3 by Sylvain Henry at 2022-08-26T13:56:45-04:00 Driver: enable JS backend by default for JS arch - - - - - f6d8ecc9 by doyougnu at 2022-08-26T13:56:45-04:00 JS.Backend: Add JS specific Linker JS: initialize Linker, DynamicLinking JS.Printer: adapted to GHC Head JS.Printer: some cleanup and init Printer StgToJS.Printer: Compiles JS.Linker: Add types, expose JS keywords JS.Syntax: add Binary instance on Ident's JS.Linker: Migrate more Types to Data.Binary JS.Linker.Types: compiles and adapted to GHC Head JS.Linker.Types: compiles JS.Linker.Types: add UseBase type JS.Linker: Comments and Cleanup JS.Linker.Types: add TH types, Env type, DepsLoc JS.Linker: more FIXMEs numerous Linker fixes JS.Linker: removed Text references JS.UnitUtils: add package related helper functions JS.Linker: more DynFlags removal JS.Linker: Time for semantic errors JS.Linker: DynFlags finally removed JS.Linker: 107 compile errors to go JS.Linker.Utils: initialized, adapted to GHC Head JS.Linker.Utils: initialize Utils module JS.Linker.Utils: more utils JS.Rts: move rtsText to Rts JS.Linker: linkerStats implemented JS.Compactor: compiles, adapted to GHC Head JS.Compactor: have to retrofit compact for linker JS.Linker.Compactor: unwinding lenses JS.Linker.Compactor: comments over addItem JS.Linker.Compactor: Lenses removed JS.Linker.Compactor: SHA256 removed JS.Linker.Compactor: only missing instances left JS.Linker.Compactor: compiles JS.Linker: compiles, adapted to ghc Head JS.Linker: More progress JS.Linker: link in memory compiles JS.Linker: just shims left JS.Linker.DynamicLinking compiles: adapted to head JS.Linker.DynamicLinking: initialization JS.Linker.DynamicLinking: compiles up to Variants JS.Variants: initialize JS.Linker: numerous and various fixes JS.Linker.DynamicLinking: only small errors left JS.Linker.Archive: compiles, adapted to GHC Head JS.Linker: initialize Archive compat module JS.Linker.Archive: minor fixes JS.Linker.DynamicLinking: compiles JS.Linker: cleanup, remove Variants, add comments fixup: more cleanup JS.Linker: more cleanup and comments - - - - - 407f634a by Sylvain Henry at 2022-08-26T13:56:45-04:00 Minor panic fix - - - - - fccaf25f by Sylvain Henry at 2022-08-26T13:56:46-04:00 Linker: fix stage2 build - - - - - 312cf892 by Sylvain Henry at 2022-08-26T13:56:46-04:00 Configure: Add support fo JS as unregistered ABI Configure: detect emscripten tools e.g. on ArchLinux: EMSDK=/usr/lib/emscripten EMSDK_LLVM=/opt/emscripten-llvm ./configure --target=js-unknown-ghcjs Configure: detect nm tool too, required by Hadrian Configure: make StgToJS use non-unregisterised ABI It should probably be a third kind of ABI... - - - - - 0410aee3 by doyougnu at 2022-08-26T13:56:46-04:00 JS.Linker: Hook up to GHC.Driver.Pipeline JS.Linker.Types: Add newGhcjsEnv function JS.UnitUtils: fix encodeModule api JS.Linker: more removal of HscEnv JS.Linker: hooked into GHC.Driver.Pipeline - - - - - 26f863f1 by Sylvain Henry at 2022-08-26T13:59:21-04:00 VERY WIP Hadrian/rts fixes export EMSDK_LLVM=/opt/emscripten-llvm export EMSDK=/usr/lib/emscripten export PATH=./inplace/ghcjs_toolchain/bin:$PATH ./configure --target=js-unknown-ghcjs ./hadrian/build --flavour=quick-js -j --bignum=native --docs=none -V - - - - - bba6f8ed by Sylvain Henry at 2022-08-26T13:59:23-04:00 Force creation of rts library with dummy file - - - - - 71e2ebdf by Sylvain Henry at 2022-08-26T13:59:23-04:00 ghc-prim: avoid building C files - - - - - 95b84e69 by Sylvain Henry at 2022-08-26T13:59:24-04:00 Hadrian: disable -fllvm - - - - - 295f4177 by Sylvain Henry at 2022-08-26T13:59:24-04:00 JS: fix caches Note that the fact that we need index 0 may hide another issue... - - - - - 8fb25c10 by Sylvain Henry at 2022-08-26T13:59:24-04:00 codegen: enhance genCon debug message - - - - - 85c1715d by Sylvain Henry at 2022-08-26T13:59:24-04:00 RTS: fix stupid comment - - - - - 0aa419e7 by Sylvain Henry at 2022-08-26T13:59:24-04:00 RTS: embed headers - - - - - 9672054a by Sylvain Henry at 2022-08-26T13:59:24-04:00 JS.StgToJS: add documentation header for JS Types - - - - - 10f71e2e by Sylvain Henry at 2022-08-26T13:59:25-04:00 CodeGen: refactor ExprCtx code - - - - - 3bd12657 by Sylvain Henry at 2022-08-26T13:59:25-04:00 CodeGen: cache LNE frame size - - - - - 655b3f4e by doyougnu at 2022-08-26T13:59:25-04:00 JS.Types: Add Outputable for TypedExpr - - - - - 354eb5bc by doyougnu at 2022-08-26T13:59:25-04:00 JS.CoreUtils: handle IOPort case - - - - - 7e6ee154 by doyougnu at 2022-08-26T13:59:25-04:00 JS.Expr: Fix unhandled datacon for RuntimeRep - - - - - a4ac9c08 by doyougnu at 2022-08-26T13:59:25-04:00 JS.Literals: Adapt genLit to new Literal domain - - - - - 3c0b00c5 by Sylvain Henry at 2022-08-26T13:59:25-04:00 RTS: expose more headers (required to build base) - - - - - 541154d5 by Sylvain Henry at 2022-08-26T13:59:26-04:00 Base: don't build C and Cmm sources with ghcjs - - - - - caf381a4 by Sylvain Henry at 2022-08-26T13:59:26-04:00 Tentatively set NO_REGS for JS platforms - - - - - 138cc14e by Sylvain Henry at 2022-08-26T13:59:26-04:00 CodeGen: output LitRubbish as null JS values - - - - - 98dade23 by Sylvain Henry at 2022-08-26T13:59:26-04:00 base: disable forkOS and bound thread machinery - - - - - ff736b38 by Sylvain Henry at 2022-08-26T13:59:26-04:00 CodeGen: support StackSnapshot# in primTypeVt - - - - - 8c8fe037 by Sylvain Henry at 2022-08-26T13:59:26-04:00 CodeGen: better debug message for assignCoerce1 - - - - - c4f9f24b by Sylvain Henry at 2022-08-26T13:59:26-04:00 Misc: enable HasDebugCallStack for zipWithEqual* - - - - - c0ce1f25 by Sylvain Henry at 2022-08-26T13:59:27-04:00 CodeGen: remove useless imports - - - - - f0511ef6 by Sylvain Henry at 2022-08-26T13:59:27-04:00 Stg: expose pprStgAlt - - - - - 0a05a077 by Sylvain Henry at 2022-08-26T13:59:27-04:00 CodeGen: restore assignAll (instead of assignAllEqual) - - - - - 599b972b by Sylvain Henry at 2022-08-26T13:59:27-04:00 CodeGen: handle proxy# - - - - - a7f03312 by doyougnu at 2022-08-26T13:59:27-04:00 ghc-heap: Don't compile Cmm file for JS-Backend - - - - - e13a01ba by doyougnu at 2022-08-26T13:59:27-04:00 Driver.Main: minor refactor do_code_gen To clearly separate the JS-Backend from any other backend - - - - - bf6141de by Sylvain Henry at 2022-08-26T13:59:27-04:00 Configure: fix echo on Mac, add ghcjs target OS - - - - - bc29c63d by Sylvain Henry at 2022-08-26T13:59:28-04:00 Configure: fix previous commit - - - - - f998661a by Luite Stegeman at 2022-08-26T13:59:28-04:00 fix package name in module name field of system dependencies - - - - - 4734171f by Luite Stegeman at 2022-08-26T13:59:28-04:00 fix duplicate module name in symbols - - - - - 08530e14 by doyougnu at 2022-08-26T13:59:28-04:00 GHCi.FFI: ignore ffi.h and friends for js-backend - - - - - f015b134 by Sylvain Henry at 2022-08-26T13:59:28-04:00 RTS: fix build of native rts - - - - - df65b6c7 by Sylvain Henry at 2022-08-26T13:59:28-04:00 Remove temporary -fjavascript flag - - - - - e9aae38d by Sylvain Henry at 2022-08-26T13:59:29-04:00 Codegen: fix symbol names ppr - - - - - 245e7500 by Sylvain Henry at 2022-08-26T13:59:29-04:00 Outputable: add ShortText instance - - - - - 9a83d084 by Sylvain Henry at 2022-08-26T13:59:29-04:00 Linker: enhance debugging message - - - - - 0174851f by Sylvain Henry at 2022-08-26T13:59:29-04:00 Remove unused ghcjs unit related code - - - - - 8cf5fae3 by Sylvain Henry at 2022-08-26T13:59:29-04:00 ghci: Avoid unused-xyz warnings - - - - - 85331a21 by Sylvain Henry at 2022-08-26T13:59:29-04:00 Linker: remove wiring of ghcjs-prim and ghcjs-th They will be replaced by ghc-prim, base, template-haskell, etc. - - - - - 4c44ffe3 by Sylvain Henry at 2022-08-26T13:59:29-04:00 Add outputable instance for Deps - - - - - dbfd46dd by doyougnu at 2022-08-26T13:59:30-04:00 Docs: JS.Syntax, JS.Make docs done JS-backend: Add documentation headers Docs: JS.Syntax done Docs: JS.Make done Docs: JS.Make JS.Syntax refined a bit - - - - - e9e717e1 by Sylvain Henry at 2022-08-26T13:59:30-04:00 Rename u_env into unit_env (more common) - - - - - 556451a1 by Sylvain Henry at 2022-08-26T13:59:30-04:00 Linker: deduplication + fixes - deduplicate code that was copied from old GHC - explicitly add preloadUnits to the link - avoid calling getShims - - - - - 43a3c3fb by Sylvain Henry at 2022-08-26T13:59:30-04:00 Linker: reenable packStrings (not yet implemented though) - - - - - 2ee0b278 by Sylvain Henry at 2022-08-26T13:59:30-04:00 ShortText: add singleton - - - - - 3766388f by Sylvain Henry at 2022-08-26T13:59:30-04:00 Linker: force less efficient (but working) static encoding - - - - - 6b1732a6 by Luite Stegeman at 2022-08-26T13:59:31-04:00 add GHCJS modules to base package - - - - - 8912b0f9 by Sylvain Henry at 2022-08-26T13:59:31-04:00 Linker: remove JS Shims,tiny GHC.Linker refactor - - - - - 1367f7e5 by doyougnu at 2022-08-26T13:59:31-04:00 Hadrian: QuickJS ways [] --> Set - - - - - ba81a823 by doyougnu at 2022-08-26T13:59:31-04:00 JS-Backend: rebased to master 468f919b First rebase of the JS-Backend. This rebase includes the JS backend combined with !7442 (new backend design). Unfortunately we have to short circuit the new backend design because the JS backend takes over after STG and not after StgToCmm. What's working: - hadrian builds JS backend - JS backend outputs .js files and "links" them What still has to be done: - JS backend is missing core js libraries as we add these we discover bugs in the linker and js rts. - - - - - c1709ea6 by doyougnu at 2022-08-26T13:59:31-04:00 JS: silence haddock warnings JS Backend: remove misc. warnings - - - - - 1cb0e787 by doyougnu at 2022-08-26T13:59:31-04:00 JS Backend: ghcjs_HOST_OS --> js_HOST_ARCH - - - - - 1001e8cf by Sylvain Henry at 2022-08-26T13:59:32-04:00 JS.Linker: add shims GHCJS uses JS files for primitive things like the GC and RTS. We call these JS files "shims". This sequence of commits adds shims from JS and includes them for linking. In addition the shim directory is controlled via an evironment variable JS_RTS_PATH...at least for now. Linker: implement tryReadShimFile Linker: link with shims provided via an env variable Use JS_RTS_PATH to provide a directory into which .js and .js.pp files will be linked into rts.js JS.Linker: add js dir at root, fix js cpp includes JS.gc.pp: remove variadic macro JS.RTS: add rts JS shims files, remove shim CPP RTS: remove the need for rts.h and add rts JS files rts.h only contained a few constants duplicated in the codegen. Let's use the Haskell version as the single source of truth and pass defined values explicitly to cpp command line ("-DXYZ=abc" arguments). Also switch from "raw" (use_cpp_and_not_cc_dash_E = True) to the opposite: in both case we call "cc -E" (meh), but with False the preprocessor doesn't choke one varargs in macros. RTS: remove integer.js.pp We use the native ghc-bignum backend, so we don't need the GMP compatible JS code. In addition, this code was failing to run as it requires the JSBN (https://www.npmjs.com/package/jsbn) "Javascript big number" library, which we don't necessarily have installed. RTS: fix typo in field name RTS: generate CPP macros in Haskell RTS: share common CPP def into CAFs - - - - - 1e9a3963 by Sylvain Henry at 2022-08-26T13:59:32-04:00 CPP: disable line markers CPP: move option before input filename (to be squashed) - - - - - ee2a286c by Sylvain Henry at 2022-08-26T13:59:32-04:00 Linker: add more types Some cleanup Enhance and fix LinkerStats Document and refactor renderLinker Split collectDeps Fix collectDeps Fix linker stats rendering Remove unused seqListSpine It isn't used in ghcjs either - - - - - 01259bbb by Sylvain Henry at 2022-08-26T13:59:32-04:00 Add some missing primops (Word32,Int32) Also fix the rendering of missing primops (they must be z-encoded to avoid having a "#" in their JS name) - - - - - a026338d by Sylvain Henry at 2022-08-26T13:59:32-04:00 FFI: desugar every foreign import/export in JS with JS backend It means we also desugar CApi calls into JS. It's probably wrong but instead of generating invalid JS we will only get the failure at runtime when we will use the function. fixup - - - - - 964d6fe3 by doyougnu at 2022-08-26T13:59:32-04:00 JS.Linker: remove dflags includePath workaround. We implemented a workaround for shims that modified the dynflags includePaths so that the JS backend would find the rts.h file during CPP of shims. Since aebcca98 this is no longer required because we've removed the need for rts.h completely. Thus, this commit reverts that modification. - - - - - 2c33348c by Sylvain Henry at 2022-08-26T13:59:32-04:00 Temporarily wire-in base's shim Use JS_BASE_PATH env var to set base's shim directory (js_base for now) Also minor other changes base: fix encoding for JS arch - - - - - 638a9ee6 by Sylvain Henry at 2022-08-26T13:59:33-04:00 Add primops Add primop - - - - - 834b3405 by doyougnu at 2022-08-26T13:59:33-04:00 Make Shims type, refactor JS Linker This commit: - Adds a proper Shim type and associated utilities. These utitlies are purposefully limited to ensure the ShimLbl tag is preserved thus guarenteeing shim ordering at link time. - Refactors the JS backend linker to use this ordering and Shim API. The ordering is not correct (yet!) but with this API its much easier to triage, experiment and diagnose link time issues. Refactor linker to compile time shim ordering - - - - - 07fa085c by doyougnu at 2022-08-26T13:59:33-04:00 Base: Adapt primitives to JS backend, add base.js - - - - - 0c8f6a69 by doyougnu at 2022-08-26T13:59:33-04:00 Base: Remove binding forms in JS ffi - - - - - d3167c0a by Josh Meredith at 2022-08-26T13:59:33-04:00 Replace GHCJS Objectable with GHC Binary - - - - - 0ecf12e1 by Sylvain Henry at 2022-08-26T13:59:33-04:00 Binary: remove unused Map instance - - - - - d6bf5484 by Sylvain Henry at 2022-08-26T13:59:34-04:00 CodeGen: Add export list - - - - - 743b1d1a by Sylvain Henry at 2022-08-26T13:59:34-04:00 Primops: add some Int64/Word64 primops - - - - - be8dd711 by Sylvain Henry at 2022-08-26T13:59:34-04:00 base: fix one ffi import - - - - - cb7b8562 by doyougnu at 2022-08-26T13:59:34-04:00 base: CPP for JS-backend, adapt write in base shim This commit ports over each CPP directive from GHCJS to base. In addition, it adds struct.js.pp to Base shim directory and modifies h$base_write to always take 6 arguments. Thereby avoiding errors such as "c(bytesWritten) is not a function". The missing parameter was the file descriptor object, fdo, which was looked up in the function itself and is now passed through to comport with the FFI expectations. - - - - - 83e18804 by doyougnu at 2022-08-26T13:59:34-04:00 fixup: remove redundant struct.js.pp in js_base - - - - - 3ee95860 by doyougnu at 2022-08-26T13:59:34-04:00 JS.Linker: enable linker RTS symbols - - - - - 578fd8f7 by doyougnu at 2022-08-26T13:59:34-04:00 base.GHCJS: adapt Prim to direct call FFI format - - - - - 67b916b3 by doyougnu at 2022-08-26T13:59:35-04:00 Linker: Load JSVal from base not ghc-prim - - - - - 36f57eb1 by doyougnu at 2022-08-26T13:59:35-04:00 fixup: caught one more reference to JSVal in prim - - - - - 3899448f by Sylvain Henry at 2022-08-26T13:59:35-04:00 base: match on js arch , not ghcjs os - - - - - e095397b by Sylvain Henry at 2022-08-26T13:59:35-04:00 Fix MK_JSVAL - - - - - 9c9e9e45 by doyougnu at 2022-08-26T13:59:35-04:00 Prim: cleanup comments - - - - - a0c9d7d1 by doyougnu at 2022-08-26T13:59:35-04:00 JS.Prim: add Int64 PrimOps - - - - - 38ad0836 by Sylvain Henry at 2022-08-26T13:59:35-04:00 Vendor MD5 lib - - - - - 4f282fd5 by Sylvain Henry at 2022-08-26T13:59:36-04:00 More 64-bit primops - - - - - 1b40e01a by Sylvain Henry at 2022-08-26T13:59:36-04:00 CodeGen: use if10 helper - - - - - acca046b by Sylvain Henry at 2022-08-26T13:59:36-04:00 Ppr: fix selector to avoid adding a newline - - - - - 44dbc5fe by doyougnu at 2022-08-26T13:59:36-04:00 base: GHCJS.Prim make ffi imports use anon funcs - - - - - 1afc4e2f by Sylvain Henry at 2022-08-26T13:59:36-04:00 Linker: disable invalid constructors again - - - - - 2b95f3e9 by Sylvain Henry at 2022-08-26T13:59:36-04:00 More 64-bits primops - - - - - a5b91fff by Sylvain Henry at 2022-08-26T13:59:36-04:00 Fix base_write function - - - - - 0053597b by Sylvain Henry at 2022-08-26T13:59:37-04:00 Fix base_write for 32-bit size_t - - - - - a4143825 by Sylvain Henry at 2022-08-26T13:59:37-04:00 Configure: fix detection of the target toolchain - - - - - 4264c1e8 by Sylvain Henry at 2022-08-26T13:59:37-04:00 Remove js_base directory - - - - - 6eb71a93 by Sylvain Henry at 2022-08-26T13:59:37-04:00 Kill Node when the main loop reports an unhandled exception - - - - - 61b89fff by Sylvain Henry at 2022-08-26T13:59:37-04:00 CodeGen: preparation to make match on primops complete - - - - - 5563dd21 by Sylvain Henry at 2022-08-26T13:59:37-04:00 Primops: fix Compact primops - - - - - c449986b by Sylvain Henry at 2022-08-26T13:59:38-04:00 Ignore result arity for some exception primops - - - - - af300b51 by Sylvain Henry at 2022-08-26T13:59:38-04:00 Fix more primops. Bump array submodule! - - - - - b5b68b27 by Sylvain Henry at 2022-08-26T13:59:38-04:00 Compact: fix return of 3 values - - - - - c0a36b43 by Sylvain Henry at 2022-08-26T13:59:38-04:00 Configure: switch to absolute path - - - - - 34bf3f81 by Sylvain Henry at 2022-08-26T13:59:38-04:00 Add a few primops - - - - - d6145e74 by Sylvain Henry at 2022-08-26T13:59:38-04:00 Primop: implement WordAdd2 - - - - - de98aa4b by Luite Stegeman at 2022-08-26T13:59:38-04:00 quick fix for uTypeVt and typePrimRep panics this may cause other panics, a full fix will require a bit more rework and probably removal of VarType - - - - - 7a8f4370 by Josh Meredith at 2022-08-26T13:59:39-04:00 Replace ShortText with (Lexical)FastString in GHCJS backend - - - - - d20642fd by Sylvain Henry at 2022-08-26T13:59:39-04:00 Primops: add arithmetic ops Primops: add decodeDoubleInt64 back Primop: added timesInt2# Primop: add mulWord32 and mul2Word32 - - - - - d33002af by Sylvain Henry at 2022-08-26T13:59:39-04:00 Reduce dependency on goog - - - - - 8a7d3bf9 by Sylvain Henry at 2022-08-26T13:59:39-04:00 Primop: implement quotWord32, remWord32, and quotRemWord32 - - - - - 21526445 by Sylvain Henry at 2022-08-26T13:59:39-04:00 Primop: Implement quotRem2Word32, misc fixes Primop: implement quotRem2Word32 Primop: fix timesInt2# Primop: fix some shifting primops - - - - - a07c0816 by Sylvain Henry at 2022-08-26T13:59:39-04:00 Fix bug in upd_frame I've introduced this bug when I've refactored the code to use helpers to assign closures. - - - - - f511df9a by Sylvain Henry at 2022-08-26T13:59:40-04:00 Primop: throw an exception for unimplemented primops - - - - - b9d4c977 by Sylvain Henry at 2022-08-26T13:59:40-04:00 Primop: fix remWord32 - - - - - 746e87f9 by Josh Meredith at 2022-08-26T13:59:40-04:00 Configure: add EMSDK_BIN, match emsdk expectations Change EMSDK vars to match emscripten/emsdk_env.sh definitions Add EMSDK_BIN environment variable to configure - - - - - 9820ec9c by Sylvain Henry at 2022-08-26T13:59:40-04:00 resultSize: correctly handle Void# - - - - - 7f551f28 by Sylvain Henry at 2022-08-26T13:59:40-04:00 Primop: fix Sized test, more shifting fixes Primop: ensure that we return u32 values for word primops Also a refactoring from i3 to i32 for clarity. Primop: add/fix more shifting primops Primops: fix Sized test! - - - - - bf4a2297 by Sylvain Henry at 2022-08-26T13:59:40-04:00 StgToJS.Apply: Docs Doc Doc - - - - - 98e30a3e by Josh Meredith at 2022-08-26T13:59:40-04:00 Fix EMSDK configure condition - - - - - cbfa77bd by doyougnu at 2022-08-26T13:59:41-04:00 StgToJS.Arg: Unboxable Literal Optimization note - - - - - 3d9b2a8a by Sylvain Henry at 2022-08-26T13:59:41-04:00 Fix Outputable instances for JExpr/JVal - Put orphan instances in JS.Ppr - Also fix some redundant imports - - - - - b2ba24b4 by doyougnu at 2022-08-26T13:59:41-04:00 configure: avoid CXX stdlib check for js backend and some cleanup for a previously mis-applied commit during rebasing - - - - - feb9babb by doyougnu at 2022-08-26T13:59:41-04:00 fixup: misc. fixes post rebase - - - - - c86fe5ab by Sylvain Henry at 2022-08-26T13:59:41-04:00 PrimOps: add more 64-bit primops PrimOp: implement more 64-bit primops + PM fix Ensure that we cover every primop explicitly - - - - - 32c05468 by Sylvain Henry at 2022-08-26T13:59:41-04:00 PrimOp: correclty (un)handle new thread related primops - - - - - 74460d7c by Sylvain Henry at 2022-08-26T13:59:41-04:00 PrimOp: disable LabelThreadOp for now - - - - - dbd3a63a by Sylvain Henry at 2022-08-26T13:59:42-04:00 Minor doc/cleanup Fix more redundant imports - - - - - 4f7467cf by doyougnu at 2022-08-26T13:59:42-04:00 base: GHCJS.Prim directory --> GHC.JS.Prim - - - - - 8e08f1ce by Luite Stegeman at 2022-08-26T13:59:42-04:00 implement KeepAlive primop - - - - - 66d533b6 by Sylvain Henry at 2022-08-26T13:59:42-04:00 Remove orphan instance for StaticArg - - - - - 54e8be35 by Sylvain Henry at 2022-08-26T13:59:42-04:00 Remove redundant jsIdIdent' function - - - - - 20bd29f3 by Sylvain Henry at 2022-08-26T13:59:42-04:00 Split StgToJS.Monad into StgToJS.{Monad,Ids,Stack} - - - - - adbb357a by Sylvain Henry at 2022-08-26T13:59:43-04:00 Apply: remove commented case (wasn't optimized either in latest ghcjs) - - - - - 1514f9b4 by Sylvain Henry at 2022-08-26T13:59:43-04:00 Doc: Apply Apply: doc and refactoring - use new types instead of Bool/Int - factorize some code - - - - - 3cb7132e by Sylvain Henry at 2022-08-26T13:59:43-04:00 Primop: arith fixes Primop: fix 64-bit shifting primops + add some traces Primop: fix quotRem2Word32 Primop: fix timesInt2. Progress towards passing arith003 PrimOp: fix timesInt32 PrimOp: use mulWord32 when appropriate - - - - - 20a01b2b by doyougnu at 2022-08-26T13:59:43-04:00 Configure: remove EMSDK hacks and wrapper scripts configure JS: remove wrapper scripts Configure: remove EMSDK hacks. Use emconfigure instead emconfigure ./configure --target=js-unknown-ghcjs - - - - - 8a1b4d1d by Sylvain Henry at 2022-08-26T13:59:43-04:00 GHCJS.Prim leftovers - - - - - 6d04d063 by Sylvain Henry at 2022-08-26T13:59:43-04:00 Linker: fix linking issue for tuples - - - - - d8e06ba0 by Sylvain Henry at 2022-08-26T13:59:43-04:00 FFI: remove narrowing Fix tests such as cgrun015 (Core lint error) - - - - - 31f0d373 by Sylvain Henry at 2022-08-26T13:59:44-04:00 Linker: disable logs with default verbosity - - - - - 639480c9 by Sylvain Henry at 2022-08-26T13:59:44-04:00 Append program name in top-level exception handler - - - - - af99d11d by doyougnu at 2022-08-26T13:59:44-04:00 GHC.JS: Remove FIXMEs JS.Syntax: Remove FIXMEs JS.Make: remove FIXMEs JS.Ppr/Transform: Remove FIXMEs - - - - - 77d30a25 by Sylvain Henry at 2022-08-26T13:59:44-04:00 Primop: fix timesInt2# Pass arith003 test - - - - - 921f3fe5 by doyougnu at 2022-08-26T13:59:44-04:00 JS.Linker.Linker: remove FIXMEs, clean dead code - - - - - a04220cc by Sylvain Henry at 2022-08-26T13:59:44-04:00 Linker: link platform shim before the others - - - - - 7acf8884 by Sylvain Henry at 2022-08-26T13:59:45-04:00 Primops: rework 64-bit and Word32 primops - Use BigInt instead of complex and buggy bit twiddling. We'll assess performance later. Let's use a correct and simple implementation for now. - Implement previously missing 64-bit quot and rem - Refactor logical operators and Prim module more generally - - - - - 946a1ac8 by Sylvain Henry at 2022-08-26T13:59:45-04:00 PrimOp: fixup previous commit... - - - - - 05cd63a6 by Sylvain Henry at 2022-08-26T13:59:45-04:00 Primop: fixup previous commit - - - - - c60dca40 by Sylvain Henry at 2022-08-26T13:59:45-04:00 Doc: minor changes - - - - - 0c4085e8 by Sylvain Henry at 2022-08-26T13:59:45-04:00 Add debug option to watch for insertion of undefined/null in the stack - - - - - 0d55e08a by Sylvain Henry at 2022-08-26T13:59:45-04:00 Apply: fix tag generation - - - - - 5985ab1e by Sylvain Henry at 2022-08-26T13:59:45-04:00 Remove redundant import - - - - - dc0e279e by Sylvain Henry at 2022-08-26T13:59:46-04:00 Testsuite: disable Cmm tests with the JS backend - - - - - ed6c45df by Sylvain Henry at 2022-08-26T13:59:46-04:00 Base: fix c_interruptible_open - - - - - a6b90dca by Sylvain Henry at 2022-08-26T13:59:46-04:00 Base: fix typo in long_from_number - - - - - a14f0b65 by Sylvain Henry at 2022-08-26T13:59:46-04:00 Env: only add program name to errors, not to traces - - - - - 6b358d7a by Sylvain Henry at 2022-08-26T13:59:46-04:00 Testsuite: disable more Cmm tests - - - - - 4bdbe4e8 by doyougnu at 2022-08-26T13:59:47-04:00 JS.Linker: removes FIXMEs JS.Linker.Linker: remove FIXMEs, clean dead code StgToJS.Linker.Utils: remove FIXMEs Compactor: Remove FIXMEs StgToJS.Linker.Types: Remove FIXMEs JS.Linker.Archive/Dynamic: remove FIXMEs StgToJS.Linker.Shims: remove FIXMEs - - - - - fe1d250f by doyougnu at 2022-08-26T13:59:47-04:00 JS RTS: remove FIXMEs StgToJS.Rts.Types: Remove FIXMEs - - - - - 3aabc8e2 by Sylvain Henry at 2022-08-26T13:59:47-04:00 Primop: fix bswap32/64 (cf cgrun072) - - - - - 16abdb90 by Sylvain Henry at 2022-08-26T13:59:47-04:00 Testsuite: normalise ghc program name - - - - - 73529eeb by doyougnu at 2022-08-26T13:59:47-04:00 JS Backend: Remove FIXMEs StgToJS.Apply: Remove FIXMEs StgToJS.FFI: remove FIXMEs StgToJS.Expr: remove FIXMEs StgToJS: Remove FIXMEs - - - - - e35c0721 by Sylvain Henry at 2022-08-26T13:59:48-04:00 Enable RTS args filtering (cf cgrun025) - - - - - 816f2547 by Sylvain Henry at 2022-08-26T13:59:48-04:00 Remove trailing whitespaces (whitespace test) - - - - - 0ed9923d by Sylvain Henry at 2022-08-26T13:59:48-04:00 Testsuite: remove platform prefix for unlit tool - - - - - 67d00373 by Sylvain Henry at 2022-08-26T13:59:48-04:00 Primop: fix Int64 conversion/negate (integerConversions test) - - - - - 691548ac by Sylvain Henry at 2022-08-26T13:59:48-04:00 Linker: remove message with default verbosity - - - - - dec067ec by Sylvain Henry at 2022-08-26T13:59:48-04:00 Testsuite: normalise .jsexe suffix - - - - - 28022ac4 by Sylvain Henry at 2022-08-26T13:59:48-04:00 Remove warning about orphan instance - - - - - 66382e10 by Sylvain Henry at 2022-08-26T13:59:49-04:00 Compactor: disable dead code - - - - - e26689d1 by Sylvain Henry at 2022-08-26T13:59:49-04:00 Exception: implement raiseUnderflow etc. as primops - - - - - dc2755dc by Sylvain Henry at 2022-08-26T13:59:49-04:00 Primop: fix Int8/18 quot/rem - - - - - 157e67a1 by Sylvain Henry at 2022-08-26T13:59:49-04:00 Linker: refactor wired-in deps - - - - - 0d8ab4a9 by Sylvain Henry at 2022-08-26T13:59:49-04:00 Ppr: remove useless left padding for functions in JS dumps - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CommonBlockElim.hs - 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/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/Graph/Directed.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backend/Internal.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/StgToCmm.hs - + compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cea5c8c5b76ab76631fe0d1521334858051faea8...0d8ab4a9ee6e152957418aa23b81c1c273cf36c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cea5c8c5b76ab76631fe0d1521334858051faea8...0d8ab4a9ee6e152957418aa23b81c1c273cf36c1 You're receiving 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 26 22:48:59 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 Aug 2022 18:48:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Improve SpecConstr for evals Message-ID: <63094ddb99450_e9d7d68dd31b0153797f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 63608fd9 by Simon Peyton Jones at 2022-08-26T18:48:35-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 1d37f291 by Matthew Pickering at 2022-08-26T18:48:38-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 910d7bd9 by Matthew Pickering at 2022-08-26T18:48:38-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - fc5164cd by Matthew Pickering at 2022-08-26T18:48:38-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - 9f6c96ea by Matthew Pickering at 2022-08-26T18:48:38-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 10 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs - + testsuite/tests/simplCore/should_compile/T21763.hs - + testsuite/tests/simplCore/should_compile/T21763.stderr - + testsuite/tests/simplCore/should_compile/T21763a.hs - + testsuite/tests/simplCore/should_compile/T21763a.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3437,24 +3437,26 @@ lintAnnots pname pass guts = {-# SCC "lintAnnots" #-} do logger <- getLogger when (gopt Opt_DoAnnotationLinting dflags) $ liftIO $ Err.showPass logger "Annotation linting - first run" - nguts <- pass guts -- If appropriate re-run it without debug annotations to make sure -- that they made no difference. - when (gopt Opt_DoAnnotationLinting dflags) $ do - liftIO $ Err.showPass logger "Annotation linting - second run" - nguts' <- withoutAnnots pass guts - -- Finally compare the resulting bindings - liftIO $ Err.showPass logger "Annotation linting - comparison" - let binds = flattenBinds $ mg_binds nguts - binds' = flattenBinds $ mg_binds nguts' - (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' - when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat - [ lint_banner "warning" pname - , text "Core changes with annotations:" - , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs - ] - -- Return actual new guts - return nguts + if gopt Opt_DoAnnotationLinting dflags + then do + nguts <- pass guts + liftIO $ Err.showPass logger "Annotation linting - second run" + nguts' <- withoutAnnots pass guts + -- Finally compare the resulting bindings + liftIO $ Err.showPass logger "Annotation linting - comparison" + let binds = flattenBinds $ mg_binds nguts + binds' = flattenBinds $ mg_binds nguts' + (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' + when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat + [ lint_banner "warning" pname + , text "Core changes with annotations:" + , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs + ] + return nguts + else + pass guts -- | Run the given pass without annotations. This means that we both -- set the debugLevel setting to 0 in the environment as well as all ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -153,7 +153,7 @@ simplifyPgm logger unit_env opts , mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) = do { (termination_msg, it_count, counts_out, guts') - <- do_iteration 1 [] binds rules + <- do_iteration 1 [] binds rules ; when (logHasDumpFlag logger Opt_D_verbose_core2core && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ @@ -175,6 +175,9 @@ simplifyPgm logger unit_env opts print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode + -- Note the bang in !guts_no_binds. If you don't force `guts_no_binds` + -- the old bindings are retained until the end of all simplifier iterations + !guts_no_binds = guts { mg_binds = [], mg_rules = [] } do_iteration :: Int -- Counts iterations -> [SimplCount] -- Counts from earlier iterations, reversed @@ -198,7 +201,7 @@ simplifyPgm logger unit_env opts -- number of iterations we actually completed return ( "Simplifier baled out", iteration_no - 1 , totalise counts_so_far - , guts { mg_binds = binds, mg_rules = rules } ) + , guts_no_binds { mg_binds = binds, mg_rules = rules } ) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -253,7 +256,7 @@ simplifyPgm logger unit_env opts if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks - , guts { mg_binds = binds1, mg_rules = rules1 } ) + , guts_no_binds { mg_binds = binds1, mg_rules = rules1 } ) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2257,7 +2257,7 @@ prepareAlts tries these things: case e of x { (a,b) -> rhs } where the type is a single constructor type. This gives better code when rhs also scrutinises x or e. - See CoreUtils Note [Refine DEFAULT case alternatives] + See GHC.Core.Utils Note [Refine DEFAULT case alternatives] 3. combineIdenticalAlts: combine identical alternatives into a DEFAULT. See CoreUtils Note [Combine identical alternatives], which also ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,9 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) +import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) +import Data.Tuple {- ----------------------------------------------------- @@ -374,11 +376,14 @@ 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 [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: +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: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -401,52 +406,42 @@ 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.) -However, if we find any boring calls in the body, including *unsaturated* -ones, such as +Wrinkles + +* Boring calls. 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 callsToPats reports if it finds any of these. + 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. -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.) +* 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! Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -671,14 +666,16 @@ But regardless, SpecConstr can and should! It's easy: well as constructor applications. Wrinkles: + * This should all work perfectly fine for newtype classes. Mind you, currently newtype classes are inlined fairly agressively, but we may change that. And it would take extra code to exclude them, as well as being unnecessary. -* We (mis-) use LambdaVal for this purpose, because ConVal - requires us to list the data constructor and fields, and that - is (a) inconvenient and (b) unnecessary for class methods. +* In isValue, we (mis-) use LambdaVal for this ($fblah d1 .. dn) + because ConVal requires us to list the data constructor and + fields, and that is (a) inconvenient and (b) unnecessary for + class methods. ----------------------------------------------------- Stuff not yet handled @@ -764,35 +761,18 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = 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') + = 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') } {- ************************************************************************ @@ -956,14 +936,24 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -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 } +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. data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -984,8 +974,18 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v -scSubstTy :: ScEnv -> InType -> OutType -scSubstTy env ty = substTyUnchecked (sc_subst env) ty +-- The !subst ensures that we force the selection `(sc_subst env)`, which avoids +-- retaining all of `env` when we only need `subst`. The `Solo` means that the +-- substitution itself is lazy, because that type is often discarded. +-- The callers of `scSubstTy` always force the result (to unpack the `Solo`) +-- so we get the desired effect: we leave a thunk, but retain only the subst, +-- not the whole env. +-- +-- Fully forcing the result of `scSubstTy` regresses performance (#22102) +scSubstTy :: ScEnv -> InType -> Solo OutType +scSubstTy env ty = + let !subst = sc_subst env + in Solo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co @@ -1187,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -data Call = Call Id [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] -- Domain is OutIds +data Call = Call OutId [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 @@ -1210,6 +1210,9 @@ 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) } @@ -1227,7 +1230,20 @@ data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument | UnkOcc -- Used in some unknown way | ScrutOcc -- See Note [ScrutOcc] - (DataConEnv [ArgOcc]) -- How the sub-components are used + (DataConEnv [ArgOcc]) + -- [ArgOcc]: how the sub-components are used + +deadArgOcc :: ArgOcc -> Bool +deadArgOcc (ScrutOcc {}) = False +deadArgOcc UnkOcc = False +deadArgOcc NoOcc = True + +specialisableArgOcc :: ArgOcc -> Bool +-- | Does this occurence represent one worth specializing for. +specialisableArgOcc UnkOcc = False +specialisableArgOcc NoOcc = False +specialisableArgOcc (ScrutOcc {}) = True + {- Note [ScrutOcc] ~~~~~~~~~~~~~~~~~~ @@ -1253,6 +1269,9 @@ instance Outputable ArgOcc where ppr NoOcc = text "no-occ" evalScrutOcc :: ArgOcc +-- We use evalScrutOcc for +-- - mkVarUsage: applied functions +-- - scApp: dicts that are the arugment of a classop evalScrutOcc = ScrutOcc emptyUFM -- Experimentally, this version of combineOcc makes ScrutOcc "win", so @@ -1292,6 +1311,121 @@ 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 @@ -1302,7 +1436,9 @@ scExpr' env (Var v) = case scSubstId env v of Var v' -> return (mkVarUsage env v' [], Var v') e' -> scExpr (zapScSubst env) e' -scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) +scExpr' env (Type t) = + let !(Solo ty') = scSubstTy env t + in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e @@ -1316,6 +1452,11 @@ 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 @@ -1333,17 +1474,19 @@ scExpr' env (Case scrut b ty alts) = do { let (alt_env,b') = extendBndrWith RecArg env b -- Record RecArg for the components - ; (alt_usgs, alt_occs, alts') - <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts + ; (alt_usgs, alt_occs, alts') <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts ; let scrut_occ = foldr combineOcc NoOcc alt_occs scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ -- The combined usage of the scrutinee is given - -- by scrut_occ, which is passed to scScrut, which + -- by scrut_occ, which is passed to setScrutOcc, which -- in turn treats a bare-variable scrutinee specially + ; let !(Solo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, - Case scrut' b' (scSubstTy env ty) alts') } + Case scrut' b' ty' alts') } + + single_alt = isSingleton alts sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs @@ -1351,82 +1494,52 @@ scExpr' env (Case scrut b ty alts) ; (usg, rhs') <- scExpr env2 rhs ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2) scrut_occ = case con of - DataAlt dc -> ScrutOcc (unitUFM dc arg_occs) - _ -> evalScrutOcc + DataAlt dc -- See Note [Do not specialise evals] + | not (single_alt && all deadArgOcc arg_occs) + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; 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. +{- Note [Do not specialise evals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x y = case x of I# _ -> + if y>1 then f x (y-1) else x + +Here `x` is scrutinised by a case, but only in an eval-like way; the +/component/ of the I# is unused. We don't want to specialise this +function, even if we find a call (f (I# z)), because nothing is gained + * No case branches are discarded + * No allocation in removed +The specialised version would take an unboxed Int#, pass it along, +and rebox it at the end. + +In fact this can cause significant regression. In #21763 we had: +like + f = ... case x of x' { I# n -> + join j y = rhs + in ...jump j x'... + +Now if we specialise `j` for the argument `I# n`, we'll end up reboxing +it in `j`, without even removing an allocation from the call site. + +Reboxing is always a worry. But here we can ameliorate the problem as +follows. + +* In scExpr (Case ...), for a /single-alternative/ case expression, in + which the pattern binders are all unused, we build a UnkOcc for + the scrutinee, not one that maps the data constructor; we don't treat + this occurrence as a reason for specialisation. + +* Conveniently, SpecConstr is doing its own occurrence analysis, so + the "unused" bit is just looking for NoOcc + +* Note that if we have + f x = case x of { True -> e1; False -> e2 } + then even though the pattern binders are unused (there are none), it is + still worth specialising on x. Hence the /single-alternative/ guard. -} scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) @@ -1478,55 +1591,9 @@ mkVarUsage env fn args , scu_occs = unitVarEnv fn arg_occ } Nothing -> nullUsage where - -- I rather think we could use UnkOcc all the time 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) @@ -1574,7 +1641,8 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have generated + = SI { si_specs :: [OneSpec] -- The specialisations we have + -- generated for this function , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1585,7 +1653,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Local recursive groups] + -- See Note [Seeding recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1595,57 +1663,62 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -noSpecInfo :: SpecInfo -noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } +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 ---------------------- specNonRec :: ScEnv - -> ScUsage -- Body usage + -> CallEnv -- Calls in body -> 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_usg rhs_info - = specialise env (scu_calls body_usg) rhs_info - (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) +specNonRec env body_calls rhs_info + = specialise env body_calls rhs_info (initSpecInfo rhs_info) ---------------------- -specRec :: TopLevelFlag -> ScEnv - -> ScUsage -- Body usage +specRec :: ScEnv + -> CallEnv -- Calls in body -> [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 top_lvl env body_usg rhs_infos - = go 1 seed_calls nullUsage init_spec_infos +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 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 :: 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, 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 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 - = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) - -- , ppr seed_calls - -- , ppr body_usg ]) $ - return (usg_so_far, spec_infos) + = return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1654,26 +1727,20 @@ specRec top_lvl env body_usg rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - return (usg_so_far, 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) | otherwise - = -- 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 } + = go (n_iter + 1) seed_calls usg_so_far spec_infos -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max - ---------------------- specialise :: ScEnv @@ -1696,14 +1763,12 @@ 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 @@ -1729,14 +1794,16 @@ 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 | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') = case mb_unspec of + Just rhs_usg | unspec_rhs_needed + -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1744,8 +1811,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 @@ -2027,7 +2094,8 @@ 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, unless there are no calls at all to the function. +the passed-in SpecInfo in si_mb_unspec, 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 @@ -2245,9 +2313,11 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) - -- Result has no duplicate patterns, - -- nor ones mentioned in done_pats - -- Bool indicates that there was at least one boring pattern +-- 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" callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls @@ -2558,10 +2628,8 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str -- (b) we know what its value is -- In that case it counts as "interesting" argToPat1 env in_scope val_env (Var v) arg_occ arg_str - | sc_force env || case arg_occ of { ScrutOcc {} -> True - ; UnkOcc -> False - ; NoOcc -> False } -- (a) - , is_value -- (b) + | sc_force env || specialisableArgOcc arg_occ -- (a) + , is_value -- (b) -- Ignoring sc_keen here to avoid gratuitously incurring Note [Reboxing] -- So sc_keen focused just on f (I# x), where we have freshly-allocated -- box that we can eliminate in the caller ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -706,7 +706,11 @@ filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (us -- in a "case" statement then they will need to manually add a dummy case branch that just -- calls "error" or similar. filterAlts _tycon inst_tys imposs_cons alts - = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + = imposs_deflt_cons `seqList` + (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which + -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter + -- leads to a huge space leak (see #22102 and !8896) where (alts_wo_default, maybe_deflt) = findDefault alts alt_cons = [con | Alt con _ _ <- alts_wo_default] ===================================== testsuite/tests/simplCore/should_compile/T21763.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash #-} +module T21763 where + +import GHC.Exts + +-- We should get ONE SpecConstr-generated rule, for f2, +-- not one for f1 and one for f2 + +f1 :: Int -> [Int] -> (Int, [Int]) +-- This one only seq's x, so SpecConstr should not specialise it +f1 x [] = (x, x `seq` []) +f1 x (_:ys) = f1 x ys + + +f2 :: Int -> [Int] -> (Int, [Int]) +-- This one takes x apart, so SpecConstr should specialise it +f2 x [] = (x+1, x `seq` []) +f2 x (_:ys) = f2 x ys + +foo1 :: [Int] -> (Int, [Int]) +foo1 ys = f1 9 ys + +foo2 :: [Int] -> (Int, [Int]) +foo2 ys = f2 9 ys ===================================== testsuite/tests/simplCore/should_compile/T21763.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf20" [2] forall (sc :: Int#). $wf2 (I# sc) = f2_$s$wf2 sc + + ===================================== testsuite/tests/simplCore/should_compile/T21763a.hs ===================================== @@ -0,0 +1,12 @@ +module T21763a where + +{-# NOINLINE g_imp #-} +g_imp !x = not x + +f3 :: (Bool -> Bool) -> Bool -> [Bool] -> (Bool, [Bool]) +-- We want to specialize for `g` to turn it into a known call. +f3 g x [] = (g x, []) +f3 g x (_:ys) = f3 g x ys + +foo3 :: [Bool] -> (Bool, [Bool]) +foo3 ys = f3 g_imp True ys ===================================== testsuite/tests/simplCore/should_compile/T21763a.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf30" [2] forall. $wf3 g_imp = f3_$s$wf3 + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -424,3 +424,5 @@ test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) test('T21694b', [grep_errmsg(r'Arity=4') ], compile, ['-O -ddump-simpl']) test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) +test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d6ae3e91997b56ebfe129e97ed4f58657993814...9f6c96ea203d889d3f399d1d8d01fd6023dd7512 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d6ae3e91997b56ebfe129e97ed4f58657993814...9f6c96ea203d889d3f399d1d8d01fd6023dd7512 You're receiving 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 27 02:19:21 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 Aug 2022 22:19:21 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Improve SpecConstr for evals Message-ID: <63097f2952a04_e9d7d3d103bf415573bc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4451ba28 by Simon Peyton Jones at 2022-08-26T22:18:54-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 0ea4d0c6 by Matthew Pickering at 2022-08-26T22:18:57-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - bad5e5c2 by Matthew Pickering at 2022-08-26T22:18:57-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 0025aee1 by Matthew Pickering at 2022-08-26T22:18:57-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - 69f816e6 by Matthew Pickering at 2022-08-26T22:18:57-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - acb617f2 by Simon Peyton Jones at 2022-08-26T22:18:58-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 15 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Types/Id/Info.hs - + testsuite/tests/simplCore/should_compile/T21763.hs - + testsuite/tests/simplCore/should_compile/T21763.stderr - + testsuite/tests/simplCore/should_compile/T21763a.hs - + testsuite/tests/simplCore/should_compile/T21763a.stderr - + testsuite/tests/simplCore/should_compile/T22112.hs - + testsuite/tests/simplCore/should_compile/T22112.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3437,24 +3437,26 @@ lintAnnots pname pass guts = {-# SCC "lintAnnots" #-} do logger <- getLogger when (gopt Opt_DoAnnotationLinting dflags) $ liftIO $ Err.showPass logger "Annotation linting - first run" - nguts <- pass guts -- If appropriate re-run it without debug annotations to make sure -- that they made no difference. - when (gopt Opt_DoAnnotationLinting dflags) $ do - liftIO $ Err.showPass logger "Annotation linting - second run" - nguts' <- withoutAnnots pass guts - -- Finally compare the resulting bindings - liftIO $ Err.showPass logger "Annotation linting - comparison" - let binds = flattenBinds $ mg_binds nguts - binds' = flattenBinds $ mg_binds nguts' - (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' - when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat - [ lint_banner "warning" pname - , text "Core changes with annotations:" - , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs - ] - -- Return actual new guts - return nguts + if gopt Opt_DoAnnotationLinting dflags + then do + nguts <- pass guts + liftIO $ Err.showPass logger "Annotation linting - second run" + nguts' <- withoutAnnots pass guts + -- Finally compare the resulting bindings + liftIO $ Err.showPass logger "Annotation linting - comparison" + let binds = flattenBinds $ mg_binds nguts + binds' = flattenBinds $ mg_binds nguts' + (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' + when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat + [ lint_banner "warning" pname + , text "Core changes with annotations:" + , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs + ] + return nguts + else + pass guts -- | Run the given pass without annotations. This means that we both -- set the debugLevel setting to 0 in the environment as well as all ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -153,7 +153,7 @@ simplifyPgm logger unit_env opts , mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) = do { (termination_msg, it_count, counts_out, guts') - <- do_iteration 1 [] binds rules + <- do_iteration 1 [] binds rules ; when (logHasDumpFlag logger Opt_D_verbose_core2core && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ @@ -175,6 +175,9 @@ simplifyPgm logger unit_env opts print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode + -- Note the bang in !guts_no_binds. If you don't force `guts_no_binds` + -- the old bindings are retained until the end of all simplifier iterations + !guts_no_binds = guts { mg_binds = [], mg_rules = [] } do_iteration :: Int -- Counts iterations -> [SimplCount] -- Counts from earlier iterations, reversed @@ -198,7 +201,7 @@ simplifyPgm logger unit_env opts -- number of iterations we actually completed return ( "Simplifier baled out", iteration_no - 1 , totalise counts_so_far - , guts { mg_binds = binds, mg_rules = rules } ) + , guts_no_binds { mg_binds = binds, mg_rules = rules } ) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -253,7 +256,7 @@ simplifyPgm logger unit_env opts if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks - , guts { mg_binds = binds1, mg_rules = rules1 } ) + , guts_no_binds { mg_binds = binds1, mg_rules = rules1 } ) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2257,7 +2257,7 @@ prepareAlts tries these things: case e of x { (a,b) -> rhs } where the type is a single constructor type. This gives better code when rhs also scrutinises x or e. - See CoreUtils Note [Refine DEFAULT case alternatives] + See GHC.Core.Utils Note [Refine DEFAULT case alternatives] 3. combineIdenticalAlts: combine identical alternatives into a DEFAULT. See CoreUtils Note [Combine identical alternatives], which also ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,9 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) +import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) +import Data.Tuple {- ----------------------------------------------------- @@ -374,11 +376,14 @@ 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 [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: +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: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -401,52 +406,42 @@ 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.) -However, if we find any boring calls in the body, including *unsaturated* -ones, such as +Wrinkles + +* Boring calls. 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 callsToPats reports if it finds any of these. + 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. -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.) +* 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! Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -671,14 +666,16 @@ But regardless, SpecConstr can and should! It's easy: well as constructor applications. Wrinkles: + * This should all work perfectly fine for newtype classes. Mind you, currently newtype classes are inlined fairly agressively, but we may change that. And it would take extra code to exclude them, as well as being unnecessary. -* We (mis-) use LambdaVal for this purpose, because ConVal - requires us to list the data constructor and fields, and that - is (a) inconvenient and (b) unnecessary for class methods. +* In isValue, we (mis-) use LambdaVal for this ($fblah d1 .. dn) + because ConVal requires us to list the data constructor and + fields, and that is (a) inconvenient and (b) unnecessary for + class methods. ----------------------------------------------------- Stuff not yet handled @@ -764,35 +761,18 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = 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') + = 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') } {- ************************************************************************ @@ -956,14 +936,24 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -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 } +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. data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -984,8 +974,18 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v -scSubstTy :: ScEnv -> InType -> OutType -scSubstTy env ty = substTyUnchecked (sc_subst env) ty +-- The !subst ensures that we force the selection `(sc_subst env)`, which avoids +-- retaining all of `env` when we only need `subst`. The `Solo` means that the +-- substitution itself is lazy, because that type is often discarded. +-- The callers of `scSubstTy` always force the result (to unpack the `Solo`) +-- so we get the desired effect: we leave a thunk, but retain only the subst, +-- not the whole env. +-- +-- Fully forcing the result of `scSubstTy` regresses performance (#22102) +scSubstTy :: ScEnv -> InType -> Solo OutType +scSubstTy env ty = + let !subst = sc_subst env + in Solo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co @@ -1187,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -data Call = Call Id [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] -- Domain is OutIds +data Call = Call OutId [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 @@ -1210,6 +1210,9 @@ 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) } @@ -1227,7 +1230,20 @@ data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument | UnkOcc -- Used in some unknown way | ScrutOcc -- See Note [ScrutOcc] - (DataConEnv [ArgOcc]) -- How the sub-components are used + (DataConEnv [ArgOcc]) + -- [ArgOcc]: how the sub-components are used + +deadArgOcc :: ArgOcc -> Bool +deadArgOcc (ScrutOcc {}) = False +deadArgOcc UnkOcc = False +deadArgOcc NoOcc = True + +specialisableArgOcc :: ArgOcc -> Bool +-- | Does this occurence represent one worth specializing for. +specialisableArgOcc UnkOcc = False +specialisableArgOcc NoOcc = False +specialisableArgOcc (ScrutOcc {}) = True + {- Note [ScrutOcc] ~~~~~~~~~~~~~~~~~~ @@ -1253,6 +1269,9 @@ instance Outputable ArgOcc where ppr NoOcc = text "no-occ" evalScrutOcc :: ArgOcc +-- We use evalScrutOcc for +-- - mkVarUsage: applied functions +-- - scApp: dicts that are the arugment of a classop evalScrutOcc = ScrutOcc emptyUFM -- Experimentally, this version of combineOcc makes ScrutOcc "win", so @@ -1292,6 +1311,121 @@ 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 @@ -1302,7 +1436,9 @@ scExpr' env (Var v) = case scSubstId env v of Var v' -> return (mkVarUsage env v' [], Var v') e' -> scExpr (zapScSubst env) e' -scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) +scExpr' env (Type t) = + let !(Solo ty') = scSubstTy env t + in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e @@ -1316,6 +1452,11 @@ 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 @@ -1333,17 +1474,19 @@ scExpr' env (Case scrut b ty alts) = do { let (alt_env,b') = extendBndrWith RecArg env b -- Record RecArg for the components - ; (alt_usgs, alt_occs, alts') - <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts + ; (alt_usgs, alt_occs, alts') <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts ; let scrut_occ = foldr combineOcc NoOcc alt_occs scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ -- The combined usage of the scrutinee is given - -- by scrut_occ, which is passed to scScrut, which + -- by scrut_occ, which is passed to setScrutOcc, which -- in turn treats a bare-variable scrutinee specially + ; let !(Solo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, - Case scrut' b' (scSubstTy env ty) alts') } + Case scrut' b' ty' alts') } + + single_alt = isSingleton alts sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs @@ -1351,82 +1494,52 @@ scExpr' env (Case scrut b ty alts) ; (usg, rhs') <- scExpr env2 rhs ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2) scrut_occ = case con of - DataAlt dc -> ScrutOcc (unitUFM dc arg_occs) - _ -> evalScrutOcc + DataAlt dc -- See Note [Do not specialise evals] + | not (single_alt && all deadArgOcc arg_occs) + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; 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. +{- Note [Do not specialise evals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x y = case x of I# _ -> + if y>1 then f x (y-1) else x + +Here `x` is scrutinised by a case, but only in an eval-like way; the +/component/ of the I# is unused. We don't want to specialise this +function, even if we find a call (f (I# z)), because nothing is gained + * No case branches are discarded + * No allocation in removed +The specialised version would take an unboxed Int#, pass it along, +and rebox it at the end. + +In fact this can cause significant regression. In #21763 we had: +like + f = ... case x of x' { I# n -> + join j y = rhs + in ...jump j x'... + +Now if we specialise `j` for the argument `I# n`, we'll end up reboxing +it in `j`, without even removing an allocation from the call site. + +Reboxing is always a worry. But here we can ameliorate the problem as +follows. + +* In scExpr (Case ...), for a /single-alternative/ case expression, in + which the pattern binders are all unused, we build a UnkOcc for + the scrutinee, not one that maps the data constructor; we don't treat + this occurrence as a reason for specialisation. + +* Conveniently, SpecConstr is doing its own occurrence analysis, so + the "unused" bit is just looking for NoOcc + +* Note that if we have + f x = case x of { True -> e1; False -> e2 } + then even though the pattern binders are unused (there are none), it is + still worth specialising on x. Hence the /single-alternative/ guard. -} scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) @@ -1478,55 +1591,9 @@ mkVarUsage env fn args , scu_occs = unitVarEnv fn arg_occ } Nothing -> nullUsage where - -- I rather think we could use UnkOcc all the time 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) @@ -1574,7 +1641,8 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have generated + = SI { si_specs :: [OneSpec] -- The specialisations we have + -- generated for this function , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1585,7 +1653,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Local recursive groups] + -- See Note [Seeding recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1595,57 +1663,62 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -noSpecInfo :: SpecInfo -noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } +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 ---------------------- specNonRec :: ScEnv - -> ScUsage -- Body usage + -> CallEnv -- Calls in body -> 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_usg rhs_info - = specialise env (scu_calls body_usg) rhs_info - (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) +specNonRec env body_calls rhs_info + = specialise env body_calls rhs_info (initSpecInfo rhs_info) ---------------------- -specRec :: TopLevelFlag -> ScEnv - -> ScUsage -- Body usage +specRec :: ScEnv + -> CallEnv -- Calls in body -> [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 top_lvl env body_usg rhs_infos - = go 1 seed_calls nullUsage init_spec_infos +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 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 :: 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, 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 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 - = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) - -- , ppr seed_calls - -- , ppr body_usg ]) $ - return (usg_so_far, spec_infos) + = return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1654,26 +1727,20 @@ specRec top_lvl env body_usg rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - return (usg_so_far, 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) | otherwise - = -- 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 } + = go (n_iter + 1) seed_calls usg_so_far spec_infos -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max - ---------------------- specialise :: ScEnv @@ -1696,14 +1763,12 @@ 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 @@ -1729,14 +1794,16 @@ 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 | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') = case mb_unspec of + Just rhs_usg | unspec_rhs_needed + -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1744,8 +1811,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 @@ -2027,7 +2094,8 @@ 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, unless there are no calls at all to the function. +the passed-in SpecInfo in si_mb_unspec, 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 @@ -2245,9 +2313,11 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) - -- Result has no duplicate patterns, - -- nor ones mentioned in done_pats - -- Bool indicates that there was at least one boring pattern +-- 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" callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls @@ -2558,10 +2628,8 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str -- (b) we know what its value is -- In that case it counts as "interesting" argToPat1 env in_scope val_env (Var v) arg_occ arg_str - | sc_force env || case arg_occ of { ScrutOcc {} -> True - ; UnkOcc -> False - ; NoOcc -> False } -- (a) - , is_value -- (b) + | sc_force env || specialisableArgOcc arg_occ -- (a) + , is_value -- (b) -- Ignoring sc_keen here to avoid gratuitously incurring Note [Reboxing] -- So sc_keen focused just on f (I# x), where we have freshly-allocated -- box that we can eliminate in the caller ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -10,7 +10,7 @@ The code for *top-level* bindings is in GHC.Iface.Tidy. {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} module GHC.Core.Tidy ( - tidyExpr, tidyRules, tidyUnfolding, tidyCbvInfoTop + tidyExpr, tidyRules, tidyCbvInfoTop, tidyBndrs ) where import GHC.Prelude @@ -360,33 +360,36 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id `setUnfoldingInfo` new_unf old_unf = realUnfoldingInfo old_info - new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf - | otherwise = trimUnfolding old_unf - -- See Note [Preserve evaluatedness] + new_unf = tidyNestedUnfolding rec_tidy_env old_unf in ((tidy_env', var_env'), id') } ------------ Unfolding -------------- -tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding -tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _ +tidyNestedUnfolding :: TidyEnv -> Unfolding -> Unfolding +tidyNestedUnfolding _ NoUnfolding = NoUnfolding +tidyNestedUnfolding _ BootUnfolding = BootUnfolding +tidyNestedUnfolding _ (OtherCon {}) = evaldUnfolding + +tidyNestedUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args } where (tidy_env', bndrs') = tidyBndrs tidy_env bndrs -tidyUnfolding tidy_env - unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) - unf_from_rhs +tidyNestedUnfolding tidy_env + unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_is_value = is_value }) | isStableSource src = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo - -- This seqIt avoids a space leak: otherwise the uf_is_value, - -- uf_is_conlike, ... fields may retain a reference to the - -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them) - - | otherwise - = unf_from_rhs - where seqIt unf = seqUnfolding unf `seq` unf -tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon + -- This seqIt avoids a space leak: otherwise the uf_is_value, + -- uf_is_conlike, ... fields may retain a reference to the + -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them) + + -- Discard unstable unfoldings, but see Note [Preserve evaluatedness] + | is_value = evaldUnfolding + | otherwise = noUnfolding + + where + seqIt unf = seqUnfolding unf `seq` unf {- Note [Tidy IdInfo] ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -706,7 +706,11 @@ filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (us -- in a "case" statement then they will need to manually add a dummy case branch that just -- calls "error" or similar. filterAlts _tycon inst_tys imposs_cons alts - = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + = imposs_deflt_cons `seqList` + (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which + -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter + -- leads to a huge space leak (see #22102 and !8896) where (alts_wo_default, maybe_deflt) = findDefault alts alt_cons = [con | Alt con _ _ <- alts_wo_default] ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -24,16 +24,17 @@ import GHC.Tc.Utils.Env import GHC.Core import GHC.Core.Unfold -import GHC.Core.Unfold.Make +-- import GHC.Core.Unfold.Make import GHC.Core.FVs import GHC.Core.Tidy -import GHC.Core.Seq (seqBinds) +import GHC.Core.Seq ( seqBinds ) import GHC.Core.Opt.Arity ( exprArity, typeArity, exprBotStrictness_maybe ) import GHC.Core.InstEnv import GHC.Core.Type ( Type, tidyTopType ) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Iface.Tidy.StaticPtrTable import GHC.Iface.Env @@ -383,8 +384,7 @@ tidyProgram opts (ModGuts { mg_module = mod (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod binds implicit_binds imp_rules let (trimmed_binds, trimmed_rules) = findExternalRules opts binds imp_rules unfold_env - let uf_opts = opt_unfolding_opts opts - (tidy_env, tidy_binds) <- tidyTopBinds uf_opts unfold_env boot_exports tidy_occ_env trimmed_binds + (tidy_env, tidy_binds) <- tidyTopBinds unfold_env boot_exports tidy_occ_env trimmed_binds -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. (spt_entries, mcstub, tidy_binds') <- case opt_static_ptr_opts opts of @@ -1152,60 +1152,49 @@ tidyTopName mod name_cache maybe_ref occ_env id -- -- * subst_env: A Var->Var mapping that substitutes the new Var for the old -tidyTopBinds :: UnfoldingOpts - -> UnfoldEnv +tidyTopBinds :: UnfoldEnv -> NameSet -> TidyOccEnv -> CoreProgram -> IO (TidyEnv, CoreProgram) -tidyTopBinds uf_opts unfold_env boot_exports init_occ_env binds +tidyTopBinds unfold_env boot_exports init_occ_env binds = do let result = tidy init_env binds seqBinds (snd result) `seq` return result -- This seqBinds avoids a spike in space usage (see #13564) where init_env = (init_occ_env, emptyVarEnv) - tidy = mapAccumL (tidyTopBind uf_opts unfold_env boot_exports) + tidy = mapAccumL (tidyTopBind unfold_env boot_exports) ------------------------ -tidyTopBind :: UnfoldingOpts - -> UnfoldEnv +tidyTopBind :: UnfoldEnv -> NameSet -> TidyEnv -> CoreBind -> (TidyEnv, CoreBind) -tidyTopBind uf_opts unfold_env boot_exports +tidyTopBind unfold_env boot_exports (occ_env,subst1) (NonRec bndr rhs) = (tidy_env2, NonRec bndr' rhs') where - Just (name',show_unfold) = lookupVarEnv unfold_env bndr - (bndr', rhs') = tidyTopPair uf_opts show_unfold boot_exports tidy_env2 name' (bndr, rhs) + (bndr', rhs') = tidyTopPair unfold_env boot_exports tidy_env2 (bndr, rhs) subst2 = extendVarEnv subst1 bndr bndr' tidy_env2 = (occ_env, subst2) -tidyTopBind uf_opts unfold_env boot_exports (occ_env, subst1) (Rec prs) +tidyTopBind unfold_env boot_exports (occ_env, subst1) (Rec prs) = (tidy_env2, Rec prs') where - prs' = [ tidyTopPair uf_opts show_unfold boot_exports tidy_env2 name' (id,rhs) - | (id,rhs) <- prs, - let (name',show_unfold) = - expectJust "tidyTopBind" $ lookupVarEnv unfold_env id - ] - - subst2 = extendVarEnvList subst1 (bndrs `zip` map fst prs') + prs' = map (tidyTopPair unfold_env boot_exports tidy_env2) prs + subst2 = extendVarEnvList subst1 (map fst prs `zip` map fst prs') tidy_env2 = (occ_env, subst2) - - bndrs = map fst prs + -- This is where we "tie the knot": tidy_env2 is fed into tidyTopPair ----------------------------------------------------------- -tidyTopPair :: UnfoldingOpts - -> Bool -- show unfolding +tidyTopPair :: UnfoldEnv -> NameSet -> TidyEnv -- The TidyEnv is used to tidy the IdInfo -- It is knot-tied: don't look at it! - -> Name -- New name -> (Id, CoreExpr) -- Binder and RHS before tidying -> (Id, CoreExpr) -- This function is the heart of Step 2 @@ -1214,17 +1203,18 @@ tidyTopPair :: UnfoldingOpts -- group, a variable late in the group might be mentioned -- in the IdInfo of one early in the group -tidyTopPair uf_opts show_unfold boot_exports rhs_tidy_env name' (bndr, rhs) +tidyTopPair unfold_env boot_exports rhs_tidy_env (bndr, rhs) = -- pprTrace "tidyTop" (ppr name' <+> ppr details <+> ppr rhs) $ (bndr1, rhs1) where + Just (name',show_unfold) = lookupVarEnv unfold_env bndr !cbv_bndr = tidyCbvInfoTop boot_exports bndr rhs bndr1 = mkGlobalId details name' ty' idinfo' details = idDetails cbv_bndr -- Preserve the IdDetails ty' = tidyTopType (idType cbv_bndr) rhs1 = tidyExpr rhs_tidy_env rhs - idinfo' = tidyTopIdInfo uf_opts rhs_tidy_env name' ty' + idinfo' = tidyTopIdInfo rhs_tidy_env name' ty' rhs rhs1 (idInfo cbv_bndr) show_unfold -- tidyTopIdInfo creates the final IdInfo for top-level @@ -1234,9 +1224,9 @@ tidyTopPair uf_opts show_unfold boot_exports rhs_tidy_env name' (bndr, rhs) -- Indeed, CorePrep must eta expand where necessary to make -- the manifest arity equal to the claimed arity. -- -tidyTopIdInfo :: UnfoldingOpts -> TidyEnv -> Name -> Type +tidyTopIdInfo :: TidyEnv -> Name -> Type -> CoreExpr -> CoreExpr -> IdInfo -> Bool -> IdInfo -tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold +tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold | not is_external -- For internal Ids (not externally visible) = vanillaIdInfo -- we only need enough info for code generation -- Arity and strictness info are enough; @@ -1292,31 +1282,20 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf Just (arity, _, _) -> not (isDeadEndAppSig id_sig arity) --------- Unfolding ------------ + -- Force unfold_info (hence bangs), otherwise the old unfolding + -- is retained during code generation. See #22071 + unf_info = realUnfoldingInfo idinfo - -- 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 - 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 - -- marked NOINLINE or something like that - -- This is important: if you expose the worker for a loop-breaker - -- then you can make the simplifier go into an infinite loop, because - -- in effect the unfolding is exposed. See #1709 - -- - -- You might think that if show_unfold is False, then the thing should - -- not be w/w'd in the first place. But a legitimate reason is this: - -- the function returns bottom - -- In this case, show_unfold will be false (we don't expose unfoldings - -- for bottoming functions), but we might still have a worker/wrapper - -- split (see Note [Worker/wrapper for bottoming functions] in - -- GHC.Core.Opt.WorkWrap) + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold + = tidyTopUnfolding rhs_tidy_env tidy_rhs unf_info + | otherwise + = minimal_unfold_info +-- unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig orig_rhs + -- NB: use `orig_rhs` not `tidy_rhs` in this call to mkFinalUnfolding + -- else you get a black hole (#22122). Reason: mkFinalUnfolding + -- looks at IdInfo, and that is knot-tied in tidyTopBind (the Rec case) --------- Arity ------------ -- Usually the Id will have an accurate arity on it, because @@ -1328,10 +1307,59 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf arity = exprArity orig_rhs `min` typeArity rhs_ty -- orig_rhs: using tidy_rhs would make a black hole, since -- exprArity uses the arities of Ids inside the rhs + -- -- typeArity: see Note [Arity invariants for bindings] -- in GHC.Core.Opt.Arity -{- +------------ Unfolding -------------- +tidyTopUnfolding :: TidyEnv -> CoreExpr -> Unfolding -> Unfolding +tidyTopUnfolding _ _ NoUnfolding = NoUnfolding +tidyTopUnfolding _ _ BootUnfolding = BootUnfolding +tidyTopUnfolding _ _ (OtherCon {}) = evaldUnfolding + +tidyTopUnfolding tidy_env _ df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) + = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args } + where + (tidy_env', bndrs') = tidyBndrs tidy_env bndrs + +tidyTopUnfolding tidy_env tidy_rhs + unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) + = -- See Note [tidyTopUnfolding: avoiding black holes] + unf { uf_tmpl = tidy_unf_rhs } + where + tidy_unf_rhs | isStableSource src + = tidyExpr tidy_env unf_rhs -- Preserves OccInfo in unf_rhs + | otherwise + = occurAnalyseExpr tidy_rhs -- Do occ-anal + +{- Note [tidyTopUnfolding: avoiding black holes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we are exposing all unfoldings we don't want to tidy the unfolding +twice -- we just want to use the tidied RHS. That tidied RHS itself +contains fully-tidied Ids -- it is knot-tied. So the uf_tmpl for the +unfolding contains stuff we can't look at. Now consider (#22112) + foo = foo +If we freshly compute the uf_is_value field for foo's unfolding, +we'll call `exprIsValue`, which will look at foo's unfolding! +Whether or not the RHS is a value depends on whether foo is a value... +black hole. + +In the Simplifier we deal with this by not giving `foo` an unfolding +in its own RHS. And we could do that here. But it's qite nice +to common everything up to a single Id for foo, used everywhere. + +And it's not too hard: simply leave the unfolding undisturbed, except +tidy the uf_tmpl field. Hence tidyTopUnfolding does + unf { uf_tmpl = tidy_unf_rhs } + +Don't mess with uf_is_value, or guidance; in particular don't recompute +them from tidy_unf_rhs. + +And (unlike tidyNestedUnfolding) don't deep-seq the new unfolding, +because that'll cause a black hole (I /think/ because occurAnalyseExpr +looks in IdInfo). + + ************************************************************************ * * Old, dead, type-trimming code ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -816,7 +816,7 @@ zapFragileUnfolding unf trimUnfolding :: Unfolding -> Unfolding -- Squash all unfolding info, preserving only evaluated-ness trimUnfolding unf | isEvaldUnfolding unf = evaldUnfolding - | otherwise = noUnfolding + | otherwise = noUnfolding zapTailCallInfo :: IdInfo -> Maybe IdInfo zapTailCallInfo info ===================================== testsuite/tests/simplCore/should_compile/T21763.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash #-} +module T21763 where + +import GHC.Exts + +-- We should get ONE SpecConstr-generated rule, for f2, +-- not one for f1 and one for f2 + +f1 :: Int -> [Int] -> (Int, [Int]) +-- This one only seq's x, so SpecConstr should not specialise it +f1 x [] = (x, x `seq` []) +f1 x (_:ys) = f1 x ys + + +f2 :: Int -> [Int] -> (Int, [Int]) +-- This one takes x apart, so SpecConstr should specialise it +f2 x [] = (x+1, x `seq` []) +f2 x (_:ys) = f2 x ys + +foo1 :: [Int] -> (Int, [Int]) +foo1 ys = f1 9 ys + +foo2 :: [Int] -> (Int, [Int]) +foo2 ys = f2 9 ys ===================================== testsuite/tests/simplCore/should_compile/T21763.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf20" [2] forall (sc :: Int#). $wf2 (I# sc) = f2_$s$wf2 sc + + ===================================== testsuite/tests/simplCore/should_compile/T21763a.hs ===================================== @@ -0,0 +1,12 @@ +module T21763a where + +{-# NOINLINE g_imp #-} +g_imp !x = not x + +f3 :: (Bool -> Bool) -> Bool -> [Bool] -> (Bool, [Bool]) +-- We want to specialize for `g` to turn it into a known call. +f3 g x [] = (g x, []) +f3 g x (_:ys) = f3 g x ys + +foo3 :: [Bool] -> (Bool, [Bool]) +foo3 ys = f3 g_imp True ys ===================================== testsuite/tests/simplCore/should_compile/T21763a.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf30" [2] forall. $wf3 g_imp = f3_$s$wf3 + + ===================================== testsuite/tests/simplCore/should_compile/T22112.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Rec where + +-- This one created a black hole in Tidy, +-- when creating the tidied unfolding for foo +foo :: () -> () +foo = foo ===================================== testsuite/tests/simplCore/should_compile/T22112.stderr ===================================== @@ -0,0 +1,14 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 2, types: 2, coercions: 0, joins: 0/0} + +Rec { +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +foo [Occ=LoopBreaker] :: () -> () +[GblId, Str=b, Cpr=b] +foo = foo +end Rec } + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -415,6 +415,7 @@ test('T17966', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec']) # We expect to see a SPEC rule for $cm test('T19644', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec']) test('T21391', normal, compile, ['-O -dcore-lint']) +test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T21391a', normal, compile, ['-O -dcore-lint']) # We don't want to see a thunk allocation for the insertBy expression after CorePrep. test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) @@ -424,3 +425,5 @@ test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) test('T21694b', [grep_errmsg(r'Arity=4') ], compile, ['-O -ddump-simpl']) test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) +test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f6c96ea203d889d3f399d1d8d01fd6023dd7512...acb617f23bac29376a86318539fbbb1c264b988b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f6c96ea203d889d3f399d1d8d01fd6023dd7512...acb617f23bac29376a86318539fbbb1c264b988b You're receiving 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 27 04:29:19 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 27 Aug 2022 00:29:19 -0400 Subject: [Git][ghc/ghc][master] Improve SpecConstr for evals Message-ID: <63099d9fd0c41_e9d7d3d103bf41582664@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 7 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - + testsuite/tests/simplCore/should_compile/T21763.hs - + testsuite/tests/simplCore/should_compile/T21763.stderr - + testsuite/tests/simplCore/should_compile/T21763a.hs - + testsuite/tests/simplCore/should_compile/T21763a.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2257,7 +2257,7 @@ prepareAlts tries these things: case e of x { (a,b) -> rhs } where the type is a single constructor type. This gives better code when rhs also scrutinises x or e. - See CoreUtils Note [Refine DEFAULT case alternatives] + See GHC.Core.Utils Note [Refine DEFAULT case alternatives] 3. combineIdenticalAlts: combine identical alternatives into a DEFAULT. See CoreUtils Note [Combine identical alternatives], which also ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -671,14 +671,16 @@ But regardless, SpecConstr can and should! It's easy: well as constructor applications. Wrinkles: + * This should all work perfectly fine for newtype classes. Mind you, currently newtype classes are inlined fairly agressively, but we may change that. And it would take extra code to exclude them, as well as being unnecessary. -* We (mis-) use LambdaVal for this purpose, because ConVal - requires us to list the data constructor and fields, and that - is (a) inconvenient and (b) unnecessary for class methods. +* In isValue, we (mis-) use LambdaVal for this ($fblah d1 .. dn) + because ConVal requires us to list the data constructor and + fields, and that is (a) inconvenient and (b) unnecessary for + class methods. ----------------------------------------------------- Stuff not yet handled @@ -1227,7 +1229,20 @@ data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument | UnkOcc -- Used in some unknown way | ScrutOcc -- See Note [ScrutOcc] - (DataConEnv [ArgOcc]) -- How the sub-components are used + (DataConEnv [ArgOcc]) + -- [ArgOcc]: how the sub-components are used + +deadArgOcc :: ArgOcc -> Bool +deadArgOcc (ScrutOcc {}) = False +deadArgOcc UnkOcc = False +deadArgOcc NoOcc = True + +specialisableArgOcc :: ArgOcc -> Bool +-- | Does this occurence represent one worth specializing for. +specialisableArgOcc UnkOcc = False +specialisableArgOcc NoOcc = False +specialisableArgOcc (ScrutOcc {}) = True + {- Note [ScrutOcc] ~~~~~~~~~~~~~~~~~~ @@ -1253,6 +1268,9 @@ instance Outputable ArgOcc where ppr NoOcc = text "no-occ" evalScrutOcc :: ArgOcc +-- We use evalScrutOcc for +-- - mkVarUsage: applied functions +-- - scApp: dicts that are the arugment of a classop evalScrutOcc = ScrutOcc emptyUFM -- Experimentally, this version of combineOcc makes ScrutOcc "win", so @@ -1333,26 +1351,29 @@ scExpr' env (Case scrut b ty alts) = do { let (alt_env,b') = extendBndrWith RecArg env b -- Record RecArg for the components - ; (alt_usgs, alt_occs, alts') - <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts + ; (alt_usgs, alt_occs, alts') <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts ; let scrut_occ = foldr combineOcc NoOcc alt_occs scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ -- The combined usage of the scrutinee is given - -- by scrut_occ, which is passed to scScrut, which + -- by scrut_occ, which is passed to setScrutOcc, which -- in turn treats a bare-variable scrutinee specially ; return (foldr combineUsage scrut_usg' alt_usgs, Case scrut' b' (scSubstTy env ty) alts') } + single_alt = isSingleton alts + sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs (env2, bs2) = extendCaseBndrs env1 scrut' b' con bs1 ; (usg, rhs') <- scExpr env2 rhs ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2) scrut_occ = case con of - DataAlt dc -> ScrutOcc (unitUFM dc arg_occs) - _ -> evalScrutOcc + DataAlt dc -- See Note [Do not specialise evals] + | not (single_alt && all deadArgOcc arg_occs) + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } scExpr' env (Let (NonRec bndr rhs) body) @@ -1429,6 +1450,46 @@ recursive function, but that's not essential and might even be harmful. I'm not sure. -} +{- Note [Do not specialise evals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x y = case x of I# _ -> + if y>1 then f x (y-1) else x + +Here `x` is scrutinised by a case, but only in an eval-like way; the +/component/ of the I# is unused. We don't want to specialise this +function, even if we find a call (f (I# z)), because nothing is gained + * No case branches are discarded + * No allocation in removed +The specialised version would take an unboxed Int#, pass it along, +and rebox it at the end. + +In fact this can cause significant regression. In #21763 we had: +like + f = ... case x of x' { I# n -> + join j y = rhs + in ...jump j x'... + +Now if we specialise `j` for the argument `I# n`, we'll end up reboxing +it in `j`, without even removing an allocation from the call site. + +Reboxing is always a worry. But here we can ameliorate the problem as +follows. + +* In scExpr (Case ...), for a /single-alternative/ case expression, in + which the pattern binders are all unused, we build a UnkOcc for + the scrutinee, not one that maps the data constructor; we don't treat + this occurrence as a reason for specialisation. + +* Conveniently, SpecConstr is doing its own occurrence analysis, so + the "unused" bit is just looking for NoOcc + +* Note that if we have + f x = case x of { True -> e1; False -> e2 } + then even though the pattern binders are unused (there are none), it is + still worth specialising on x. Hence the /single-alternative/ guard. +-} + scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) scApp env (Var fn, args) -- Function is a variable @@ -1478,7 +1539,6 @@ mkVarUsage env fn args , scu_occs = unitVarEnv fn arg_occ } Nothing -> nullUsage where - -- I rather think we could use UnkOcc all the time arg_occ | null args = UnkOcc | otherwise = evalScrutOcc @@ -2558,10 +2618,8 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str -- (b) we know what its value is -- In that case it counts as "interesting" argToPat1 env in_scope val_env (Var v) arg_occ arg_str - | sc_force env || case arg_occ of { ScrutOcc {} -> True - ; UnkOcc -> False - ; NoOcc -> False } -- (a) - , is_value -- (b) + | sc_force env || specialisableArgOcc arg_occ -- (a) + , is_value -- (b) -- Ignoring sc_keen here to avoid gratuitously incurring Note [Reboxing] -- So sc_keen focused just on f (I# x), where we have freshly-allocated -- box that we can eliminate in the caller ===================================== testsuite/tests/simplCore/should_compile/T21763.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash #-} +module T21763 where + +import GHC.Exts + +-- We should get ONE SpecConstr-generated rule, for f2, +-- not one for f1 and one for f2 + +f1 :: Int -> [Int] -> (Int, [Int]) +-- This one only seq's x, so SpecConstr should not specialise it +f1 x [] = (x, x `seq` []) +f1 x (_:ys) = f1 x ys + + +f2 :: Int -> [Int] -> (Int, [Int]) +-- This one takes x apart, so SpecConstr should specialise it +f2 x [] = (x+1, x `seq` []) +f2 x (_:ys) = f2 x ys + +foo1 :: [Int] -> (Int, [Int]) +foo1 ys = f1 9 ys + +foo2 :: [Int] -> (Int, [Int]) +foo2 ys = f2 9 ys ===================================== testsuite/tests/simplCore/should_compile/T21763.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf20" [2] forall (sc :: Int#). $wf2 (I# sc) = f2_$s$wf2 sc + + ===================================== testsuite/tests/simplCore/should_compile/T21763a.hs ===================================== @@ -0,0 +1,12 @@ +module T21763a where + +{-# NOINLINE g_imp #-} +g_imp !x = not x + +f3 :: (Bool -> Bool) -> Bool -> [Bool] -> (Bool, [Bool]) +-- We want to specialize for `g` to turn it into a known call. +f3 g x [] = (g x, []) +f3 g x (_:ys) = f3 g x ys + +foo3 :: [Bool] -> (Bool, [Bool]) +foo3 ys = f3 g_imp True ys ===================================== testsuite/tests/simplCore/should_compile/T21763a.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf30" [2] forall. $wf3 g_imp = f3_$s$wf3 + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -424,3 +424,5 @@ test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) test('T21694b', [grep_errmsg(r'Arity=4') ], compile, ['-O -ddump-simpl']) test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) +test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95fe09da09b386008fd730abc5374f3521dd339b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95fe09da09b386008fd730abc5374f3521dd339b You're receiving 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 27 04:29:57 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 27 Aug 2022 00:29:57 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" Message-ID: <63099dc5bb430_e9d7d6cf320ac1586288@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3437,24 +3437,26 @@ lintAnnots pname pass guts = {-# SCC "lintAnnots" #-} do logger <- getLogger when (gopt Opt_DoAnnotationLinting dflags) $ liftIO $ Err.showPass logger "Annotation linting - first run" - nguts <- pass guts -- If appropriate re-run it without debug annotations to make sure -- that they made no difference. - when (gopt Opt_DoAnnotationLinting dflags) $ do - liftIO $ Err.showPass logger "Annotation linting - second run" - nguts' <- withoutAnnots pass guts - -- Finally compare the resulting bindings - liftIO $ Err.showPass logger "Annotation linting - comparison" - let binds = flattenBinds $ mg_binds nguts - binds' = flattenBinds $ mg_binds nguts' - (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' - when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat - [ lint_banner "warning" pname - , text "Core changes with annotations:" - , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs - ] - -- Return actual new guts - return nguts + if gopt Opt_DoAnnotationLinting dflags + then do + nguts <- pass guts + liftIO $ Err.showPass logger "Annotation linting - second run" + nguts' <- withoutAnnots pass guts + -- Finally compare the resulting bindings + liftIO $ Err.showPass logger "Annotation linting - comparison" + let binds = flattenBinds $ mg_binds nguts + binds' = flattenBinds $ mg_binds nguts' + (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' + when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat + [ lint_banner "warning" pname + , text "Core changes with annotations:" + , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs + ] + return nguts + else + pass guts -- | Run the given pass without annotations. This means that we both -- set the debugLevel setting to 0 in the environment as well as all ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -153,7 +153,7 @@ simplifyPgm logger unit_env opts , mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) = do { (termination_msg, it_count, counts_out, guts') - <- do_iteration 1 [] binds rules + <- do_iteration 1 [] binds rules ; when (logHasDumpFlag logger Opt_D_verbose_core2core && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ @@ -175,6 +175,9 @@ simplifyPgm logger unit_env opts print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode + -- Note the bang in !guts_no_binds. If you don't force `guts_no_binds` + -- the old bindings are retained until the end of all simplifier iterations + !guts_no_binds = guts { mg_binds = [], mg_rules = [] } do_iteration :: Int -- Counts iterations -> [SimplCount] -- Counts from earlier iterations, reversed @@ -198,7 +201,7 @@ simplifyPgm logger unit_env opts -- number of iterations we actually completed return ( "Simplifier baled out", iteration_no - 1 , totalise counts_so_far - , guts { mg_binds = binds, mg_rules = rules } ) + , guts_no_binds { mg_binds = binds, mg_rules = rules } ) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -253,7 +256,7 @@ simplifyPgm logger unit_env opts if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks - , guts { mg_binds = binds1, mg_rules = rules1 } ) + , guts_no_binds { mg_binds = binds1, mg_rules = rules1 } ) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,9 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) +import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) +import Data.Tuple {- ----------------------------------------------------- @@ -374,11 +376,14 @@ 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 [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: +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: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -401,52 +406,42 @@ 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.) -However, if we find any boring calls in the body, including *unsaturated* -ones, such as +Wrinkles + +* Boring calls. 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 callsToPats reports if it finds any of these. + 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. -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.) +* 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! Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -766,35 +761,18 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = 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') + = 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') } {- ************************************************************************ @@ -958,14 +936,24 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -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 } +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. data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -986,8 +974,18 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v -scSubstTy :: ScEnv -> InType -> OutType -scSubstTy env ty = substTyUnchecked (sc_subst env) ty +-- The !subst ensures that we force the selection `(sc_subst env)`, which avoids +-- retaining all of `env` when we only need `subst`. The `Solo` means that the +-- substitution itself is lazy, because that type is often discarded. +-- The callers of `scSubstTy` always force the result (to unpack the `Solo`) +-- so we get the desired effect: we leave a thunk, but retain only the subst, +-- not the whole env. +-- +-- Fully forcing the result of `scSubstTy` regresses performance (#22102) +scSubstTy :: ScEnv -> InType -> Solo OutType +scSubstTy env ty = + let !subst = sc_subst env + in Solo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co @@ -1189,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -data Call = Call Id [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] -- Domain is OutIds +data Call = Call OutId [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 @@ -1212,6 +1210,9 @@ 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) } @@ -1310,6 +1311,121 @@ 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 @@ -1320,7 +1436,9 @@ scExpr' env (Var v) = case scSubstId env v of Var v' -> return (mkVarUsage env v' [], Var v') e' -> scExpr (zapScSubst env) e' -scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) +scExpr' env (Type t) = + let !(Solo ty') = scSubstTy env t + in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e @@ -1334,6 +1452,11 @@ 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 @@ -1358,9 +1481,10 @@ scExpr' env (Case scrut b ty alts) -- The combined usage of the scrutinee is given -- by scrut_occ, which is passed to setScrutOcc, which -- in turn treats a bare-variable scrutinee specially + ; let !(Solo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, - Case scrut' b' (scSubstTy env ty) alts') } + Case scrut' b' ty' alts') } single_alt = isSingleton alts @@ -1376,79 +1500,7 @@ scExpr' env (Case scrut b ty alts) _ -> UnkOcc ; 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. --} {- Note [Do not specialise evals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1542,51 +1594,6 @@ 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) @@ -1634,7 +1641,8 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have generated + = SI { si_specs :: [OneSpec] -- The specialisations we have + -- generated for this function , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1645,7 +1653,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Local recursive groups] + -- See Note [Seeding recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1655,57 +1663,62 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -noSpecInfo :: SpecInfo -noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } +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 ---------------------- specNonRec :: ScEnv - -> ScUsage -- Body usage + -> CallEnv -- Calls in body -> 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_usg rhs_info - = specialise env (scu_calls body_usg) rhs_info - (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) +specNonRec env body_calls rhs_info + = specialise env body_calls rhs_info (initSpecInfo rhs_info) ---------------------- -specRec :: TopLevelFlag -> ScEnv - -> ScUsage -- Body usage +specRec :: ScEnv + -> CallEnv -- Calls in body -> [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 top_lvl env body_usg rhs_infos - = go 1 seed_calls nullUsage init_spec_infos +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 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 :: 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, 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 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 - = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) - -- , ppr seed_calls - -- , ppr body_usg ]) $ - return (usg_so_far, spec_infos) + = return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1714,26 +1727,20 @@ specRec top_lvl env body_usg rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - return (usg_so_far, 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) | otherwise - = -- 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 } + = go (n_iter + 1) seed_calls usg_so_far spec_infos -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max - ---------------------- specialise :: ScEnv @@ -1756,14 +1763,12 @@ 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 @@ -1789,14 +1794,16 @@ 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 | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') = case mb_unspec of + Just rhs_usg | unspec_rhs_needed + -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1804,8 +1811,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 @@ -2087,7 +2094,8 @@ 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, unless there are no calls at all to the function. +the passed-in SpecInfo in si_mb_unspec, 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 @@ -2305,9 +2313,11 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) - -- Result has no duplicate patterns, - -- nor ones mentioned in done_pats - -- Bool indicates that there was at least one boring pattern +-- 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" callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -706,7 +706,11 @@ filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (us -- in a "case" statement then they will need to manually add a dummy case branch that just -- calls "error" or similar. filterAlts _tycon inst_tys imposs_cons alts - = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + = imposs_deflt_cons `seqList` + (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which + -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter + -- leads to a huge space leak (see #22102 and !8896) where (alts_wo_default, maybe_deflt) = findDefault alts alt_cons = [con | Alt con _ _ <- alts_wo_default] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95fe09da09b386008fd730abc5374f3521dd339b...a3b23a3318a556beba62a3637600692639575c44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95fe09da09b386008fd730abc5374f3521dd339b...a3b23a3318a556beba62a3637600692639575c44 You're receiving 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 27 04:30:30 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 27 Aug 2022 00:30:30 -0400 Subject: [Git][ghc/ghc][master] Fix a nasty loop in Tidy Message-ID: <63099de682093_e9d7d36163a74158979f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 6 changed files: - compiler/GHC/Core/Tidy.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Types/Id/Info.hs - + testsuite/tests/simplCore/should_compile/T22112.hs - + testsuite/tests/simplCore/should_compile/T22112.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -10,7 +10,7 @@ The code for *top-level* bindings is in GHC.Iface.Tidy. {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} module GHC.Core.Tidy ( - tidyExpr, tidyRules, tidyUnfolding, tidyCbvInfoTop + tidyExpr, tidyRules, tidyCbvInfoTop, tidyBndrs ) where import GHC.Prelude @@ -360,33 +360,36 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id `setUnfoldingInfo` new_unf old_unf = realUnfoldingInfo old_info - new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf - | otherwise = trimUnfolding old_unf - -- See Note [Preserve evaluatedness] + new_unf = tidyNestedUnfolding rec_tidy_env old_unf in ((tidy_env', var_env'), id') } ------------ Unfolding -------------- -tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding -tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _ +tidyNestedUnfolding :: TidyEnv -> Unfolding -> Unfolding +tidyNestedUnfolding _ NoUnfolding = NoUnfolding +tidyNestedUnfolding _ BootUnfolding = BootUnfolding +tidyNestedUnfolding _ (OtherCon {}) = evaldUnfolding + +tidyNestedUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args } where (tidy_env', bndrs') = tidyBndrs tidy_env bndrs -tidyUnfolding tidy_env - unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) - unf_from_rhs +tidyNestedUnfolding tidy_env + unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_is_value = is_value }) | isStableSource src = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo - -- This seqIt avoids a space leak: otherwise the uf_is_value, - -- uf_is_conlike, ... fields may retain a reference to the - -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them) - - | otherwise - = unf_from_rhs - where seqIt unf = seqUnfolding unf `seq` unf -tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon + -- This seqIt avoids a space leak: otherwise the uf_is_value, + -- uf_is_conlike, ... fields may retain a reference to the + -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them) + + -- Discard unstable unfoldings, but see Note [Preserve evaluatedness] + | is_value = evaldUnfolding + | otherwise = noUnfolding + + where + seqIt unf = seqUnfolding unf `seq` unf {- Note [Tidy IdInfo] ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -24,16 +24,17 @@ import GHC.Tc.Utils.Env import GHC.Core import GHC.Core.Unfold -import GHC.Core.Unfold.Make +-- import GHC.Core.Unfold.Make import GHC.Core.FVs import GHC.Core.Tidy -import GHC.Core.Seq (seqBinds) +import GHC.Core.Seq ( seqBinds ) import GHC.Core.Opt.Arity ( exprArity, typeArity, exprBotStrictness_maybe ) import GHC.Core.InstEnv import GHC.Core.Type ( Type, tidyTopType ) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Iface.Tidy.StaticPtrTable import GHC.Iface.Env @@ -383,8 +384,7 @@ tidyProgram opts (ModGuts { mg_module = mod (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod binds implicit_binds imp_rules let (trimmed_binds, trimmed_rules) = findExternalRules opts binds imp_rules unfold_env - let uf_opts = opt_unfolding_opts opts - (tidy_env, tidy_binds) <- tidyTopBinds uf_opts unfold_env boot_exports tidy_occ_env trimmed_binds + (tidy_env, tidy_binds) <- tidyTopBinds unfold_env boot_exports tidy_occ_env trimmed_binds -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. (spt_entries, mcstub, tidy_binds') <- case opt_static_ptr_opts opts of @@ -1152,60 +1152,49 @@ tidyTopName mod name_cache maybe_ref occ_env id -- -- * subst_env: A Var->Var mapping that substitutes the new Var for the old -tidyTopBinds :: UnfoldingOpts - -> UnfoldEnv +tidyTopBinds :: UnfoldEnv -> NameSet -> TidyOccEnv -> CoreProgram -> IO (TidyEnv, CoreProgram) -tidyTopBinds uf_opts unfold_env boot_exports init_occ_env binds +tidyTopBinds unfold_env boot_exports init_occ_env binds = do let result = tidy init_env binds seqBinds (snd result) `seq` return result -- This seqBinds avoids a spike in space usage (see #13564) where init_env = (init_occ_env, emptyVarEnv) - tidy = mapAccumL (tidyTopBind uf_opts unfold_env boot_exports) + tidy = mapAccumL (tidyTopBind unfold_env boot_exports) ------------------------ -tidyTopBind :: UnfoldingOpts - -> UnfoldEnv +tidyTopBind :: UnfoldEnv -> NameSet -> TidyEnv -> CoreBind -> (TidyEnv, CoreBind) -tidyTopBind uf_opts unfold_env boot_exports +tidyTopBind unfold_env boot_exports (occ_env,subst1) (NonRec bndr rhs) = (tidy_env2, NonRec bndr' rhs') where - Just (name',show_unfold) = lookupVarEnv unfold_env bndr - (bndr', rhs') = tidyTopPair uf_opts show_unfold boot_exports tidy_env2 name' (bndr, rhs) + (bndr', rhs') = tidyTopPair unfold_env boot_exports tidy_env2 (bndr, rhs) subst2 = extendVarEnv subst1 bndr bndr' tidy_env2 = (occ_env, subst2) -tidyTopBind uf_opts unfold_env boot_exports (occ_env, subst1) (Rec prs) +tidyTopBind unfold_env boot_exports (occ_env, subst1) (Rec prs) = (tidy_env2, Rec prs') where - prs' = [ tidyTopPair uf_opts show_unfold boot_exports tidy_env2 name' (id,rhs) - | (id,rhs) <- prs, - let (name',show_unfold) = - expectJust "tidyTopBind" $ lookupVarEnv unfold_env id - ] - - subst2 = extendVarEnvList subst1 (bndrs `zip` map fst prs') + prs' = map (tidyTopPair unfold_env boot_exports tidy_env2) prs + subst2 = extendVarEnvList subst1 (map fst prs `zip` map fst prs') tidy_env2 = (occ_env, subst2) - - bndrs = map fst prs + -- This is where we "tie the knot": tidy_env2 is fed into tidyTopPair ----------------------------------------------------------- -tidyTopPair :: UnfoldingOpts - -> Bool -- show unfolding +tidyTopPair :: UnfoldEnv -> NameSet -> TidyEnv -- The TidyEnv is used to tidy the IdInfo -- It is knot-tied: don't look at it! - -> Name -- New name -> (Id, CoreExpr) -- Binder and RHS before tidying -> (Id, CoreExpr) -- This function is the heart of Step 2 @@ -1214,17 +1203,18 @@ tidyTopPair :: UnfoldingOpts -- group, a variable late in the group might be mentioned -- in the IdInfo of one early in the group -tidyTopPair uf_opts show_unfold boot_exports rhs_tidy_env name' (bndr, rhs) +tidyTopPair unfold_env boot_exports rhs_tidy_env (bndr, rhs) = -- pprTrace "tidyTop" (ppr name' <+> ppr details <+> ppr rhs) $ (bndr1, rhs1) where + Just (name',show_unfold) = lookupVarEnv unfold_env bndr !cbv_bndr = tidyCbvInfoTop boot_exports bndr rhs bndr1 = mkGlobalId details name' ty' idinfo' details = idDetails cbv_bndr -- Preserve the IdDetails ty' = tidyTopType (idType cbv_bndr) rhs1 = tidyExpr rhs_tidy_env rhs - idinfo' = tidyTopIdInfo uf_opts rhs_tidy_env name' ty' + idinfo' = tidyTopIdInfo rhs_tidy_env name' ty' rhs rhs1 (idInfo cbv_bndr) show_unfold -- tidyTopIdInfo creates the final IdInfo for top-level @@ -1234,9 +1224,9 @@ tidyTopPair uf_opts show_unfold boot_exports rhs_tidy_env name' (bndr, rhs) -- Indeed, CorePrep must eta expand where necessary to make -- the manifest arity equal to the claimed arity. -- -tidyTopIdInfo :: UnfoldingOpts -> TidyEnv -> Name -> Type +tidyTopIdInfo :: TidyEnv -> Name -> Type -> CoreExpr -> CoreExpr -> IdInfo -> Bool -> IdInfo -tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold +tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold | not is_external -- For internal Ids (not externally visible) = vanillaIdInfo -- we only need enough info for code generation -- Arity and strictness info are enough; @@ -1292,31 +1282,20 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf Just (arity, _, _) -> not (isDeadEndAppSig id_sig arity) --------- Unfolding ------------ + -- Force unfold_info (hence bangs), otherwise the old unfolding + -- is retained during code generation. See #22071 + unf_info = realUnfoldingInfo idinfo - -- 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 - 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 - -- marked NOINLINE or something like that - -- This is important: if you expose the worker for a loop-breaker - -- then you can make the simplifier go into an infinite loop, because - -- in effect the unfolding is exposed. See #1709 - -- - -- You might think that if show_unfold is False, then the thing should - -- not be w/w'd in the first place. But a legitimate reason is this: - -- the function returns bottom - -- In this case, show_unfold will be false (we don't expose unfoldings - -- for bottoming functions), but we might still have a worker/wrapper - -- split (see Note [Worker/wrapper for bottoming functions] in - -- GHC.Core.Opt.WorkWrap) + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold + = tidyTopUnfolding rhs_tidy_env tidy_rhs unf_info + | otherwise + = minimal_unfold_info +-- unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig orig_rhs + -- NB: use `orig_rhs` not `tidy_rhs` in this call to mkFinalUnfolding + -- else you get a black hole (#22122). Reason: mkFinalUnfolding + -- looks at IdInfo, and that is knot-tied in tidyTopBind (the Rec case) --------- Arity ------------ -- Usually the Id will have an accurate arity on it, because @@ -1328,10 +1307,59 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf arity = exprArity orig_rhs `min` typeArity rhs_ty -- orig_rhs: using tidy_rhs would make a black hole, since -- exprArity uses the arities of Ids inside the rhs + -- -- typeArity: see Note [Arity invariants for bindings] -- in GHC.Core.Opt.Arity -{- +------------ Unfolding -------------- +tidyTopUnfolding :: TidyEnv -> CoreExpr -> Unfolding -> Unfolding +tidyTopUnfolding _ _ NoUnfolding = NoUnfolding +tidyTopUnfolding _ _ BootUnfolding = BootUnfolding +tidyTopUnfolding _ _ (OtherCon {}) = evaldUnfolding + +tidyTopUnfolding tidy_env _ df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) + = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args } + where + (tidy_env', bndrs') = tidyBndrs tidy_env bndrs + +tidyTopUnfolding tidy_env tidy_rhs + unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) + = -- See Note [tidyTopUnfolding: avoiding black holes] + unf { uf_tmpl = tidy_unf_rhs } + where + tidy_unf_rhs | isStableSource src + = tidyExpr tidy_env unf_rhs -- Preserves OccInfo in unf_rhs + | otherwise + = occurAnalyseExpr tidy_rhs -- Do occ-anal + +{- Note [tidyTopUnfolding: avoiding black holes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we are exposing all unfoldings we don't want to tidy the unfolding +twice -- we just want to use the tidied RHS. That tidied RHS itself +contains fully-tidied Ids -- it is knot-tied. So the uf_tmpl for the +unfolding contains stuff we can't look at. Now consider (#22112) + foo = foo +If we freshly compute the uf_is_value field for foo's unfolding, +we'll call `exprIsValue`, which will look at foo's unfolding! +Whether or not the RHS is a value depends on whether foo is a value... +black hole. + +In the Simplifier we deal with this by not giving `foo` an unfolding +in its own RHS. And we could do that here. But it's qite nice +to common everything up to a single Id for foo, used everywhere. + +And it's not too hard: simply leave the unfolding undisturbed, except +tidy the uf_tmpl field. Hence tidyTopUnfolding does + unf { uf_tmpl = tidy_unf_rhs } + +Don't mess with uf_is_value, or guidance; in particular don't recompute +them from tidy_unf_rhs. + +And (unlike tidyNestedUnfolding) don't deep-seq the new unfolding, +because that'll cause a black hole (I /think/ because occurAnalyseExpr +looks in IdInfo). + + ************************************************************************ * * Old, dead, type-trimming code ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -816,7 +816,7 @@ zapFragileUnfolding unf trimUnfolding :: Unfolding -> Unfolding -- Squash all unfolding info, preserving only evaluated-ness trimUnfolding unf | isEvaldUnfolding unf = evaldUnfolding - | otherwise = noUnfolding + | otherwise = noUnfolding zapTailCallInfo :: IdInfo -> Maybe IdInfo zapTailCallInfo info ===================================== testsuite/tests/simplCore/should_compile/T22112.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Rec where + +-- This one created a black hole in Tidy, +-- when creating the tidied unfolding for foo +foo :: () -> () +foo = foo ===================================== testsuite/tests/simplCore/should_compile/T22112.stderr ===================================== @@ -0,0 +1,14 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 2, types: 2, coercions: 0, joins: 0/0} + +Rec { +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +foo [Occ=LoopBreaker] :: () -> () +[GblId, Str=b, Cpr=b] +foo = foo +end Rec } + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -415,6 +415,7 @@ test('T17966', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec']) # We expect to see a SPEC rule for $cm test('T19644', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec']) test('T21391', normal, compile, ['-O -dcore-lint']) +test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T21391a', normal, compile, ['-O -dcore-lint']) # We don't want to see a thunk allocation for the insertBy expression after CorePrep. test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/161a6f1fd62e797e978e7808a5f567fefa123f16 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/161a6f1fd62e797e978e7808a5f567fefa123f16 You're receiving 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 27 19:00:54 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sat, 27 Aug 2022 15:00:54 -0400 Subject: [Git][ghc/ghc][wip/T22028] 10 commits: Pmc: consider any 2 dicts of the same type equal Message-ID: <630a69e63b5b7_2f2e584886412903e@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T22028 at Glasgow Haskell Compiler / GHC Commits: 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 29cde550 by Simon Peyton Jones at 2022-08-27T21:00:30+02:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 30 changed files: - boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Iface/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d061941ce09cafae64fec462f3592db79336d9d...29cde5501af36785fb68eb0f38036b6a866606f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d061941ce09cafae64fec462f3592db79336d9d...29cde5501af36785fb68eb0f38036b6a866606f5 You're receiving 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 28 10:09:18 2022 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 28 Aug 2022 06:09:18 -0400 Subject: [Git][ghc/ghc][wip/T20155] 8 commits: tcLookupId Message-ID: <630b3ece50c94_2f2e58a70ea68153494@gitlab.mail> Ben Gamari pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: 1f09b68d by Ben Gamari at 2022-08-26T13:34:58-04:00 tcLookupId - - - - - 262ccaf3 by Ben Gamari at 2022-08-26T13:34:58-04:00 Revert "Fix wired-in occurrences" This reverts commit d509aae8c99e9c2c3143c3831d19e2a5d76dbbdf. - - - - - 367a6c88 by Ben Gamari at 2022-08-26T13:34:58-04:00 genprimopcode - - - - - fd140853 by Ben Gamari at 2022-08-26T13:36:06-04:00 inferId - - - - - 162be476 by Ben Gamari at 2022-08-26T13:47:58-04:00 Back out tcLookupId - - - - - bed74c94 by Ben Gamari at 2022-08-26T13:48:02-04:00 tcInferId - - - - - 5d4667de by Ben Gamari at 2022-08-26T13:48:10-04:00 Error message - - - - - 28fc6634 by Ben Gamari at 2022-08-27T16:23:03-04:00 Fix fixed runtime-rep criteria - - - - - 6 changed files: - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Utils/Env.hs - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/PrimOps/Ids.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude -- primop rules are attached to primop ids import {-# SOURCE #-} GHC.Core.Opt.ConstantFold (primOpRules) -import GHC.Core.Type (mkForAllTys, mkVisFunTysMany, argsHaveFixedRuntimeRep ) +import GHC.Core.Type (mkForAllTys, mkVisFunTysMany, argsHaveFixedRuntimeRep, typeHasFixedRuntimeRep ) import GHC.Core.FVs (mkRuleInfo) import GHC.Builtin.PrimOps @@ -39,7 +39,7 @@ mkPrimOpId prim_op (mkPrimOpIdUnique (primOpTag prim_op)) (AnId id) UserSyntax id = mkGlobalId (PrimOpId prim_op lev_poly) name ty info - lev_poly = not (argsHaveFixedRuntimeRep ty) + lev_poly = not (argsHaveFixedRuntimeRep ty && typeHasFixedRuntimeRep res_ty) -- PrimOps don't ever construct a product, but we want to preserve bottoms cpr ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -1619,7 +1619,8 @@ boxedRepDataCon = pcSpecialDataCon boxedRepDataConName where -- See Note [Getting from RuntimeRep to PrimRep] in RepType prim_rep_fun [lev] - = case tyConRuntimeRepInfo (tyConAppTyCon lev) of + | Just lev_tc <- tyConAppTyCon_maybe lev + = case tyConRuntimeRepInfo lev_tc of LiftedInfo -> [LiftedRep] UnliftedInfo -> [UnliftedRep] _ -> pprPanic "boxedRepDataCon" (ppr lev) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -201,9 +201,6 @@ tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- - ones taken apart by GHC.Tc.Gen.Head.splitHsApps -- - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe -- See Note [Application chains and heads] in GHC.Tc.Gen.App -tcExpr (HsVar _ v) res_ty - | Just (AnId id) <- wiredInNameTyThing_maybe (unLoc v) - = return $ HsVar noExtField (noLocA id) tcExpr e@(HsVar {}) res_ty = tcApp e res_ty tcExpr e@(HsApp {}) res_ty = tcApp e res_ty tcExpr e@(OpApp {}) res_ty = tcApp e res_ty ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1037,6 +1037,9 @@ tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType) -- Look up an occurrence of an Id -- Do not instantiate its type tcInferId id_name + -- TODO: Note + | Just (AnId id) <- wiredInNameTyThing_maybe id_name = do + return (HsVar noExtField (noLocA id), idType id) | id_name `hasKey` assertIdKey = do { dflags <- getDynFlags ; if gopt Opt_IgnoreAsserts dflags ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -456,10 +456,7 @@ tcLookupLcl_maybe name ; return (lookupNameEnv local_env name) } tcLookup :: Name -> TcM TcTyThing -tcLookup name - | Just thing <- wiredInNameTyThing_maybe name = do - return $ AGlobal thing - | otherwise = do +tcLookup name = do local_env <- getLclTypeEnv case lookupNameEnv local_env name of Just thing -> return thing ===================================== utils/genprimopcode/Main.hs ===================================== @@ -339,9 +339,17 @@ gen_hs_source (Info defaults entries) = prim_func :: String -> Ty -> Bool -> [String] prim_func n t llvm_only + | not (opTyHasFixedRuntimeRep t) = + [ "-- No wrapper due to RuntimeRep polymorphism:" + , "-- " ++ wrapOp n ++ " :: " ++ pprTy t + ] + -- Representationally polymorphic functions cannot be wrapped; we + -- instead eta expand them. + | llvm_only = [] -- We can't assume that GHC.Prim will be compiled via LLVM, therefore -- we generate bottoming wrappers for LLVM-only primops. + -- TODO: Where does this happen? | 0 <- arity t = [] -- Unlifted arity-0 things like void# can't be bound at the top-level. | otherwise = @@ -676,6 +684,37 @@ ppTyVarBinders names = case go names of { (infs, bndrs) -> (nub infs, nub bndrs) , (other_infs, bndrs) <- ppTyVarBinders tvs = (infs ++ other_infs, bndr : bndrs) +-- | Split a function type into its arguments and result types. +splitFunTy :: Ty -> ([Ty], Ty) +splitFunTy = go [] + where + go acc (TyF arg res) = go (arg:acc) res + go acc (TyC arg res) = go (arg:acc) res + go acc ty = (reverse acc, ty) + +-- | This should match the levity polymorphism check in +-- GHC.Builtin.PrimOps.Ids.mkPrimOpId. +opTyHasFixedRuntimeRep :: Ty -> Bool +opTyHasFixedRuntimeRep ty = + let (args, res) = splitFunTy ty + in all typeHasFixedRuntimeRep args && typeHasFixedRuntimeRep res + +-- | Is a type representationally monomorphic? +typeHasFixedRuntimeRep :: Ty -> Bool +typeHasFixedRuntimeRep (TyF a b) = True +typeHasFixedRuntimeRep (TyC a b) = True +typeHasFixedRuntimeRep (TyApp _ as) = True +typeHasFixedRuntimeRep (TyVar v) = tyVarHasFixedRuntimeRep v +typeHasFixedRuntimeRep (TyUTup as) = all typeHasFixedRuntimeRep as + +-- | Does a tyvar have a representationally polymorphic kind? +tyVarHasFixedRuntimeRep :: TyVar -> Bool +tyVarHasFixedRuntimeRep "o" = False +tyVarHasFixedRuntimeRep "p" = False +tyVarHasFixedRuntimeRep "v" = False +tyVarHasFixedRuntimeRep "w" = False +tyVarHasFixedRuntimeRep _ = True + ppTyVar :: TyVar -> PrimOpTyVarBinder ppTyVar "a" = nonDepTyVarBinder "alphaTyVarSpec" ppTyVar "b" = nonDepTyVarBinder "betaTyVarSpec" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54d300661d4bfa132afcb6c40538390b8d4f4b5c...28fc66345f315e4113004b0c71b145090fbe92bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54d300661d4bfa132afcb6c40538390b8d4f4b5c...28fc66345f315e4113004b0c71b145090fbe92bf You're receiving 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 29 01:18:22 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 28 Aug 2022 21:18:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Improve SpecConstr for evals Message-ID: <630c13de215ee_2f2e584887824642d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - 5e58c7fb by Simon Peyton Jones at 2022-08-28T21:17:53-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 26 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Var/Env.hs - testsuite/tests/backpack/should_fail/bkpfail40.stderr - + testsuite/tests/simplCore/should_compile/T21763.hs - + testsuite/tests/simplCore/should_compile/T21763.stderr - + testsuite/tests/simplCore/should_compile/T21763a.hs - + testsuite/tests/simplCore/should_compile/T21763a.stderr - + testsuite/tests/simplCore/should_compile/T22028.hs - + testsuite/tests/simplCore/should_compile/T22028.stderr - + testsuite/tests/simplCore/should_compile/T22112.hs - + testsuite/tests/simplCore/should_compile/T22112.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.hs - + testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3437,24 +3437,26 @@ lintAnnots pname pass guts = {-# SCC "lintAnnots" #-} do logger <- getLogger when (gopt Opt_DoAnnotationLinting dflags) $ liftIO $ Err.showPass logger "Annotation linting - first run" - nguts <- pass guts -- If appropriate re-run it without debug annotations to make sure -- that they made no difference. - when (gopt Opt_DoAnnotationLinting dflags) $ do - liftIO $ Err.showPass logger "Annotation linting - second run" - nguts' <- withoutAnnots pass guts - -- Finally compare the resulting bindings - liftIO $ Err.showPass logger "Annotation linting - comparison" - let binds = flattenBinds $ mg_binds nguts - binds' = flattenBinds $ mg_binds nguts' - (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' - when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat - [ lint_banner "warning" pname - , text "Core changes with annotations:" - , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs - ] - -- Return actual new guts - return nguts + if gopt Opt_DoAnnotationLinting dflags + then do + nguts <- pass guts + liftIO $ Err.showPass logger "Annotation linting - second run" + nguts' <- withoutAnnots pass guts + -- Finally compare the resulting bindings + liftIO $ Err.showPass logger "Annotation linting - comparison" + let binds = flattenBinds $ mg_binds nguts + binds' = flattenBinds $ mg_binds nguts' + (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' + when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat + [ lint_banner "warning" pname + , text "Core changes with annotations:" + , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs + ] + return nguts + else + pass guts -- | Run the given pass without annotations. This means that we both -- set the debugLevel setting to 0 in the environment as well as all ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -153,7 +153,7 @@ simplifyPgm logger unit_env opts , mg_binds = binds, mg_rules = rules , mg_fam_inst_env = fam_inst_env }) = do { (termination_msg, it_count, counts_out, guts') - <- do_iteration 1 [] binds rules + <- do_iteration 1 [] binds rules ; when (logHasDumpFlag logger Opt_D_verbose_core2core && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ @@ -175,6 +175,9 @@ simplifyPgm logger unit_env opts print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode + -- Note the bang in !guts_no_binds. If you don't force `guts_no_binds` + -- the old bindings are retained until the end of all simplifier iterations + !guts_no_binds = guts { mg_binds = [], mg_rules = [] } do_iteration :: Int -- Counts iterations -> [SimplCount] -- Counts from earlier iterations, reversed @@ -198,7 +201,7 @@ simplifyPgm logger unit_env opts -- number of iterations we actually completed return ( "Simplifier baled out", iteration_no - 1 , totalise counts_so_far - , guts { mg_binds = binds, mg_rules = rules } ) + , guts_no_binds { mg_binds = binds, mg_rules = rules } ) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. @@ -253,7 +256,7 @@ simplifyPgm logger unit_env opts if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks - , guts { mg_binds = binds1, mg_rules = rules1 } ) + , guts_no_binds { mg_binds = binds1, mg_rules = rules1 } ) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2257,7 +2257,7 @@ prepareAlts tries these things: case e of x { (a,b) -> rhs } where the type is a single constructor type. This gives better code when rhs also scrutinises x or e. - See CoreUtils Note [Refine DEFAULT case alternatives] + See GHC.Core.Utils Note [Refine DEFAULT case alternatives] 3. combineIdenticalAlts: combine identical alternatives into a DEFAULT. See CoreUtils Note [Combine identical alternatives], which also ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -77,7 +77,9 @@ import GHC.Serialized ( deserializeWithData ) import Control.Monad ( zipWithM ) import Data.List (nubBy, sortBy, partition, dropWhileEnd, mapAccumL ) +import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) +import Data.Tuple {- ----------------------------------------------------- @@ -374,11 +376,14 @@ 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 [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: +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: bar m n = foo n (n,n) (n,n) (n,n) (n,n) where @@ -401,52 +406,42 @@ 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.) -However, if we find any boring calls in the body, including *unsaturated* -ones, such as +Wrinkles + +* Boring calls. 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 callsToPats reports if it finds any of these. + 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. -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.) +* 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! Note [Do not specialise diverging functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -671,14 +666,16 @@ But regardless, SpecConstr can and should! It's easy: well as constructor applications. Wrinkles: + * This should all work perfectly fine for newtype classes. Mind you, currently newtype classes are inlined fairly agressively, but we may change that. And it would take extra code to exclude them, as well as being unnecessary. -* We (mis-) use LambdaVal for this purpose, because ConVal - requires us to list the data constructor and fields, and that - is (a) inconvenient and (b) unnecessary for class methods. +* In isValue, we (mis-) use LambdaVal for this ($fblah d1 .. dn) + because ConVal requires us to list the data constructor and + fields, and that is (a) inconvenient and (b) unnecessary for + class methods. ----------------------------------------------------- Stuff not yet handled @@ -764,35 +761,18 @@ unbox the strict fields, because T is polymorphic!) specConstrProgram :: ModGuts -> CoreM ModGuts specConstrProgram guts - = 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') + = 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') } {- ************************************************************************ @@ -956,14 +936,24 @@ initScOpts dflags this_mod = SpecConstrOpts sc_keen = gopt Opt_SpecConstrKeen dflags } -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 } +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. data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -984,8 +974,18 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v -scSubstTy :: ScEnv -> InType -> OutType -scSubstTy env ty = substTyUnchecked (sc_subst env) ty +-- The !subst ensures that we force the selection `(sc_subst env)`, which avoids +-- retaining all of `env` when we only need `subst`. The `Solo` means that the +-- substitution itself is lazy, because that type is often discarded. +-- The callers of `scSubstTy` always force the result (to unpack the `Solo`) +-- so we get the desired effect: we leave a thunk, but retain only the subst, +-- not the whole env. +-- +-- Fully forcing the result of `scSubstTy` regresses performance (#22102) +scSubstTy :: ScEnv -> InType -> Solo OutType +scSubstTy env ty = + let !subst = sc_subst env + in Solo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co @@ -1187,8 +1187,8 @@ data ScUsage scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences } -- The domain is OutIds -type CallEnv = IdEnv [Call] -data Call = Call Id [CoreArg] ValueEnv +type CallEnv = IdEnv [Call] -- Domain is OutIds +data Call = Call OutId [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 @@ -1210,6 +1210,9 @@ 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) } @@ -1227,7 +1230,20 @@ data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument | UnkOcc -- Used in some unknown way | ScrutOcc -- See Note [ScrutOcc] - (DataConEnv [ArgOcc]) -- How the sub-components are used + (DataConEnv [ArgOcc]) + -- [ArgOcc]: how the sub-components are used + +deadArgOcc :: ArgOcc -> Bool +deadArgOcc (ScrutOcc {}) = False +deadArgOcc UnkOcc = False +deadArgOcc NoOcc = True + +specialisableArgOcc :: ArgOcc -> Bool +-- | Does this occurence represent one worth specializing for. +specialisableArgOcc UnkOcc = False +specialisableArgOcc NoOcc = False +specialisableArgOcc (ScrutOcc {}) = True + {- Note [ScrutOcc] ~~~~~~~~~~~~~~~~~~ @@ -1253,6 +1269,9 @@ instance Outputable ArgOcc where ppr NoOcc = text "no-occ" evalScrutOcc :: ArgOcc +-- We use evalScrutOcc for +-- - mkVarUsage: applied functions +-- - scApp: dicts that are the arugment of a classop evalScrutOcc = ScrutOcc emptyUFM -- Experimentally, this version of combineOcc makes ScrutOcc "win", so @@ -1292,6 +1311,121 @@ 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 @@ -1302,7 +1436,9 @@ scExpr' env (Var v) = case scSubstId env v of Var v' -> return (mkVarUsage env v' [], Var v') e' -> scExpr (zapScSubst env) e' -scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) +scExpr' env (Type t) = + let !(Solo ty') = scSubstTy env t + in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e @@ -1316,6 +1452,11 @@ 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 @@ -1333,17 +1474,19 @@ scExpr' env (Case scrut b ty alts) = do { let (alt_env,b') = extendBndrWith RecArg env b -- Record RecArg for the components - ; (alt_usgs, alt_occs, alts') - <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts + ; (alt_usgs, alt_occs, alts') <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts ; let scrut_occ = foldr combineOcc NoOcc alt_occs scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ -- The combined usage of the scrutinee is given - -- by scrut_occ, which is passed to scScrut, which + -- by scrut_occ, which is passed to setScrutOcc, which -- in turn treats a bare-variable scrutinee specially + ; let !(Solo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, - Case scrut' b' (scSubstTy env ty) alts') } + Case scrut' b' ty' alts') } + + single_alt = isSingleton alts sc_alt env scrut' b' (Alt con bs rhs) = do { let (env1, bs1) = extendBndrsWith RecArg env bs @@ -1351,82 +1494,52 @@ scExpr' env (Case scrut b ty alts) ; (usg, rhs') <- scExpr env2 rhs ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2) scrut_occ = case con of - DataAlt dc -> ScrutOcc (unitUFM dc arg_occs) - _ -> evalScrutOcc + DataAlt dc -- See Note [Do not specialise evals] + | not (single_alt && all deadArgOcc arg_occs) + -> ScrutOcc (unitUFM dc arg_occs) + _ -> UnkOcc ; 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. +{- Note [Do not specialise evals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x y = case x of I# _ -> + if y>1 then f x (y-1) else x + +Here `x` is scrutinised by a case, but only in an eval-like way; the +/component/ of the I# is unused. We don't want to specialise this +function, even if we find a call (f (I# z)), because nothing is gained + * No case branches are discarded + * No allocation in removed +The specialised version would take an unboxed Int#, pass it along, +and rebox it at the end. + +In fact this can cause significant regression. In #21763 we had: +like + f = ... case x of x' { I# n -> + join j y = rhs + in ...jump j x'... + +Now if we specialise `j` for the argument `I# n`, we'll end up reboxing +it in `j`, without even removing an allocation from the call site. + +Reboxing is always a worry. But here we can ameliorate the problem as +follows. + +* In scExpr (Case ...), for a /single-alternative/ case expression, in + which the pattern binders are all unused, we build a UnkOcc for + the scrutinee, not one that maps the data constructor; we don't treat + this occurrence as a reason for specialisation. + +* Conveniently, SpecConstr is doing its own occurrence analysis, so + the "unused" bit is just looking for NoOcc + +* Note that if we have + f x = case x of { True -> e1; False -> e2 } + then even though the pattern binders are unused (there are none), it is + still worth specialising on x. Hence the /single-alternative/ guard. -} scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr) @@ -1478,55 +1591,9 @@ mkVarUsage env fn args , scu_occs = unitVarEnv fn arg_occ } Nothing -> nullUsage where - -- I rather think we could use UnkOcc all the time 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) @@ -1574,7 +1641,8 @@ data RhsInfo } data SpecInfo -- Info about specialisations for a particular Id - = SI { si_specs :: [OneSpec] -- The specialisations we have generated + = SI { si_specs :: [OneSpec] -- The specialisations we have + -- generated for this function , si_n_specs :: Int -- Length of si_specs; used for numbering them @@ -1585,7 +1653,7 @@ data SpecInfo -- Info about specialisations for a particular Id -- RHS usage (which has not yet been -- unleashed) -- Nothing => we have - -- See Note [Local recursive groups] + -- See Note [Seeding recursive groups] -- See Note [spec_usg includes rhs_usg] -- One specialisation: Rule plus definition @@ -1595,57 +1663,62 @@ data OneSpec = , os_id :: OutId -- Spec id , os_rhs :: OutExpr } -- Spec rhs -noSpecInfo :: SpecInfo -noSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing } +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 ---------------------- specNonRec :: ScEnv - -> ScUsage -- Body usage + -> CallEnv -- Calls in body -> 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_usg rhs_info - = specialise env (scu_calls body_usg) rhs_info - (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) }) +specNonRec env body_calls rhs_info + = specialise env body_calls rhs_info (initSpecInfo rhs_info) ---------------------- -specRec :: TopLevelFlag -> ScEnv - -> ScUsage -- Body usage +specRec :: ScEnv + -> CallEnv -- Calls in body -> [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 top_lvl env body_usg rhs_infos - = go 1 seed_calls nullUsage init_spec_infos +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 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 :: 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, 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 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 - = -- pprTrace "specRec1" (vcat [ ppr (map ri_fn rhs_infos) - -- , ppr seed_calls - -- , ppr body_usg ]) $ - return (usg_so_far, spec_infos) + = return (usg_so_far, spec_infos) -- Limit recursive specialisation -- See Note [Limit recursive specialisation] @@ -1654,26 +1727,20 @@ specRec top_lvl env body_usg rhs_infos -- If both of these are false, the sc_count -- threshold will prevent non-termination , any ((> the_limit) . si_n_specs) spec_infos - = -- pprTrace "specRec2" (ppr (map (map os_pat . si_specs) spec_infos)) $ - return (usg_so_far, 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) | otherwise - = -- 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 } + = go (n_iter + 1) seed_calls usg_so_far spec_infos -- See Note [Limit recursive specialisation] the_limit = case sc_count opts of Nothing -> 10 -- Ugh! Just max -> max - ---------------------- specialise :: ScEnv @@ -1696,14 +1763,12 @@ 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 @@ -1729,14 +1794,16 @@ 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 | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing) - _ -> (spec_usg, mb_unspec) + (new_usg, mb_unspec') = case mb_unspec of + Just rhs_usg | unspec_rhs_needed + -> (spec_usg `combineUsage` rhs_usg, Nothing) + _ -> (spec_usg, mb_unspec) -- ; pprTrace "specialise return }" -- (vcat [ ppr fn @@ -1744,8 +1811,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 @@ -2027,7 +2094,8 @@ 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, unless there are no calls at all to the function. +the passed-in SpecInfo in si_mb_unspec, 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 @@ -2245,9 +2313,11 @@ callsToNewPats :: ScEnv -> Id -> SpecInfo -> [ArgOcc] -> [Call] -> UniqSM (Bool, [CallPat]) - -- Result has no duplicate patterns, - -- nor ones mentioned in done_pats - -- Bool indicates that there was at least one boring pattern +-- 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" callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls = do { mb_pats <- mapM (callToPats env bndr_occs) calls @@ -2558,10 +2628,8 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str -- (b) we know what its value is -- In that case it counts as "interesting" argToPat1 env in_scope val_env (Var v) arg_occ arg_str - | sc_force env || case arg_occ of { ScrutOcc {} -> True - ; UnkOcc -> False - ; NoOcc -> False } -- (a) - , is_value -- (b) + | sc_force env || specialisableArgOcc arg_occ -- (a) + , is_value -- (b) -- Ignoring sc_keen here to avoid gratuitously incurring Note [Reboxing] -- So sc_keen focused just on f (I# x), where we have freshly-allocated -- box that we can eliminate in the caller ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -10,7 +10,7 @@ The code for *top-level* bindings is in GHC.Iface.Tidy. {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} module GHC.Core.Tidy ( - tidyExpr, tidyRules, tidyUnfolding, tidyCbvInfoTop + tidyExpr, tidyRules, tidyCbvInfoTop, tidyBndrs ) where import GHC.Prelude @@ -360,33 +360,36 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id `setUnfoldingInfo` new_unf old_unf = realUnfoldingInfo old_info - new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf - | otherwise = trimUnfolding old_unf - -- See Note [Preserve evaluatedness] + new_unf = tidyNestedUnfolding rec_tidy_env old_unf in ((tidy_env', var_env'), id') } ------------ Unfolding -------------- -tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding -tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _ +tidyNestedUnfolding :: TidyEnv -> Unfolding -> Unfolding +tidyNestedUnfolding _ NoUnfolding = NoUnfolding +tidyNestedUnfolding _ BootUnfolding = BootUnfolding +tidyNestedUnfolding _ (OtherCon {}) = evaldUnfolding + +tidyNestedUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args } where (tidy_env', bndrs') = tidyBndrs tidy_env bndrs -tidyUnfolding tidy_env - unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) - unf_from_rhs +tidyNestedUnfolding tidy_env + unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_is_value = is_value }) | isStableSource src = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo - -- This seqIt avoids a space leak: otherwise the uf_is_value, - -- uf_is_conlike, ... fields may retain a reference to the - -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them) - - | otherwise - = unf_from_rhs - where seqIt unf = seqUnfolding unf `seq` unf -tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon + -- This seqIt avoids a space leak: otherwise the uf_is_value, + -- uf_is_conlike, ... fields may retain a reference to the + -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them) + + -- Discard unstable unfoldings, but see Note [Preserve evaluatedness] + | is_value = evaldUnfolding + | otherwise = noUnfolding + + where + seqIt unf = seqUnfolding unf `seq` unf {- Note [Tidy IdInfo] ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -706,7 +706,11 @@ filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (us -- in a "case" statement then they will need to manually add a dummy case branch that just -- calls "error" or similar. filterAlts _tycon inst_tys imposs_cons alts - = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + = imposs_deflt_cons `seqList` + (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt) + -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which + -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter + -- leads to a huge space leak (see #22102 and !8896) where (alts_wo_default, maybe_deflt) = findDefault alts alt_cons = [con | Alt con _ _ <- alts_wo_default] ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -24,16 +24,17 @@ import GHC.Tc.Utils.Env import GHC.Core import GHC.Core.Unfold -import GHC.Core.Unfold.Make +-- import GHC.Core.Unfold.Make import GHC.Core.FVs import GHC.Core.Tidy -import GHC.Core.Seq (seqBinds) +import GHC.Core.Seq ( seqBinds ) import GHC.Core.Opt.Arity ( exprArity, typeArity, exprBotStrictness_maybe ) import GHC.Core.InstEnv import GHC.Core.Type ( Type, tidyTopType ) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Iface.Tidy.StaticPtrTable import GHC.Iface.Env @@ -383,8 +384,7 @@ tidyProgram opts (ModGuts { mg_module = mod (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod binds implicit_binds imp_rules let (trimmed_binds, trimmed_rules) = findExternalRules opts binds imp_rules unfold_env - let uf_opts = opt_unfolding_opts opts - (tidy_env, tidy_binds) <- tidyTopBinds uf_opts unfold_env boot_exports tidy_occ_env trimmed_binds + (tidy_env, tidy_binds) <- tidyTopBinds unfold_env boot_exports tidy_occ_env trimmed_binds -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. (spt_entries, mcstub, tidy_binds') <- case opt_static_ptr_opts opts of @@ -1152,60 +1152,49 @@ tidyTopName mod name_cache maybe_ref occ_env id -- -- * subst_env: A Var->Var mapping that substitutes the new Var for the old -tidyTopBinds :: UnfoldingOpts - -> UnfoldEnv +tidyTopBinds :: UnfoldEnv -> NameSet -> TidyOccEnv -> CoreProgram -> IO (TidyEnv, CoreProgram) -tidyTopBinds uf_opts unfold_env boot_exports init_occ_env binds +tidyTopBinds unfold_env boot_exports init_occ_env binds = do let result = tidy init_env binds seqBinds (snd result) `seq` return result -- This seqBinds avoids a spike in space usage (see #13564) where init_env = (init_occ_env, emptyVarEnv) - tidy = mapAccumL (tidyTopBind uf_opts unfold_env boot_exports) + tidy = mapAccumL (tidyTopBind unfold_env boot_exports) ------------------------ -tidyTopBind :: UnfoldingOpts - -> UnfoldEnv +tidyTopBind :: UnfoldEnv -> NameSet -> TidyEnv -> CoreBind -> (TidyEnv, CoreBind) -tidyTopBind uf_opts unfold_env boot_exports +tidyTopBind unfold_env boot_exports (occ_env,subst1) (NonRec bndr rhs) = (tidy_env2, NonRec bndr' rhs') where - Just (name',show_unfold) = lookupVarEnv unfold_env bndr - (bndr', rhs') = tidyTopPair uf_opts show_unfold boot_exports tidy_env2 name' (bndr, rhs) + (bndr', rhs') = tidyTopPair unfold_env boot_exports tidy_env2 (bndr, rhs) subst2 = extendVarEnv subst1 bndr bndr' tidy_env2 = (occ_env, subst2) -tidyTopBind uf_opts unfold_env boot_exports (occ_env, subst1) (Rec prs) +tidyTopBind unfold_env boot_exports (occ_env, subst1) (Rec prs) = (tidy_env2, Rec prs') where - prs' = [ tidyTopPair uf_opts show_unfold boot_exports tidy_env2 name' (id,rhs) - | (id,rhs) <- prs, - let (name',show_unfold) = - expectJust "tidyTopBind" $ lookupVarEnv unfold_env id - ] - - subst2 = extendVarEnvList subst1 (bndrs `zip` map fst prs') + prs' = map (tidyTopPair unfold_env boot_exports tidy_env2) prs + subst2 = extendVarEnvList subst1 (map fst prs `zip` map fst prs') tidy_env2 = (occ_env, subst2) - - bndrs = map fst prs + -- This is where we "tie the knot": tidy_env2 is fed into tidyTopPair ----------------------------------------------------------- -tidyTopPair :: UnfoldingOpts - -> Bool -- show unfolding +tidyTopPair :: UnfoldEnv -> NameSet -> TidyEnv -- The TidyEnv is used to tidy the IdInfo -- It is knot-tied: don't look at it! - -> Name -- New name -> (Id, CoreExpr) -- Binder and RHS before tidying -> (Id, CoreExpr) -- This function is the heart of Step 2 @@ -1214,17 +1203,18 @@ tidyTopPair :: UnfoldingOpts -- group, a variable late in the group might be mentioned -- in the IdInfo of one early in the group -tidyTopPair uf_opts show_unfold boot_exports rhs_tidy_env name' (bndr, rhs) +tidyTopPair unfold_env boot_exports rhs_tidy_env (bndr, rhs) = -- pprTrace "tidyTop" (ppr name' <+> ppr details <+> ppr rhs) $ (bndr1, rhs1) where + Just (name',show_unfold) = lookupVarEnv unfold_env bndr !cbv_bndr = tidyCbvInfoTop boot_exports bndr rhs bndr1 = mkGlobalId details name' ty' idinfo' details = idDetails cbv_bndr -- Preserve the IdDetails ty' = tidyTopType (idType cbv_bndr) rhs1 = tidyExpr rhs_tidy_env rhs - idinfo' = tidyTopIdInfo uf_opts rhs_tidy_env name' ty' + idinfo' = tidyTopIdInfo rhs_tidy_env name' ty' rhs rhs1 (idInfo cbv_bndr) show_unfold -- tidyTopIdInfo creates the final IdInfo for top-level @@ -1234,9 +1224,9 @@ tidyTopPair uf_opts show_unfold boot_exports rhs_tidy_env name' (bndr, rhs) -- Indeed, CorePrep must eta expand where necessary to make -- the manifest arity equal to the claimed arity. -- -tidyTopIdInfo :: UnfoldingOpts -> TidyEnv -> Name -> Type +tidyTopIdInfo :: TidyEnv -> Name -> Type -> CoreExpr -> CoreExpr -> IdInfo -> Bool -> IdInfo -tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold +tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold | not is_external -- For internal Ids (not externally visible) = vanillaIdInfo -- we only need enough info for code generation -- Arity and strictness info are enough; @@ -1292,31 +1282,20 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf Just (arity, _, _) -> not (isDeadEndAppSig id_sig arity) --------- Unfolding ------------ + -- Force unfold_info (hence bangs), otherwise the old unfolding + -- is retained during code generation. See #22071 + unf_info = realUnfoldingInfo idinfo - -- 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 - 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 - -- marked NOINLINE or something like that - -- This is important: if you expose the worker for a loop-breaker - -- then you can make the simplifier go into an infinite loop, because - -- in effect the unfolding is exposed. See #1709 - -- - -- You might think that if show_unfold is False, then the thing should - -- not be w/w'd in the first place. But a legitimate reason is this: - -- the function returns bottom - -- In this case, show_unfold will be false (we don't expose unfoldings - -- for bottoming functions), but we might still have a worker/wrapper - -- split (see Note [Worker/wrapper for bottoming functions] in - -- GHC.Core.Opt.WorkWrap) + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold + = tidyTopUnfolding rhs_tidy_env tidy_rhs unf_info + | otherwise + = minimal_unfold_info +-- unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig orig_rhs + -- NB: use `orig_rhs` not `tidy_rhs` in this call to mkFinalUnfolding + -- else you get a black hole (#22122). Reason: mkFinalUnfolding + -- looks at IdInfo, and that is knot-tied in tidyTopBind (the Rec case) --------- Arity ------------ -- Usually the Id will have an accurate arity on it, because @@ -1328,10 +1307,59 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf arity = exprArity orig_rhs `min` typeArity rhs_ty -- orig_rhs: using tidy_rhs would make a black hole, since -- exprArity uses the arities of Ids inside the rhs + -- -- typeArity: see Note [Arity invariants for bindings] -- in GHC.Core.Opt.Arity -{- +------------ Unfolding -------------- +tidyTopUnfolding :: TidyEnv -> CoreExpr -> Unfolding -> Unfolding +tidyTopUnfolding _ _ NoUnfolding = NoUnfolding +tidyTopUnfolding _ _ BootUnfolding = BootUnfolding +tidyTopUnfolding _ _ (OtherCon {}) = evaldUnfolding + +tidyTopUnfolding tidy_env _ df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) + = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args } + where + (tidy_env', bndrs') = tidyBndrs tidy_env bndrs + +tidyTopUnfolding tidy_env tidy_rhs + unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) + = -- See Note [tidyTopUnfolding: avoiding black holes] + unf { uf_tmpl = tidy_unf_rhs } + where + tidy_unf_rhs | isStableSource src + = tidyExpr tidy_env unf_rhs -- Preserves OccInfo in unf_rhs + | otherwise + = occurAnalyseExpr tidy_rhs -- Do occ-anal + +{- Note [tidyTopUnfolding: avoiding black holes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we are exposing all unfoldings we don't want to tidy the unfolding +twice -- we just want to use the tidied RHS. That tidied RHS itself +contains fully-tidied Ids -- it is knot-tied. So the uf_tmpl for the +unfolding contains stuff we can't look at. Now consider (#22112) + foo = foo +If we freshly compute the uf_is_value field for foo's unfolding, +we'll call `exprIsValue`, which will look at foo's unfolding! +Whether or not the RHS is a value depends on whether foo is a value... +black hole. + +In the Simplifier we deal with this by not giving `foo` an unfolding +in its own RHS. And we could do that here. But it's qite nice +to common everything up to a single Id for foo, used everywhere. + +And it's not too hard: simply leave the unfolding undisturbed, except +tidy the uf_tmpl field. Hence tidyTopUnfolding does + unf { uf_tmpl = tidy_unf_rhs } + +Don't mess with uf_is_value, or guidance; in particular don't recompute +them from tidy_unf_rhs. + +And (unlike tidyNestedUnfolding) don't deep-seq the new unfolding, +because that'll cause a black hole (I /think/ because occurAnalyseExpr +looks in IdInfo). + + ************************************************************************ * * Old, dead, type-trimming code ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -82,6 +82,8 @@ import GHC.Utils.Panic import qualified GHC.LanguageExtensions as LangExt +import GHC.Data.BooleanFormula (pprBooleanFormulaNice) + import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Function (on) @@ -961,6 +963,36 @@ instance Diagnostic TcRnMessage where impMsg = text "imported from" <+> ppr pragma_warning_import_mod <> extra extra | pragma_warning_import_mod == pragma_warning_defined_mod = empty | otherwise = text ", but defined in" <+> ppr pragma_warning_defined_mod + TcRnIllegalHsigDefaultMethods name meths + -> mkSimpleDecorated $ + text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file" + TcRnBadGenericMethod clas op + -> mkSimpleDecorated $ + hsep [text "Class", quotes (ppr clas), + text "has a generic-default signature without a binding", quotes (ppr op)] + TcRnWarningMinimalDefIncomplete mindef + -> mkSimpleDecorated $ + vcat [ text "The MINIMAL pragma does not require:" + , nest 2 (pprBooleanFormulaNice mindef) + , text "but there is no default implementation." ] + TcRnDefaultMethodForPragmaLacksBinding sel_id prag + -> mkSimpleDecorated $ + text "The" <+> hsSigDoc prag <+> text "for default method" + <+> quotes (ppr sel_id) + <+> text "lacks an accompanying binding" + TcRnIgnoreSpecialisePragmaOnDefMethod sel_name + -> mkSimpleDecorated $ + text "Ignoring SPECIALISE pragmas on default method" + <+> quotes (ppr sel_name) + TcRnBadMethodErr{badMethodErrClassName, badMethodErrMethodName} + -> mkSimpleDecorated $ + hsep [text "Class", quotes (ppr badMethodErrClassName), + text "does not have a method", quotes (ppr badMethodErrMethodName)] + TcRnNoExplicitAssocTypeOrDefaultDeclaration name + -> mkSimpleDecorated $ + text "No explicit" <+> text "associated type" + <+> text "or default declaration for" + <+> quotes (ppr name) diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -1276,6 +1308,20 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnPragmaWarning{} -> WarningWithFlag Opt_WarnWarningsDeprecations + TcRnIllegalHsigDefaultMethods{} + -> ErrorWithoutFlag + TcRnBadGenericMethod{} + -> ErrorWithoutFlag + TcRnWarningMinimalDefIncomplete{} + -> WarningWithoutFlag + TcRnDefaultMethodForPragmaLacksBinding{} + -> ErrorWithoutFlag + TcRnIgnoreSpecialisePragmaOnDefMethod{} + -> WarningWithoutFlag + TcRnBadMethodErr{} + -> ErrorWithoutFlag + TcRnNoExplicitAssocTypeOrDefaultDeclaration{} + -> WarningWithFlag (Opt_WarnMissingMethods) diagnosticHints = \case TcRnUnknownMessage m @@ -1591,7 +1637,13 @@ instance Diagnostic TcRnMessage where TcRnNameByTemplateHaskellQuote{} -> noHints TcRnIllegalBindingOfBuiltIn{} -> noHints TcRnPragmaWarning{} -> noHints - + TcRnIllegalHsigDefaultMethods{} -> noHints + TcRnBadGenericMethod{} -> noHints + TcRnWarningMinimalDefIncomplete{} -> noHints + TcRnDefaultMethodForPragmaLacksBinding{} -> noHints + TcRnIgnoreSpecialisePragmaOnDefMethod{} -> noHints + TcRnBadMethodErr{} -> noHints + TcRnNoExplicitAssocTypeOrDefaultDeclaration{} -> noHints -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", -- and so on. The `and` stands for any `conjunction`, which is passed in. ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -91,7 +91,7 @@ import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) import GHC.Utils.Outputable -import GHC.Core.Class (Class) +import GHC.Core.Class (Class, ClassMinimalDef) import GHC.Core.Coercion.Axiom (CoAxBranch) import GHC.Core.ConLike (ConLike) import GHC.Core.DataCon (DataCon) @@ -2187,9 +2187,93 @@ data TcRnMessage where pragma_warning_defined_mod :: ModuleName } -> TcRnMessage + + {-| TcRnIllegalHsigDefaultMethods is an error that occurs when a binding for + a class default method is provided in a Backpack signature file. + + Test case: + bkpfail40 + -} + + TcRnIllegalHsigDefaultMethods :: !Name -- ^ 'Name' of the class + -> NE.NonEmpty (LHsBind GhcRn) -- ^ default methods + -> TcRnMessage + {-| TcRnBadGenericMethod + This test ensures that if you provide a "more specific" type signatures + for the default method, you must also provide a binding. + + Example: + {-# LANGUAGE DefaultSignatures #-} + + class C a where + meth :: a + default meth :: Num a => a + meth = 0 + + Test case: + testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.hs + -} + TcRnBadGenericMethod :: !Name -- ^ 'Name' of the class + -> !Name -- ^ Problematic method + -> TcRnMessage + + {-| TcRnWarningMinimalDefIncomplete is a warning that one must + specify which methods must be implemented by all instances. + + Example: + class Cheater a where -- WARNING LINE + cheater :: a + {-# MINIMAL #-} -- warning! + + Test case: + testsuite/tests/warnings/minimal/WarnMinimal.hs: + -} + TcRnWarningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage + + {-| TcRnDefaultMethodForPragmaLacksBinding is an error that occurs when + a default method pragma is missing an accompanying binding. + + Test cases: + testsuite/tests/typecheck/should_fail/T5084.hs + testsuite/tests/typecheck/should_fail/T2354.hs + -} + TcRnDefaultMethodForPragmaLacksBinding + :: Id -- ^ method + -> Sig GhcRn -- ^ the pragma + -> TcRnMessage + {-| TcRnIgnoreSpecialisePragmaOnDefMethod is a warning that occurs when + a specialise pragma is put on a default method. + + Test cases: none + -} + TcRnIgnoreSpecialisePragmaOnDefMethod + :: !Name + -> TcRnMessage + {-| TcRnBadMethodErr is an error that happens when one attempts to provide a method + in a class instance, when the class doesn't have a method by that name. + + Test case: + testsuite/tests/th/T12387 + -} + TcRnBadMethodErr + :: { badMethodErrClassName :: !Name + , badMethodErrMethodName :: !Name + } -> TcRnMessage + {-| TcRnNoExplicitAssocTypeOrDefaultDeclaration is an error that occurs + when a class instance does not provide an expected associated type + or default declaration. + + Test cases: + testsuite/tests/deriving/should_compile/T14094 + testsuite/tests/indexed-types/should_compile/Simple2 + testsuite/tests/typecheck/should_compile/tc254 + -} + TcRnNoExplicitAssocTypeOrDefaultDeclaration + :: Name + -> TcRnMessage + -- | Specifies which back ends can handle a requested foreign import or export type ExpectedBackends = [Backend] - -- | Specifies which calling convention is unsupported on the current platform data UnsupportedCallConvention = StdCallConvUnsupported ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -18,7 +18,6 @@ module GHC.Tc.TyCl.Class , tcClassMinimalDef , HsSigFun , mkHsSigFun - , badMethodErr , instDeclCtxt1 , instDeclCtxt2 , instDeclCtxt3 @@ -70,6 +69,7 @@ import GHC.Data.BooleanFormula import Control.Monad import Data.List ( mapAccumL, partition ) +import qualified Data.List.NonEmpty as NE {- Dictionary handling @@ -112,10 +112,6 @@ Death to "ExpandingDicts". ************************************************************************ -} -illegalHsigDefaultMethod :: Name -> TcRnMessage -illegalHsigDefaultMethod n = TcRnUnknownMessage $ mkPlainError noHints $ - text "Illegal default method(s) in class definition of" <+> ppr n <+> text "in hsig file" - tcClassSigs :: Name -- Name of the class -> [LSig GhcRn] -> LHsBinds GhcRn @@ -130,7 +126,7 @@ tcClassSigs clas sigs def_methods ; op_info <- concatMapM (addLocM (tc_sig gen_dm_env)) vanilla_sigs ; let op_names = mkNameSet [ n | (n,_,_) <- op_info ] - ; sequence_ [ failWithTc (badMethodErr clas n) + ; sequence_ [ failWithTc (TcRnBadMethodErr clas n) | n <- dm_bind_names, not (n `elemNameSet` op_names) ] -- Value binding for non class-method (ie no TypeSig) @@ -141,11 +137,12 @@ tcClassSigs clas sigs def_methods -- (Generic signatures without value bindings indicate -- that a default of this form is expected to be -- provided.) - when (not (null def_methods)) $ - failWithTc (illegalHsigDefaultMethod clas) + case bagToList def_methods of + [] -> return () + meth : meths -> failWithTc (TcRnIllegalHsigDefaultMethods clas (meth NE.:| meths)) else -- Error for each generic signature without value binding - sequence_ [ failWithTc (badGenericMethod clas n) + sequence_ [ failWithTc (TcRnBadGenericMethod clas n) | (n,_) <- gen_dm_prs, not (n `elem` dm_bind_names) ] ; traceTc "tcClassSigs 2" (ppr clas) @@ -236,7 +233,7 @@ tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn tcDefMeth _ _ _ _ _ prag_fn (sel_id, Nothing) = do { -- No default method - mapM_ (addLocMA (badDmPrag sel_id)) + mapM_ (addLocMA (badDmPrag sel_id )) (lookupPragEnv prag_fn (idName sel_id)) ; return emptyBag } @@ -262,9 +259,8 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn ; spec_prags <- discardConstraints $ tcSpecPrags global_dm_id prags - ; let dia = TcRnUnknownMessage $ - mkPlainDiagnostic WarningWithoutFlag noHints $ - (text "Ignoring SPECIALISE pragmas on default method" <+> quotes (ppr sel_name)) + ; let dia = TcRnIgnoreSpecialisePragmaOnDefMethod sel_name + ; diagnosticTc (not (null spec_prags)) dia ; let hs_ty = hs_sig_fn sel_name @@ -340,7 +336,7 @@ tcClassMinimalDef _clas sigs op_info -- since you can't write a default implementation. when (tcg_src tcg_env /= HsigFile) $ whenIsJust (isUnsatisfied (mindef `impliesAtom`) defMindef) $ - (\bf -> addDiagnosticTc (warningMinimalDefIncomplete bf)) + (\bf -> addDiagnosticTc (TcRnWarningMinimalDefIncomplete bf)) return mindef where -- By default require all methods without a default implementation @@ -441,18 +437,6 @@ This makes the error messages right. ************************************************************************ -} -badMethodErr :: Outputable a => a -> Name -> TcRnMessage -badMethodErr clas op - = TcRnUnknownMessage $ mkPlainError noHints $ - hsep [text "Class", quotes (ppr clas), - text "does not have a method", quotes (ppr op)] - -badGenericMethod :: Outputable a => a -> Name -> TcRnMessage -badGenericMethod clas op - = TcRnUnknownMessage $ mkPlainError noHints $ - hsep [text "Class", quotes (ppr clas), - text "has a generic-default signature without a binding", quotes (ppr op)] - {- badGenericInstanceType :: LHsBinds Name -> SDoc badGenericInstanceType binds @@ -472,19 +456,10 @@ dupGenericInsts tc_inst_infos where ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst) -} + badDmPrag :: TcId -> Sig GhcRn -> TcM () badDmPrag sel_id prag - = addErrTc (TcRnUnknownMessage $ mkPlainError noHints $ - text "The" <+> hsSigDoc prag <+> text "for default method" - <+> quotes (ppr sel_id) - <+> text "lacks an accompanying binding") - -warningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage -warningMinimalDefIncomplete mindef - = TcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $ - vcat [ text "The MINIMAL pragma does not require:" - , nest 2 (pprBooleanFormulaNice mindef) - , text "but there is no default implementation." ] + = addErrTc (TcRnDefaultMethodForPragmaLacksBinding sel_id prag) instDeclCtxt1 :: LHsSigType GhcRn -> SDoc instDeclCtxt1 hs_inst_ty @@ -563,10 +538,6 @@ warnMissingAT name -- hs-boot and signatures never need to provide complete "definitions" -- of any sort, as they aren't really defining anything, but just -- constraining items which are defined elsewhere. - ; let dia = TcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingMethods) noHints $ - (text "No explicit" <+> text "associated type" - <+> text "or default declaration for" - <+> quotes (ppr name)) + ; let dia = TcRnNoExplicitAssocTypeOrDefaultDeclaration name ; diagnosticTc (warn && hsc_src == HsSrcFile) dia } ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -27,8 +27,8 @@ import GHC.Tc.Gen.Bind import GHC.Tc.TyCl import GHC.Tc.TyCl.Utils ( addTyConsToGblEnv ) import GHC.Tc.TyCl.Class ( tcClassDecl2, tcATDefault, - HsSigFun, mkHsSigFun, badMethodErr, - findMethodBind, instantiateMethod ) + HsSigFun, mkHsSigFun, findMethodBind, + instantiateMethod ) import GHC.Tc.Solver( pushLevelAndSolveEqualitiesX, reportUnsolvedEqualities ) import GHC.Tc.Gen.Sig import GHC.Tc.Utils.Monad @@ -1800,7 +1800,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys -- Check if any method bindings do not correspond to the class. -- See Note [Mismatched class methods and associated type families]. checkMethBindMembership - = mapM_ (addErrTc . badMethodErr clas) mismatched_meths + = mapM_ (addErrTc . TcRnBadMethodErr (className clas)) mismatched_meths where bind_nms = map unLoc $ collectMethodBinders binds cls_meth_nms = map (idName . fst) op_items ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -816,7 +816,7 @@ zapFragileUnfolding unf trimUnfolding :: Unfolding -> Unfolding -- Squash all unfolding info, preserving only evaluated-ness trimUnfolding unf | isEvaldUnfolding unf = evaldUnfolding - | otherwise = noUnfolding + | otherwise = noUnfolding zapTailCallInfo :: IdInfo -> Maybe IdInfo zapTailCallInfo info ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Types.Var.Env ( -- ** Manipulating these environments emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly, - elemVarEnv, disjointVarEnv, + elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, @@ -62,7 +62,8 @@ module GHC.Types.Var.Env ( -- ** Operations on RnEnv2s mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var, - rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe, + rnOccL, rnOccR, inRnEnvL, inRnEnvR, anyInRnEnvR, + rnOccL_maybe, rnOccR_maybe, rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap, delBndrL, delBndrR, delBndrsL, delBndrsR, extendRnInScopeSetList, @@ -72,7 +73,7 @@ module GHC.Types.Var.Env ( -- * TidyEnv and its operation TidyEnv, - emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList, anyInRnEnvR + emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList ) where import GHC.Prelude @@ -409,7 +410,7 @@ anyInRnEnvR :: RnEnv2 -> VarSet -> Bool anyInRnEnvR (RV2 { envR = env }) vs -- Avoid allocating the predicate if we deal with an empty env. | isEmptyVarEnv env = False - | otherwise = anyVarEnv (`elemVarSet` vs) env + | otherwise = anyVarSet (`elemVarEnv` env) vs lookupRnInScope :: RnEnv2 -> Var -> Var lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v ===================================== testsuite/tests/backpack/should_fail/bkpfail40.stderr ===================================== @@ -2,5 +2,5 @@ [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) bkpfail40.bkp:3:9: error: - • Illegal default method(s) in class definition of C in hsig file + • Illegal default method in class definition of C in hsig file • In the class declaration for ‘C’ ===================================== testsuite/tests/simplCore/should_compile/T21763.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash #-} +module T21763 where + +import GHC.Exts + +-- We should get ONE SpecConstr-generated rule, for f2, +-- not one for f1 and one for f2 + +f1 :: Int -> [Int] -> (Int, [Int]) +-- This one only seq's x, so SpecConstr should not specialise it +f1 x [] = (x, x `seq` []) +f1 x (_:ys) = f1 x ys + + +f2 :: Int -> [Int] -> (Int, [Int]) +-- This one takes x apart, so SpecConstr should specialise it +f2 x [] = (x+1, x `seq` []) +f2 x (_:ys) = f2 x ys + +foo1 :: [Int] -> (Int, [Int]) +foo1 ys = f1 9 ys + +foo2 :: [Int] -> (Int, [Int]) +foo2 ys = f2 9 ys ===================================== testsuite/tests/simplCore/should_compile/T21763.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf20" [2] forall (sc :: Int#). $wf2 (I# sc) = f2_$s$wf2 sc + + ===================================== testsuite/tests/simplCore/should_compile/T21763a.hs ===================================== @@ -0,0 +1,12 @@ +module T21763a where + +{-# NOINLINE g_imp #-} +g_imp !x = not x + +f3 :: (Bool -> Bool) -> Bool -> [Bool] -> (Bool, [Bool]) +-- We want to specialize for `g` to turn it into a known call. +f3 g x [] = (g x, []) +f3 g x (_:ys) = f3 g x ys + +foo3 :: [Bool] -> (Bool, [Bool]) +foo3 ys = f3 g_imp True ys ===================================== testsuite/tests/simplCore/should_compile/T21763a.stderr ===================================== @@ -0,0 +1,5 @@ + +==================== Tidy Core rules ==================== +"SC:$wf30" [2] forall. $wf3 g_imp = f3_$s$wf3 + + ===================================== testsuite/tests/simplCore/should_compile/T22028.hs ===================================== @@ -0,0 +1,19 @@ + +-- This one triggers the bug reported in #22028, which +-- was in a test for #1092 +-- The problem is that the rule +-- forall w. f (\v->w) = w +-- erroneously matches the call +-- f id +-- And that caused an assertion error. + +module Foo where + +f :: (Int -> Int) -> Int +{-# NOINLINE f #-} +f g = g 4 +{-# RULES "f" forall w. f (\v->w) = w #-} + +h1 = f (\v -> v) -- Rule should not fire +h2 = f id -- Rule should not fire +h3 = f (\v -> 3) -- Rule should fire ===================================== testsuite/tests/simplCore/should_compile/T22028.stderr ===================================== @@ -0,0 +1 @@ +Rule fired: f (Foo) ===================================== testsuite/tests/simplCore/should_compile/T22112.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Rec where + +-- This one created a black hole in Tidy, +-- when creating the tidied unfolding for foo +foo :: () -> () +foo = foo ===================================== testsuite/tests/simplCore/should_compile/T22112.stderr ===================================== @@ -0,0 +1,14 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 2, types: 2, coercions: 0, joins: 0/0} + +Rec { +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +foo [Occ=LoopBreaker] :: () -> () +[GblId, Str=b, Cpr=b] +foo = foo +end Rec } + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -415,6 +415,7 @@ test('T17966', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec']) # We expect to see a SPEC rule for $cm test('T19644', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-spec']) test('T21391', normal, compile, ['-O -dcore-lint']) +test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T21391a', normal, compile, ['-O -dcore-lint']) # We don't want to see a thunk allocation for the insertBy expression after CorePrep. test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) @@ -424,3 +425,6 @@ test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) test('T21694b', [grep_errmsg(r'Arity=4') ], compile, ['-O -ddump-simpl']) test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) +test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T22028', normal, compile, ['-O -ddump-rule-firings']) ===================================== testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE DefaultSignatures #-} + +module MissingDefaultMethodBinding where + +class C a where + meth :: a + default meth :: Num a => a ===================================== testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.stderr ===================================== @@ -0,0 +1,4 @@ + +MissingDefaultMethodBinding.hs:5:1: + Class ‘C’ has a generic-default signature without a binding ‘meth’ + In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -658,3 +658,4 @@ test('T21327', normal, compile_fail, ['']) test('T21338', normal, compile_fail, ['']) test('T21158', normal, compile_fail, ['']) test('T21583', normal, compile_fail, ['']) +test('MissingDefaultMethodBinding', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acb617f23bac29376a86318539fbbb1c264b988b...5e58c7fbf62ca07d452d380f7c3f4f971430ffb2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acb617f23bac29376a86318539fbbb1c264b988b...5e58c7fbf62ca07d452d380f7c3f4f971430ffb2 You're receiving 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 29 05:08:28 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 29 Aug 2022 01:08:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] Fix a bug in anyInRnEnvR Message-ID: <630c49cc40e7f_2f2e58487d82723e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 23c0677d by Simon Peyton Jones at 2022-08-29T01:08:15-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 4 changed files: - compiler/GHC/Types/Var/Env.hs - + testsuite/tests/simplCore/should_compile/T22028.hs - + testsuite/tests/simplCore/should_compile/T22028.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Types.Var.Env ( -- ** Manipulating these environments emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly, - elemVarEnv, disjointVarEnv, + elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, @@ -62,7 +62,8 @@ module GHC.Types.Var.Env ( -- ** Operations on RnEnv2s mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var, - rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe, + rnOccL, rnOccR, inRnEnvL, inRnEnvR, anyInRnEnvR, + rnOccL_maybe, rnOccR_maybe, rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap, delBndrL, delBndrR, delBndrsL, delBndrsR, extendRnInScopeSetList, @@ -72,7 +73,7 @@ module GHC.Types.Var.Env ( -- * TidyEnv and its operation TidyEnv, - emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList, anyInRnEnvR + emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList ) where import GHC.Prelude @@ -409,7 +410,7 @@ anyInRnEnvR :: RnEnv2 -> VarSet -> Bool anyInRnEnvR (RV2 { envR = env }) vs -- Avoid allocating the predicate if we deal with an empty env. | isEmptyVarEnv env = False - | otherwise = anyVarEnv (`elemVarSet` vs) env + | otherwise = anyVarSet (`elemVarEnv` env) vs lookupRnInScope :: RnEnv2 -> Var -> Var lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v ===================================== testsuite/tests/simplCore/should_compile/T22028.hs ===================================== @@ -0,0 +1,19 @@ + +-- This one triggers the bug reported in #22028, which +-- was in a test for #1092 +-- The problem is that the rule +-- forall w. f (\v->w) = w +-- erroneously matches the call +-- f id +-- And that caused an assertion error. + +module Foo where + +f :: (Int -> Int) -> Int +{-# NOINLINE f #-} +f g = g 4 +{-# RULES "f" forall w. f (\v->w) = w #-} + +h1 = f (\v -> v) -- Rule should not fire +h2 = f id -- Rule should not fire +h3 = f (\v -> 3) -- Rule should fire ===================================== testsuite/tests/simplCore/should_compile/T22028.stderr ===================================== @@ -0,0 +1 @@ +Rule fired: f (Foo) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -427,3 +427,4 @@ test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T22028', normal, compile, ['-O -ddump-rule-firings']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23c0677d55d4c095c3ad6cf6b2aae5125a53d4f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23c0677d55d4c095c3ad6cf6b2aae5125a53d4f2 You're receiving 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 29 05:08:56 2022 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 29 Aug 2022 01:08:56 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Disable llvm ways and ghci for JS backend testsuite Message-ID: <630c49e890f8c_2f2e58488782780b3@gitlab.mail> Josh Meredith pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 8428b5d9 by Josh Meredith at 2022-08-29T05:08:44+00:00 Disable llvm ways and ghci for JS backend testsuite - - - - - 2 changed files: - configure.ac - testsuite/config/ghc Changes: ===================================== configure.ac ===================================== @@ -331,7 +331,7 @@ AC_SUBST(TablesNextToCode) dnl ** Does target have runtime linker support? dnl -------------------------------------------------------------- case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*) + powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|js-*) TargetHasRTSLinker=NO ;; *) ===================================== testsuite/config/ghc ===================================== @@ -182,6 +182,8 @@ llvm_ways = [x[0] for x in config.way_flags.items() def get_compiler_info(): if config.unregisterised: print("Unregisterised build; skipping LLVM ways...") + elif config.arch == "js": + print("JavaScript backend; skipping LLVM ways...") elif config.have_llvm: config.compile_ways.append('optllvm') config.run_ways.append('optllvm') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8428b5d9358bc94d89b084128fbe9cdce65771af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8428b5d9358bc94d89b084128fbe9cdce65771af You're receiving 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 29 08:18:40 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 29 Aug 2022 04:18:40 -0400 Subject: [Git][ghc/ghc][master] Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) Message-ID: <630c7660ce4a1_2f2e5813a03c9c302980@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - 8 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - testsuite/tests/backpack/should_fail/bkpfail40.stderr - + testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.hs - + testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -82,6 +82,8 @@ import GHC.Utils.Panic import qualified GHC.LanguageExtensions as LangExt +import GHC.Data.BooleanFormula (pprBooleanFormulaNice) + import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Function (on) @@ -961,6 +963,36 @@ instance Diagnostic TcRnMessage where impMsg = text "imported from" <+> ppr pragma_warning_import_mod <> extra extra | pragma_warning_import_mod == pragma_warning_defined_mod = empty | otherwise = text ", but defined in" <+> ppr pragma_warning_defined_mod + TcRnIllegalHsigDefaultMethods name meths + -> mkSimpleDecorated $ + text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file" + TcRnBadGenericMethod clas op + -> mkSimpleDecorated $ + hsep [text "Class", quotes (ppr clas), + text "has a generic-default signature without a binding", quotes (ppr op)] + TcRnWarningMinimalDefIncomplete mindef + -> mkSimpleDecorated $ + vcat [ text "The MINIMAL pragma does not require:" + , nest 2 (pprBooleanFormulaNice mindef) + , text "but there is no default implementation." ] + TcRnDefaultMethodForPragmaLacksBinding sel_id prag + -> mkSimpleDecorated $ + text "The" <+> hsSigDoc prag <+> text "for default method" + <+> quotes (ppr sel_id) + <+> text "lacks an accompanying binding" + TcRnIgnoreSpecialisePragmaOnDefMethod sel_name + -> mkSimpleDecorated $ + text "Ignoring SPECIALISE pragmas on default method" + <+> quotes (ppr sel_name) + TcRnBadMethodErr{badMethodErrClassName, badMethodErrMethodName} + -> mkSimpleDecorated $ + hsep [text "Class", quotes (ppr badMethodErrClassName), + text "does not have a method", quotes (ppr badMethodErrMethodName)] + TcRnNoExplicitAssocTypeOrDefaultDeclaration name + -> mkSimpleDecorated $ + text "No explicit" <+> text "associated type" + <+> text "or default declaration for" + <+> quotes (ppr name) diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -1276,6 +1308,20 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnPragmaWarning{} -> WarningWithFlag Opt_WarnWarningsDeprecations + TcRnIllegalHsigDefaultMethods{} + -> ErrorWithoutFlag + TcRnBadGenericMethod{} + -> ErrorWithoutFlag + TcRnWarningMinimalDefIncomplete{} + -> WarningWithoutFlag + TcRnDefaultMethodForPragmaLacksBinding{} + -> ErrorWithoutFlag + TcRnIgnoreSpecialisePragmaOnDefMethod{} + -> WarningWithoutFlag + TcRnBadMethodErr{} + -> ErrorWithoutFlag + TcRnNoExplicitAssocTypeOrDefaultDeclaration{} + -> WarningWithFlag (Opt_WarnMissingMethods) diagnosticHints = \case TcRnUnknownMessage m @@ -1591,7 +1637,13 @@ instance Diagnostic TcRnMessage where TcRnNameByTemplateHaskellQuote{} -> noHints TcRnIllegalBindingOfBuiltIn{} -> noHints TcRnPragmaWarning{} -> noHints - + TcRnIllegalHsigDefaultMethods{} -> noHints + TcRnBadGenericMethod{} -> noHints + TcRnWarningMinimalDefIncomplete{} -> noHints + TcRnDefaultMethodForPragmaLacksBinding{} -> noHints + TcRnIgnoreSpecialisePragmaOnDefMethod{} -> noHints + TcRnBadMethodErr{} -> noHints + TcRnNoExplicitAssocTypeOrDefaultDeclaration{} -> noHints -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", -- and so on. The `and` stands for any `conjunction`, which is passed in. ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -91,7 +91,7 @@ import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) import GHC.Utils.Outputable -import GHC.Core.Class (Class) +import GHC.Core.Class (Class, ClassMinimalDef) import GHC.Core.Coercion.Axiom (CoAxBranch) import GHC.Core.ConLike (ConLike) import GHC.Core.DataCon (DataCon) @@ -2187,9 +2187,93 @@ data TcRnMessage where pragma_warning_defined_mod :: ModuleName } -> TcRnMessage + + {-| TcRnIllegalHsigDefaultMethods is an error that occurs when a binding for + a class default method is provided in a Backpack signature file. + + Test case: + bkpfail40 + -} + + TcRnIllegalHsigDefaultMethods :: !Name -- ^ 'Name' of the class + -> NE.NonEmpty (LHsBind GhcRn) -- ^ default methods + -> TcRnMessage + {-| TcRnBadGenericMethod + This test ensures that if you provide a "more specific" type signatures + for the default method, you must also provide a binding. + + Example: + {-# LANGUAGE DefaultSignatures #-} + + class C a where + meth :: a + default meth :: Num a => a + meth = 0 + + Test case: + testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.hs + -} + TcRnBadGenericMethod :: !Name -- ^ 'Name' of the class + -> !Name -- ^ Problematic method + -> TcRnMessage + + {-| TcRnWarningMinimalDefIncomplete is a warning that one must + specify which methods must be implemented by all instances. + + Example: + class Cheater a where -- WARNING LINE + cheater :: a + {-# MINIMAL #-} -- warning! + + Test case: + testsuite/tests/warnings/minimal/WarnMinimal.hs: + -} + TcRnWarningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage + + {-| TcRnDefaultMethodForPragmaLacksBinding is an error that occurs when + a default method pragma is missing an accompanying binding. + + Test cases: + testsuite/tests/typecheck/should_fail/T5084.hs + testsuite/tests/typecheck/should_fail/T2354.hs + -} + TcRnDefaultMethodForPragmaLacksBinding + :: Id -- ^ method + -> Sig GhcRn -- ^ the pragma + -> TcRnMessage + {-| TcRnIgnoreSpecialisePragmaOnDefMethod is a warning that occurs when + a specialise pragma is put on a default method. + + Test cases: none + -} + TcRnIgnoreSpecialisePragmaOnDefMethod + :: !Name + -> TcRnMessage + {-| TcRnBadMethodErr is an error that happens when one attempts to provide a method + in a class instance, when the class doesn't have a method by that name. + + Test case: + testsuite/tests/th/T12387 + -} + TcRnBadMethodErr + :: { badMethodErrClassName :: !Name + , badMethodErrMethodName :: !Name + } -> TcRnMessage + {-| TcRnNoExplicitAssocTypeOrDefaultDeclaration is an error that occurs + when a class instance does not provide an expected associated type + or default declaration. + + Test cases: + testsuite/tests/deriving/should_compile/T14094 + testsuite/tests/indexed-types/should_compile/Simple2 + testsuite/tests/typecheck/should_compile/tc254 + -} + TcRnNoExplicitAssocTypeOrDefaultDeclaration + :: Name + -> TcRnMessage + -- | Specifies which back ends can handle a requested foreign import or export type ExpectedBackends = [Backend] - -- | Specifies which calling convention is unsupported on the current platform data UnsupportedCallConvention = StdCallConvUnsupported ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -18,7 +18,6 @@ module GHC.Tc.TyCl.Class , tcClassMinimalDef , HsSigFun , mkHsSigFun - , badMethodErr , instDeclCtxt1 , instDeclCtxt2 , instDeclCtxt3 @@ -70,6 +69,7 @@ import GHC.Data.BooleanFormula import Control.Monad import Data.List ( mapAccumL, partition ) +import qualified Data.List.NonEmpty as NE {- Dictionary handling @@ -112,10 +112,6 @@ Death to "ExpandingDicts". ************************************************************************ -} -illegalHsigDefaultMethod :: Name -> TcRnMessage -illegalHsigDefaultMethod n = TcRnUnknownMessage $ mkPlainError noHints $ - text "Illegal default method(s) in class definition of" <+> ppr n <+> text "in hsig file" - tcClassSigs :: Name -- Name of the class -> [LSig GhcRn] -> LHsBinds GhcRn @@ -130,7 +126,7 @@ tcClassSigs clas sigs def_methods ; op_info <- concatMapM (addLocM (tc_sig gen_dm_env)) vanilla_sigs ; let op_names = mkNameSet [ n | (n,_,_) <- op_info ] - ; sequence_ [ failWithTc (badMethodErr clas n) + ; sequence_ [ failWithTc (TcRnBadMethodErr clas n) | n <- dm_bind_names, not (n `elemNameSet` op_names) ] -- Value binding for non class-method (ie no TypeSig) @@ -141,11 +137,12 @@ tcClassSigs clas sigs def_methods -- (Generic signatures without value bindings indicate -- that a default of this form is expected to be -- provided.) - when (not (null def_methods)) $ - failWithTc (illegalHsigDefaultMethod clas) + case bagToList def_methods of + [] -> return () + meth : meths -> failWithTc (TcRnIllegalHsigDefaultMethods clas (meth NE.:| meths)) else -- Error for each generic signature without value binding - sequence_ [ failWithTc (badGenericMethod clas n) + sequence_ [ failWithTc (TcRnBadGenericMethod clas n) | (n,_) <- gen_dm_prs, not (n `elem` dm_bind_names) ] ; traceTc "tcClassSigs 2" (ppr clas) @@ -236,7 +233,7 @@ tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn tcDefMeth _ _ _ _ _ prag_fn (sel_id, Nothing) = do { -- No default method - mapM_ (addLocMA (badDmPrag sel_id)) + mapM_ (addLocMA (badDmPrag sel_id )) (lookupPragEnv prag_fn (idName sel_id)) ; return emptyBag } @@ -262,9 +259,8 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn ; spec_prags <- discardConstraints $ tcSpecPrags global_dm_id prags - ; let dia = TcRnUnknownMessage $ - mkPlainDiagnostic WarningWithoutFlag noHints $ - (text "Ignoring SPECIALISE pragmas on default method" <+> quotes (ppr sel_name)) + ; let dia = TcRnIgnoreSpecialisePragmaOnDefMethod sel_name + ; diagnosticTc (not (null spec_prags)) dia ; let hs_ty = hs_sig_fn sel_name @@ -340,7 +336,7 @@ tcClassMinimalDef _clas sigs op_info -- since you can't write a default implementation. when (tcg_src tcg_env /= HsigFile) $ whenIsJust (isUnsatisfied (mindef `impliesAtom`) defMindef) $ - (\bf -> addDiagnosticTc (warningMinimalDefIncomplete bf)) + (\bf -> addDiagnosticTc (TcRnWarningMinimalDefIncomplete bf)) return mindef where -- By default require all methods without a default implementation @@ -441,18 +437,6 @@ This makes the error messages right. ************************************************************************ -} -badMethodErr :: Outputable a => a -> Name -> TcRnMessage -badMethodErr clas op - = TcRnUnknownMessage $ mkPlainError noHints $ - hsep [text "Class", quotes (ppr clas), - text "does not have a method", quotes (ppr op)] - -badGenericMethod :: Outputable a => a -> Name -> TcRnMessage -badGenericMethod clas op - = TcRnUnknownMessage $ mkPlainError noHints $ - hsep [text "Class", quotes (ppr clas), - text "has a generic-default signature without a binding", quotes (ppr op)] - {- badGenericInstanceType :: LHsBinds Name -> SDoc badGenericInstanceType binds @@ -472,19 +456,10 @@ dupGenericInsts tc_inst_infos where ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst) -} + badDmPrag :: TcId -> Sig GhcRn -> TcM () badDmPrag sel_id prag - = addErrTc (TcRnUnknownMessage $ mkPlainError noHints $ - text "The" <+> hsSigDoc prag <+> text "for default method" - <+> quotes (ppr sel_id) - <+> text "lacks an accompanying binding") - -warningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage -warningMinimalDefIncomplete mindef - = TcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $ - vcat [ text "The MINIMAL pragma does not require:" - , nest 2 (pprBooleanFormulaNice mindef) - , text "but there is no default implementation." ] + = addErrTc (TcRnDefaultMethodForPragmaLacksBinding sel_id prag) instDeclCtxt1 :: LHsSigType GhcRn -> SDoc instDeclCtxt1 hs_inst_ty @@ -563,10 +538,6 @@ warnMissingAT name -- hs-boot and signatures never need to provide complete "definitions" -- of any sort, as they aren't really defining anything, but just -- constraining items which are defined elsewhere. - ; let dia = TcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingMethods) noHints $ - (text "No explicit" <+> text "associated type" - <+> text "or default declaration for" - <+> quotes (ppr name)) + ; let dia = TcRnNoExplicitAssocTypeOrDefaultDeclaration name ; diagnosticTc (warn && hsc_src == HsSrcFile) dia } ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -27,8 +27,8 @@ import GHC.Tc.Gen.Bind import GHC.Tc.TyCl import GHC.Tc.TyCl.Utils ( addTyConsToGblEnv ) import GHC.Tc.TyCl.Class ( tcClassDecl2, tcATDefault, - HsSigFun, mkHsSigFun, badMethodErr, - findMethodBind, instantiateMethod ) + HsSigFun, mkHsSigFun, findMethodBind, + instantiateMethod ) import GHC.Tc.Solver( pushLevelAndSolveEqualitiesX, reportUnsolvedEqualities ) import GHC.Tc.Gen.Sig import GHC.Tc.Utils.Monad @@ -1800,7 +1800,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys -- Check if any method bindings do not correspond to the class. -- See Note [Mismatched class methods and associated type families]. checkMethBindMembership - = mapM_ (addErrTc . badMethodErr clas) mismatched_meths + = mapM_ (addErrTc . TcRnBadMethodErr (className clas)) mismatched_meths where bind_nms = map unLoc $ collectMethodBinders binds cls_meth_nms = map (idName . fst) op_items ===================================== testsuite/tests/backpack/should_fail/bkpfail40.stderr ===================================== @@ -2,5 +2,5 @@ [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) bkpfail40.bkp:3:9: error: - • Illegal default method(s) in class definition of C in hsig file + • Illegal default method in class definition of C in hsig file • In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE DefaultSignatures #-} + +module MissingDefaultMethodBinding where + +class C a where + meth :: a + default meth :: Num a => a ===================================== testsuite/tests/typecheck/should_fail/MissingDefaultMethodBinding.stderr ===================================== @@ -0,0 +1,4 @@ + +MissingDefaultMethodBinding.hs:5:1: + Class ‘C’ has a generic-default signature without a binding ‘meth’ + In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -658,3 +658,4 @@ test('T21327', normal, compile_fail, ['']) test('T21338', normal, compile_fail, ['']) test('T21158', normal, compile_fail, ['']) test('T21583', normal, compile_fail, ['']) +test('MissingDefaultMethodBinding', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68e6786f3d1bde5d044a649462cdf2b6034a2df8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68e6786f3d1bde5d044a649462cdf2b6034a2df8 You're receiving 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 29 08:19:10 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 29 Aug 2022 04:19:10 -0400 Subject: [Git][ghc/ghc][master] Fix a bug in anyInRnEnvR Message-ID: <630c767e9560f_2f2e5816becc683063d9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 4 changed files: - compiler/GHC/Types/Var/Env.hs - + testsuite/tests/simplCore/should_compile/T22028.hs - + testsuite/tests/simplCore/should_compile/T22028.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Types.Var.Env ( -- ** Manipulating these environments emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly, - elemVarEnv, disjointVarEnv, + elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, @@ -62,7 +62,8 @@ module GHC.Types.Var.Env ( -- ** Operations on RnEnv2s mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var, - rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe, + rnOccL, rnOccR, inRnEnvL, inRnEnvR, anyInRnEnvR, + rnOccL_maybe, rnOccR_maybe, rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap, delBndrL, delBndrR, delBndrsL, delBndrsR, extendRnInScopeSetList, @@ -72,7 +73,7 @@ module GHC.Types.Var.Env ( -- * TidyEnv and its operation TidyEnv, - emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList, anyInRnEnvR + emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList ) where import GHC.Prelude @@ -409,7 +410,7 @@ anyInRnEnvR :: RnEnv2 -> VarSet -> Bool anyInRnEnvR (RV2 { envR = env }) vs -- Avoid allocating the predicate if we deal with an empty env. | isEmptyVarEnv env = False - | otherwise = anyVarEnv (`elemVarSet` vs) env + | otherwise = anyVarSet (`elemVarEnv` env) vs lookupRnInScope :: RnEnv2 -> Var -> Var lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v ===================================== testsuite/tests/simplCore/should_compile/T22028.hs ===================================== @@ -0,0 +1,19 @@ + +-- This one triggers the bug reported in #22028, which +-- was in a test for #1092 +-- The problem is that the rule +-- forall w. f (\v->w) = w +-- erroneously matches the call +-- f id +-- And that caused an assertion error. + +module Foo where + +f :: (Int -> Int) -> Int +{-# NOINLINE f #-} +f g = g 4 +{-# RULES "f" forall w. f (\v->w) = w #-} + +h1 = f (\v -> v) -- Rule should not fire +h2 = f id -- Rule should not fire +h3 = f (\v -> 3) -- Rule should fire ===================================== testsuite/tests/simplCore/should_compile/T22028.stderr ===================================== @@ -0,0 +1 @@ +Rule fired: f (Foo) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -427,3 +427,4 @@ test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T22028', normal, compile, ['-O -ddump-rule-firings']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbe51ac5e0bbe2667b6c7204ae62a534a9bc7c95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbe51ac5e0bbe2667b6c7204ae62a534a9bc7c95 You're receiving 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 29 09:33:21 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 29 Aug 2022 05:33:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22114 Message-ID: <630c87e1991fe_2f2e5813a03c9c349732@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22114 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22114 You're receiving 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 29 10:22:25 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 29 Aug 2022 06:22:25 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] 31 commits: Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <630c93613fd5c_2f2e58487ec371642@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 299b0653 by Matthew Pickering at 2022-08-29T11:22:16+01:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - f523b6ff by Matthew Pickering at 2022-08-29T11:22:16+01:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - b4cacdde by Matthew Pickering at 2022-08-29T11:22:16+01:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - 2609d718 by Matthew Pickering at 2022-08-29T11:22:16+01:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - 1e42c17d by Matthew Pickering at 2022-08-29T11:22:16+01:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - 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.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/094ed61a860e5f5821cac164fae8a29fc74819d3...1e42c17d642b56d34b5b1221dea914a9a9f4fa14 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/094ed61a860e5f5821cac164fae8a29fc74819d3...1e42c17d642b56d34b5b1221dea914a9a9f4fa14 You're receiving 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 29 12:28:36 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 29 Aug 2022 08:28:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21470 Message-ID: <630cb0f48633e_2f2e5816becc6842287@gitlab.mail> Simon Peyton Jones pushed new branch wip/T21470 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21470 You're receiving 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 29 12:45:08 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 29 Aug 2022 08:45:08 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 2 commits: StaticPtr: don't generate CStubs for the JS backend Message-ID: <630cb4d449a68_2f2e5813a03c9c437526@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: a1f586ea by Sylvain Henry at 2022-08-29T14:48:01+02:00 StaticPtr: don't generate CStubs for the JS backend - - - - - 5cdbdbc9 by Sylvain Henry at 2022-08-29T14:48:01+02:00 StaticPtr: fix hs_spt_lookup after upstream change - - - - - 2 changed files: - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - js/staticpointer.js.pp Changes: ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -239,8 +239,13 @@ sptCreateStaticBinds opts this_mod binds = do -- @fps@ is a list associating each binding corresponding to a static entry with -- its fingerprint. sptModuleInitCode :: Platform -> Module -> [SptEntry] -> CStub -sptModuleInitCode _ _ [] = mempty -sptModuleInitCode platform this_mod entries = +sptModuleInitCode platform this_mod entries + -- no CStub if there is no entry + | [] <- entries = mempty + -- no CStub for the JS backend: it deals with it directly during JS code + -- generation + | ArchJavaScript <- platformArch platform = mempty + | otherwise = initializerCStub platform init_fn_nm empty init_fn_body `mappend` finalizerCStub platform fini_fn_nm empty fini_fn_body where ===================================== js/staticpointer.js.pp ===================================== @@ -36,9 +36,15 @@ function h$hs_spt_keys(tgt_d, tgt_o, n) { return Math.min(n,ks.length); } -function h$hs_spt_lookup(key1,key2,key3,key4) { - // var i3 = key_d.i3, o = key_o >> 2; - // h$log("hs_spt_lookup"); +function h$hs_spt_lookup(key_v,key_o) { + // We know that the array is freshly allocated so we don't have to care + // about the offset (should be 0). + // + // note that the order of the keys is weird due to endianness + var key2 = key_v.i3[0] >>> 0; + var key1 = key_v.i3[1] >>> 0; + var key4 = key_v.i3[2] >>> 0; + var key3 = key_v.i3[3] >>> 0; RETURN_UBX_TUP2(h$hs_spt_lookup_key(key1,key2,key3,key4), 0); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8428b5d9358bc94d89b084128fbe9cdce65771af...5cdbdbc9d6e5e097638f54de1f08a06de9bf3286 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8428b5d9358bc94d89b084128fbe9cdce65771af...5cdbdbc9d6e5e097638f54de1f08a06de9bf3286 You're receiving 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 29 12:45:49 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 29 Aug 2022 08:45:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22121 Message-ID: <630cb4fd4254c_2f2e584880043777a@gitlab.mail> Matthew Pickering pushed new branch wip/T22121 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22121 You're receiving 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 29 13:07:36 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 29 Aug 2022 09:07:36 -0400 Subject: [Git][ghc/ghc][wip/T22121] ci: Attempt using normal submodule cloning strategy Message-ID: <630cba188a77_2f2e5813a03c9c4483a2@gitlab.mail> Matthew Pickering pushed to branch wip/T22121 at Glasgow Haskell Compiler / GHC Commits: e3678d47 by Matthew Pickering at 2022-08-29T14:07:23+01:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3678d47079559e17f082b618a6ea12f521b64fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3678d47079559e17f082b618a6ea12f521b64fc You're receiving 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 29 15:12:29 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 29 Aug 2022 11:12:29 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Testsuite: fix normalisation for unlit Message-ID: <630cd75d1bae3_2f2e584909f1c4836af@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: c286e9e4 by Sylvain Henry at 2022-08-29T17:09:50+02:00 Testsuite: fix normalisation for unlit T8430 shows: `js-unknown-ghcjs-unlit' failed in phase `Literate pre-processor'. (Exit code: 1) Notice the quote around the program name. So I've made the regex match more cases (i.e. not only lines starting with the program name). - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -2313,7 +2313,7 @@ def normalise_errmsg(s: str) -> str: s = re.sub('ghc-stage[123]', 'ghc', s) # Remove platform prefix (e.g. js-unknown-ghcjs) for cross-compiled ghc s = re.sub('^\\w+-\\w+-\\w+-ghc', 'ghc', s) - s = re.sub('^\\w+-\\w+-\\w+-unlit', 'unlit', s) + s = re.sub('\\w+-\\w+-\\w+-unlit', 'unlit', s) # On windows error messages can mention versioned executables s = re.sub('ghc-[0-9.]+', 'ghc', s) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c286e9e4917e03cc8bca7e77b0e9f2a0aae550a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c286e9e4917e03cc8bca7e77b0e9f2a0aae550a8 You're receiving 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 29 16:38:09 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 29 Aug 2022 12:38:09 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Codegen: fix codegen of string literals Message-ID: <630ceb71e8d2_2f2e58488784971b6@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 0f02642e by Sylvain Henry at 2022-08-29T18:39:23+02:00 Codegen: fix codegen of string literals Due to FastString change: Before: Text.pack . BSC.unpack After: mkFastString . BSC.unpack It seems that Text handles buggy multi-byte codepoints split into several String Chars. - - - - - 1 changed file: - compiler/GHC/StgToJS/Linker/Compactor.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Compactor.hs ===================================== @@ -400,8 +400,9 @@ staticDeclStat (StaticInfo si sv _) = ssu StaticUnboxedStringOffset {} = 0 in maybe (appS "h$di" [toJExpr si']) (\v -> DeclStat si' `mappend` (toJExpr si' |= v)) (ssv sv) +-- | JS expression corresponding to a static string initStr :: BS.ByteString -> JExpr -initStr str = app "h$str" [ValExpr (JStr . mkFastString . BSC.unpack $! str)] +initStr str = app "h$str" [ValExpr (JStr . mkFastStringByteString $! str)] -- | rename a heap object, which means adding it to the -- static init table in addition to the renamer View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f02642ef60dd3fb07d80a49a3b826b7bf0de7ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f02642ef60dd3fb07d80a49a3b826b7bf0de7ea You're receiving 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 29 16:49:36 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 29 Aug 2022 12:49:36 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibbles Message-ID: <630cee2043516_2f2e58488b44976b2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 9e2f92c1 by Simon Peyton Jones at 2022-08-29T16:10:19+01:00 Wibbles - - - - - 15 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/RoughMap.hs - compiler/GHC/Tc/Gen/Foreign.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs - testsuite/tests/pmcheck/should_compile/T11195.hs - testsuite/tests/roles/should_compile/Roles3.stderr - testsuite/tests/tcplugins/ArgsPlugin.hs - testsuite/tests/tcplugins/EmitWantedPlugin.hs - testsuite/tests/tcplugins/RewritePlugin.hs - testsuite/tests/tcplugins/TyFamPlugin.hs - testsuite/tests/typecheck/should_compile/T18406b.stderr - testsuite/tests/typecheck/should_compile/T18529.stderr Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -1491,9 +1491,8 @@ constraintKindTyConName :: Name constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon -typeToTypeKind, constraintKind :: Kind +constraintKind :: Kind constraintKind = mkTyConTy constraintKindTyCon -typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind ---------------------- -- type Type = TYPE LiftedRep @@ -1507,8 +1506,9 @@ liftedTypeKindTyConName :: Name liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon -liftedTypeKind :: Type +liftedTypeKind, typeToTypeKind :: Type liftedTypeKind = mkTyConTy liftedTypeKindTyCon +typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind ---------------------- -- type UnliftedType = TYPE ('BoxedRep 'Unlifted) ===================================== compiler/GHC/Core/FamInstEnv.hs ===================================== @@ -367,7 +367,7 @@ type FamInstEnvs = (FamInstEnv, FamInstEnv) data FamInstEnv = FamIE !Int -- The number of instances, used to choose the smaller environment - -- when checking type family consistnecy of home modules. + -- when checking type family consistency of home modules. !(RoughMap FamInst) -- See Note [FamInstEnv] -- See Note [FamInstEnv determinism] ===================================== compiler/GHC/Core/RoughMap.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.Type import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Builtin.Types.Prim( cONSTRAINTTyConName, tYPETyConName ) import Control.Monad (join) import Data.Data (Data) @@ -275,11 +276,23 @@ typeToRoughMatchTc :: Type -> RoughMatchTc typeToRoughMatchTc ty | Just (ty', _) <- splitCastTy_maybe ty = typeToRoughMatchTc ty' | Just (tc,_) <- splitTyConApp_maybe ty - , not (isTypeFamilyTyCon tc) = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) - RM_KnownTc $! tyConName tc + , not (isTypeFamilyTyCon tc) = RM_KnownTc $! roughMatchTyConName tc -- See Note [Rough matching in class and family instances] | otherwise = RM_WildCard +roughMatchTyConName :: TyCon -> Name +roughMatchTyConName tc + | tc_name == cONSTRAINTTyConName + = tYPETyConName -- TYPE and CONSTRAINT are not apart, so they must use + -- the same rough-map key. We arbitrarily use TYPE. + -- See Note [Type and Constraint are not apart] + -- in GHC.Builtin.Types.Prim + | otherwise + = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) tc_name + where + tc_name = tyConName tc + + -- | Trie of @[RoughMatchTc]@ -- -- *Examples* @@ -333,6 +346,7 @@ lookupRM' (RML_KnownTc tc : tcs) rm = (m, u) = maybe (emptyBag, []) (lookupRM' tcs) (lookupDNameEnv (rm_known rm) tc) in (rm_empty rm `unionBags` common_m `unionBags` m , bagToList (rm_empty rm) ++ common_u ++ u) + -- A RML_NoKnownTC does **not** match any KnownTC but can unify lookupRM' (RML_NoKnownTc : tcs) rm = ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -244,10 +244,17 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty ; (Reduction norm_co norm_sig_ty, gres) <- normaliseFfiType sig_ty ; let - -- Drop the foralls before inspecting the - -- structure of the foreign type. - (arg_tys, res_ty) = tcSplitFunTys (dropForAlls norm_sig_ty) - id = mkLocalId nm ManyTy sig_ty + -- Drop the foralls before inspecting the + -- structure of the foreign type. + -- Use splitFunTys, which splits (=>) as well as (->) + -- so that for foreign import foo :: Eq a => a -> blah + -- we get "unacceptable argument Eq a" rather than + -- "unacceptable result Eq a => a -> blah" + -- Not a big deal. We could make a better error message specially + -- for overloaded functions, but doesn't seem worth it + (arg_tys, res_ty) = splitFunTys (dropForAlls norm_sig_ty) + + id = mkLocalId nm ManyTy sig_ty -- Use a LocalId to obey the invariant that locally-defined -- things are LocalIds. However, it does not need zonking, -- (so GHC.Tc.Utils.Zonk.zonkForeignExports ignores it). ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -61,6 +61,7 @@ GHC.Core.SimpleOpt GHC.Core.Stats GHC.Core.Subst GHC.Core.Tidy +GHC.Core.TyCo.Compare GHC.Core.TyCo.FVs GHC.Core.TyCo.Ppr GHC.Core.TyCo.Rep ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -61,6 +61,7 @@ GHC.Core.SimpleOpt GHC.Core.Stats GHC.Core.Subst GHC.Core.Tidy +GHC.Core.TyCo.Compare GHC.Core.TyCo.FVs GHC.Core.TyCo.Ppr GHC.Core.TyCo.Rep ===================================== testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs ===================================== @@ -12,7 +12,8 @@ import Data.List import GHC.Tc.Types import qualified Data.Map as M import Control.Monad (liftM2) -import GHC.Tc.Utils.TcType +import GHC.Tc.Utils.TcType( isAmbiguousTyVar ) +import GHC.Core.TyCo.Compare( eqType, nonDetCmpType ) class DefaultType x (y :: x) ===================================== testsuite/tests/pmcheck/should_compile/T11195.hs ===================================== @@ -3,6 +3,7 @@ module T11195 where import GHC.Core.TyCo.Rep +import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Coercion import GHC.Core.Type hiding( substTyVarBndr, substTy, extendTCvSubst ) import GHC.Core.InstEnv @@ -61,7 +62,7 @@ opt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] opt_transList is = zipWith (opt_trans is) opt_trans_rule :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo -opt_trans_rule is in_co1@(NthCo r1 d1 co1) in_co2@(NthCo r2 d2 co2) +opt_trans_rule is in_co1@(SelCo d1 co1) in_co2@(SelCo d2 co2) | d1 == d2 , co1 `compatible_co` co2 = undefined ===================================== testsuite/tests/roles/should_compile/Roles3.stderr ===================================== @@ -21,7 +21,7 @@ COERCION AXIOMS axiom Roles3.N:C3 :: C3 a b = a -> F3 b -> F3 b axiom Roles3.N:C4 :: C4 a b = a -> F4 b -> F4 b Dependent modules: [] -Dependent packages: [base-4.16.0.0] +Dependent packages: [base-4.17.0.0] ==================== Typechecker ==================== Roles3.$tcC4 @@ -48,24 +48,23 @@ Roles3.$tc'C:C1 = GHC.Types.TyCon 4508088879886988796##64 13962145553903222779##64 Roles3.$trModule (GHC.Types.TrNameS "'C:C1"#) 1# $krep +$krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp + GHC.Types.$tc~ ((:) GHC.Types.krep$* ((:) $krep ((:) $krep []))) +$krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp Roles3.$tcC2 ((:) $krep ((:) $krep [])) +$krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp Roles3.$tcC1 ((:) $krep []) $krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep $krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [] + = GHC.Types.KindRepFun GHC.Types.krep$* GHC.Types.krep$Constraint $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp - GHC.Types.$tc~ ((:) GHC.Types.krep$* ((:) $krep ((:) $krep []))) -$krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp Roles3.$tcC2 ((:) $krep ((:) $krep [])) -$krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp Roles3.$tcC1 ((:) $krep []) Roles3.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles3"#) ===================================== testsuite/tests/tcplugins/ArgsPlugin.hs ===================================== @@ -17,7 +17,7 @@ import GHC.Core.DataCon ( classDataCon ) import GHC.Core.Make ( mkCoreConApps, mkIntegerExpr ) -import GHC.Core.Type +import GHC.Core.TyCo.Compare ( eqType ) import GHC.Plugins ( Plugin ) ===================================== testsuite/tests/tcplugins/EmitWantedPlugin.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Core.DataCon ( classDataCon ) import GHC.Core.Make ( mkCoreConApps, unitExpr ) -import GHC.Core.Type +import GHC.Core.TyCo.Compare ( eqType ) import GHC.Core.Utils ( mkCast ) ===================================== testsuite/tests/tcplugins/RewritePlugin.hs ===================================== @@ -21,12 +21,14 @@ import GHC.Core.Predicate ) import GHC.Core.Reduction ( Reduction(..) ) +import GHC.Core.TyCo.Compare + ( eqType ) import GHC.Core.TyCo.Rep ( Type, UnivCoProvenance(PluginProv) ) import GHC.Core.TyCon ( TyCon ) import GHC.Core.Type - ( eqType, mkTyConApp, splitTyConApp_maybe ) + ( mkTyConApp, splitTyConApp_maybe ) import GHC.Plugins ( Plugin ) import GHC.Tc.Plugin ===================================== testsuite/tests/tcplugins/TyFamPlugin.hs ===================================== @@ -19,10 +19,12 @@ import GHC.Core.Predicate ( EqRel(NomEq), Pred(EqPred) , classifyPredType ) +import GHC.Core.TyCo.Compare + ( eqType ) import GHC.Core.TyCo.Rep ( Type, UnivCoProvenance(PluginProv) ) import GHC.Core.Type - ( eqType, mkTyConApp, splitTyConApp_maybe ) + ( mkTyConApp, splitTyConApp_maybe ) import GHC.Plugins ( Plugin ) import GHC.Tc.Plugin ===================================== testsuite/tests/typecheck/should_compile/T18406b.stderr ===================================== @@ -17,20 +17,18 @@ Bug.$tc'C:C = GHC.Types.TyCon 302756782745842909##64 14248103394115774781##64 Bug.$trModule (GHC.Types.TrNameS "'C:C"#) 2# $krep +$krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp + Bug.$tcC + ((:) @GHC.Types.KindRep + $krep ((:) @GHC.Types.KindRep $krep [] @GHC.Types.KindRep)) $krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep $krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp - GHC.Types.$tcConstraint [] @GHC.Types.KindRep -$krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp - Bug.$tcC - ((:) @GHC.Types.KindRep - $krep ((:) @GHC.Types.KindRep $krep [] @GHC.Types.KindRep)) + = GHC.Types.KindRepFun GHC.Types.krep$* GHC.Types.krep$Constraint Bug.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Bug"#) ===================================== testsuite/tests/typecheck/should_compile/T18529.stderr ===================================== @@ -17,23 +17,21 @@ Bug.$tc'C:C = GHC.Types.TyCon 302756782745842909##64 14248103394115774781##64 Bug.$trModule (GHC.Types.TrNameS "'C:C"#) 2# $krep +$krep [InlPrag=[~]] + = GHC.Types.KindRepTyConApp + Bug.$tcC + ((:) @GHC.Types.KindRep + $krep ((:) @GHC.Types.KindRep $krep [] @GHC.Types.KindRep)) $krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep $krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp - GHC.Types.$tcConstraint [] @GHC.Types.KindRep + = GHC.Types.KindRepFun GHC.Types.krep$* GHC.Types.krep$Constraint $krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp GHC.Tuple.$tc() [] @GHC.Types.KindRep -$krep [InlPrag=[~]] - = GHC.Types.KindRepTyConApp - Bug.$tcC - ((:) @GHC.Types.KindRep - $krep ((:) @GHC.Types.KindRep $krep [] @GHC.Types.KindRep)) Bug.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Bug"#) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e2f92c188c3936ef41e8382ea0ffa5c0201cf0c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e2f92c188c3936ef41e8382ea0ffa5c0201cf0c You're receiving 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 29 16:50:57 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 29 Aug 2022 12:50:57 -0400 Subject: [Git][ghc/ghc][wip/T21623] Wibble output of T16575 Message-ID: <630cee7121085_2f2e58488b44982a3@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: f0b01534 by Simon Peyton Jones at 2022-08-29T17:52:20+01:00 Wibble output of T16575 - - - - - 1 changed file: - testsuite/tests/ghci/scripts/T16575.stdout Changes: ===================================== testsuite/tests/ghci/scripts/T16575.stdout ===================================== @@ -5,15 +5,15 @@ T16575.hs:(4,15)-(4,18): [Ghost.X] -> GHC.Show.ShowS T16575.hs:(7,7)-(7,8): Ghost.X -> Ghost.X -> GHC.Types.Bool T16575.hs:(6,10)-(6,13): Ghost.X -> Ghost.X -> GHC.Types.Bool T16575.hs:(4,15)-(4,18): GHC.Show.Show Ghost.X -T16575.hs:(4,15)-(4,18): ([Ghost.X] -> GHC.Show.ShowS) -> GHC.Show.Show Ghost.X -T16575.hs:(4,15)-(4,18): (Ghost.X -> GHC.Base.String) -> ([Ghost.X] -> GHC.Show.ShowS) -> GHC.Show.Show Ghost.X -T16575.hs:(4,15)-(4,18): (GHC.Types.Int -> Ghost.X -> GHC.Show.ShowS) -> (Ghost.X -> GHC.Base.String) -> ([Ghost.X] -> GHC.Show.ShowS) -> GHC.Show.Show Ghost.X +T16575.hs:(4,15)-(4,18): ([Ghost.X] -> GHC.Show.ShowS) -=> GHC.Show.Show Ghost.X +T16575.hs:(4,15)-(4,18): (Ghost.X -> GHC.Base.String) -=> ([Ghost.X] -> GHC.Show.ShowS) -=> GHC.Show.Show Ghost.X +T16575.hs:(4,15)-(4,18): (GHC.Types.Int -> Ghost.X -> GHC.Show.ShowS) -=> (Ghost.X -> GHC.Base.String) -=> ([Ghost.X] -> GHC.Show.ShowS) -=> GHC.Show.Show Ghost.X T16575.hs:(4,15)-(4,18): GHC.Types.Int -> Ghost.X -> GHC.Show.ShowS T16575.hs:(4,15)-(4,18): Ghost.X -> GHC.Base.String T16575.hs:(4,15)-(4,18): [Ghost.X] -> GHC.Show.ShowS T16575.hs:(6,10)-(6,13): GHC.Classes.Eq Ghost.X -T16575.hs:(6,10)-(6,13): (Ghost.X -> Ghost.X -> GHC.Types.Bool) -> GHC.Classes.Eq Ghost.X -T16575.hs:(6,10)-(6,13): (Ghost.X -> Ghost.X -> GHC.Types.Bool) -> (Ghost.X -> Ghost.X -> GHC.Types.Bool) -> GHC.Classes.Eq Ghost.X +T16575.hs:(6,10)-(6,13): (Ghost.X -> Ghost.X -> GHC.Types.Bool) -=> GHC.Classes.Eq Ghost.X +T16575.hs:(6,10)-(6,13): (Ghost.X -> Ghost.X -> GHC.Types.Bool) -=> (Ghost.X -> Ghost.X -> GHC.Types.Bool) -=> GHC.Classes.Eq Ghost.X T16575.hs:(6,10)-(6,13): Ghost.X -> Ghost.X -> GHC.Types.Bool T16575.hs:(6,10)-(6,13): Ghost.X -> Ghost.X -> GHC.Types.Bool T16575.hs:(7,14)-(7,17): GHC.Types.Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0b0153422736168deb606751f6f5f4f703c409e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0b0153422736168deb606751f6f5f4f703c409e You're receiving 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 29 18:37:27 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 29 Aug 2022 14:37:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21623-TyCo-Utils Message-ID: <630d07671e06e_2f2e584909f1c5022f5@gitlab.mail> Simon Peyton Jones pushed new branch wip/T21623-TyCo-Utils at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21623-TyCo-Utils You're receiving 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 29 18:37:51 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 29 Aug 2022 14:37:51 -0400 Subject: [Git][ghc/ghc][wip/T21623] 2 commits: Wibbles Message-ID: <630d077f90b88_2f2e5848878502467@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 0a2c5120 by Simon Peyton Jones at 2022-08-29T19:35:03+01:00 Wibbles - - - - - ca80f62b by Simon Peyton Jones at 2022-08-29T19:36:12+01:00 More wibbles - - - - - 15 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Types/Basic.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -590,7 +590,8 @@ pcDataCon n univs tys (map linear tys) pcDataConConstraint :: Name -> [TyVar] -> ThetaType -> TyCon -> DataCon --- Used for the data constructor of the Coercible ( +-- Used for data constructors whose arguments are all constraints. +-- Notably constraint tuples, Eq# etc. pcDataConConstraint n univs theta = pcDataConWithFixity False n univs [] -- No ex_tvs ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -47,7 +47,7 @@ module GHC.Builtin.Types.Prim( cONSTRAINTTyCon, cONSTRAINTTyConName, cONSTRAINTKind, -- Arrows - anonArgTyCon, + anonArgTyCon, isArrowTyCon, fUNTyCon, fUNTyConName, ctArrowTyCon, ctArrowTyConName, ccArrowTyCon, ccArrowTyConName, @@ -129,7 +129,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , constraintKind ) import {-# SOURCE #-} GHC.Types.TyThing -import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, mkTyConApp, getLevity ) +import {-# SOURCE #-} GHC.Core.Type ( mkTyConApp, getLevity ) import GHC.Types.Var ( TyVarBinder, TyVar , mkTyVar, mkTyVarBinder, mkTyVarBinders ) @@ -597,6 +597,11 @@ anonArgTyCon (VisArg ConstraintLike) = tcArrowTyCon anonArgTyCon (InvisArg TypeLike) = ctArrowTyCon anonArgTyCon (InvisArg ConstraintLike) = ccArrowTyCon +isArrowTyCon :: TyCon -> Bool +isArrowTyCon tc + = getUnique tc `elem` + [fUNTyConKey, ctArrowTyConKey, ccArrowTyConKey, tcArrowTyConKey] + fUNTyConName, ctArrowTyConName, ccArrowTyConName, tcArrowTyConName :: Name fUNTyConName = mkPrimTc (fsLit "FUN") fUNTyConKey fUNTyCon ctArrowTyConName = mkBuiltInPrimTc (fsLit "=>") ctArrowTyConKey ctArrowTyCon @@ -680,7 +685,7 @@ All types that classify values have a kind of the form where the `RuntimeRep` parameter, rr, tells us how the value is represented at runtime. TYPE and CONSTRAINT are primitive type constructors. -There are a bunch of type synonyms and data types defined in in the +There are a bunch of type synonyms and data types defined in the library ghc-prim:GHC.Types. All of them are also wired in to GHC, in GHC.Builtin.Types @@ -750,9 +755,9 @@ Note that, as before, nothing prevents writing instances like: instance C (Proxy @Type a) where ... 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: +etc) are all allowed in instance heads. It's just that TYPE apart from +CONSTRAINT, which means that the above instance would irretrievably +overlap with: instance C (Proxy @Constraint a) where ... ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -625,7 +625,7 @@ eqTyConRole tc = pprPanic "eqTyConRole: unknown tycon" (ppr tc) -- | Given a coercion @co1 :: (a :: TYPE r1) ~ (b :: TYPE r2)@, --- (or CONSTRAINT instead of TPYE) +-- (or CONSTRAINT instead of TYPE) -- produce a coercion @rep_co :: r1 ~ r2 at . mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion mkRuntimeRepCo co ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -146,9 +146,8 @@ instance Eq (DeBruijn CoreExpr) where eqDeBruijnExpr :: DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where - go (Var v1) (Var v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) + go (Var v1) (Var v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) go (Lit lit1) (Lit lit2) = lit1 == lit2 - -- See Note [Using tcView inside eqDeBruijnType] in GHC.Core.Map.Type go (Type t1) (Type t2) = eqDeBruijnType (D env1 t1) (D env2 t2) -- See Note [Alpha-equality for Coercion arguments] go (Coercion {}) (Coercion {}) = True @@ -159,7 +158,6 @@ eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where && go e1 e2 go (Lam b1 e1) (Lam b2 e2) - -- See Note [Using tcView inside eqDeBruijnType] in GHC.Core.Map.Type = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) && eqDeBruijnExpr (D (extendCME env1 b1) e1) (D (extendCME env2 b2) e2) @@ -171,9 +169,7 @@ eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where go (Let (Rec ps1) e1) (Let (Rec ps2) e2) = equalLength ps1 ps2 -- See Note [Alpha-equality for let-bindings] - && all2 (\b1 b2 -> -- See Note [Using tcView inside eqDeBruijnType] in - -- GHC.Core.Map.Type - eqDeBruijnType (D env1 (varType b1)) + && all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2))) bs1 bs2 && D env1' rs1 == D env2' rs2 ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -5,7 +5,7 @@ {-# LANGUAGE FlexibleContexts, PatternSynonyms, ViewPatterns, MultiWayIf #-} --- | Main functions for manipulating types and type-related things +-- | Type equality and comparison module GHC.Core.TyCo.Compare ( -- * Type comparison @@ -37,28 +37,46 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic -{- Note [Comparision of types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This module implements type comparison, notably `eqType`. -* It uses a few functions from GHC.Core.Type, notably `typeKind`, so it - currently sits "on top of" GHC.Core.Type. +{- Note [GHC.Core.TyCo.Compare overview] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This module implements type equality and comparison +It uses a few functions from GHC.Core.Type, notably `typeKind`, +so it currently sits "on top of" GHC.Core.Type. -} - {- ********************************************************************* * * - Type equalities + Type equality * * ********************************************************************* -} +{- Note [Computing equality on types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This module implements type equality, notably `eqType`. This is +"definitional equality" or just "equality" for short. + +There are several places within GHC that depend on the precise choice of +definitional equality used. If we change that definition, all these places +must be updated. This Note merely serves as a place for all these places +to refer to, so searching for references to this Note will find every place +that needs to be updated. + +* See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep. + +* See Historical Note [Typechecker equality vs definitional equality] + below +-} + + tcEqKind :: HasDebugCallStack => Kind -> Kind -> Bool tcEqKind = tcEqType tcEqType :: HasDebugCallStack => Type -> Type -> Bool --- ^ tcEqType implements typechecker equality, as described in --- @Note [Typechecker equality vs definitional equality]@. +-- ^ tcEqType implements typechecker equality +-- It behaves just like eqType, but is implemented +-- differently (for now) tcEqType ty1 ty2 = tcEqTypeNoSyns ki1 ki2 && tcEqTypeNoSyns ty1 ty2 @@ -215,29 +233,7 @@ cmpForAllVis (Invisible _) Required = GT cmpForAllVis (Invisible _) (Invisible _) = EQ -{- Note [Typechecker equality vs definitional equality] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -GHC has two notions of equality over Core types: - -* Definitional equality, as implemented by GHC.Core.Type.eqType. - See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep. -* Typechecker equality, as implemented by tcEqType (in GHC.Tc.Utils.TcType). - GHC.Tc.Solver.Canonical.canEqNC also respects typechecker equality. - -Typechecker equality implies definitional equality: if two types are equal -according to typechecker equality, then they are also equal according to -definitional equality. The converse is not always true, as typechecker equality -is more finer-grained than definitional equality in two places: - -* Unlike definitional equality, which equates Type and Constraint, typechecker - treats them as distinct types. See Note [Kind Constraint and kind Type] in - GHC.Core.Type. -* Unlike definitional equality, which does not care about the ArgFlag of a - ForAllTy, typechecker equality treats Required type variable binders as - distinct from Invisible type variable binders. - See Note [ForAllTy and type equality] - -Note [ForAllTy and type equality] +{- Note [ForAllTy and type equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we compare (ForAllTy (Bndr tv1 vis1) ty1) and (ForAllTy (Bndr tv2 vis2) ty2) @@ -271,9 +267,8 @@ specified or inferred can be somewhat subtle, however, especially for kinds that aren't explicitly written out in the source code (like in D above). For now, we decide to not make the specified/inferred status of an invisible -type variable binder affect GHC's notion of typechecker equality -(see Note [Typechecker equality vs definitional equality] in -GHC.Tc.Utils.TcType). That is, we have the following: +type variable binder affect GHC's notion of equality. That is, we have the +following: -------------------------------------------------- | Type 1 | Type 2 | Equal? | @@ -291,6 +286,36 @@ GHC.Tc.Utils.TcType). That is, we have the following: | | forall k -> <...> | Yes | -------------------------------------------------- +Historical Note [Typechecker equality vs definitional equality] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This Note describes some history, in case there are vesitges of this +history lying around in the code. + +Summary: prior to summer 2022, GHC had have two notions of equality +over Core types. But now there is only one: definitional equality, +or just equality for short. + +The old setup was: + +* Definitional equality, as implemented by GHC.Core.Type.eqType. + See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep. + +* Typechecker equality, as implemented by tcEqType. + GHC.Tc.Solver.Canonical.canEqNC also respects typechecker equality. + +Typechecker equality implied definitional equality: if two types are equal +according to typechecker equality, then they are also equal according to +definitional equality. The converse is not always true, as typechecker equality +is more finer-grained than definitional equality in two places: + +* Constraint vs Type. Definitional equality equated Type and + Constraint, but typechecker treats them as distinct types. + +* Unlike definitional equality, which does not care about the ArgFlag of a + ForAllTy, typechecker equality treats Required type variable binders as + distinct from Invisible type variable binders. + See Note [ForAllTy and type equality] + ************************************************************************ * * @@ -388,17 +413,6 @@ ordering leads to nondeterminism. We hit the same problem in the TyVarTy case, comparing type variables is nondeterministic, note the call to nonDetCmpVar in nonDetCmpTypeX. See Note [Unique Determinism] for more details. - -Note [Computing equality on types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There are several places within GHC that depend on the precise choice of -definitional equality used. If we change that definition, all these places -must be updated. This Note merely serves as a place for all these places -to refer to, so searching for references to this Note will find every place -that needs to be updated. - -See also Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep. - -} nonDetCmpType :: Type -> Type -> Ordering ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -547,12 +547,6 @@ cannot appear outside a coercion. We do not (yet) have a function to extract relevant free variables, but it would not be hard to write if the need arises. -Besides eqType, another equality relation that upholds the (EQ) property above -is /typechecker equality/, which is implemented as -GHC.Tc.Utils.TcType.tcEqType. See -Note [Typechecker equality vs definitional equality] in GHC.Tc.Utils.TcType for -what the difference between eqType and tcEqType is. - Note [Respecting definitional equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Note [Non-trivial definitional equality] introduces the property (EQ). @@ -1439,7 +1433,7 @@ SelTyCon, SelForAll, and SelFun. Note [FunCo] ~~~~~~~~~~~~ -You might think that a FunCo (which connects two function types should +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) @@ -2223,6 +2217,3 @@ So that Mult feels a bit more structured, we provide pattern synonyms and smart constructors for these. -} type Mult = Type - - - ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -87,7 +87,7 @@ module GHC.Core.TyCon( tyConFamilySize, tyConStupidTheta, tyConArity, - tyConNullaryTy, + tyConNullaryTy, mkTyConTy, tyConRoles, tyConFlavour, tyConTuple_maybe, tyConClass_maybe, tyConATs, @@ -525,6 +525,13 @@ mkTyConKind bndrs res_kind = foldr mk res_kind bndrs mk (Bndr tv (AnonTCB af)) k = mkNakedKindFunTy af (varType tv) k -- mkNakedKindFunTy: see Note [Naked FunTy] in GHC.Builtin.Types +-- | (mkTyConTy tc) returns (TyConApp tc []) +-- but arranges to share that TyConApp among all calls +-- See Note [Sharing nullary TyConApps] +-- So it's just an alias for tyConNullaryTy! +mkTyConTy :: TyCon -> Type +mkTyConTy tycon = tyConNullaryTy tycon + tyConInvisTVBinders :: [TyConBinder] -- From the TyCon -> [InvisTVBinder] -- Suitable for the foralls of a term function -- See Note [Building TyVarBinders from TyConBinders] ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -428,12 +428,21 @@ coreView _ = Nothing -- See Note [Inlining coreView]. {-# INLINE coreView #-} --------------------------- --- *** TODO: strange change in coreView **** --------------------------- +coreFullView, core_full_view :: Type -> Type +-- ^ Iterates 'coreView' until there is no more to synonym to expand. +-- NB: coreFullView is non-recursive and can be inlined; +-- core_full_view is the recursive one +-- See Note [Inlining coreView]. +coreFullView ty@(TyConApp tc _) + | isTypeSynonymTyCon tc = core_full_view ty +coreFullView ty = ty +{-# INLINE coreFullView #-} ------------------------------------------------ +core_full_view ty + | Just ty' <- coreView ty = core_full_view ty' + | otherwise = ty +----------------------------------------------- -- | @expandSynTyConApp_maybe tc tys@ expands the RHS of type synonym @tc@ -- instantiated at arguments @tys@, or returns 'Nothing' if @tc@ is not a -- synonym. @@ -489,21 +498,6 @@ expand_syn tvs rhs arg_tys go _ (_:_) [] = pprPanic "expand_syn" (ppr tvs $$ ppr rhs $$ ppr arg_tys) -- Under-saturated, precondition failed -coreFullView, core_full_view :: Type -> Type --- ^ Iterates 'coreView' until there is no more to synonym to expand. --- NB: coreFullView is non-recursive and can be inlined; --- core_full_view is the recursive one --- See Note [Inlining coreView]. -coreFullView ty@(TyConApp tc _) - | isTypeSynonymTyCon tc = core_full_view ty -coreFullView ty = ty -{-# INLINE coreFullView #-} - -core_full_view ty - | Just ty' <- coreView ty = core_full_view ty' - | otherwise = ty - - {- Note [Inlining coreView] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is very common to have a function @@ -522,7 +516,13 @@ in its fast path. For this to really be fast, all calls made on its fast path must also be inlined, linked back to this Note. -} ------------------------------------------------ + +{- ********************************************************************* +* * + expandTypeSynonyms +* * +********************************************************************* -} + expandTypeSynonyms :: Type -> Type -- ^ Expand out all type synonyms. Actually, it'd suffice to expand out -- just the ones that discard type variables (e.g. type Funny a = Int) @@ -632,6 +632,12 @@ The reason is that we then get better (shorter) type signatures in interfaces. Notably this plays a role in tcTySigs in GHC.Tc.Gen.Bind. -} +{- ********************************************************************* +* * + Random functions (todo: organise) +* * +********************************************************************* -} + -- | An INLINE helper for function such as 'kindRep_maybe' below. -- -- @isTyConKeyApp_maybe key ty@ returns @Just tys@ iff @@ -1085,6 +1091,8 @@ the test in repSplitAppTy_maybe, which applies throughout, because the other calls to splitAppTy are in GHC.Core.Unify, which is also used by the type checker (e.g. when matching type-function equations). +We are willing to split (t1 -=> t2) because the argument is still of +kind Type, not Constraint. So the criterion is isVisibleAnonArg. -} -- | Applies a type to another, as in e.g. @k a@ @@ -1130,18 +1138,23 @@ splitAppTy_maybe :: Type -> Maybe (Type, Type) -- that type family applications are NEVER unsaturated by this! splitAppTy_maybe = repSplitAppTy_maybe . coreFullView +splitAppTy :: Type -> (Type, Type) +-- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe', +-- and panics if this is not possible +splitAppTy ty = splitAppTy_maybe ty `orElse` pprPanic "splitAppTy" (ppr ty) + ------------- repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type) -- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that --- any Core view stuff is already done +-- any coreView stuff is already done +repSplitAppTy_maybe (AppTy ty1 ty2) + = Just (ty1, ty2) + repSplitAppTy_maybe (FunTy af w ty1 ty2) | Just (tc, tys) <- funTyConAppTy_maybe af w ty1 ty2 , Just (tys', ty') <- snocView tys = Just (TyConApp tc tys', ty') -repSplitAppTy_maybe (AppTy ty1 ty2) - = Just (ty1, ty2) - repSplitAppTy_maybe (TyConApp tc tys) | not (mustBeSaturated tc) || tys `lengthExceeds` tyConArity tc , Just (tys', ty') <- snocView tys @@ -1149,38 +1162,15 @@ repSplitAppTy_maybe (TyConApp tc tys) repSplitAppTy_maybe _other = Nothing --- This one doesn't break apart (c => t). --- See Note [Decomposing fat arrow c=>t] --- Defined here to avoid module loops between Unify and TcType. tcRepSplitAppTy_maybe :: Type -> Maybe (Type,Type) --- ^ Does the AppTy split as in 'tcSplitAppTy_maybe', but assumes that --- any coreView stuff is already done. Refuses to look through (c => t) -tcRepSplitAppTy_maybe (FunTy { ft_af = af, ft_mult = w, ft_arg = ty1, ft_res = ty2 }) - | isVisibleAnonArg af -- See Note [Decomposing fat arrow c=>t] - - -- See Note [The Purely Kinded Type Invariant (PKTI)] in GHC.Tc.Gen.HsType, - -- Wrinkle around FunTy - , Just rep1 <- getRuntimeRep_maybe ty1 - , Just rep2 <- getRuntimeRep_maybe ty2 - = Just (TyConApp fUNTyCon [w, rep1, rep2, ty1], ty2) - - | otherwise +-- ^ Just like repSplitAppTy_maybe, but does not split (c => t) +-- See Note [Decomposing fat arrow c=>t] +tcRepSplitAppTy_maybe ty + | FunTy { ft_af = af } <- ty + , not (isVisibleAnonArg af) -- See Note [Decomposing fat arrow c=>t] = Nothing - -tcRepSplitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2) -tcRepSplitAppTy_maybe (TyConApp tc tys) - | not (mustBeSaturated tc) || tys `lengthExceeds` tyConArity tc - , Just (tys', ty') <- snocView tys - = Just (TyConApp tc tys', ty') -- Never create unsaturated type family apps! -tcRepSplitAppTy_maybe _other = Nothing - -------------- -splitAppTy :: Type -> (Type, Type) --- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe', --- and panics if this is not possible -splitAppTy ty = case splitAppTy_maybe ty of - Just pr -> pr - Nothing -> panic "splitAppTy" + | otherwise + = repSplitAppTy_maybe ty ------------- splitAppTys :: Type -> (Type, [Type]) @@ -1341,9 +1331,8 @@ See #11714. ----------------------------------------------- funTyConAppTy_maybe :: AnonArgFlag -> Type -> Type -> Type -> Maybe (TyCon, [Type]) --- Given the components of a FunTy/FuNCo, +-- Given the components of a FunTy -- figure out the corresponding TyConApp. --- Not used for coercions funTyConAppTy_maybe af mult arg res | Just arg_rep <- getRuntimeRep_maybe arg , Just res_rep <- getRuntimeRep_maybe res @@ -1642,7 +1631,6 @@ splitTyConAppNoSyn_maybe ty -- Differs from splitTyConApp_maybe in that it does *not* split types -- headed with (=>), as that's not a TyCon in the type-checker. -- --- -- Note that this may fail (in funTyConAppTy_maybe) in the case -- of a 'FunTy' with an argument of unknown kind 'FunTy' -- (e.g. `FunTy (a :: k) Int`, since the kind of @a@ isn't of @@ -1667,9 +1655,8 @@ tcSplitTyConApp_maybe ty _ -> Nothing tcSplitTyConApp :: Type -> (TyCon, [Type]) -tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of - Just stuff -> stuff - Nothing -> pprPanic "tcSplitTyConApp" (ppr ty) +tcSplitTyConApp ty + = tcSplitTyConApp_maybe ty `orElse` pprPanic "tcSplitTyConApp" (ppr ty) --------------------------- -- | (mkTyConTy tc) returns (TyConApp tc []) ===================================== compiler/GHC/Core/Type.hs-boot ===================================== @@ -14,7 +14,6 @@ isCoercionTy :: Type -> Bool mkAppTy :: Type -> Type -> Type mkCastTy :: Type -> Coercion -> Type -mkTyConTy :: TyCon -> Type mkTyConApp :: TyCon -> [Type] -> Type mkCoercionTy :: Coercion -> Type piResultTy :: HasDebugCallStack => Type -> Type -> Type ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -8,7 +8,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -{-a +{- % (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -1008,7 +1008,7 @@ qlUnify delta ty1 ty2 -- impredicative instantiation info from there seems...remote. go bvs (FunTy { ft_af = af1, ft_arg = arg1, ft_res = res1, ft_mult = mult1 }) (FunTy { ft_af = af2, ft_arg = arg2, ft_res = res2, ft_mult = mult2 }) - | af1 == af2 + | af1 == af2 -- Match the arrow TyCon = do { when (isVisibleAnonArg af1) (go bvs arg1 arg2) ; when (isFUNAnonArg af1) (go bvs mult1 mult2) ; go bvs res1 res2 } ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1182,7 +1182,7 @@ desugarRecordUpd record_expr rbnds res_ty -- the record to disambiguate its fields, so we must infer the record -- type here before we can desugar. See Wrinkle [Disambiguating fields] -- in Note [Record Updates]. - ; ((_, record_rho), _lie) <- captureConstraints $ -- see (1) below + ; ((_, record_rho), _lie) <- captureConstraints $ -- see (1) below tcScalingUsage ManyTy $ -- see (2) below tcInferRho record_expr ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -141,7 +141,10 @@ normaliseFfiType' env ty0 = runWriterT $ go Representational initRecTc ty0 go_tc_app role rec_nts tc tys -- We don't want to look through the IO newtype, even if it is -- in scope, so we have a special case for it: - | tc_key `elem` [ioTyConKey, funPtrTyConKey, fUNTyConKey] + | isArrowTyCon tc + = children_only + + | tc_key `elem` [ioTyConKey, funPtrTyConKey] = children_only | isNewTyCon tc -- Expand newtypes ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2143,8 +2143,10 @@ reifyTyCon tc | Just cls <- tyConClass_maybe tc = reifyClass cls +{- Seems to be just a short cut for the next equation -- omit | tc `hasKey` fUNTyConKey -- I'm not quite sure what is happening here = return (TH.PrimTyConI (reifyName tc) 2 False) +-} | isPrimTyCon tc = return (TH.PrimTyConI (reifyName tc) (length (tyConVisibleTyVars tc)) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -952,7 +952,8 @@ second time around. Also note that we require the AnonArgFlag to match. This will stop us decomposing (Int -> Bool) ~ (Show a => blah) -It's as if we treat (->) and (=>) as different type constructors. +It's as if we treat (->) and (=>) as different type constructors, which +indeed they are! -} canEqNC :: CtEvidence -> EqRel -> Type -> Type -> TcS (StopOrContinue Ct) ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1881,7 +1881,7 @@ isKindLevel KindLevel = True ********************************************************************* -} {- The types `Levity` and `TypeOrConstraint` are internal to GHC. - They are the same shape as the eponomyous types in the library + They have the same shape as the eponymous types in the library ghc-prim:GHC.Types but they aren't the same types -- after all, they are defined in a different module. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f0b0153422736168deb606751f6f5f4f703c409e...ca80f62bd98dcbfab3e45da7dbfc85e734c0c6ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f0b0153422736168deb606751f6f5f4f703c409e...ca80f62bd98dcbfab3e45da7dbfc85e734c0c6ee You're receiving 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 29 19:24:44 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 29 Aug 2022 15:24:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Fix a bug in anyInRnEnvR Message-ID: <630d127c6bb1c_2f2e58487ec505581@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 131fc39f by sheaf at 2022-08-29T15:24:29-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 0daf2e89 by Matthew Pickering at 2022-08-29T15:24:31-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 7 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Types/Var/Env.hs - hadrian/bootstrap/bootstrap.py - + testsuite/tests/simplCore/should_compile/T22028.hs - + testsuite/tests/simplCore/should_compile/T22028.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Types.Var.Env ( -- ** Manipulating these environments emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly, - elemVarEnv, disjointVarEnv, + elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, @@ -62,7 +62,8 @@ module GHC.Types.Var.Env ( -- ** Operations on RnEnv2s mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var, - rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe, + rnOccL, rnOccR, inRnEnvL, inRnEnvR, anyInRnEnvR, + rnOccL_maybe, rnOccR_maybe, rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap, delBndrL, delBndrR, delBndrsL, delBndrsR, extendRnInScopeSetList, @@ -72,7 +73,7 @@ module GHC.Types.Var.Env ( -- * TidyEnv and its operation TidyEnv, - emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList, anyInRnEnvR + emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList ) where import GHC.Prelude @@ -409,7 +410,7 @@ anyInRnEnvR :: RnEnv2 -> VarSet -> Bool anyInRnEnvR (RV2 { envR = env }) vs -- Avoid allocating the predicate if we deal with an empty env. | isEmptyVarEnv env = False - | otherwise = anyVarEnv (`elemVarSet` vs) env + | otherwise = anyVarSet (`elemVarEnv` env) vs lookupRnInScope :: RnEnv2 -> Var -> Var lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v ===================================== hadrian/bootstrap/bootstrap.py ===================================== @@ -86,14 +86,17 @@ class Compiler: self.ghc_path = ghc_path.resolve() + exe = '' + if platform.system() == 'Windows': exe = '.exe' + info = self._get_ghc_info() self.version = info['Project version'] #self.lib_dir = Path(info['LibDir']) #self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve() - self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve() + self.ghc_pkg_path = (self.ghc_path.parent / ('ghc-pkg' + exe)).resolve() if not self.ghc_pkg_path.is_file(): raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file') - self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve() + self.hsc2hs_path = (self.ghc_path.parent / ('hsc2hs' + exe)).resolve() if not self.hsc2hs_path.is_file(): raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file') @@ -367,6 +370,11 @@ def main() -> None: help='path to GHC') parser.add_argument('-s', '--bootstrap-sources', type=Path, help='Path to prefetched bootstrap sources tarball') + parser.add_argument('--archive', dest='want_archive', action='store_true', + help='produce a Hadrian distribution archive (default)') + parser.add_argument('--no-archive', dest='want_archive', action='store_false', + help='do not produce a Hadrian distribution archive') + parser.set_defaults(want_archive=True) subparsers = parser.add_subparsers(dest="command") @@ -381,6 +389,9 @@ def main() -> None: ghc = None + sources_fmt = 'gztar' # The archive format for the bootstrap sources archive. + if platform.system() == 'Windows': sources_fmt = 'zip' + if args.deps is None: if args.bootstrap_sources is None: # find appropriate plan in the same directory as the script @@ -390,7 +401,7 @@ def main() -> None: # We have a tarball with all the required information, unpack it and use for further elif args.bootstrap_sources is not None and args.command != 'list-sources': print(f'Unpacking {args.bootstrap_sources} to {TARBALLS}') - shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, 'gztar') + shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, sources_fmt) args.deps = TARBALLS / 'plan-bootstrap.json' print(f"using plan-bootstrap.json ({args.deps}) from {args.bootstrap_sources}") else: @@ -428,10 +439,7 @@ def main() -> None: shutil.copyfile(args.deps, rootdir / 'plan-bootstrap.json') - fmt = 'gztar' - if platform.system() == 'Windows': fmt = 'zip' - - archivename = shutil.make_archive(args.output, fmt, root_dir=rootdir) + archivename = shutil.make_archive(args.output, sources_fmt, root_dir=rootdir) print(f""" Bootstrap sources saved to {archivename} @@ -475,21 +483,21 @@ Alternatively, you could use `bootstrap.py -w {ghc.ghc_path} -d {args.deps} fetc bootstrap(info, ghc) hadrian_path = (BINDIR / 'hadrian').resolve() - archive = make_archive(hadrian_path) - print(dedent(f''' Bootstrapping finished! The resulting hadrian executable can be found at {hadrian_path} + ''')) - It has been archived for distribution in - - {archive} + if args.want_archive: + dist_archive = make_archive(hadrian_path) + print(dedent(f''' + The Hadrian executable has been archived for distribution in - You can use this executable to build GHC. - ''')) + {dist_archive} + ''')) else: print(f"No such command: {args.command}") ===================================== testsuite/tests/simplCore/should_compile/T22028.hs ===================================== @@ -0,0 +1,19 @@ + +-- This one triggers the bug reported in #22028, which +-- was in a test for #1092 +-- The problem is that the rule +-- forall w. f (\v->w) = w +-- erroneously matches the call +-- f id +-- And that caused an assertion error. + +module Foo where + +f :: (Int -> Int) -> Int +{-# NOINLINE f #-} +f g = g 4 +{-# RULES "f" forall w. f (\v->w) = w #-} + +h1 = f (\v -> v) -- Rule should not fire +h2 = f id -- Rule should not fire +h3 = f (\v -> 3) -- Rule should fire ===================================== testsuite/tests/simplCore/should_compile/T22028.stderr ===================================== @@ -0,0 +1 @@ +Rule fired: f (Foo) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -427,3 +427,4 @@ test('T21960', [grep_errmsg(r'^ Arity=5') ], compile, ['-O2 -ddump-simpl']) test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) +test('T22028', normal, compile, ['-O -ddump-rule-firings']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23c0677d55d4c095c3ad6cf6b2aae5125a53d4f2...0daf2e89354fb98f2d405b82250dc58efa17e186 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23c0677d55d4c095c3ad6cf6b2aae5125a53d4f2...0daf2e89354fb98f2d405b82250dc58efa17e186 You're receiving 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 29 23:06:43 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 29 Aug 2022 19:06:43 -0400 Subject: [Git][ghc/ghc][wip/T21623] Remove infinite loop in T1946 Message-ID: <630d468379f4c_2f2e58487d85269cf@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC Commits: 8ebd8d3f by Simon Peyton Jones at 2022-08-30T00:06:52+01:00 Remove infinite loop in T1946 See Note [ForAllTy and type equality] - - - - - 11 changed files: - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Types/Name/Occurrence.hs Changes: ===================================== compiler/GHC/Core/Reduction.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core.Type import GHC.Data.Pair ( Pair(Pair) ) -import GHC.Types.Var ( setTyVarKind ) +import GHC.Types.Var ( VarBndr(..), setTyVarKind ) import GHC.Types.Var.Env ( mkInScopeSet ) import GHC.Types.Var.Set ( TyCoVarSet ) @@ -375,7 +375,7 @@ mkForAllRedn :: ArgFlag mkForAllRedn vis tv1 (Reduction h ki') (Reduction co ty) = mkReduction (mkForAllCo tv1 h co) - (mkForAllTy tv2 vis ty) + (mkForAllTy (Bndr tv2 vis) ty) where tv2 = setTyVarKind tv1 ki' {-# INLINE mkForAllRedn #-} ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -161,7 +161,7 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 go env (ForAllTy (Bndr tv1 vis1) ty1) (ForAllTy (Bndr tv2 vis2) ty2) - = vis1 == vis2 + = vis1 `eqForAllVis` vis2 && (vis_only || go env (varType tv1) (varType tv2)) && go (rnBndr2 env tv1 tv2) ty1 ty2 @@ -218,6 +218,7 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 -- equates 'Specified' and 'Inferred'. Used for printing. eqForAllVis :: ArgFlag -> ArgFlag -> Bool -- See Note [ForAllTy and type equality] +-- If you change this, see IMPORTANT NOTE in the above Note eqForAllVis Required Required = True eqForAllVis (Invisible _) (Invisible _) = True eqForAllVis _ _ = False @@ -227,6 +228,7 @@ eqForAllVis _ _ = False -- equates 'Specified' and 'Inferred'. Used for printing. cmpForAllVis :: ArgFlag -> ArgFlag -> Ordering -- See Note [ForAllTy and type equality] +-- If you change this, see IMPORTANT NOTE in the above Note cmpForAllVis Required Required = EQ cmpForAllVis Required (Invisible {}) = LT cmpForAllVis (Invisible _) Required = GT @@ -234,7 +236,7 @@ cmpForAllVis (Invisible _) (Invisible _) = EQ {- Note [ForAllTy and type equality] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we compare (ForAllTy (Bndr tv1 vis1) ty1) and (ForAllTy (Bndr tv2 vis2) ty2) what should we do about `vis1` vs `vis2`. @@ -266,9 +268,12 @@ programs like the one above. Whether a kind variable binder ends up being specified or inferred can be somewhat subtle, however, especially for kinds that aren't explicitly written out in the source code (like in D above). -For now, we decide to not make the specified/inferred status of an invisible -type variable binder affect GHC's notion of equality. That is, we have the -following: +For now, we decide + + the specified/inferred status of an invisible type variable binder + does not affect GHC's notion of equality. + +That is, we have the following: -------------------------------------------------- | Type 1 | Type 2 | Equal? | @@ -286,6 +291,12 @@ following: | | forall k -> <...> | Yes | -------------------------------------------------- +IMPORTANT NOTE: if we want to change this decision, ForAllCo will need to carry +visiblity (by taking a TyCoVarBinder rathre than a TyCoVar), so that +coercionLKind/RKind build forall types that match (are equal to) the desired +ones. Otherwise we get an infinite loop in the solver via canEqCanLHSHetero. +Examples: T16946, T15079. + Historical Note [Typechecker equality vs definitional equality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This Note describes some history, in case there are vesitges of this ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1126,8 +1126,8 @@ tcMkScaledFunTys tys ty = foldr mk ty tys --------------- -- | Like 'mkTyCoForAllTy', but does not check the occurrence of the binder -- See Note [Unused coercion variable in ForAllTy] -mkForAllTy :: TyCoVar -> ArgFlag -> Type -> Type -mkForAllTy tv vis ty = ForAllTy (Bndr tv vis) ty +mkForAllTy :: TyCoVarBinder -> Type -> Type +mkForAllTy = ForAllTy -- | Wraps foralls over the type using the provided 'TyCoVar's from left to right mkForAllTys :: [TyCoVarBinder] -> Type -> Type @@ -1139,7 +1139,7 @@ mkInvisForAllTys tyvars = mkForAllTys (tyVarSpecToBinders tyvars) mkPiTy :: TyCoBinder -> Type -> Type mkPiTy (Anon af ty1) ty2 = mkScaledFunTy af ty1 ty2 -mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty +mkPiTy (Named bndr) ty = mkForAllTy bndr ty mkPiTys :: [TyCoBinder] -> Type -> Type mkPiTys tbs ty = foldr mkPiTy ty tbs ===================================== compiler/GHC/Core/TyCo/Rep.hs-boot ===================================== @@ -3,7 +3,7 @@ module GHC.Core.TyCo.Rep where import GHC.Utils.Outputable ( Outputable ) import Data.Data ( Data ) -import {-# SOURCE #-} GHC.Types.Var( Var, ArgFlag, AnonArgFlag ) +import {-# SOURCE #-} GHC.Types.Var( Var, VarBndr, ArgFlag, AnonArgFlag ) import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) data Type @@ -24,7 +24,7 @@ type ThetaType = [PredType] type CoercionN = Coercion type MCoercionN = MCoercion -mkForAllTy :: Var -> ArgFlag -> Type -> Type +mkForAllTy :: VarBndr Var ArgFlag -> Type -> Type mkNakedTyConTy :: TyCon -> Type mkNakedKindFunTy :: AnonArgFlag -> Type -> Type -> Type ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -521,7 +521,7 @@ mkTyConKind :: [TyConBinder] -> Kind -> Kind mkTyConKind bndrs res_kind = foldr mk res_kind bndrs where mk :: TyConBinder -> Kind -> Kind - mk (Bndr tv (NamedTCB vis)) k = mkForAllTy tv vis k + mk (Bndr tv (NamedTCB vis)) k = mkForAllTy (Bndr tv vis) k mk (Bndr tv (AnonTCB af)) k = mkNakedKindFunTy af (varType tv) k -- mkNakedKindFunTy: see Note [Naked FunTy] in GHC.Builtin.Types ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1659,13 +1659,6 @@ tcSplitTyConApp ty = tcSplitTyConApp_maybe ty `orElse` pprPanic "tcSplitTyConApp" (ppr ty) --------------------------- --- | (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 - -------------------- newTyConInstRhs :: TyCon -> [Type] -> Type -- ^ Unwrap one 'layer' of newtype on a type constructor and its -- arguments, using an eta-reduced version of the @newtype@ if possible. ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -170,11 +170,11 @@ mkLamTypes :: [Var] -> Type -> Type mkLamType v body_ty | isTyVar v - = mkForAllTy v Inferred body_ty + = mkForAllTy (Bndr v Inferred) body_ty | isCoVar v , v `elemVarSet` tyCoVarsOfType body_ty - = mkForAllTy v Required body_ty + = mkForAllTy (Bndr v Required) body_ty | otherwise = mkFunctionType (varMult v) (varType v) body_ty ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Core.Type import GHC.Hs import GHC.Tc.Types.Evidence import GHC.Types.Id +import GHC.Types.Var( VarBndr(..) ) import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic @@ -183,7 +184,7 @@ hsWrapperType wrap ty = prTypeType $ go wrap (ty,[]) go (WpCast co) = liftPRType $ \_ -> coercionRKind co go (WpEvLam v) = liftPRType $ mkInvisFunTy (idType v) go (WpEvApp _) = liftPRType $ funResultTy - go (WpTyLam tv) = liftPRType $ mkForAllTy tv Inferred + go (WpTyLam tv) = liftPRType $ mkForAllTy (Bndr tv Inferred) go (WpTyApp ta) = \(ty,tas) -> (ty, ta:tas) go (WpLet _) = id go (WpMultCoercion _) = id ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -44,29 +44,35 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Expr import GHC.Tc.Utils.Env - +import GHC.Tc.Utils.TcType import GHC.Tc.Instance.Family + import GHC.Core.FamInstEnv import GHC.Core.Coercion import GHC.Core.Reduction import GHC.Core.Type import GHC.Core.Multiplicity +import GHC.Core.DataCon +import GHC.Core.TyCon +import GHC.Core.TyCon.RecWalk + import GHC.Types.ForeignCall -import GHC.Utils.Error import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Reader -import GHC.Core.DataCon -import GHC.Core.TyCon -import GHC.Core.TyCon.RecWalk -import GHC.Tc.Utils.TcType +import GHC.Types.SrcLoc + import GHC.Builtin.Names +import GHC.Builtin.Types.Prim( isArrowTyCon ) + import GHC.Driver.Session import GHC.Driver.Backend + +import GHC.Utils.Error import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Platform -import GHC.Types.SrcLoc + import GHC.Data.Bag import GHC.Driver.Hooks import qualified GHC.LanguageExtensions as LangExt ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -853,7 +853,7 @@ literalType (LitNumber lt _) = case lt of -- LitRubbish: see Note [Rubbish literals] literalType (LitRubbish torc rep) - = mkForAllTy a Inferred (mkTyVarTy a) + = mkForAllTy (Bndr a Inferred) (mkTyVarTy a) where a = mkTemplateKindVar kind kind = case torc of ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -791,7 +791,6 @@ after we allocate a new one. Note [Tidying multiple names at once] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Consider > :t (id,id,id) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ebd8d3f9ac254a49244290e0c767c9ab8892b7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ebd8d3f9ac254a49244290e0c767c9ab8892b7c You're receiving 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 30 01:15:06 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 29 Aug 2022 21:15:06 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Various Hadrian bootstrapping fixes Message-ID: <630d649adb1a8_2f2e584887853348f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5dd97f70 by sheaf at 2022-08-29T21:14:51-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - f8eaae74 by Matthew Pickering at 2022-08-29T21:14:53-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/bootstrap/bootstrap.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" ===================================== hadrian/bootstrap/bootstrap.py ===================================== @@ -86,14 +86,17 @@ class Compiler: self.ghc_path = ghc_path.resolve() + exe = '' + if platform.system() == 'Windows': exe = '.exe' + info = self._get_ghc_info() self.version = info['Project version'] #self.lib_dir = Path(info['LibDir']) #self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve() - self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve() + self.ghc_pkg_path = (self.ghc_path.parent / ('ghc-pkg' + exe)).resolve() if not self.ghc_pkg_path.is_file(): raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file') - self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve() + self.hsc2hs_path = (self.ghc_path.parent / ('hsc2hs' + exe)).resolve() if not self.hsc2hs_path.is_file(): raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file') @@ -367,6 +370,11 @@ def main() -> None: help='path to GHC') parser.add_argument('-s', '--bootstrap-sources', type=Path, help='Path to prefetched bootstrap sources tarball') + parser.add_argument('--archive', dest='want_archive', action='store_true', + help='produce a Hadrian distribution archive (default)') + parser.add_argument('--no-archive', dest='want_archive', action='store_false', + help='do not produce a Hadrian distribution archive') + parser.set_defaults(want_archive=True) subparsers = parser.add_subparsers(dest="command") @@ -381,6 +389,9 @@ def main() -> None: ghc = None + sources_fmt = 'gztar' # The archive format for the bootstrap sources archive. + if platform.system() == 'Windows': sources_fmt = 'zip' + if args.deps is None: if args.bootstrap_sources is None: # find appropriate plan in the same directory as the script @@ -390,7 +401,7 @@ def main() -> None: # We have a tarball with all the required information, unpack it and use for further elif args.bootstrap_sources is not None and args.command != 'list-sources': print(f'Unpacking {args.bootstrap_sources} to {TARBALLS}') - shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, 'gztar') + shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, sources_fmt) args.deps = TARBALLS / 'plan-bootstrap.json' print(f"using plan-bootstrap.json ({args.deps}) from {args.bootstrap_sources}") else: @@ -428,10 +439,7 @@ def main() -> None: shutil.copyfile(args.deps, rootdir / 'plan-bootstrap.json') - fmt = 'gztar' - if platform.system() == 'Windows': fmt = 'zip' - - archivename = shutil.make_archive(args.output, fmt, root_dir=rootdir) + archivename = shutil.make_archive(args.output, sources_fmt, root_dir=rootdir) print(f""" Bootstrap sources saved to {archivename} @@ -475,21 +483,21 @@ Alternatively, you could use `bootstrap.py -w {ghc.ghc_path} -d {args.deps} fetc bootstrap(info, ghc) hadrian_path = (BINDIR / 'hadrian').resolve() - archive = make_archive(hadrian_path) - print(dedent(f''' Bootstrapping finished! The resulting hadrian executable can be found at {hadrian_path} + ''')) - It has been archived for distribution in - - {archive} + if args.want_archive: + dist_archive = make_archive(hadrian_path) + print(dedent(f''' + The Hadrian executable has been archived for distribution in - You can use this executable to build GHC. - ''')) + {dist_archive} + ''')) else: print(f"No such command: {args.command}") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0daf2e89354fb98f2d405b82250dc58efa17e186...f8eaae746d645a2cbd4a9df9563187dc4b3bb853 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0daf2e89354fb98f2d405b82250dc58efa17e186...f8eaae746d645a2cbd4a9df9563187dc4b3bb853 You're receiving 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 30 03:45:17 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 29 Aug 2022 23:45:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Various Hadrian bootstrapping fixes Message-ID: <630d87cdccfcb_2f2e58a70ea685503f8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ce387870 by sheaf at 2022-08-29T23:45:09-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - cbb66e39 by Matthew Pickering at 2022-08-29T23:45:11-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/bootstrap/bootstrap.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" ===================================== hadrian/bootstrap/bootstrap.py ===================================== @@ -86,14 +86,17 @@ class Compiler: self.ghc_path = ghc_path.resolve() + exe = '' + if platform.system() == 'Windows': exe = '.exe' + info = self._get_ghc_info() self.version = info['Project version'] #self.lib_dir = Path(info['LibDir']) #self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve() - self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve() + self.ghc_pkg_path = (self.ghc_path.parent / ('ghc-pkg' + exe)).resolve() if not self.ghc_pkg_path.is_file(): raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file') - self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve() + self.hsc2hs_path = (self.ghc_path.parent / ('hsc2hs' + exe)).resolve() if not self.hsc2hs_path.is_file(): raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file') @@ -367,6 +370,11 @@ def main() -> None: help='path to GHC') parser.add_argument('-s', '--bootstrap-sources', type=Path, help='Path to prefetched bootstrap sources tarball') + parser.add_argument('--archive', dest='want_archive', action='store_true', + help='produce a Hadrian distribution archive (default)') + parser.add_argument('--no-archive', dest='want_archive', action='store_false', + help='do not produce a Hadrian distribution archive') + parser.set_defaults(want_archive=True) subparsers = parser.add_subparsers(dest="command") @@ -381,6 +389,9 @@ def main() -> None: ghc = None + sources_fmt = 'gztar' # The archive format for the bootstrap sources archive. + if platform.system() == 'Windows': sources_fmt = 'zip' + if args.deps is None: if args.bootstrap_sources is None: # find appropriate plan in the same directory as the script @@ -390,7 +401,7 @@ def main() -> None: # We have a tarball with all the required information, unpack it and use for further elif args.bootstrap_sources is not None and args.command != 'list-sources': print(f'Unpacking {args.bootstrap_sources} to {TARBALLS}') - shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, 'gztar') + shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, sources_fmt) args.deps = TARBALLS / 'plan-bootstrap.json' print(f"using plan-bootstrap.json ({args.deps}) from {args.bootstrap_sources}") else: @@ -428,10 +439,7 @@ def main() -> None: shutil.copyfile(args.deps, rootdir / 'plan-bootstrap.json') - fmt = 'gztar' - if platform.system() == 'Windows': fmt = 'zip' - - archivename = shutil.make_archive(args.output, fmt, root_dir=rootdir) + archivename = shutil.make_archive(args.output, sources_fmt, root_dir=rootdir) print(f""" Bootstrap sources saved to {archivename} @@ -475,21 +483,21 @@ Alternatively, you could use `bootstrap.py -w {ghc.ghc_path} -d {args.deps} fetc bootstrap(info, ghc) hadrian_path = (BINDIR / 'hadrian').resolve() - archive = make_archive(hadrian_path) - print(dedent(f''' Bootstrapping finished! The resulting hadrian executable can be found at {hadrian_path} + ''')) - It has been archived for distribution in - - {archive} + if args.want_archive: + dist_archive = make_archive(hadrian_path) + print(dedent(f''' + The Hadrian executable has been archived for distribution in - You can use this executable to build GHC. - ''')) + {dist_archive} + ''')) else: print(f"No such command: {args.command}") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8eaae746d645a2cbd4a9df9563187dc4b3bb853...cbb66e39ed10b4a5a54be51ee67a6a8abf036ccb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8eaae746d645a2cbd4a9df9563187dc4b3bb853...cbb66e39ed10b4a5a54be51ee67a6a8abf036ccb You're receiving 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 30 07:25:45 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 Aug 2022 03:25:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Various Hadrian bootstrapping fixes Message-ID: <630dbb79bc587_2f2e58d8b7934574844@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bc18c1bd by sheaf at 2022-08-30T03:25:30-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 6aada809 by Matthew Pickering at 2022-08-30T03:25:33-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/bootstrap/bootstrap.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" ===================================== hadrian/bootstrap/bootstrap.py ===================================== @@ -86,14 +86,17 @@ class Compiler: self.ghc_path = ghc_path.resolve() + exe = '' + if platform.system() == 'Windows': exe = '.exe' + info = self._get_ghc_info() self.version = info['Project version'] #self.lib_dir = Path(info['LibDir']) #self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve() - self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve() + self.ghc_pkg_path = (self.ghc_path.parent / ('ghc-pkg' + exe)).resolve() if not self.ghc_pkg_path.is_file(): raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file') - self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve() + self.hsc2hs_path = (self.ghc_path.parent / ('hsc2hs' + exe)).resolve() if not self.hsc2hs_path.is_file(): raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file') @@ -367,6 +370,11 @@ def main() -> None: help='path to GHC') parser.add_argument('-s', '--bootstrap-sources', type=Path, help='Path to prefetched bootstrap sources tarball') + parser.add_argument('--archive', dest='want_archive', action='store_true', + help='produce a Hadrian distribution archive (default)') + parser.add_argument('--no-archive', dest='want_archive', action='store_false', + help='do not produce a Hadrian distribution archive') + parser.set_defaults(want_archive=True) subparsers = parser.add_subparsers(dest="command") @@ -381,6 +389,9 @@ def main() -> None: ghc = None + sources_fmt = 'gztar' # The archive format for the bootstrap sources archive. + if platform.system() == 'Windows': sources_fmt = 'zip' + if args.deps is None: if args.bootstrap_sources is None: # find appropriate plan in the same directory as the script @@ -390,7 +401,7 @@ def main() -> None: # We have a tarball with all the required information, unpack it and use for further elif args.bootstrap_sources is not None and args.command != 'list-sources': print(f'Unpacking {args.bootstrap_sources} to {TARBALLS}') - shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, 'gztar') + shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, sources_fmt) args.deps = TARBALLS / 'plan-bootstrap.json' print(f"using plan-bootstrap.json ({args.deps}) from {args.bootstrap_sources}") else: @@ -428,10 +439,7 @@ def main() -> None: shutil.copyfile(args.deps, rootdir / 'plan-bootstrap.json') - fmt = 'gztar' - if platform.system() == 'Windows': fmt = 'zip' - - archivename = shutil.make_archive(args.output, fmt, root_dir=rootdir) + archivename = shutil.make_archive(args.output, sources_fmt, root_dir=rootdir) print(f""" Bootstrap sources saved to {archivename} @@ -475,21 +483,21 @@ Alternatively, you could use `bootstrap.py -w {ghc.ghc_path} -d {args.deps} fetc bootstrap(info, ghc) hadrian_path = (BINDIR / 'hadrian').resolve() - archive = make_archive(hadrian_path) - print(dedent(f''' Bootstrapping finished! The resulting hadrian executable can be found at {hadrian_path} + ''')) - It has been archived for distribution in - - {archive} + if args.want_archive: + dist_archive = make_archive(hadrian_path) + print(dedent(f''' + The Hadrian executable has been archived for distribution in - You can use this executable to build GHC. - ''')) + {dist_archive} + ''')) else: print(f"No such command: {args.command}") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbb66e39ed10b4a5a54be51ee67a6a8abf036ccb...6aada809cd75dc229a3b7a62e79aa4a1624358e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbb66e39ed10b4a5a54be51ee67a6a8abf036ccb...6aada809cd75dc229a3b7a62e79aa4a1624358e2 You're receiving 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 30 09:02:07 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 30 Aug 2022 05:02:07 -0400 Subject: [Git][ghc/ghc][wip/inplace-final] 5 commits: hadrian: Use a stamp file to record when a package is built in a certain way Message-ID: <630dd20f1fde9_2f2e5813a03c9c603341@gitlab.mail> Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC Commits: 74d5f7b9 by Matthew Pickering at 2022-08-30T10:02:00+01:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - 4d86474c by Matthew Pickering at 2022-08-30T10:02:00+01:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6eb200d6 by Matthew Pickering at 2022-08-30T10:02:00+01:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - b2cd2765 by Matthew Pickering at 2022-08-30T10:02:00+01:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - 481e568a by Matthew Pickering at 2022-08-30T10:02:00+01:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 30 changed files: - .gitlab/ci.sh - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Context/Type.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Nofib.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/GhcPkg.hs - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Builders/RunTest.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e42c17d642b56d34b5b1221dea914a9a9f4fa14...481e568a572852886a564ffec13c7114f198d091 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e42c17d642b56d34b5b1221dea914a9a9f4fa14...481e568a572852886a564ffec13c7114f198d091 You're receiving 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 30 09:08:26 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 30 Aug 2022 05:08:26 -0400 Subject: [Git][ghc/ghc][wip/T21470] Fix binder-swap bug Message-ID: <630dd38a8c43b_2f2e5816becc686041fb@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21470 at Glasgow Haskell Compiler / GHC Commits: a4305deb by Simon Peyton Jones at 2022-08-30T10:04:44+01:00 Fix binder-swap bug This patch fixes #21229 / #21470 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. I als modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 3 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -19,7 +19,7 @@ core expression with (hopefully) improved usage information. module GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr, - zapLambdaBndrs + zapLambdaBndrs, scrutBinderSwap_maybe ) where import GHC.Prelude @@ -27,11 +27,12 @@ import GHC.Prelude import GHC.Core import GHC.Core.FVs import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, - stripTicksTopE, mkTicks ) + mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion +import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type -import GHC.Core.TyCo.FVs( tyCoVarsOfMCo ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) import GHC.Data.Maybe( isJust, orElse ) import GHC.Data.Graph.Directed ( SCC(..), Node(..) @@ -2462,8 +2463,8 @@ data OccEnv -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, - -- then please replace x by (y |> sym mco) - -- Invariant of course: idType x = exprType (y |> sym mco) + -- then please replace x by (y |> mco) + -- Invariant of course: idType x = exprType (y |> mco) , occ_bs_env :: !(VarEnv (OutId, MCoercion)) , occ_bs_rng :: !VarSet -- Vars free in the range of occ_bs_env -- Domain is Global and Local Ids @@ -2669,7 +2670,7 @@ The binder-swap is implemented by the occ_bs_env field of OccEnv. There are two main pieces: * Given case x |> co of b { alts } - we add [x :-> (b, co)] to the occ_bs_env environment; this is + we add [x :-> (b, sym co)] to the occ_bs_env environment; this is done by addBndrSwap. * Then, at an occurrence of a variable, we look up in the occ_bs_env @@ -2737,30 +2738,8 @@ Some tricky corners: (BS5) We have to apply the occ_bs_env substitution uniformly, including to (local) rules and unfoldings. -Historical note ---------------- -We used to do the binder-swap transformation by introducing -a proxy let-binding, thus; - - case x of b { pi -> ri } - ==> - case x of b { pi -> let x = b in ri } - -But that had two problems: - -1. If 'x' is an imported GlobalId, we'd end up with a GlobalId - on the LHS of a let-binding which isn't allowed. We worked - around this for a while by "localising" x, but it turned - out to be very painful #16296, - -2. In CorePrep we use the occurrence analyser to do dead-code - elimination (see Note [Dead code in CorePrep]). But that - occasionally led to an unlifted let-binding - case x of b { DEFAULT -> let x::Int# = b in ... } - which disobeys one of CorePrep's output invariants (no unlifted - let-bindings) -- see #5433. - -Doing a substitution (via occ_bs_env) is much better. +(BS6) We must be very careful with dictionaries. + See Note [Care with binder-swap on dictionaries] Note [Case of cast] ~~~~~~~~~~~~~~~~~~~ @@ -2770,6 +2749,54 @@ We'd like to eliminate the inner case. That is the motivation for equation (2) in Note [Binder swap]. When we get to the inner case, we inline x, cancel the casts, and away we go. +Note [Care with binder-swap on dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This Note explains why we need isDictId in scrutBinderSwap_maybe. +Consider this tricky example (#21229, #21470): + + class Sing (b :: Bool) where sing :: Bool + instance Sing 'True where sing = True + instance Sing 'False where sing = False + + f :: forall a. Sing a => blah + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a dSing + +Now do a binder-swap on the case-expression: + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (wild |> sym the_co) + +And now substitute `False` for `wild` (since wild=False in the False branch): + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (False |> sym the_co) + +And now we have a problem. The specialiser will specialise (f @a d)a (for all +vtypes a and dictionaries d!!) with the dictionary (False |> sym the_co), using +Note [Specialising polymorphic dictionaries] in GHC.Core.Opt.Specialise. + +The real problem is the binder-swap. It swaps a dictionary variable $dSing +(of kind Constraint) for a term variable wild (of kind Type). And that is +dangerous: a dictionary is a /singleton/ type whereas a general term variable is +not. In this particular example, Bool is most certainly not a singleton type! + +Conclusion: + for a /dictionary variable/ do not perform + the clever cast version of the binder-swap + +Hence the subtle isDictId in scrutBinderSwap_maybe. + Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From the original @@ -2784,8 +2811,83 @@ binding x = cb. See #5028. NB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier doesn't use it. So this is only to satisfy the perhaps-over-picky Lint. +-} + +addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv +-- See Note [The binder-swap substitution] +addBndrSwap scrut case_bndr + env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) + | Just (scrut_var, mco) <- scrutBinderSwap_maybe scrut + , scrut_var /= case_bndr + -- Consider: case x of x { ... } + -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop + = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) + , occ_bs_rng = rng_vars `extendVarSet` case_bndr' + `unionVarSet` tyCoVarsOfMCo mco } + + | otherwise + = env + where + case_bndr' = zapIdOccInfo case_bndr + -- See Note [Zap case binders in proxy bindings] + +scrutBinderSwap_maybe :: OutExpr -> Maybe (OutVar, MCoercion) +-- If (scrutBinderSwap_maybe e = Just (v, mco), then +-- v = e |> mco +-- See Note [Case of cast] +-- See Note [Care with binder-swap on dictionaries] +-- +-- We use this same function in SpecConstr, and Simplify.Iteration, +-- when something binder-swap-like is happening +scrutBinderSwap_maybe (Var v) = Just (v, MRefl) +scrutBinderSwap_maybe (Cast (Var v) co) + | not (isDictId v) = Just (v, MCo (mkSymCo co)) + -- Cast: see Note [Case of cast] + -- isDictId: see Note [Care with binder-swap on dictionaries] +scrutBinderSwap_maybe (Tick _ e) = scrutBinderSwap_maybe e -- Drop ticks +scrutBinderSwap_maybe _ = Nothing + +lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) +-- See Note [The binder-swap substitution] +-- Returns an expression of the same type as Id +lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr + = case lookupVarEnv bs_env bndr of { + Nothing -> (Var bndr, bndr) ; + Just (bndr1, mco) -> + + -- Why do we iterate here? + -- See (BS2) in Note [The binder-swap substitution] + case lookupBndrSwap env bndr1 of + (fun, fun_id) -> (mkCastMCo fun mco, fun_id) } + + +{- Historical note [Proxy let-bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We used to do the binder-swap transformation by introducing +a proxy let-binding, thus; + + case x of b { pi -> ri } + ==> + case x of b { pi -> let x = b in ri } + +But that had two problems: + +1. If 'x' is an imported GlobalId, we'd end up with a GlobalId + on the LHS of a let-binding which isn't allowed. We worked + around this for a while by "localising" x, but it turned + out to be very painful #16296, + +2. In CorePrep we use the occurrence analyser to do dead-code + elimination (see Note [Dead code in CorePrep]). But that + occasionally led to an unlifted let-binding + case x of b { DEFAULT -> let x::Int# = b in ... } + which disobeys one of CorePrep's output invariants (no unlifted + let-bindings) -- see #5433. + +Doing a substitution (via occ_bs_env) is much better. + Historical Note [no-case-of-case] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We *used* to suppress the binder-swap in case expressions when -fno-case-of-case is on. Old remarks: "This happens in the first simplifier pass, @@ -2844,53 +2946,8 @@ binder-swap in OccAnal: It's fixed by doing the binder-swap in OccAnal because we can do the binder-swap unconditionally and still get occurrence analysis information right. --} -addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv --- See Note [The binder-swap substitution] -addBndrSwap scrut case_bndr - env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) - | Just (scrut_var, mco) <- get_scrut_var (stripTicksTopE (const True) scrut) - , scrut_var /= case_bndr - -- Consider: case x of x { ... } - -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop - = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) - , occ_bs_rng = rng_vars `extendVarSet` case_bndr' - `unionVarSet` tyCoVarsOfMCo mco } - - | otherwise - = env - where - get_scrut_var :: OutExpr -> Maybe (OutVar, MCoercion) - get_scrut_var (Var v) = Just (v, MRefl) - get_scrut_var (Cast (Var v) co) = Just (v, MCo co) -- See Note [Case of cast] - get_scrut_var _ = Nothing - - case_bndr' = zapIdOccInfo case_bndr - -- See Note [Zap case binders in proxy bindings] -lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) --- See Note [The binder-swap substitution] --- Returns an expression of the same type as Id -lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr - = case lookupVarEnv bs_env bndr of { - Nothing -> (Var bndr, bndr) ; - Just (bndr1, mco) -> - - -- Why do we iterate here? - -- See (BS2) in Note [The binder-swap substitution] - case lookupBndrSwap env bndr1 of - (fun, fun_id) -> (add_cast fun mco, fun_id) } - - where - add_cast fun MRefl = fun - add_cast fun (MCo co) = Cast fun (mkSymCo co) - -- We must switch that 'co' to 'sym co'; - -- see the comment with occ_bs_env - -- No need to test for isReflCo, because 'co' came from - -- a (Cast e co) and hence is unlikely to be Refl - -{- ************************************************************************ * * \subsection[OccurAnal-types]{OccEnv} ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Utils -import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs ) +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutBinderSwap_maybe ) import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) @@ -3240,19 +3240,21 @@ zapIdOccInfoAndSetEvald str v = -- see Note [Case alternative occ info] addAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv -addAltUnfoldings env scrut case_bndr con_app +addAltUnfoldings env mb_scrut case_bndr con_app = do { let con_app_unf = mk_simple_unf con_app env1 = addBinderUnfolding env case_bndr con_app_unf -- See Note [Add unfolding for scrutinee] - env2 | Many <- idMult case_bndr = case scrut of - Just (Var v) -> addBinderUnfolding env1 v con_app_unf - Just (Cast (Var v) co) -> addBinderUnfolding env1 v $ - mk_simple_unf (Cast con_app (mkSymCo co)) - _ -> env1 + env2 | Just scrut <- mb_scrut + , Just (v,mco) <- scrutBinderSwap_maybe scrut + = addBinderUnfolding env1 v $ + if isReflMCo mco -- isReflMCo: avoid calling mk_simple_unf + then con_app_unf -- twice in the common case + else mk_simple_unf (mkCastMCo con_app mco) + | otherwise = env1 - ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr scrut, ppr con_app]) + ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr mb_scrut, ppr con_app]) ; return env2 } where -- Force the opts, so that the whole SimplEnv isn't retained @@ -3315,9 +3317,6 @@ it's also good for case-elimination -- suppose that 'f' was inlined and did multi-level case analysis, then we'd solve it in one simplifier sweep instead of two. -Exactly the same issue arises in GHC.Core.Opt.SpecConstr; -see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr - HOWEVER, given case x of y { Just a -> r1; Nothing -> r2 } we do not want to add the unfolding x -> y to 'x', which might seem cool, @@ -3328,8 +3327,11 @@ piece of information. So instead we add the unfolding x -> Just a, and x -> Nothing in the respective RHSs. -Since this transformation is tantamount to a binder swap, the same caveat as in -Note [Suppressing binder-swaps on linear case] in OccurAnal apply. +Since this transformation is tantamount to a binder swap, we use +GHC.Core.Opt.OccurAnal.scrutBinderSwap_maybe to do the check. + +Exactly the same issue arises in GHC.Core.Opt.SpecConstr; +see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr ************************************************************************ ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Core.Unfold import GHC.Core.FVs ( exprsFreeVarsList, exprFreeVars ) import GHC.Core.Opt.Monad import GHC.Core.Opt.WorkWrap.Utils +import GHC.Core.Opt.OccurAnal( scrutBinderSwap_maybe ) import GHC.Core.DataCon import GHC.Core.Class( classTyVars ) import GHC.Core.Coercion hiding( substCo ) @@ -1057,8 +1058,8 @@ extendCaseBndrs env scrut case_bndr con alt_bndrs = (env2, alt_bndrs') where live_case_bndr = not (isDeadBinder case_bndr) - env1 | Var v <- stripTicksTopE (const True) scrut - = extendValEnv env v cval + env1 | Just (v, mco) <- scrutBinderSwap_maybe scrut + , isReflMCo mco = extendValEnv env v cval | otherwise = env -- See Note [Add scrutinee to ValueEnv too] env2 | live_case_bndr = extendValEnv env1 case_bndr cval | otherwise = env1 @@ -1148,6 +1149,10 @@ though the simplifier has systematically replaced uses of 'x' with 'y' and 'b' with 'c' in the code. The use of 'b' in the ValueEnv came from outside the case. See #4908 for the live example. +It's very like the binder-swap story, so we use scrutBinderSwap_maybe +to identify suitable scrutinees -- but only if there is no cast +(isReflMCo) because that's all that the ValueEnv allows. + Note [Avoiding exponential blowup] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The sc_count field of the ScEnv says how many times we are prepared to View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a4305deb90e81b713433f2f3701162056ba1c3a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a4305deb90e81b713433f2f3701162056ba1c3a5 You're receiving 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 30 09:09:09 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 30 Aug 2022 05:09:09 -0400 Subject: [Git][ghc/ghc][wip/js-staging] CPP: fix LINE markers. Only disable them for JS Message-ID: <630dd3b541ae4_2f2e58d8b7934606685@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 48f77448 by Sylvain Henry at 2022-08-30T11:11:49+02:00 CPP: fix LINE markers. Only disable them for JS - - - - - 2 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/StgToJS/Linker/Shims.hs Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,10 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) (hsc_unit_env hsc_env) - False{-not raw-} + (CppOpts + { cppUseCc = True + , cppLinePragmas = True + }) [] input_fn output_fn return output_fn @@ -629,7 +632,10 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) (hsc_unit_env hsc_env) - True{-raw-} + (CppOpts + { cppUseCc = False + , cppLinePragmas = True + }) [] input_fn output_fn return output_fn @@ -970,11 +976,16 @@ offsetIncludePaths dflags (IncludeSpecs incs quotes impl) = -- ----------------------------------------------------------------------------- -- Running CPP +data CppOpts = CppOpts + { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" + , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + } + -- | Run CPP -- -- UnitEnv is needed to compute MIN_VERSION macros -doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> Bool -> [Option] -> FilePath -> FilePath -> IO () -doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do +doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> [Option] -> FilePath -> FilePath -> IO () +doCpp logger tmpfs dflags unit_env opts extra_opts input_fn output_fn = do let hscpp_opts = picPOpts dflags let cmdline_include_paths = offsetIncludePaths dflags (includePaths dflags) let unit_state = ue_units unit_env @@ -998,9 +1009,10 @@ doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do let verbFlags = getVerbFlags dflags - let cpp_prog args | raw = GHC.SysTools.runCpp logger dflags args - | otherwise = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + let cpp_prog args + | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags + (GHC.SysTools.Option "-E" : args) + | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags targetArch = stringEncodeArch $ platformArch platform @@ -1053,6 +1065,10 @@ doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do return [GHC.SysTools.FileOption "-include" macro_stub] else return [] + let line_pragmas + | cppLinePragmas opts = [] -- on by default + | otherwise = [GHC.SysTools.Option "-P"] -- disable LINE markers + cpp_prog ( map GHC.SysTools.Option verbFlags ++ map GHC.SysTools.Option include_paths ++ map GHC.SysTools.Option hsSourceCppOpts @@ -1065,13 +1081,13 @@ doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do ++ map GHC.SysTools.Option io_manager_defs ++ mb_macro_include ++ extra_opts + ++ line_pragmas -- Set the language mode to assembler-with-cpp when preprocessing. This -- alleviates some of the C99 macro rules relating to whitespace and the hash -- operator, which we tend to abuse. Clang in particular is not very happy -- about this. ++ [ GHC.SysTools.Option "-x" , GHC.SysTools.Option "assembler-with-cpp" - , GHC.SysTools.Option "-P" -- disable line markers , GHC.SysTools.Option input_fn -- We hackily use Option instead of FileOption here, so that the file -- name is not back-slashed on Windows. cpp is capable of ===================================== compiler/GHC/StgToJS/Linker/Shims.hs ===================================== @@ -32,7 +32,7 @@ import GHC.StgToJS.Linker.Utils import System.FilePath import GHC.Driver.Session -import GHC.Driver.Pipeline.Execute (doCpp) +import GHC.Driver.Pipeline.Execute (doCpp, CppOpts(..)) import GHC.Unit.Env import GHC.Utils.TmpFs @@ -166,7 +166,10 @@ tryReadShimFile logger tmpfs dflags unit_env file = do if needsCpp file then do let profiling = False - use_cpp_and_not_cc_dash_E = False + cpp_opts = CppOpts + { cppUseCc = True + , cppLinePragmas = False -- LINE pragmas aren't JS compatible + } extra_opts = [] -- load the shim into memory @@ -179,7 +182,7 @@ tryReadShimFile logger tmpfs dflags unit_env file = do B.writeFile infile $ (commonCppDefs profiling) <> payload outfile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "jspp" -- do the business - doCpp logger tmpfs dflags unit_env use_cpp_and_not_cc_dash_E extra_opts infile outfile + doCpp logger tmpfs dflags unit_env cpp_opts extra_opts infile outfile B.readFile outfile else parseShim file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f7744844bfabb4e41e2d886c25b9765e5edfca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f7744844bfabb4e41e2d886c25b9765e5edfca You're receiving 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 30 10:05:36 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 30 Aug 2022 06:05:36 -0400 Subject: [Git][ghc/ghc][wip/T21470] Fix binder-swap bug Message-ID: <630de0f08034f_2f2e584887864945c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21470 at Glasgow Haskell Compiler / GHC Commits: 8b7d4eb5 by Simon Peyton Jones at 2022-08-30T11:07:01+01:00 Fix binder-swap bug This patch fixes #21229 / #21470 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. I als modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 7 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - testsuite/tests/linters/notes.stdout - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -19,7 +19,7 @@ core expression with (hopefully) improved usage information. module GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr, - zapLambdaBndrs + zapLambdaBndrs, scrutBinderSwap_maybe ) where import GHC.Prelude @@ -27,11 +27,12 @@ import GHC.Prelude import GHC.Core import GHC.Core.FVs import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, - stripTicksTopE, mkTicks ) + mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion +import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type -import GHC.Core.TyCo.FVs( tyCoVarsOfMCo ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) import GHC.Data.Maybe( isJust, orElse ) import GHC.Data.Graph.Directed ( SCC(..), Node(..) @@ -2462,8 +2463,8 @@ data OccEnv -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, - -- then please replace x by (y |> sym mco) - -- Invariant of course: idType x = exprType (y |> sym mco) + -- then please replace x by (y |> mco) + -- Invariant of course: idType x = exprType (y |> mco) , occ_bs_env :: !(VarEnv (OutId, MCoercion)) , occ_bs_rng :: !VarSet -- Vars free in the range of occ_bs_env -- Domain is Global and Local Ids @@ -2669,7 +2670,7 @@ The binder-swap is implemented by the occ_bs_env field of OccEnv. There are two main pieces: * Given case x |> co of b { alts } - we add [x :-> (b, co)] to the occ_bs_env environment; this is + we add [x :-> (b, sym co)] to the occ_bs_env environment; this is done by addBndrSwap. * Then, at an occurrence of a variable, we look up in the occ_bs_env @@ -2737,30 +2738,8 @@ Some tricky corners: (BS5) We have to apply the occ_bs_env substitution uniformly, including to (local) rules and unfoldings. -Historical note ---------------- -We used to do the binder-swap transformation by introducing -a proxy let-binding, thus; - - case x of b { pi -> ri } - ==> - case x of b { pi -> let x = b in ri } - -But that had two problems: - -1. If 'x' is an imported GlobalId, we'd end up with a GlobalId - on the LHS of a let-binding which isn't allowed. We worked - around this for a while by "localising" x, but it turned - out to be very painful #16296, - -2. In CorePrep we use the occurrence analyser to do dead-code - elimination (see Note [Dead code in CorePrep]). But that - occasionally led to an unlifted let-binding - case x of b { DEFAULT -> let x::Int# = b in ... } - which disobeys one of CorePrep's output invariants (no unlifted - let-bindings) -- see #5433. - -Doing a substitution (via occ_bs_env) is much better. +(BS6) We must be very careful with dictionaries. + See Note [Care with binder-swap on dictionaries] Note [Case of cast] ~~~~~~~~~~~~~~~~~~~ @@ -2770,6 +2749,54 @@ We'd like to eliminate the inner case. That is the motivation for equation (2) in Note [Binder swap]. When we get to the inner case, we inline x, cancel the casts, and away we go. +Note [Care with binder-swap on dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This Note explains why we need isDictId in scrutBinderSwap_maybe. +Consider this tricky example (#21229, #21470): + + class Sing (b :: Bool) where sing :: Bool + instance Sing 'True where sing = True + instance Sing 'False where sing = False + + f :: forall a. Sing a => blah + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a dSing + +Now do a binder-swap on the case-expression: + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (wild |> sym the_co) + +And now substitute `False` for `wild` (since wild=False in the False branch): + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (False |> sym the_co) + +And now we have a problem. The specialiser will specialise (f @a d)a (for all +vtypes a and dictionaries d!!) with the dictionary (False |> sym the_co), using +Note [Specialising polymorphic dictionaries] in GHC.Core.Opt.Specialise. + +The real problem is the binder-swap. It swaps a dictionary variable $dSing +(of kind Constraint) for a term variable wild (of kind Type). And that is +dangerous: a dictionary is a /singleton/ type whereas a general term variable is +not. In this particular example, Bool is most certainly not a singleton type! + +Conclusion: + for a /dictionary variable/ do not perform + the clever cast version of the binder-swap + +Hence the subtle isDictId in scrutBinderSwap_maybe. + Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From the original @@ -2784,8 +2811,83 @@ binding x = cb. See #5028. NB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier doesn't use it. So this is only to satisfy the perhaps-over-picky Lint. +-} + +addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv +-- See Note [The binder-swap substitution] +addBndrSwap scrut case_bndr + env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) + | Just (scrut_var, mco) <- scrutBinderSwap_maybe scrut + , scrut_var /= case_bndr + -- Consider: case x of x { ... } + -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop + = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) + , occ_bs_rng = rng_vars `extendVarSet` case_bndr' + `unionVarSet` tyCoVarsOfMCo mco } + + | otherwise + = env + where + case_bndr' = zapIdOccInfo case_bndr + -- See Note [Zap case binders in proxy bindings] + +scrutBinderSwap_maybe :: OutExpr -> Maybe (OutVar, MCoercion) +-- If (scrutBinderSwap_maybe e = Just (v, mco), then +-- v = e |> mco +-- See Note [Case of cast] +-- See Note [Care with binder-swap on dictionaries] +-- +-- We use this same function in SpecConstr, and Simplify.Iteration, +-- when something binder-swap-like is happening +scrutBinderSwap_maybe (Var v) = Just (v, MRefl) +scrutBinderSwap_maybe (Cast (Var v) co) + | not (isDictId v) = Just (v, MCo (mkSymCo co)) + -- Cast: see Note [Case of cast] + -- isDictId: see Note [Care with binder-swap on dictionaries] +scrutBinderSwap_maybe (Tick _ e) = scrutBinderSwap_maybe e -- Drop ticks +scrutBinderSwap_maybe _ = Nothing + +lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) +-- See Note [The binder-swap substitution] +-- Returns an expression of the same type as Id +lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr + = case lookupVarEnv bs_env bndr of { + Nothing -> (Var bndr, bndr) ; + Just (bndr1, mco) -> + + -- Why do we iterate here? + -- See (BS2) in Note [The binder-swap substitution] + case lookupBndrSwap env bndr1 of + (fun, fun_id) -> (mkCastMCo fun mco, fun_id) } + + +{- Historical note [Proxy let-bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We used to do the binder-swap transformation by introducing +a proxy let-binding, thus; + + case x of b { pi -> ri } + ==> + case x of b { pi -> let x = b in ri } + +But that had two problems: + +1. If 'x' is an imported GlobalId, we'd end up with a GlobalId + on the LHS of a let-binding which isn't allowed. We worked + around this for a while by "localising" x, but it turned + out to be very painful #16296, + +2. In CorePrep we use the occurrence analyser to do dead-code + elimination (see Note [Dead code in CorePrep]). But that + occasionally led to an unlifted let-binding + case x of b { DEFAULT -> let x::Int# = b in ... } + which disobeys one of CorePrep's output invariants (no unlifted + let-bindings) -- see #5433. + +Doing a substitution (via occ_bs_env) is much better. + Historical Note [no-case-of-case] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We *used* to suppress the binder-swap in case expressions when -fno-case-of-case is on. Old remarks: "This happens in the first simplifier pass, @@ -2844,53 +2946,8 @@ binder-swap in OccAnal: It's fixed by doing the binder-swap in OccAnal because we can do the binder-swap unconditionally and still get occurrence analysis information right. --} -addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv --- See Note [The binder-swap substitution] -addBndrSwap scrut case_bndr - env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) - | Just (scrut_var, mco) <- get_scrut_var (stripTicksTopE (const True) scrut) - , scrut_var /= case_bndr - -- Consider: case x of x { ... } - -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop - = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) - , occ_bs_rng = rng_vars `extendVarSet` case_bndr' - `unionVarSet` tyCoVarsOfMCo mco } - - | otherwise - = env - where - get_scrut_var :: OutExpr -> Maybe (OutVar, MCoercion) - get_scrut_var (Var v) = Just (v, MRefl) - get_scrut_var (Cast (Var v) co) = Just (v, MCo co) -- See Note [Case of cast] - get_scrut_var _ = Nothing - - case_bndr' = zapIdOccInfo case_bndr - -- See Note [Zap case binders in proxy bindings] -lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) --- See Note [The binder-swap substitution] --- Returns an expression of the same type as Id -lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr - = case lookupVarEnv bs_env bndr of { - Nothing -> (Var bndr, bndr) ; - Just (bndr1, mco) -> - - -- Why do we iterate here? - -- See (BS2) in Note [The binder-swap substitution] - case lookupBndrSwap env bndr1 of - (fun, fun_id) -> (add_cast fun mco, fun_id) } - - where - add_cast fun MRefl = fun - add_cast fun (MCo co) = Cast fun (mkSymCo co) - -- We must switch that 'co' to 'sym co'; - -- see the comment with occ_bs_env - -- No need to test for isReflCo, because 'co' came from - -- a (Cast e co) and hence is unlikely to be Refl - -{- ************************************************************************ * * \subsection[OccurAnal-types]{OccEnv} ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -51,17 +51,6 @@ The simplifier tries to get rid of occurrences of x, in favour of wild, in the hope that there will only be one remaining occurrence of x, namely the scrutinee of the case, and we can inline it. - - This can only work if @wild@ is an unrestricted binder. Indeed, even with the - extended typing rule (in the linter) for case expressions, if - case x of wild % 1 { p -> e} - is well-typed, then - case x of wild % 1 { p -> e[wild\x] } - is only well-typed if @e[wild\x] = e@ (that is, if @wild@ is not used in @e@ - at all). In which case, it is, of course, pointless to do the substitution - anyway. So for a linear binder (and really anything which isn't unrestricted), - doing this substitution would either produce ill-typed terms or be the - identity. -} module GHC.Core.Opt.SetLevels ( @@ -1602,7 +1591,9 @@ extendCaseBndrEnv :: LevelEnv -> LevelEnv extendCaseBndrEnv le@(LE { le_subst = subst, le_env = id_env }) case_bndr (Var scrut_var) - | Many <- varMult case_bndr + -- We could use OccurAnal. scrutBinderSwap_maybe here, and perhaps + -- get a bit more floating. But we didn't in the past and it's + -- an unforced change, so I'm leaving it. = le { le_subst = extendSubstWithVar subst case_bndr scrut_var , le_env = add_id id_env (case_bndr, scrut_var) } extendCaseBndrEnv env _ _ = env ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Utils -import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs ) +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutBinderSwap_maybe ) import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) @@ -3240,19 +3240,21 @@ zapIdOccInfoAndSetEvald str v = -- see Note [Case alternative occ info] addAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv -addAltUnfoldings env scrut case_bndr con_app +addAltUnfoldings env mb_scrut case_bndr con_app = do { let con_app_unf = mk_simple_unf con_app env1 = addBinderUnfolding env case_bndr con_app_unf -- See Note [Add unfolding for scrutinee] - env2 | Many <- idMult case_bndr = case scrut of - Just (Var v) -> addBinderUnfolding env1 v con_app_unf - Just (Cast (Var v) co) -> addBinderUnfolding env1 v $ - mk_simple_unf (Cast con_app (mkSymCo co)) - _ -> env1 + env2 | Just scrut <- mb_scrut + , Just (v,mco) <- scrutBinderSwap_maybe scrut + = addBinderUnfolding env1 v $ + if isReflMCo mco -- isReflMCo: avoid calling mk_simple_unf + then con_app_unf -- twice in the common case + else mk_simple_unf (mkCastMCo con_app mco) + | otherwise = env1 - ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr scrut, ppr con_app]) + ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr mb_scrut, ppr con_app]) ; return env2 } where -- Force the opts, so that the whole SimplEnv isn't retained @@ -3315,9 +3317,6 @@ it's also good for case-elimination -- suppose that 'f' was inlined and did multi-level case analysis, then we'd solve it in one simplifier sweep instead of two. -Exactly the same issue arises in GHC.Core.Opt.SpecConstr; -see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr - HOWEVER, given case x of y { Just a -> r1; Nothing -> r2 } we do not want to add the unfolding x -> y to 'x', which might seem cool, @@ -3328,8 +3327,11 @@ piece of information. So instead we add the unfolding x -> Just a, and x -> Nothing in the respective RHSs. -Since this transformation is tantamount to a binder swap, the same caveat as in -Note [Suppressing binder-swaps on linear case] in OccurAnal apply. +Since this transformation is tantamount to a binder swap, we use +GHC.Core.Opt.OccurAnal.scrutBinderSwap_maybe to do the check. + +Exactly the same issue arises in GHC.Core.Opt.SpecConstr; +see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr ************************************************************************ ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Core.Unfold import GHC.Core.FVs ( exprsFreeVarsList, exprFreeVars ) import GHC.Core.Opt.Monad import GHC.Core.Opt.WorkWrap.Utils +import GHC.Core.Opt.OccurAnal( scrutBinderSwap_maybe ) import GHC.Core.DataCon import GHC.Core.Class( classTyVars ) import GHC.Core.Coercion hiding( substCo ) @@ -1057,8 +1058,8 @@ extendCaseBndrs env scrut case_bndr con alt_bndrs = (env2, alt_bndrs') where live_case_bndr = not (isDeadBinder case_bndr) - env1 | Var v <- stripTicksTopE (const True) scrut - = extendValEnv env v cval + env1 | Just (v, mco) <- scrutBinderSwap_maybe scrut + , isReflMCo mco = extendValEnv env v cval | otherwise = env -- See Note [Add scrutinee to ValueEnv too] env2 | live_case_bndr = extendValEnv env1 case_bndr cval | otherwise = env1 @@ -1148,6 +1149,10 @@ though the simplifier has systematically replaced uses of 'x' with 'y' and 'b' with 'c' in the code. The use of 'b' in the ValueEnv came from outside the case. See #4908 for the live example. +It's very like the binder-swap story, so we use scrutBinderSwap_maybe +to identify suitable scrutinees -- but only if there is no cast +(isReflMCo) because that's all that the ValueEnv allows. + Note [Avoiding exponential blowup] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The sc_count field of the ScEnv says how many times we are prepared to ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -42,7 +42,6 @@ import GHC.Core import GHC.Core.FVs import GHC.Core.Seq import GHC.Core.Utils -import GHC.Core.TyCo.Subst ( substCo ) -- We are defining local versions import GHC.Core.Type hiding ( substTy ) ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -2,7 +2,6 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:458:2: Note [RoughMap and rm_empt ref compiler/GHC/Core/Opt/OccurAnal.hs:857:15: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1598:30: Note [Top level scope] ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2666:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:3288:0: Note [Suppressing binder-swaps on linear case] ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:3816:8: Note [Lambda-bound unfoldings] ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1282:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1611:28: Note [Arity decrease] ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -359,7 +359,6 @@ test('T19586', normal, compile, ['']) test('T19599', normal, compile, ['-O -ddump-rules']) test('T19599a', normal, compile, ['-O -ddump-rules']) -test('T13873', [expect_broken(21229), grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) # Look for a specialisation rule for wimwam test('T19672', normal, compile, ['-O2 -ddump-rules']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b7d4eb5b5f75a2e2b93ebbc5f3952c3ea2ace2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b7d4eb5b5f75a2e2b93ebbc5f3952c3ea2ace2c You're receiving 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 30 10:05:59 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 Aug 2022 06:05:59 -0400 Subject: [Git][ghc/ghc][master] Various Hadrian bootstrapping fixes Message-ID: <630de1075f097_2f2e584887865511c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 1 changed file: - hadrian/bootstrap/bootstrap.py Changes: ===================================== hadrian/bootstrap/bootstrap.py ===================================== @@ -86,14 +86,17 @@ class Compiler: self.ghc_path = ghc_path.resolve() + exe = '' + if platform.system() == 'Windows': exe = '.exe' + info = self._get_ghc_info() self.version = info['Project version'] #self.lib_dir = Path(info['LibDir']) #self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve() - self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve() + self.ghc_pkg_path = (self.ghc_path.parent / ('ghc-pkg' + exe)).resolve() if not self.ghc_pkg_path.is_file(): raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file') - self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve() + self.hsc2hs_path = (self.ghc_path.parent / ('hsc2hs' + exe)).resolve() if not self.hsc2hs_path.is_file(): raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file') @@ -367,6 +370,11 @@ def main() -> None: help='path to GHC') parser.add_argument('-s', '--bootstrap-sources', type=Path, help='Path to prefetched bootstrap sources tarball') + parser.add_argument('--archive', dest='want_archive', action='store_true', + help='produce a Hadrian distribution archive (default)') + parser.add_argument('--no-archive', dest='want_archive', action='store_false', + help='do not produce a Hadrian distribution archive') + parser.set_defaults(want_archive=True) subparsers = parser.add_subparsers(dest="command") @@ -381,6 +389,9 @@ def main() -> None: ghc = None + sources_fmt = 'gztar' # The archive format for the bootstrap sources archive. + if platform.system() == 'Windows': sources_fmt = 'zip' + if args.deps is None: if args.bootstrap_sources is None: # find appropriate plan in the same directory as the script @@ -390,7 +401,7 @@ def main() -> None: # We have a tarball with all the required information, unpack it and use for further elif args.bootstrap_sources is not None and args.command != 'list-sources': print(f'Unpacking {args.bootstrap_sources} to {TARBALLS}') - shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, 'gztar') + shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, sources_fmt) args.deps = TARBALLS / 'plan-bootstrap.json' print(f"using plan-bootstrap.json ({args.deps}) from {args.bootstrap_sources}") else: @@ -428,10 +439,7 @@ def main() -> None: shutil.copyfile(args.deps, rootdir / 'plan-bootstrap.json') - fmt = 'gztar' - if platform.system() == 'Windows': fmt = 'zip' - - archivename = shutil.make_archive(args.output, fmt, root_dir=rootdir) + archivename = shutil.make_archive(args.output, sources_fmt, root_dir=rootdir) print(f""" Bootstrap sources saved to {archivename} @@ -475,21 +483,21 @@ Alternatively, you could use `bootstrap.py -w {ghc.ghc_path} -d {args.deps} fetc bootstrap(info, ghc) hadrian_path = (BINDIR / 'hadrian').resolve() - archive = make_archive(hadrian_path) - print(dedent(f''' Bootstrapping finished! The resulting hadrian executable can be found at {hadrian_path} + ''')) - It has been archived for distribution in - - {archive} + if args.want_archive: + dist_archive = make_archive(hadrian_path) + print(dedent(f''' + The Hadrian executable has been archived for distribution in - You can use this executable to build GHC. - ''')) + {dist_archive} + ''')) else: print(f"No such command: {args.command}") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0154bc80b3648af15ef431cf0cf99e3cbbd881f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0154bc80b3648af15ef431cf0cf99e3cbbd881f6 You're receiving 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 30 10:06:31 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 Aug 2022 06:06:31 -0400 Subject: [Git][ghc/ghc][master] ci: Attempt using normal submodule cloning strategy Message-ID: <630de127997ed_2f2e58d8b7934660297@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/451b1d90cf14e8fb3f12b1b65d8027717093556a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/451b1d90cf14e8fb3f12b1b65d8027717093556a You're receiving 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 30 10:47:49 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 30 Aug 2022 06:47:49 -0400 Subject: [Git][ghc/ghc][wip/T21286] 129 commits: Add a note about about W/W for unlifting strict arguments Message-ID: <630dead5becde_2f2e58487d86744e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21286 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. - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 85579ac5 by Simon Peyton Jones at 2022-08-30T11:18:54+01:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that modules * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times: Metrics: compile_time/bytes allocated -------------------------------------------------------- LargeRecord(normal) -50.2% GOOD MultiLayerModulesTH_OneShot(normal) +2.0% T10547(normal) +1.3% T12545(normal) -3.9% T13056(optasm) -8.4% GOOD T14052(ghci) +1.9% T15164(normal) -3.5% GOOD T16577(normal) -2.6% GOOD T18223(normal) -33.4% GOOD T3064(normal) +1.5% T8095(normal) +1.3% T9630(normal) 32.9% GOOD WWRec(normal) -9.8% GOOD hie002(normal) +1.8% geo. mean -1.5% I diligently investigated all these big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlesslly specialising wrappers LargeRecord, T9630 Metric Decrease: LargeRecord T13056 T15164 T16577 T18223 T9630 WWRec - - - - - 564b4fda by Simon Peyton Jones at 2022-08-30T11:21:29+01:00 Refactor UnfoldingSource and IfaceUnfolding - - - - - 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 - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/CodeGen.Platform.h - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a19e0c8c946a2901fbdb23b722e6d07dcd6cf51f...564b4fda0f88e768b70d44c50da692852570bdb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a19e0c8c946a2901fbdb23b722e6d07dcd6cf51f...564b4fda0f88e768b70d44c50da692852570bdb8 You're receiving 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 30 10:59:20 2022 From: gitlab at gitlab.haskell.org (Dominik Peteler (@mmhat)) Date: Tue, 30 Aug 2022 06:59:20 -0400 Subject: [Git][ghc/ghc][wip/21611-move-corem] 71 commits: Recognize file-header pragmas in GHCi (#21507) Message-ID: <630ded8883508_2f2e58488786771d4@gitlab.mail> Dominik Peteler pushed to branch wip/21611-move-corem at Glasgow Haskell Compiler / GHC Commits: 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0940934e by Dominik Peteler at 2022-08-30T00:40:39+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. - - - - - e2f8c741 by Dominik Peteler at 2022-08-30T00:51:51+02:00 Removed CoreM uses from GHC.Core.Lint - - - - - ae1e7267 by Dominik Peteler at 2022-08-30T00:51:59+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 - - - - - f5086867 by Dominik Peteler at 2022-08-30T00:58:20+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 - - - - - e3b0bf46 by Dominik Peteler at 2022-08-30T00:58:22+02:00 Removed references to driver from Specialise pass - - - - - 1c2aaca5 by Dominik Peteler at 2022-08-30T00:58:23+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. - - - - - 73596153 by Dominik Peteler at 2022-08-30T00:58:23+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 - - - - - 1725aa40 by Dominik Peteler at 2022-08-30T00:58:24+02:00 Simplified initSimplifyOpts - - - - - a0bdfad0 by Dominik Peteler at 2022-08-30T00:58:24+02:00 Adjusted tests - - - - - a8d7ffbd by Dominik Peteler at 2022-08-30T00:58:25+02:00 Removed RuleBase from getCoreToDo - - - - - e7520a12 by Dominik Peteler at 2022-08-30T00:58:25+02:00 Purified initSpecialiseOpts Also pass the rule bases and the visible orphan modules as arguments to the Specialise pass. - - - - - 204a098c by Dominik Peteler at 2022-08-30T00:58:26+02:00 Simplified CoreToDo interpreter a bit - - - - - 617431b8 by Dominik Peteler at 2022-08-30T01:03:47+02:00 Config records of some Core passes are now provided by CoreToDo * CoreAddCallerCcs * CoreAddLateCcs * CoreDoFloatInwards * CoreLiberateCase * CoreDoSpecConstr - - - - - a4fb7117 by Dominik Peteler at 2022-08-30T01:03:50+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 - - - - - 35044900 by Dominik Peteler at 2022-08-30T01:03:50+02:00 Fixed tests - - - - - b92341c2 by Dominik Peteler at 2022-08-30T01:03:51+02:00 Fixed note - - - - - 642037e5 by John Ericson at 2022-08-30T01:03:51+02:00 Add some haddocks - - - - - a822191d by John Ericson at 2022-08-30T01:03:52+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. - - - - - fa48e8c2 by John Ericson at 2022-08-30T01:03:52+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. - - - - - ebb65378 by John Ericson at 2022-08-30T01:03:53+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`. - - - - - cc32e4bd by John Ericson at 2022-08-30T01:05:29+02:00 Split `GHC.Core.Opt.Utils` Half of it was domain layer (float out switches) but the other half was infrastructure / driver (annotations). - - - - - edccda6d by Dominik Peteler at 2022-08-30T01:05:31+02:00 Fixed tests - - - - - 0d69713b by Dominik Peteler at 2022-08-30T01:07:51+02:00 Better configuration of Core lint debug options - - - - - 98628d29 by Dominik Peteler at 2022-08-30T01:07:54+02:00 Configuration record for rule check pass - - - - - a117b814 by Dominik Peteler at 2022-08-30T01:07:54+02:00 Renamed dmdAnal to demandAnalysis and moved it to GHC.Core.Opt.DmdAnal - - - - - a24934c7 by Dominik Peteler at 2022-08-30T01:07:55+02:00 Fix tests - - - - - 2c8aae26 by Dominik Peteler at 2022-08-30T11:12:55+02:00 Added environment for worker/wrapper pass - - - - - 1fbade41 by Dominik Peteler at 2022-08-30T11:13:03+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. - - - - - b44226f2 by Dominik Peteler at 2022-08-30T11:13:03+02:00 Removed GHC.Driver.Core.Rules - - - - - ef2fb759 by Dominik Peteler at 2022-08-30T11:13:04+02:00 Removed CoreDoNothing and CoreDoPasses Rewrote the getCoreToDo function using a Writer monad. This makes these data constructors superfluous. - - - - - 1c809fa1 by Dominik Peteler at 2022-08-30T11:13:04+02:00 Renamed endPassIO to endPass - - - - - 6d2037ae by Dominik Peteler at 2022-08-30T11:13:05+02:00 Renamed hscSimplify/hscSimplify' to optimizeCoreIO/optimizeCoreHsc - - - - - e9363ca9 by Dominik Peteler at 2022-08-30T11:13:05+02:00 Run simplifyPgm in SimplCountM - - - - - 675fb87d by Dominik Peteler at 2022-08-30T11:13:06+02:00 Added note on the architecture of the Core optimizer - - - - - 78c3cf49 by Dominik Peteler at 2022-08-30T12:59:02+02:00 Merged GHC.Driver.Config.Core.Opt.* modules in GHC.Driver.Config.Core.Opt - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/CodeGen.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ffd58d021b5c6c0574b5d013365e1500d40a9fbc...78c3cf49346ab211b9c20db978c73d4ddf9b7b4f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ffd58d021b5c6c0574b5d013365e1500d40a9fbc...78c3cf49346ab211b9c20db978c73d4ddf9b7b4f You're receiving 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 30 11:35:20 2022 From: gitlab at gitlab.haskell.org (Luite Stegeman (@luite)) Date: Tue, 30 Aug 2022 07:35:20 -0400 Subject: [Git][ghc/ghc][wip/js-staging] add JavaScript files listed in js-sources to package archives Message-ID: <630df5f86b768_2f2e58487ec68913@gitlab.mail> Luite Stegeman pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 74b1fb8a by Luite Stegeman at 2022-08-30T13:16:45+02:00 add JavaScript files listed in js-sources to package archives - - - - - 28 changed files: - compiler/GHC/Driver/Phases.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - + compiler/GHC/JS/Parser/Header.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/ghc.cabal.in - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Cabal/Type.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Library.hs - libraries/base/base.cabal - libraries/base/jsbits/base.js.pp → libraries/base/jsbits/base.js - + libraries/base/jsbits/errno.js - libraries/ghc-boot-th/GHC/ForeignSrcLang/Type.hs - + rts/include/js/constants.h - + rts/include/js/rts.h - + rts/js/arith.js - + rts/js/compact.js - + rts/js/debug.js - + rts/js/enum.js - + rts/js/environment.js - + rts/js/gc.js - + rts/js/goog.js - + rts/js/hscore.js - + rts/js/md5.js The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74b1fb8a91b30be0590d8e4638d926e5355a96dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74b1fb8a91b30be0590d8e4638d926e5355a96dd You're receiving 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 30 11:37:55 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 30 Aug 2022 07:37:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22096 Message-ID: <630df693af070_2f2e58487d8689385@gitlab.mail> Matthew Pickering pushed new branch wip/T22096 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22096 You're receiving 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 30 11:58:31 2022 From: gitlab at gitlab.haskell.org (Luite Stegeman (@luite)) Date: Tue, 30 Aug 2022 07:58:31 -0400 Subject: [Git][ghc/ghc][wip/js-staging] update rts js files to include recent fixes Message-ID: <630dfb67470ec_2f2e5813a03c9c707744@gitlab.mail> Luite Stegeman pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: dd7607bc by Luite Stegeman at 2022-08-30T13:57:45+02:00 update rts js files to include recent fixes - - - - - 6 changed files: - rts/js/arith.js - rts/js/environment.js - rts/js/gc.js - rts/js/rts.js - rts/js/staticpointer.js - rts/js/thread.js Changes: ===================================== rts/js/arith.js ===================================== @@ -10,293 +10,279 @@ function h$logArith() { h$log.apply(h$log,arguments); } #define TRACE_ARITH(args...) #endif -function h$hs_leInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s < l2s || (l1s === l2s && ((l1&1) <= (l2&1)))) ? 1 : 0; - } else { - return (h1 < h2) ? 1 : 0; - } +#define UN(x) ((x)>>>0) +#define W32(x) (BigInt(x)) +#define I32(x) (BigInt(x)) +#define W64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0)) +#define W64h(x) (Number(x >> BigInt(32)) >>> 0) +#define W64l(x) (Number(BigInt.asUintN(32, x)) >>> 0) +#define I64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0)) +#define I64h(x) (Number(x >> BigInt(32))|0) +#define I64l(x) (Number(BigInt.asUintN(32,x)) >>> 0) +#define RETURN_I64(x) RETURN_UBX_TUP2(I64h(x), I64l(x)) +#define RETURN_W64(x) RETURN_UBX_TUP2(W64h(x), W64l(x)) +#define RETURN_W32(x) return Number(x) + +function h$hs_quotWord64(h1,l1,h2,l2) { + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a / b); + TRACE_ARITH("Word64: " + a + " / " + b + " ==> " + r); + RETURN_W64(r); } -function h$hs_ltInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s < l2s || (l1s === l2s && ((l1&1) < (l2&1)))) ? 1 : 0; - } else { - return (h1 < h2) ? 1 : 0; - } +function h$hs_remWord64(h1,l1,h2,l2) { + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a % b); + TRACE_ARITH("Word64: " + a + " % " + b + " ==> " + r); + RETURN_W64(r); } -function h$hs_geInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s > l2s || (l1s === l2s && ((l1&1) >= (l2&1)))) ? 1 : 0; - } else { - return (h1 > h2) ? 1 : 0; - } +function h$hs_timesWord64(h1,l1,h2,l2) { + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a * b); + TRACE_ARITH("Word64: " + a + " * " + b + " ==> " + r); + RETURN_W64(r); } -function h$hs_gtInt64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s > l2s || (l1s === l2s && ((l1&1) > (l2&1)))) ? 1 : 0; - } else { - return (h1 > h2) ? 1 : 0; - } +function h$hs_minusWord64(h1,l1,h2,l2) { + var a = (BigInt(h1) << BigInt(32)) | BigInt(l1>>>0); + var b = (BigInt(h2) << BigInt(32)) | BigInt(l2>>>0); + var r = BigInt.asUintN(64, a - b); + TRACE_ARITH("Word64: " + a + " - " + b + " ==> " + r); + RETURN_W64(r); } -function h$hs_quotWord64(h1,l1,h2,l2) { - // 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()); +function h$hs_plusWord64(h1,l1,h2,l2) { + var a = W64(h1,l1); + var b = W64(h2,l2); + var r = BigInt.asUintN(64, a + b); + TRACE_ARITH("Word64: " + a + " + " + b + " ==> " + r); + RETURN_W64(r); } function h$hs_timesInt64(h1,l1,h2,l2) { - var c = goog.math.Long.fromBits(l1,h1).multiply(goog.math.Long.fromBits(l2,h2)); - RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a * b); + TRACE_ARITH("Int64: " + a + " * " + b + " ==> " + r); + RETURN_I64(r); } function h$hs_quotInt64(h1,l1,h2,l2) { - var c = goog.math.Long.fromBits(l1,h1).div(goog.math.Long.fromBits(l2,h2)); - RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a / b); + TRACE_ARITH("Int64: " + a + " / " + b + " ==> " + r); + RETURN_I64(r); } function h$hs_remInt64(h1,l1,h2,l2) { - var c = goog.math.Long.fromBits(l1,h1).modulo(goog.math.Long.fromBits(l2,h2)); - RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a % b); + TRACE_ARITH("Int64: " + a + " % " + b + " ==> " + r); + RETURN_I64(r); } function h$hs_plusInt64(h1,l1,h2,l2) { - const a48 = h1 >>> 16; - const a32 = h1 & 0xFFFF; - const a16 = l1 >>> 16; - const a00 = l1 & 0xFFFF; - - const b48 = h2 >>> 16; - const b32 = h2 & 0xFFFF; - const b16 = l2 >>> 16; - const b00 = l2 & 0xFFFF; - - var c48 = 0, c32 = 0, c16 = 0, c00 = 0; - c00 += a00 + b00; - c16 += c00 >>> 16; - c00 &= 0xFFFF; - c16 += a16 + b16; - c32 += c16 >>> 16; - c16 &= 0xFFFF; - c32 += a32 + b32; - c48 += c32 >>> 16; - c32 &= 0xFFFF; - c48 += a48 + b48; - c48 &= 0xFFFF; - RETURN_UBX_TUP2((c48 << 16) | c32, (c16 << 16) | c00); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a + b); + TRACE_ARITH("Int64: " + a + " + " + b + " ==> " + r); + RETURN_I64(r); } function h$hs_minusInt64(h1,l1,h2,l2) { - // negate arg2 and adds it - const nl2 = (~l2 + 1) | 0; - const nh2 = (~h2 + !nl2) | 0; - h$hs_plusInt64(h1,l1,nh2,nl2); + var a = I64(h1,l1); + var b = I64(h2,l2); + var r = BigInt.asIntN(64, a - b); + TRACE_ARITH("Int64: " + a + " - " + b + " ==> " + r); + RETURN_I64(r); } -function h$hs_leWord64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s < l2s || (l1s === l2s && ((l1&1) <= (l2&1)))) ? 1 : 0; - } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s < h2s || (h1s === h2s && ((h1&1) <= (h2&1)))) ? 1 : 0; - } -} +function h$hs_uncheckedShiftLWord64(h,l,n) { + var rh, rl; -function h$hs_ltWord64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s < l2s || (l1s === l2s && ((l1&1) < (l2&1)))) ? 1 : 0; + n &= 63; + if (n == 0) { + rh = h; + rl = l; + } else if (n === 32) { + rh = l; + rl = 0; + } else if (n < 32) { + rh = UN((h << n) | (l >>> (32 - n))); + rl = UN(l << n); } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s < h2s || (h1s === h2s && ((h1&1) < (h2&1)))) ? 1 : 0; + rh = UN(l << (n - 32)); + rl = 0; } -} -function h$hs_geWord64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s > l2s || (l1s === l2s && ((l1&1) >= (l2&1)))) ? 1 : 0; - } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s > h2s || (h1s === h2s && ((h1&1) >= (h2&1)))) ? 1 : 0; - } + TRACE_ARITH("Word64: " + W64(h,l) + " << " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } -function h$hs_gtWord64(h1,l1,h2,l2) { - if(h1 === h2) { - var l1s = l1 >>> 1; - var l2s = l2 >>> 1; - return (l1s > l2s || (l1s === l2s && ((l1&1) > (l2&1)))) ? 1 : 0; +function h$hs_uncheckedShiftRWord64(h,l,n) { + var rh, rl; + + n &= 63; + if(n == 0) { + rh = h; + rl = l; + } else if(n === 32) { + rh = 0; + rl = h; + } else if(n < 32) { + rh = h >>> n; + rl = UN((l >>> n ) | (h << (32-n))); } else { - var h1s = h1 >>> 1; - var h2s = h2 >>> 1; - return (h1s > h2s || (h1s === h2s && ((h1&1) > (h2&1)))) ? 1 : 0; + rh = 0; + rl = h >>> (n-32); } + TRACE_ARITH("Word64: " + W64(h,l) + " >>> " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } -function h$hs_remWord64(h1,l1,h2,l2) { - /* 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_uncheckedShiftLLInt64(h,l,n) { + var rh,rl; -function h$hs_uncheckedIShiftL64(h,l,n) { n &= 63; if (n == 0) { - RETURN_UBX_TUP2(h,l); + rh = h; + rl = l; + } else if (n === 32) { + rh = l|0; + rl = 0; + } else if (n < 32) { + rh = (h << n) | (l >>> (32 - n)); + rl = 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); - } + rh = l << (n - 32); + rl = 0; } + + TRACE_ARITH("Int64: " + W64(h,l) + " << " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } -function h$hs_uncheckedIShiftRA64(h,l,n) { +function h$hs_uncheckedShiftRAInt64(h,l,n) { + var rh,rl; + n &= 63; if (n == 0) { - RETURN_UBX_TUP2(h,l); + rh = h; + rl = l; + } else if (n < 32) { + rh = h >> n; + rl = UN((l >>> n) | UN(h << (32 - 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)); - } + rh = h >= 0 ? 0 : -1; + rl = UN(h >> (n - 32)); } -} -// always nonnegative n? -function h$hs_uncheckedShiftL64(h1,l1,n) { - TRACE_ARITH("hs_uncheckedShiftL64 " + h1 + " " + l1 + " " + 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); - } else { - TRACE_ARITH("hs_uncheckedShiftL64 result " + ((l1 << (n-32))|0) + " " + 0); - RETURN_UBX_TUP2(((l1 << (n-32))|0), 0); - } + TRACE_ARITH("Int64: " + W64(h,l) + " >> " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } -function h$hs_uncheckedShiftRL64(h1,l1,n) { - TRACE_ARITH("hs_uncheckedShiftRL64 " + h1 + " " + l1 + " " + n); +function h$hs_uncheckedShiftRLInt64(h,l,n) { + var rh,rl; + n &= 63; if(n == 0) { - RETURN_UBX_TUP2(h1, l1); + rh = h; + rl = l; + } else if(n == 32) { + rh = 0; + rl = UN(h); } else if(n < 32) { - RETURN_UBX_TUP2(h1 >>> n, (l1 >>> n ) | (h1 << (32-n))); + rh = h >>> n; + rl = UN((l >>> n) | (h << (32-n))); } else { - RETURN_UBX_TUP2(0, (h1 >>> (n-32))|0); + rh = 0; + rl = h >>> (n-32); } -} -// fixme this function appears to deoptimize a lot due to smallint overflows -function h$imul_shim(a, b) { - var ah = (a >>> 16) & 0xffff; - var al = a & 0xffff; - var bh = (b >>> 16) & 0xffff; - var bl = b & 0xffff; - // the shift by 0 fixes the sign on the high part - // the final |0 converts the unsigned value into a signed value - return (((al * bl)|0) + (((ah * bl + al * bh) << 16) >>> 0)|0); + TRACE_ARITH("Int64: " + W64(h,l) + " >>> " + n + " ==> " + W64(rh,rl)); + RETURN_UBX_TUP2(rh,rl); } -var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim; +var h$mulInt32 = Math.imul; -// 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) { + var a = I32(l1); + var b = I32(l2); + var r = BigInt.asIntN(64, a * b); + TRACE_ARITH("Int32: " + a + " * " + b + " ==> " + r + " (Int64)"); -function h$mulWord32(a,b) { - return goog.math.Long.fromBits(a,0).multiply(goog.math.Long.fromBits(b,0)).getLowBits(); + var rh = I64h(r); + var rl = I64l(r)|0; + var nh = ((rh === 0 && rl >= 0) || (rh === -1 && rl < 0)) ? 0 : 1; + RETURN_UBX_TUP3(nh, rh, rl); } -function h$mul2Word32(a,b) { - var c = goog.math.Long.fromBits(a,0).multiply(goog.math.Long.fromBits(b,0)); - RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); -} -function h$quotWord32(a,b) { - return goog.math.Long.fromBits(a,0).div(goog.math.Long.fromBits(b,0)).getLowBits(); +function h$mulWord32(l1,l2) { + var a = W32(l1); + var b = W32(l2); + var r = BigInt.asUintN(32, a * b); + TRACE_ARITH("Word32: " + a + " * " + b + " ==> " + r); + RETURN_W32(r); } -function h$remWord32(a,b) { - return goog.math.Long.fromBits(a,0).modulo(goog.math.Long.fromBits(b,0)).getLowBits(); +function h$mul2Word32(l1,l2) { + var a = W32(l1); + var b = W32(l2); + var r = BigInt.asUintN(64, a * b); + TRACE_ARITH("Word32: " + a + " * " + b + " ==> " + r + " (Word64)"); + RETURN_W64(r); } -function h$quotRem2Word32(h1,l1,b) { -/* var a = h$bigFromWord64(h1,l1); - var b = h$bigFromWord(b); - var d = a.divide(b); */ - /* var a = h$ghcjsbn_mkBigNat_ww(h1,l1); - var b = h$ghcjsbn_mkBigNat_w(b); */ - var q = [], r = []; - h$ghcjsbn_quotRem_bb(q,r,h$ghcjsbn_mkBigNat_ww(h1,l1),h$ghcjsbn_mkBigNat_w(b)); - RETURN_UBX_TUP2(h$ghcjsbn_toWord_b(q), h$ghcjsbn_toWord_b(r)); - // RETURN_UBX_TUP2(d.intValue(), a.subtract(b.multiply(d)).intValue()); +function h$quotWord32(n,d) { + var a = W32(n); + var b = W32(d); + var r = BigInt.asUintN(32, a / b); + TRACE_ARITH("Word32: " + a + " / " + b + " ==> " + r); + RETURN_W32(r); } -function h$wordAdd2(a,b) { - const a16 = a >>> 16; - const a00 = a & 0xFFFF; +function h$remWord32(n,d) { + var a = W32(n); + var b = W32(d); + var r = BigInt.asUintN(32, a % b); + TRACE_ARITH("Word32: " + a + " % " + b + " ==> " + r); + RETURN_W32(r); +} - const b16 = b >>> 16; - const b00 = b & 0xFFFF; +function h$quotRemWord32(n,d) { + var a = W32(n); + var b = W32(d); + var q = BigInt.asUintN(32, a / b); + var r = BigInt.asUintN(32, a % b); + TRACE_ARITH("Word32: " + a + " `quotRem` " + b + " ==> (" + q + ", " + r + ")"); + RETURN_UBX_TUP2(Number(q),Number(r)); +} - var c32 = 0, c16 = 0, c00 = 0; - c00 += a00 + b00; - c16 += c00 >>> 16; - c00 &= 0xFFFF; - c16 += a16 + b16; - c32 += c16 >>> 16; - c16 &= 0xFFFF; - RETURN_UBX_TUP2(c32, (c16 << 16) | c00); +function h$quotRem2Word32(nh,nl,d) { + var a = W64(nh,nl); + var b = W32(d); + var q = BigInt.asUintN(32, a / b); + var r = BigInt.asUintN(32, a % b); + TRACE_ARITH("Word32: " + a + " `quotRem2` " + b + " ==> (" + q + ", " + r + ")"); + RETURN_UBX_TUP2(Number(q),Number(r)); } -// 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$wordAdd2(l1,l2) { + var a = W32(l1); + var b = W32(l2); + var r = BigInt.asUintN(64, a + b); + TRACE_ARITH("Word32: " + a + " + " + b + " ==> " + r + " (Word64)"); + RETURN_W64(r); } function h$isDoubleNegativeZero(d) { @@ -522,8 +508,8 @@ function h$popCnt64(x1,x2) { } function h$bswap64(x1,x2) { - RETURN_UBX_TUP2((x2 >>> 24) | (x2 << 24) | ((x2 & 0xFF00) << 8) | ((x2 & 0xFF0000) >> 8) - ,(x1 >>> 24) | (x1 << 24) | ((x1 & 0xFF00) << 8) | ((x1 & 0xFF0000) >> 8)); + RETURN_UBX_TUP2(UN((x2 >>> 24) | (x2 << 24) | ((x2 & 0xFF00) << 8) | ((x2 & 0xFF0000) >> 8)) + ,UN((x1 >>> 24) | (x1 << 24) | ((x1 & 0xFF00) << 8) | ((x1 & 0xFF0000) >> 8))); } var h$clz32 = Math.clz32 || function(x) { @@ -571,3 +557,41 @@ if(typeof Math.fround === 'function') { return h$truncateFloat_buf[0]; } } + +function h$decodeDoubleInt64(d) { + TRACE_ARITH("decodeDoubleInt64: " + d); + if(isNaN(d)) { + RETURN_UBX_TUP3(972, -1572864, 0); + } + h$convertDouble[0] = d; + var i0 = h$convertInt[0], i1 = h$convertInt[1]; + var exp = (i1&2146435072)>>>20; + var ret1, ret2 = i0, ret3; + if(exp === 0) { // denormal or zero + if((i1&2147483647) === 0 && ret2 === 0) { + ret1 = 0; + ret3 = 0; + } else { + h$convertDouble[0] = d*9007199254740992; + i1 = h$convertInt[1]; + ret1 = (i1&1048575)|1048576; + ret2 = h$convertInt[0]; + ret3 = ((i1&2146435072)>>>20)-1128; + } + } else { + ret3 = exp-1075; + ret1 = (i1&1048575)|1048576; + } + // negate mantissa for negative input + if(d < 0) { + if(ret2 === 0) { + ret1 = ((~ret1) + 1) | 0; + // ret2 = 0; + } else { + ret1 = ~ret1; + ret2 = ((~ret2) + 1) | 0; + } + } + // prim ubx tup returns don't return the first value! + RETURN_UBX_TUP3(ret3,ret1,ret2); +} ===================================== rts/js/environment.js ===================================== @@ -94,6 +94,47 @@ if(h$isNode) { } #endif +//filter RTS arguments +var h$rtsArgs = []; +{ + var prog_args = []; + var rts_args = []; + var in_rts = false; + var i = 0; + for(i=0;i - h$run(MK_AP3( h$baseZCGHCJSziPrimziresolveIO + h$run(MK_AP3( h$baseZCGHCziJSziPrimziresolveIO , x => { accept(unbox(x))} , e => { reject(new h$HaskellException(e))} , action @@ -17,7 +17,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); @@ -153,7 +153,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 @@ -707,3 +707,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(); +} ===================================== rts/js/staticpointer.js ===================================== @@ -40,9 +40,15 @@ function h$hs_spt_keys(tgt_d, tgt_o, n) { return Math.min(n,ks.length); } -function h$hs_spt_lookup(key1,key2,key3,key4) { - // var i3 = key_d.i3, o = key_o >> 2; - // h$log("hs_spt_lookup"); +function h$hs_spt_lookup(key_v,key_o) { + // We know that the array is freshly allocated so we don't have to care + // about the offset (should be 0). + // + // note that the order of the keys is weird due to endianness + var key2 = key_v.i3[0] >>> 0; + var key1 = key_v.i3[1] >>> 0; + var key4 = key_v.i3[2] >>> 0; + var key3 = key_v.i3[3] >>> 0; RETURN_UBX_TUP2(h$hs_spt_lookup_key(key1,key2,key3,key4), 0); } ===================================== rts/js/thread.js ===================================== @@ -24,6 +24,9 @@ #define GHCJS_BUSY_YIELD 500 #endif +// Watch for insertion of null or undefined in the stack +//#define GHCJS_DEBUG_STACK + #ifdef GHCJS_TRACE_SCHEDULER function h$logSched() { if(arguments.length == 1) { if(h$currentThread != null) { @@ -70,6 +73,18 @@ function h$Thread() { this.tid = ++h$threadIdN; this.status = THREAD_RUNNING; this.stack = [h$done, 0, h$baseZCGHCziConcziSynczireportError, h$catch_e]; +#ifdef GHCJS_DEBUG_STACK + this.stack = new Proxy(this.stack, { + set(obj,prop,value) { + if (value === undefined || value === null) { + throw new Error("setting stack offset " + prop + " to " + value); + } + else { + return Reflect.set(...arguments); + } + } + }); +#endif this.sp = 3; this.mask = 0; // async exceptions masked (0 unmasked, 1: uninterruptible, 2: interruptible) this.interruptible = false; // currently in an interruptible operation @@ -821,7 +836,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; @@ -893,7 +908,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) { @@ -936,7 +951,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/dd7607bc9cff3934b0ba75021193e70681a93e07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd7607bc9cff3934b0ba75021193e70681a93e07 You're receiving 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 30 12:53:44 2022 From: gitlab at gitlab.haskell.org (Luite Stegeman (@luite)) Date: Tue, 30 Aug 2022 08:53:44 -0400 Subject: [Git][ghc/ghc][wip/js-staging] fix definitions in js/rts.h Message-ID: <630e085875ddf_2f2e58d8b79347382a9@gitlab.mail> Luite Stegeman pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 8a44a493 by Luite Stegeman at 2022-08-30T14:53:01+02:00 fix definitions in js/rts.h - - - - - 1 changed file: - rts/include/js/rts.h Changes: ===================================== rts/include/js/rts.h ===================================== @@ -34,22 +34,22 @@ -// GHCJS.Prim.JSVal +// GHC.JS.Prim.JSVal #ifdef GHCJS_PROF -#define MK_JSVAL(x) (h$c1(h$ghcjszmprimZCGHCJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)) +#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)) #else -#define MK_JSVAL(x) (h$c1(h$ghcjszmprimZCGHCJSziPrimziJSVal_con_e, (x))) +#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x))) #endif #define JSVAL_VAL(x) ((x).d1) -// GHCJS.Prim.JSException +// GHC.JS.Prim.JSException #ifdef GHCJS_PROF -#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghcjszmprimZCGHCJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM)) +#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM)) #else -#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghcjszmprimZCGHCJSziPrimziJSException_con_e,(msg),(hsMsg))) +#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$baseZCGHCziJSziPrimziJSException_con_e,(msg),(hsMsg))) #endif // Exception dictionary for JSException -#define HS_JSEXCEPTION_EXCEPTION h$ghcjszmprimZCGHCJSziPrimzizdfExceptionJSException +#define HS_JSEXCEPTION_EXCEPTION h$baseZCGHCziJSziPrimzizdfExceptionJSException // SomeException #ifdef GHCJS_PROF View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a44a493d3fd9bcf5059f333b128cdab1b69566b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a44a493d3fd9bcf5059f333b128cdab1b69566b You're receiving 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 31 01:13:06 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 Aug 2022 21:13:06 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Various Hadrian bootstrapping fixes Message-ID: <630eb5a2273fc_2f2e58a70ea68820427@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 5a944e82 by Simon Peyton Jones at 2022-08-30T21:12:49-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - 8 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - hadrian/bootstrap/bootstrap.py - libraries/ghc-prim/GHC/Types.hs - + testsuite/tests/simplCore/should_compile/T22114.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -873,24 +873,49 @@ exprEtaExpandArity opts e * * ********************************************************************* -} -findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr -> Arity -> SafeArityType +findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr + -> (Bool, SafeArityType) -- This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] --- If findRhsArity e = (n, is_bot) then --- (a) any application of e to (\x1..xn. e x1 .. xn) --- (b) if is_bot=True, then e applied to n args is guaranteed bottom -- --- Returns an ArityType that is guaranteed trimmed to typeArity of 'bndr' +-- The Bool is True if the returned arity is greater than (exprArity rhs) +-- so the caller should do eta-expansion +-- That Bool is never True for join points, which are never eta-expanded +-- +-- Returns an SafeArityType that is guaranteed trimmed to typeArity of 'bndr' -- See Note [Arity trimming] -findRhsArity opts is_rec bndr rhs old_arity - = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> step init_env + +findRhsArity opts is_rec bndr rhs + | isJoinId bndr + = (False, join_arity_type) + -- False: see 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 + = (arity_increased, non_join_arity_type) + -- arity_increased: eta-expand if we'll get more lambdas + -- to the top of the RHS where + old_arity = exprArity rhs + init_env :: ArityEnv init_env = findRhsArityEnv opts (isJoinId bndr) + -- Non-join-points only + non_join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> step init_env + arity_increased = arityTypeArity non_join_arity_type > old_arity + + -- Join-points only + -- See Note [Arity for non-recursive join bindings] + -- and Note [Arity for recursive join bindings] + join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> trimArityType ty_arity (cheapArityType rhs) + ty_arity = typeArity (idType bndr) id_one_shots = idDemandOneShots bndr @@ -1076,6 +1101,117 @@ But /only/ for called-once demands. Suppose we had Now we don't want to eta-expand f1 to have 3 args; only two. Nor, in the case of f2, do we want to push that error call under a lambda. Hence the takeWhile in combineWithDemandDoneShots. + +Note [Do not eta-expand join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Similarly to CPR (see Note [Don't w/w join points for CPR] in +GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's +eta-expansion, and eta-expanding a join point is fraught with issues like how to +deal with a cast: + + let join $j1 :: IO () + $j1 = ... + $j2 :: Int -> IO () + $j2 n = if n > 0 then $j1 + else ... + + => + + let join $j1 :: IO () + $j1 = (\eta -> ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + $j2 :: Int -> IO () + $j2 n = (\eta -> if n > 0 then $j1 + else ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + +The cast here can't be pushed inside the lambda (since it's not casting to a +function type), so the lambda has to stay, but it can't because it contains a +reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather +than try and detect this situation (and whatever other situations crop up!), we +don't bother; again, any surrounding eta-expansion will improve these join +points anyway, since an outer cast can *always* be pushed inside. By the time +CorePrep comes around, the code is very likely to look more like this: + + let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) + $j1 = (...) eta + $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) + $j2 = if n > 0 then $j1 + else (...) eta + +Note [Arity for recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x = joinrec j 0 = \ a b c -> (a,x,b) + 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 + 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 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` (See Note [arityType for non-recursive let-bindings] + in GHC.Core.Opt.Arity)b + - 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 GHC.Core.Opt.Arity 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. + + +Note [Arity for non-recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Arity for recursive join bindings] deals with recursive join +bindings. But what about /non-recursive/ones? If we just call +findRhsArity, it 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.) -} ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -102,6 +102,14 @@ bindContextLevel :: BindContext -> TopLevelFlag bindContextLevel (BC_Let top_lvl _) = top_lvl bindContextLevel (BC_Join {}) = NotTopLevel +bindContextRec :: BindContext -> RecFlag +bindContextRec (BC_Let _ rec_flag) = rec_flag +bindContextRec (BC_Join rec_flag _) = rec_flag + +isJoinBC :: BindContext -> Bool +isJoinBC (BC_Let {}) = False +isJoinBC (BC_Join {}) = True + {- ********************************************************************* * * @@ -1776,39 +1784,26 @@ Wrinkles tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] --- 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 - = 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 - where - -- See Note [Arity for non-recursive join bindings] - -- and Note [Arity for recursive join bindings] - 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 - , new_arity > old_arity -- And the current manifest arity isn't enough +tryEtaExpandRhs env bind_cxt bndr rhs + | do_eta_expand -- If the current manifest arity isn't enough + -- (never true for join points) + , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs - = do { tick (EtaExpansion bndr) + = -- Do eta-expansion. + assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ + -- assert: this never happens for join points; see GHC.Core.Opt.Arity + -- Note [Do not eta-expand join points] + do { tick (EtaExpansion bndr) ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise = return (arity_type, rhs) + where in_scope = getInScope 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 + is_rec = bindContextRec bind_cxt + (do_eta_expand, arity_type) = findRhsArity arity_opts is_rec bndr rhs wantEtaExpansion :: CoreExpr -> Bool -- Mostly True; but False of PAPs which will immediately eta-reduce again @@ -1894,117 +1889,6 @@ But note that this won't eta-expand, say Does it matter not eta-expanding such functions? I'm not sure. Perhaps strictness analysis will have less to bite on? -Note [Do not eta-expand join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Similarly to CPR (see Note [Don't w/w join points for CPR] in -GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's -eta-expansion, and eta-expanding a join point is fraught with issues like how to -deal with a cast: - - let join $j1 :: IO () - $j1 = ... - $j2 :: Int -> IO () - $j2 n = if n > 0 then $j1 - else ... - - => - - let join $j1 :: IO () - $j1 = (\eta -> ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - $j2 :: Int -> IO () - $j2 n = (\eta -> if n > 0 then $j1 - else ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - -The cast here can't be pushed inside the lambda (since it's not casting to a -function type), so the lambda has to stay, but it can't because it contains a -reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather -than try and detect this situation (and whatever other situations crop up!), we -don't bother; again, any surrounding eta-expansion will improve these join -points anyway, since an outer cast can *always* be pushed inside. By the time -CorePrep comes around, the code is very likely to look more like this: - - let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) - $j1 = (...) eta - $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) - $j2 = if n > 0 then $j1 - else (...) eta - -Note [Arity for recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f x = joinrec j 0 = \ a b c -> (a,x,b) - 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 - 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 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` (See Note [arityType for non-recursive let-bindings] - in GHC.Core.Opt.Arity)b - - 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 GHC.Core.Opt.Arity 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. - - -Note [Arity for non-recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Note [Arity for recursive join bindings] deals with recursive join -bindings. But what about /non-recursive/ones? If we just call -findRhsArity, it 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.) - ************************************************************************ * * ===================================== hadrian/bootstrap/bootstrap.py ===================================== @@ -86,14 +86,17 @@ class Compiler: self.ghc_path = ghc_path.resolve() + exe = '' + if platform.system() == 'Windows': exe = '.exe' + info = self._get_ghc_info() self.version = info['Project version'] #self.lib_dir = Path(info['LibDir']) #self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve() - self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve() + self.ghc_pkg_path = (self.ghc_path.parent / ('ghc-pkg' + exe)).resolve() if not self.ghc_pkg_path.is_file(): raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file') - self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve() + self.hsc2hs_path = (self.ghc_path.parent / ('hsc2hs' + exe)).resolve() if not self.hsc2hs_path.is_file(): raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file') @@ -367,6 +370,11 @@ def main() -> None: help='path to GHC') parser.add_argument('-s', '--bootstrap-sources', type=Path, help='Path to prefetched bootstrap sources tarball') + parser.add_argument('--archive', dest='want_archive', action='store_true', + help='produce a Hadrian distribution archive (default)') + parser.add_argument('--no-archive', dest='want_archive', action='store_false', + help='do not produce a Hadrian distribution archive') + parser.set_defaults(want_archive=True) subparsers = parser.add_subparsers(dest="command") @@ -381,6 +389,9 @@ def main() -> None: ghc = None + sources_fmt = 'gztar' # The archive format for the bootstrap sources archive. + if platform.system() == 'Windows': sources_fmt = 'zip' + if args.deps is None: if args.bootstrap_sources is None: # find appropriate plan in the same directory as the script @@ -390,7 +401,7 @@ def main() -> None: # We have a tarball with all the required information, unpack it and use for further elif args.bootstrap_sources is not None and args.command != 'list-sources': print(f'Unpacking {args.bootstrap_sources} to {TARBALLS}') - shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, 'gztar') + shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, sources_fmt) args.deps = TARBALLS / 'plan-bootstrap.json' print(f"using plan-bootstrap.json ({args.deps}) from {args.bootstrap_sources}") else: @@ -428,10 +439,7 @@ def main() -> None: shutil.copyfile(args.deps, rootdir / 'plan-bootstrap.json') - fmt = 'gztar' - if platform.system() == 'Windows': fmt = 'zip' - - archivename = shutil.make_archive(args.output, fmt, root_dir=rootdir) + archivename = shutil.make_archive(args.output, sources_fmt, root_dir=rootdir) print(f""" Bootstrap sources saved to {archivename} @@ -475,21 +483,21 @@ Alternatively, you could use `bootstrap.py -w {ghc.ghc_path} -d {args.deps} fetc bootstrap(info, ghc) hadrian_path = (BINDIR / 'hadrian').resolve() - archive = make_archive(hadrian_path) - print(dedent(f''' Bootstrapping finished! The resulting hadrian executable can be found at {hadrian_path} + ''')) - It has been archived for distribution in - - {archive} + if args.want_archive: + dist_archive = make_archive(hadrian_path) + print(dedent(f''' + The Hadrian executable has been archived for distribution in - You can use this executable to build GHC. - ''')) + {dist_archive} + ''')) else: print(f"No such command: {args.command}") ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -143,7 +143,7 @@ data Symbol -- | The type constructor 'Any' is type to which you can unsafely coerce any -- lifted type, and back. More concretely, for a lifted type @t@ and --- value @x :: t@, -- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent +-- value @x :: t@, @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent -- to @x at . -- type family Any :: k where { } @@ -165,7 +165,7 @@ type family Any :: k where { } -- ==== __Examples__ -- -- Unless the OverloadedLists extension is enabled, list literals are --- syntatic sugar for repeated applications of @:@ and @[]@. +-- syntactic sugar for repeated applications of @:@ and @[]@. -- -- >>> 1:2:3:4:[] == [1,2,3,4] -- True ===================================== testsuite/tests/simplCore/should_compile/T22114.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE TypeFamilies #-} + +module T22114 where + +import Data.Kind (Type) + +value :: [Int] -> () -> Maybe Bool +value = valu + where valu [0] = valuN + valu _ = \_ -> Nothing + +type family T :: Type where + T = () -> Maybe Bool + +valuN :: T +valuN = valuN ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -428,3 +428,4 @@ test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) +test('T22114', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6aada809cd75dc229a3b7a62e79aa4a1624358e2...5a944e820a429c4208317f1171c6dfde29ad82b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6aada809cd75dc229a3b7a62e79aa4a1624358e2...5a944e820a429c4208317f1171c6dfde29ad82b7 You're receiving 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 31 04:53:26 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 00:53:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] Add a missing trimArityType Message-ID: <630ee946203af_2f2e58d8b79348367e3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 47479bde by Simon Peyton Jones at 2022-08-31T00:53:11-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - 4 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - + testsuite/tests/simplCore/should_compile/T22114.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -873,24 +873,49 @@ exprEtaExpandArity opts e * * ********************************************************************* -} -findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr -> Arity -> SafeArityType +findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr + -> (Bool, SafeArityType) -- This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] --- If findRhsArity e = (n, is_bot) then --- (a) any application of e to (\x1..xn. e x1 .. xn) --- (b) if is_bot=True, then e applied to n args is guaranteed bottom -- --- Returns an ArityType that is guaranteed trimmed to typeArity of 'bndr' +-- The Bool is True if the returned arity is greater than (exprArity rhs) +-- so the caller should do eta-expansion +-- That Bool is never True for join points, which are never eta-expanded +-- +-- Returns an SafeArityType that is guaranteed trimmed to typeArity of 'bndr' -- See Note [Arity trimming] -findRhsArity opts is_rec bndr rhs old_arity - = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> step init_env + +findRhsArity opts is_rec bndr rhs + | isJoinId bndr + = (False, join_arity_type) + -- False: see 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 + = (arity_increased, non_join_arity_type) + -- arity_increased: eta-expand if we'll get more lambdas + -- to the top of the RHS where + old_arity = exprArity rhs + init_env :: ArityEnv init_env = findRhsArityEnv opts (isJoinId bndr) + -- Non-join-points only + non_join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> step init_env + arity_increased = arityTypeArity non_join_arity_type > old_arity + + -- Join-points only + -- See Note [Arity for non-recursive join bindings] + -- and Note [Arity for recursive join bindings] + join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> trimArityType ty_arity (cheapArityType rhs) + ty_arity = typeArity (idType bndr) id_one_shots = idDemandOneShots bndr @@ -1076,6 +1101,117 @@ But /only/ for called-once demands. Suppose we had Now we don't want to eta-expand f1 to have 3 args; only two. Nor, in the case of f2, do we want to push that error call under a lambda. Hence the takeWhile in combineWithDemandDoneShots. + +Note [Do not eta-expand join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Similarly to CPR (see Note [Don't w/w join points for CPR] in +GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's +eta-expansion, and eta-expanding a join point is fraught with issues like how to +deal with a cast: + + let join $j1 :: IO () + $j1 = ... + $j2 :: Int -> IO () + $j2 n = if n > 0 then $j1 + else ... + + => + + let join $j1 :: IO () + $j1 = (\eta -> ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + $j2 :: Int -> IO () + $j2 n = (\eta -> if n > 0 then $j1 + else ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + +The cast here can't be pushed inside the lambda (since it's not casting to a +function type), so the lambda has to stay, but it can't because it contains a +reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather +than try and detect this situation (and whatever other situations crop up!), we +don't bother; again, any surrounding eta-expansion will improve these join +points anyway, since an outer cast can *always* be pushed inside. By the time +CorePrep comes around, the code is very likely to look more like this: + + let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) + $j1 = (...) eta + $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) + $j2 = if n > 0 then $j1 + else (...) eta + +Note [Arity for recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x = joinrec j 0 = \ a b c -> (a,x,b) + 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 + 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 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` (See Note [arityType for non-recursive let-bindings] + in GHC.Core.Opt.Arity)b + - 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 GHC.Core.Opt.Arity 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. + + +Note [Arity for non-recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Arity for recursive join bindings] deals with recursive join +bindings. But what about /non-recursive/ones? If we just call +findRhsArity, it 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.) -} ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -102,6 +102,14 @@ bindContextLevel :: BindContext -> TopLevelFlag bindContextLevel (BC_Let top_lvl _) = top_lvl bindContextLevel (BC_Join {}) = NotTopLevel +bindContextRec :: BindContext -> RecFlag +bindContextRec (BC_Let _ rec_flag) = rec_flag +bindContextRec (BC_Join rec_flag _) = rec_flag + +isJoinBC :: BindContext -> Bool +isJoinBC (BC_Let {}) = False +isJoinBC (BC_Join {}) = True + {- ********************************************************************* * * @@ -1776,39 +1784,26 @@ Wrinkles tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] --- 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 - = 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 - where - -- See Note [Arity for non-recursive join bindings] - -- and Note [Arity for recursive join bindings] - 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 - , new_arity > old_arity -- And the current manifest arity isn't enough +tryEtaExpandRhs env bind_cxt bndr rhs + | do_eta_expand -- If the current manifest arity isn't enough + -- (never true for join points) + , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs - = do { tick (EtaExpansion bndr) + = -- Do eta-expansion. + assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ + -- assert: this never happens for join points; see GHC.Core.Opt.Arity + -- Note [Do not eta-expand join points] + do { tick (EtaExpansion bndr) ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise = return (arity_type, rhs) + where in_scope = getInScope 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 + is_rec = bindContextRec bind_cxt + (do_eta_expand, arity_type) = findRhsArity arity_opts is_rec bndr rhs wantEtaExpansion :: CoreExpr -> Bool -- Mostly True; but False of PAPs which will immediately eta-reduce again @@ -1894,117 +1889,6 @@ But note that this won't eta-expand, say Does it matter not eta-expanding such functions? I'm not sure. Perhaps strictness analysis will have less to bite on? -Note [Do not eta-expand join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Similarly to CPR (see Note [Don't w/w join points for CPR] in -GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's -eta-expansion, and eta-expanding a join point is fraught with issues like how to -deal with a cast: - - let join $j1 :: IO () - $j1 = ... - $j2 :: Int -> IO () - $j2 n = if n > 0 then $j1 - else ... - - => - - let join $j1 :: IO () - $j1 = (\eta -> ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - $j2 :: Int -> IO () - $j2 n = (\eta -> if n > 0 then $j1 - else ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - -The cast here can't be pushed inside the lambda (since it's not casting to a -function type), so the lambda has to stay, but it can't because it contains a -reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather -than try and detect this situation (and whatever other situations crop up!), we -don't bother; again, any surrounding eta-expansion will improve these join -points anyway, since an outer cast can *always* be pushed inside. By the time -CorePrep comes around, the code is very likely to look more like this: - - let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) - $j1 = (...) eta - $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) - $j2 = if n > 0 then $j1 - else (...) eta - -Note [Arity for recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f x = joinrec j 0 = \ a b c -> (a,x,b) - 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 - 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 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` (See Note [arityType for non-recursive let-bindings] - in GHC.Core.Opt.Arity)b - - 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 GHC.Core.Opt.Arity 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. - - -Note [Arity for non-recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Note [Arity for recursive join bindings] deals with recursive join -bindings. But what about /non-recursive/ones? If we just call -findRhsArity, it 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.) - ************************************************************************ * * ===================================== testsuite/tests/simplCore/should_compile/T22114.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE TypeFamilies #-} + +module T22114 where + +import Data.Kind (Type) + +value :: [Int] -> () -> Maybe Bool +value = valu + where valu [0] = valuN + valu _ = \_ -> Nothing + +type family T :: Type where + T = () -> Maybe Bool + +valuN :: T +valuN = valuN ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -428,3 +428,4 @@ test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) +test('T22114', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47479bde7a2eb4150e51c3034cd2323c58d018ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47479bde7a2eb4150e51c3034cd2323c58d018ca You're receiving 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 31 07:53:34 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 03:53:34 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Fix typo in Any docs: stray "--" Message-ID: <630f137e710af_2f2e58487ec858549@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 1 changed file: - libraries/ghc-prim/GHC/Types.hs Changes: ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -143,7 +143,7 @@ data Symbol -- | The type constructor 'Any' is type to which you can unsafely coerce any -- lifted type, and back. More concretely, for a lifted type @t@ and --- value @x :: t@, -- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent +-- value @x :: t@, @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent -- to @x at . -- type family Any :: k where { } @@ -165,7 +165,7 @@ type family Any :: k where { } -- ==== __Examples__ -- -- Unless the OverloadedLists extension is enabled, list literals are --- syntatic sugar for repeated applications of @:@ and @[]@. +-- syntactic sugar for repeated applications of @:@ and @[]@. -- -- >>> 1:2:3:4:[] == [1,2,3,4] -- True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/451b1d90cf14e8fb3f12b1b65d8027717093556a...3a00263248e6176e06f03b7390fade48a9adb373 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/451b1d90cf14e8fb3f12b1b65d8027717093556a...3a00263248e6176e06f03b7390fade48a9adb373 You're receiving 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 31 07:54:08 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 03:54:08 -0400 Subject: [Git][ghc/ghc][master] Add a missing trimArityType Message-ID: <630f13a013206_2f2e58488008618da@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - 4 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - + testsuite/tests/simplCore/should_compile/T22114.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -873,24 +873,49 @@ exprEtaExpandArity opts e * * ********************************************************************* -} -findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr -> Arity -> SafeArityType +findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr + -> (Bool, SafeArityType) -- This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] --- If findRhsArity e = (n, is_bot) then --- (a) any application of e to (\x1..xn. e x1 .. xn) --- (b) if is_bot=True, then e applied to n args is guaranteed bottom -- --- Returns an ArityType that is guaranteed trimmed to typeArity of 'bndr' +-- The Bool is True if the returned arity is greater than (exprArity rhs) +-- so the caller should do eta-expansion +-- That Bool is never True for join points, which are never eta-expanded +-- +-- Returns an SafeArityType that is guaranteed trimmed to typeArity of 'bndr' -- See Note [Arity trimming] -findRhsArity opts is_rec bndr rhs old_arity - = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> step init_env + +findRhsArity opts is_rec bndr rhs + | isJoinId bndr + = (False, join_arity_type) + -- False: see 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 + = (arity_increased, non_join_arity_type) + -- arity_increased: eta-expand if we'll get more lambdas + -- to the top of the RHS where + old_arity = exprArity rhs + init_env :: ArityEnv init_env = findRhsArityEnv opts (isJoinId bndr) + -- Non-join-points only + non_join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> step init_env + arity_increased = arityTypeArity non_join_arity_type > old_arity + + -- Join-points only + -- See Note [Arity for non-recursive join bindings] + -- and Note [Arity for recursive join bindings] + join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> trimArityType ty_arity (cheapArityType rhs) + ty_arity = typeArity (idType bndr) id_one_shots = idDemandOneShots bndr @@ -1076,6 +1101,117 @@ But /only/ for called-once demands. Suppose we had Now we don't want to eta-expand f1 to have 3 args; only two. Nor, in the case of f2, do we want to push that error call under a lambda. Hence the takeWhile in combineWithDemandDoneShots. + +Note [Do not eta-expand join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Similarly to CPR (see Note [Don't w/w join points for CPR] in +GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's +eta-expansion, and eta-expanding a join point is fraught with issues like how to +deal with a cast: + + let join $j1 :: IO () + $j1 = ... + $j2 :: Int -> IO () + $j2 n = if n > 0 then $j1 + else ... + + => + + let join $j1 :: IO () + $j1 = (\eta -> ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + $j2 :: Int -> IO () + $j2 n = (\eta -> if n > 0 then $j1 + else ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + +The cast here can't be pushed inside the lambda (since it's not casting to a +function type), so the lambda has to stay, but it can't because it contains a +reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather +than try and detect this situation (and whatever other situations crop up!), we +don't bother; again, any surrounding eta-expansion will improve these join +points anyway, since an outer cast can *always* be pushed inside. By the time +CorePrep comes around, the code is very likely to look more like this: + + let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) + $j1 = (...) eta + $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) + $j2 = if n > 0 then $j1 + else (...) eta + +Note [Arity for recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x = joinrec j 0 = \ a b c -> (a,x,b) + 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 + 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 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` (See Note [arityType for non-recursive let-bindings] + in GHC.Core.Opt.Arity)b + - 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 GHC.Core.Opt.Arity 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. + + +Note [Arity for non-recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Arity for recursive join bindings] deals with recursive join +bindings. But what about /non-recursive/ones? If we just call +findRhsArity, it 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.) -} ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -102,6 +102,14 @@ bindContextLevel :: BindContext -> TopLevelFlag bindContextLevel (BC_Let top_lvl _) = top_lvl bindContextLevel (BC_Join {}) = NotTopLevel +bindContextRec :: BindContext -> RecFlag +bindContextRec (BC_Let _ rec_flag) = rec_flag +bindContextRec (BC_Join rec_flag _) = rec_flag + +isJoinBC :: BindContext -> Bool +isJoinBC (BC_Let {}) = False +isJoinBC (BC_Join {}) = True + {- ********************************************************************* * * @@ -1776,39 +1784,26 @@ Wrinkles tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] --- 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 - = 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 - where - -- See Note [Arity for non-recursive join bindings] - -- and Note [Arity for recursive join bindings] - 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 - , new_arity > old_arity -- And the current manifest arity isn't enough +tryEtaExpandRhs env bind_cxt bndr rhs + | do_eta_expand -- If the current manifest arity isn't enough + -- (never true for join points) + , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs - = do { tick (EtaExpansion bndr) + = -- Do eta-expansion. + assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ + -- assert: this never happens for join points; see GHC.Core.Opt.Arity + -- Note [Do not eta-expand join points] + do { tick (EtaExpansion bndr) ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise = return (arity_type, rhs) + where in_scope = getInScope 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 + is_rec = bindContextRec bind_cxt + (do_eta_expand, arity_type) = findRhsArity arity_opts is_rec bndr rhs wantEtaExpansion :: CoreExpr -> Bool -- Mostly True; but False of PAPs which will immediately eta-reduce again @@ -1894,117 +1889,6 @@ But note that this won't eta-expand, say Does it matter not eta-expanding such functions? I'm not sure. Perhaps strictness analysis will have less to bite on? -Note [Do not eta-expand join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Similarly to CPR (see Note [Don't w/w join points for CPR] in -GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's -eta-expansion, and eta-expanding a join point is fraught with issues like how to -deal with a cast: - - let join $j1 :: IO () - $j1 = ... - $j2 :: Int -> IO () - $j2 n = if n > 0 then $j1 - else ... - - => - - let join $j1 :: IO () - $j1 = (\eta -> ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - $j2 :: Int -> IO () - $j2 n = (\eta -> if n > 0 then $j1 - else ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - -The cast here can't be pushed inside the lambda (since it's not casting to a -function type), so the lambda has to stay, but it can't because it contains a -reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather -than try and detect this situation (and whatever other situations crop up!), we -don't bother; again, any surrounding eta-expansion will improve these join -points anyway, since an outer cast can *always* be pushed inside. By the time -CorePrep comes around, the code is very likely to look more like this: - - let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) - $j1 = (...) eta - $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) - $j2 = if n > 0 then $j1 - else (...) eta - -Note [Arity for recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f x = joinrec j 0 = \ a b c -> (a,x,b) - 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 - 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 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` (See Note [arityType for non-recursive let-bindings] - in GHC.Core.Opt.Arity)b - - 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 GHC.Core.Opt.Arity 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. - - -Note [Arity for non-recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Note [Arity for recursive join bindings] deals with recursive join -bindings. But what about /non-recursive/ones? If we just call -findRhsArity, it 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.) - ************************************************************************ * * ===================================== testsuite/tests/simplCore/should_compile/T22114.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE TypeFamilies #-} + +module T22114 where + +import Data.Kind (Type) + +value :: [Int] -> () -> Maybe Bool +value = valu + where valu [0] = valuN + valu _ = \_ -> Nothing + +type family T :: Type where + T = () -> Maybe Bool + +valuN :: T +valuN = valuN ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -428,3 +428,4 @@ test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) +test('T22114', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f490b1333c17ed27b213d6af8c7275aa9b3de63 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f490b1333c17ed27b213d6af8c7275aa9b3de63 You're receiving 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 31 09:58:37 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 31 Aug 2022 05:58:37 -0400 Subject: [Git][ghc/ghc][wip/T22096] 2 commits: Refine in-tree compiler args for --test-compiler=stage1 Message-ID: <630f30cd231db_2f2e5848800875975@gitlab.mail> Matthew Pickering pushed to branch wip/T22096 at Glasgow Haskell Compiler / GHC Commits: 07ec1cc6 by Matthew Pickering at 2022-08-31T09:13:43+01:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 550128f5 by Matthew Pickering at 2022-08-31T10:57:26+01:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 8 changed files: - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs - libraries/unix Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -241,7 +241,10 @@ enableLateCCS = addArgs -- | Enable assertions for the stage2 compiler enableAssertions :: Flavour -> Flavour -enableAssertions flav = flav { ghcDebugAssertions = True } +enableAssertions flav = flav { ghcDebugAssertions = f } + where + f Stage2 = True + f st = ghcDebugAssertions flav st -- | Produce fully statically-linked executables and build libraries suitable -- for static linking. ===================================== hadrian/src/Flavour/Type.hs ===================================== @@ -35,7 +35,7 @@ data Flavour = Flavour { -- | Build GHC with the debug RTS. ghcDebugged :: Stage -> Bool, -- | Build GHC with debug assertions. - ghcDebugAssertions :: Bool, + ghcDebugAssertions :: Stage -> Bool, -- | Build the GHC executable against the threaded runtime system. ghcThreaded :: Stage -> Bool, -- | Whether to build docs and which ones ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -17,6 +17,8 @@ import qualified Data.Set as Set import Flavour import qualified Context.Type as C import System.Directory (findExecutable) +import Settings.Program +import qualified Context.Type getTestSetting :: TestSetting -> Action String getTestSetting key = testSetting key @@ -91,16 +93,14 @@ inTreeCompilerArgs stg = do return (dynamic `elem` ways, threaded `elem` ways) -- MP: We should be able to vary if stage1/stage2 is dynamic, ie a dynamic stage1 -- should be able to built a static stage2? - hasDynamic <- flavour >>= dynamicGhcPrograms + hasDynamic <- (dynamic ==) . Context.Type.way <$> (programContext stg ghc) -- LeadingUnderscore is a property of the system so if cross-compiling stage1/stage2 could -- have different values? Currently not possible to express. leadingUnderscore <- flag LeadingUnderscore - -- MP: This setting seems to only dictate whether we turn on optasm as a compiler - -- way, but a lot of tests which use only_ways(optasm) seem to not test the NCG? withInterpreter <- ghcWithInterpreter unregisterised <- flag GhcUnregisterised withSMP <- targetSupportsSMP - debugAssertions <- ghcDebugAssertions <$> flavour + debugAssertions <- ($ stg) . ghcDebugAssertions <$> flavour profiled <- ghcProfiled <$> flavour <*> pure stg os <- setting HostOs ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -240,7 +240,7 @@ defaultFlavour = Flavour , ghcProfiled = const False , ghcDebugged = const False , ghcThreaded = const True - , ghcDebugAssertions = False + , ghcDebugAssertions = const False , ghcDocs = cmdDocsArgs } -- | Default logic for determining whether to build ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug] , dynamicGhcPrograms = return False - , ghcDebugAssertions = True } + , ghcDebugAssertions = (>= Stage2) } where stageString Stage2 = "2" stageString Stage1 = "1" ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] ] + , ghcDebugAssertions = (<= Stage1) } validateArgs :: Args @@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs , notStage0 ? arg "-dno-debug-output" ] , hsLibrary = pure ["-O"] - , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"] + , hsCompiler = mconcat [ stage0 ? pure ["-O2"] , notStage0 ? pure ["-O" ] ] , hsGhc = pure ["-O"] } + slowValidateFlavour :: Flavour slowValidateFlavour = validateFlavour { name = "slow-validate" - , ghcDebugAssertions = True + , ghcDebugAssertions = const True } quickValidateArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -52,7 +52,7 @@ packageArgs = do [ builder Alex ? arg "--latin1" , builder (Ghc CompileHs) ? mconcat - [ debugAssertions ? notStage0 ? arg "-DDEBUG" + [ debugAssertions stage ? arg "-DDEBUG" , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto" , input "**/Parser.hs" ? @@ -83,7 +83,7 @@ packageArgs = do , package ghc ? mconcat [ builder Ghc ? mconcat [ arg ("-I" ++ compilerPath) - , debugAssertions ? notStage0 ? arg "-DDEBUG" ] + , debugAssertions stage ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit 2a6079a2b76adf29d3e3ff213dffe66cabcb76c3 +Subproject commit 23edd4537e9051824a5683b324e6fb8abed5d6b3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4f449c3b9b67fe5b4a0aa00f879f537cb2e8131...550128f5aaeed9992241978d7eaeffe859feebdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4f449c3b9b67fe5b4a0aa00f879f537cb2e8131...550128f5aaeed9992241978d7eaeffe859feebdb You're receiving 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 31 10:02:06 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 31 Aug 2022 06:02:06 -0400 Subject: [Git][ghc/ghc][wip/T22096] Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) Message-ID: <630f319e75802_2f2e584909f1c876417@gitlab.mail> Matthew Pickering pushed to branch wip/T22096 at Glasgow Haskell Compiler / GHC Commits: e210b504 by Matthew Pickering at 2022-08-31T11:01:59+01:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 7 changed files: - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -241,7 +241,10 @@ enableLateCCS = addArgs -- | Enable assertions for the stage2 compiler enableAssertions :: Flavour -> Flavour -enableAssertions flav = flav { ghcDebugAssertions = True } +enableAssertions flav = flav { ghcDebugAssertions = f } + where + f Stage2 = True + f st = ghcDebugAssertions flav st -- | Produce fully statically-linked executables and build libraries suitable -- for static linking. ===================================== hadrian/src/Flavour/Type.hs ===================================== @@ -35,7 +35,7 @@ data Flavour = Flavour { -- | Build GHC with the debug RTS. ghcDebugged :: Stage -> Bool, -- | Build GHC with debug assertions. - ghcDebugAssertions :: Bool, + ghcDebugAssertions :: Stage -> Bool, -- | Build the GHC executable against the threaded runtime system. ghcThreaded :: Stage -> Bool, -- | Whether to build docs and which ones ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -100,9 +100,7 @@ inTreeCompilerArgs stg = do withInterpreter <- ghcWithInterpreter unregisterised <- flag GhcUnregisterised withSMP <- targetSupportsSMP - debugAssertions <- if stg >= Stage2 - then ghcDebugAssertions <$> flavour - else return False + debugAssertions <- ($ stg) . ghcDebugAssertions <$> flavour profiled <- ghcProfiled <$> flavour <*> pure stg os <- setting HostOs ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -240,7 +240,7 @@ defaultFlavour = Flavour , ghcProfiled = const False , ghcDebugged = const False , ghcThreaded = const True - , ghcDebugAssertions = False + , ghcDebugAssertions = const False , ghcDocs = cmdDocsArgs } -- | Default logic for determining whether to build ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug] , dynamicGhcPrograms = return False - , ghcDebugAssertions = True } + , ghcDebugAssertions = (>= Stage2) } where stageString Stage2 = "2" stageString Stage1 = "1" ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] ] + , ghcDebugAssertions = (<= Stage1) } validateArgs :: Args @@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs , notStage0 ? arg "-dno-debug-output" ] , hsLibrary = pure ["-O"] - , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"] + , hsCompiler = mconcat [ stage0 ? pure ["-O2"] , notStage0 ? pure ["-O" ] ] , hsGhc = pure ["-O"] } + slowValidateFlavour :: Flavour slowValidateFlavour = validateFlavour { name = "slow-validate" - , ghcDebugAssertions = True + , ghcDebugAssertions = const True } quickValidateArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -52,7 +52,7 @@ packageArgs = do [ builder Alex ? arg "--latin1" , builder (Ghc CompileHs) ? mconcat - [ debugAssertions ? notStage0 ? arg "-DDEBUG" + [ debugAssertions stage ? arg "-DDEBUG" , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto" , input "**/Parser.hs" ? @@ -83,7 +83,7 @@ packageArgs = do , package ghc ? mconcat [ builder Ghc ? mconcat [ arg ("-I" ++ compilerPath) - , debugAssertions ? notStage0 ? arg "-DDEBUG" ] + , debugAssertions stage ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e210b504a10813407be6d551da3c78c893e8b68c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e210b504a10813407be6d551da3c78c893e8b68c You're receiving 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 31 12:13:45 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 31 Aug 2022 08:13:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-9.0-boostrap Message-ID: <630f50793be9f_2f2e58a70ea68902728@gitlab.mail> Matthew Pickering pushed new branch wip/fix-9.0-boostrap at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-9.0-boostrap You're receiving 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 31 12:28:06 2022 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 31 Aug 2022 08:28:06 -0400 Subject: [Git][ghc/ghc][wip/9.4-foward-fixed-make] 81 commits: typo Message-ID: <630f53d640400_2f2e5816becc6891108b@gitlab.mail> Matthew Pickering pushed to branch wip/9.4-foward-fixed-make 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. - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/upload_ghc_libs.py - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55930757f2071c1315c8a1d7e9ae1a4804416110...f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55930757f2071c1315c8a1d7e9ae1a4804416110...f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02 You're receiving 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 31 14:31:20 2022 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 31 Aug 2022 10:31:20 -0400 Subject: [Git][ghc/ghc][wip/js-staging] stopgap fix for missing ghc-pkg in cross-compiler tests Message-ID: <630f70b8e9e49_2f2e58d8b79349265a5@gitlab.mail> Josh Meredith pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 67f65dae by Josh Meredith at 2022-08-31T14:31:03+00:00 stopgap fix for missing ghc-pkg in cross-compiler tests - - - - - 1 changed file: - testsuite/mk/boilerplate.mk Changes: ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -150,7 +150,17 @@ BIN_ROOT = $(shell dirname '$(TEST_HC)') ifeq "$(IMPLICIT_COMPILER)" "YES" find_tool = $(shell which $(1)) else -find_tool = $(BIN_ROOT)/$(1) +find_tool = $(BIN_ROOT)/$(PLATFORM_PREFIX)$(1) +endif + +ifeq "$(IMPLICIT_COMPILER)" "YES" +find_other_tool = $(shell which $(1)) +else + ifeq "$(TOOL_ROOT)" "" + find_other_tool = $(BIN_ROOT)/$(PLATFORM_PREFIX)$(1) + else + find_other_tool = $(TOOL_ROOT)/$(PLATFORM_PREFIX)$(1) + endif endif ifeq "$(GHC_PKG)" "" @@ -158,11 +168,11 @@ GHC_PKG := $(call find_tool,ghc-pkg) endif ifeq "$(RUNGHC)" "" -RUNGHC := $(call find_tool,runghc) +RUNGHC := $(call find_other_tool,runghc) endif ifeq "$(HADDOCK)" "" -HADDOCK := $(call find_tool,haddock) +HADDOCK := $(call find_other_tool,haddock) endif ifeq "$(HSC2HS)" "" @@ -174,7 +184,7 @@ HP2PS_ABS := $(call find_tool,hp2ps) endif ifeq "$(HPC)" "" -HPC := $(call find_tool,hpc) +HPC := $(call find_other_tool,hpc) endif $(eval $(call canonicaliseExecutable,TEST_HC)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67f65daedfb649538dd133e85a898a27c07d33b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67f65daedfb649538dd133e85a898a27c07d33b4 You're receiving 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 31 15:27:41 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 11:27:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: Add a missing trimArityType Message-ID: <630f7ded98afc_2f2e58d8b7934931710@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - 3aa28dca by Matthew Pickering at 2022-08-31T11:27:04-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 7f8a363d by Matthew Pickering at 2022-08-31T11:27:04-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 29 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/ghc.cabal.in - config.guess - config.sub - docs/users_guide/packages.rst - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs - libraries/Cabal - libraries/binary - libraries/bytestring - libraries/containers - libraries/deepseq - libraries/directory - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-prim/changelog.md - libraries/ghc-prim/ghc-prim.cabal - libraries/process - libraries/stm - libraries/text - testsuite/tests/driver/T4437.hs - testsuite/tests/package/T4806a.stderr - + testsuite/tests/simplCore/should_compile/T22114.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -873,24 +873,49 @@ exprEtaExpandArity opts e * * ********************************************************************* -} -findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr -> Arity -> SafeArityType +findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr + -> (Bool, SafeArityType) -- This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] --- If findRhsArity e = (n, is_bot) then --- (a) any application of e to (\x1..xn. e x1 .. xn) --- (b) if is_bot=True, then e applied to n args is guaranteed bottom -- --- Returns an ArityType that is guaranteed trimmed to typeArity of 'bndr' +-- The Bool is True if the returned arity is greater than (exprArity rhs) +-- so the caller should do eta-expansion +-- That Bool is never True for join points, which are never eta-expanded +-- +-- Returns an SafeArityType that is guaranteed trimmed to typeArity of 'bndr' -- See Note [Arity trimming] -findRhsArity opts is_rec bndr rhs old_arity - = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> step init_env + +findRhsArity opts is_rec bndr rhs + | isJoinId bndr + = (False, join_arity_type) + -- False: see 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 + = (arity_increased, non_join_arity_type) + -- arity_increased: eta-expand if we'll get more lambdas + -- to the top of the RHS where + old_arity = exprArity rhs + init_env :: ArityEnv init_env = findRhsArityEnv opts (isJoinId bndr) + -- Non-join-points only + non_join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> step init_env + arity_increased = arityTypeArity non_join_arity_type > old_arity + + -- Join-points only + -- See Note [Arity for non-recursive join bindings] + -- and Note [Arity for recursive join bindings] + join_arity_type = case is_rec of + Recursive -> go 0 botArityType + NonRecursive -> trimArityType ty_arity (cheapArityType rhs) + ty_arity = typeArity (idType bndr) id_one_shots = idDemandOneShots bndr @@ -1076,6 +1101,117 @@ But /only/ for called-once demands. Suppose we had Now we don't want to eta-expand f1 to have 3 args; only two. Nor, in the case of f2, do we want to push that error call under a lambda. Hence the takeWhile in combineWithDemandDoneShots. + +Note [Do not eta-expand join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Similarly to CPR (see Note [Don't w/w join points for CPR] in +GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's +eta-expansion, and eta-expanding a join point is fraught with issues like how to +deal with a cast: + + let join $j1 :: IO () + $j1 = ... + $j2 :: Int -> IO () + $j2 n = if n > 0 then $j1 + else ... + + => + + let join $j1 :: IO () + $j1 = (\eta -> ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + $j2 :: Int -> IO () + $j2 n = (\eta -> if n > 0 then $j1 + else ...) + `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) + ~ IO () + +The cast here can't be pushed inside the lambda (since it's not casting to a +function type), so the lambda has to stay, but it can't because it contains a +reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather +than try and detect this situation (and whatever other situations crop up!), we +don't bother; again, any surrounding eta-expansion will improve these join +points anyway, since an outer cast can *always* be pushed inside. By the time +CorePrep comes around, the code is very likely to look more like this: + + let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) + $j1 = (...) eta + $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) + $j2 = if n > 0 then $j1 + else (...) eta + +Note [Arity for recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x = joinrec j 0 = \ a b c -> (a,x,b) + 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 + 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 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` (See Note [arityType for non-recursive let-bindings] + in GHC.Core.Opt.Arity)b + - 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 GHC.Core.Opt.Arity 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. + + +Note [Arity for non-recursive join bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Arity for recursive join bindings] deals with recursive join +bindings. But what about /non-recursive/ones? If we just call +findRhsArity, it 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.) -} ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -102,6 +102,14 @@ bindContextLevel :: BindContext -> TopLevelFlag bindContextLevel (BC_Let top_lvl _) = top_lvl bindContextLevel (BC_Join {}) = NotTopLevel +bindContextRec :: BindContext -> RecFlag +bindContextRec (BC_Let _ rec_flag) = rec_flag +bindContextRec (BC_Join rec_flag _) = rec_flag + +isJoinBC :: BindContext -> Bool +isJoinBC (BC_Let {}) = False +isJoinBC (BC_Join {}) = True + {- ********************************************************************* * * @@ -1776,39 +1784,26 @@ Wrinkles tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] --- 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 - = 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 - where - -- See Note [Arity for non-recursive join bindings] - -- and Note [Arity for recursive join bindings] - 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 - , new_arity > old_arity -- And the current manifest arity isn't enough +tryEtaExpandRhs env bind_cxt bndr rhs + | do_eta_expand -- If the current manifest arity isn't enough + -- (never true for join points) + , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs - = do { tick (EtaExpansion bndr) + = -- Do eta-expansion. + assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ + -- assert: this never happens for join points; see GHC.Core.Opt.Arity + -- Note [Do not eta-expand join points] + do { tick (EtaExpansion bndr) ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise = return (arity_type, rhs) + where in_scope = getInScope 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 + is_rec = bindContextRec bind_cxt + (do_eta_expand, arity_type) = findRhsArity arity_opts is_rec bndr rhs wantEtaExpansion :: CoreExpr -> Bool -- Mostly True; but False of PAPs which will immediately eta-reduce again @@ -1894,117 +1889,6 @@ But note that this won't eta-expand, say Does it matter not eta-expanding such functions? I'm not sure. Perhaps strictness analysis will have less to bite on? -Note [Do not eta-expand join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Similarly to CPR (see Note [Don't w/w join points for CPR] in -GHC.Core.Opt.WorkWrap), a join point stands well to gain from its outer binding's -eta-expansion, and eta-expanding a join point is fraught with issues like how to -deal with a cast: - - let join $j1 :: IO () - $j1 = ... - $j2 :: Int -> IO () - $j2 n = if n > 0 then $j1 - else ... - - => - - let join $j1 :: IO () - $j1 = (\eta -> ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - $j2 :: Int -> IO () - $j2 n = (\eta -> if n > 0 then $j1 - else ...) - `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ()) - ~ IO () - -The cast here can't be pushed inside the lambda (since it's not casting to a -function type), so the lambda has to stay, but it can't because it contains a -reference to a join point. In fact, $j2 can't be eta-expanded at all. Rather -than try and detect this situation (and whatever other situations crop up!), we -don't bother; again, any surrounding eta-expansion will improve these join -points anyway, since an outer cast can *always* be pushed inside. By the time -CorePrep comes around, the code is very likely to look more like this: - - let join $j1 :: State# RealWorld -> (# State# RealWorld, ()) - $j1 = (...) eta - $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ()) - $j2 = if n > 0 then $j1 - else (...) eta - -Note [Arity for recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f x = joinrec j 0 = \ a b c -> (a,x,b) - 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 - 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 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` (See Note [arityType for non-recursive let-bindings] - in GHC.Core.Opt.Arity)b - - 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 GHC.Core.Opt.Arity 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. - - -Note [Arity for non-recursive join bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Note [Arity for recursive join bindings] deals with recursive join -bindings. But what about /non-recursive/ones? If we just call -findRhsArity, it 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.) - ************************************************************************ * * ===================================== 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*) ;; -*) ===================================== docs/users_guide/packages.rst ===================================== @@ -1449,3 +1449,23 @@ The allowed fields, with their types, are: HTML for this package. .. [1] it used to in GHC 6.4, but not since 6.6 + + +.. _system-cxx-std-lib: + +Linking against C++ libraries +----------------------------- + +.. index:: + single: system-cxx-std-lib + single: packages; system-cxx-std-lib + single: C++; linking + +Use of C++ libraries requires that the user link against the host +system's C++ standard library. As the configuration necessary to +achieve this is generally quite platform-dependent, GHC provides a +built-in package, ``system-cxx-std-lib``. This package captures the +configuration necessary for linking against the C++ standard library +and can be used via the :ghc-flag:`-package ⟨pkg⟩` flag or the Cabal +``build-depends`` field to link code against the C++ standard +library. ===================================== hadrian/src/Flavour.hs ===================================== @@ -241,7 +241,10 @@ enableLateCCS = addArgs -- | Enable assertions for the stage2 compiler enableAssertions :: Flavour -> Flavour -enableAssertions flav = flav { ghcDebugAssertions = True } +enableAssertions flav = flav { ghcDebugAssertions = f } + where + f Stage2 = True + f st = ghcDebugAssertions flav st -- | Produce fully statically-linked executables and build libraries suitable -- for static linking. ===================================== hadrian/src/Flavour/Type.hs ===================================== @@ -35,7 +35,7 @@ data Flavour = Flavour { -- | Build GHC with the debug RTS. ghcDebugged :: Stage -> Bool, -- | Build GHC with debug assertions. - ghcDebugAssertions :: Bool, + ghcDebugAssertions :: Stage -> Bool, -- | Build the GHC executable against the threaded runtime system. ghcThreaded :: Stage -> Bool, -- | Whether to build docs and which ones ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -17,6 +17,8 @@ import qualified Data.Set as Set import Flavour import qualified Context.Type as C import System.Directory (findExecutable) +import Settings.Program +import qualified Context.Type getTestSetting :: TestSetting -> Action String getTestSetting key = testSetting key @@ -91,16 +93,14 @@ inTreeCompilerArgs stg = do return (dynamic `elem` ways, threaded `elem` ways) -- MP: We should be able to vary if stage1/stage2 is dynamic, ie a dynamic stage1 -- should be able to built a static stage2? - hasDynamic <- flavour >>= dynamicGhcPrograms + hasDynamic <- (dynamic ==) . Context.Type.way <$> (programContext stg ghc) -- LeadingUnderscore is a property of the system so if cross-compiling stage1/stage2 could -- have different values? Currently not possible to express. leadingUnderscore <- flag LeadingUnderscore - -- MP: This setting seems to only dictate whether we turn on optasm as a compiler - -- way, but a lot of tests which use only_ways(optasm) seem to not test the NCG? withInterpreter <- ghcWithInterpreter unregisterised <- flag GhcUnregisterised withSMP <- targetSupportsSMP - debugAssertions <- ghcDebugAssertions <$> flavour + debugAssertions <- ($ stg) . ghcDebugAssertions <$> flavour profiled <- ghcProfiled <$> flavour <*> pure stg os <- setting HostOs ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -240,7 +240,7 @@ defaultFlavour = Flavour , ghcProfiled = const False , ghcDebugged = const False , ghcThreaded = const True - , ghcDebugAssertions = False + , ghcDebugAssertions = const False , ghcDocs = cmdDocsArgs } -- | Default logic for determining whether to build ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug] , dynamicGhcPrograms = return False - , ghcDebugAssertions = True } + , ghcDebugAssertions = (>= Stage2) } where stageString Stage2 = "2" stageString Stage1 = "1" ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] ] + , ghcDebugAssertions = (<= Stage1) } validateArgs :: Args @@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs , notStage0 ? arg "-dno-debug-output" ] , hsLibrary = pure ["-O"] - , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"] + , hsCompiler = mconcat [ stage0 ? pure ["-O2"] , notStage0 ? pure ["-O" ] ] , hsGhc = pure ["-O"] } + slowValidateFlavour :: Flavour slowValidateFlavour = validateFlavour { name = "slow-validate" - , ghcDebugAssertions = True + , ghcDebugAssertions = const True } quickValidateArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -52,7 +52,7 @@ packageArgs = do [ builder Alex ? arg "--latin1" , builder (Ghc CompileHs) ? mconcat - [ debugAssertions ? notStage0 ? arg "-DDEBUG" + [ debugAssertions stage ? arg "-DDEBUG" , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto" , input "**/Parser.hs" ? @@ -83,7 +83,7 @@ packageArgs = do , package ghc ? mconcat [ builder Ghc ? mconcat [ arg ("-I" ++ compilerPath) - , debugAssertions ? notStage0 ? arg "-DDEBUG" ] + , debugAssertions stage ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 18d801832a3ad5f346eeaaf3f8f3df1abd5a6b9d +Subproject commit 5d18b763356dca719f5286a52328cb41b9fa4192 ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 6af054b4431fa7c20bf6309536cfef7d47f2c17f +Subproject commit 96599519783a5e02e9f050744a7ce5fb0940dc99 ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit acfe93480a15ecd373a5de5e423b1460749e52e1 +Subproject commit 1543e054a314865d89a259065921d5acba03d966 ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 5c1ce92782d89ecc44913834069c7b362b217191 +Subproject commit 50175b72dc781f82a419bddafba1bdd758fbee4b ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit f241315f4cc905076d5c988c27c7db9fbde8bbe7 +Subproject commit 38ab699cd5e08a85fdc9ac27f1612ce130e98a5a ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 4556d3cb689b8ef7c0f433de3c957559613e3429 +Subproject commit b33c1087d746389a687be42aa1fb73c12e3885d3 ===================================== 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 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 +Subproject commit 2ac3ff366631a36d84101000045abbefa4415b15 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit d4da9d83d1eab562460aa89cedac61abc884d93e +Subproject commit f4eb5a85c2732f8f5a03ef8af88d6aff90945415 ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit 0fcf98843b7f03dd6741cfc730a55ad65748bea9 +Subproject commit fdb06ff327519f3c0fc6cc9997b7cb7fe8ab8178 ===================================== 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] ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -1,7 +1,7 @@ T4806a.hs:1:1: error: Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.0.1’ + It is a member of the package ‘containers-0.6.6’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: - deepseq-1.4.8.0 + deepseq-1.4.8.0 template-haskell-2.19.0.0 Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/simplCore/should_compile/T22114.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE TypeFamilies #-} + +module T22114 where + +import Data.Kind (Type) + +value :: [Int] -> () -> Maybe Bool +value = valu + where valu [0] = valuN + valu _ = \_ -> Nothing + +type family T :: Type where + T = () -> Maybe Bool + +valuN :: T +valuN = valuN ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -428,3 +428,4 @@ test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) +test('T22114', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47479bde7a2eb4150e51c3034cd2323c58d018ca...7f8a363df8c36067850f0f4f0772745a9dff8cef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47479bde7a2eb4150e51c3034cd2323c58d018ca...7f8a363df8c36067850f0f4f0772745a9dff8cef You're receiving 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 31 15:54:13 2022 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 31 Aug 2022 11:54:13 -0400 Subject: [Git][ghc/ghc][wip/T22039] DmdAnal: Don't panic in addCaseBndrDmd (#22039) Message-ID: <630f8425b7a9a_2f2e58a70ea68942978@gitlab.mail> Sebastian Graf pushed to branch wip/T22039 at Glasgow Haskell Compiler / GHC Commits: 4aba9b09 by Sebastian Graf at 2022-08-31T17:53:14+02:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 3 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - + testsuite/tests/stranal/should_compile/T22039.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -455,8 +455,9 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt_con bndrs rhs]) !(!bndrs', !scrut_sd) | DataAlt _ <- alt_con -- See Note [Demand on the scrutinee of a product case] + , let !scrut_sd = scrutSubDmd case_bndr_sd fld_dmds -- See Note [Demand on case-alternative binders] - , (!scrut_sd, fld_dmds') <- addCaseBndrDmd case_bndr_sd fld_dmds + , let !fld_dmds' = fieldBndrDmds scrut_sd (length fld_dmds) , let !bndrs' = setBndrsDemandInfo bndrs fld_dmds' = (bndrs', scrut_sd) | otherwise @@ -560,7 +561,6 @@ forcesRealWorld fam_envs ty = False dmdAnalSumAlts :: AnalEnv -> SubDemand -> Id -> [CoreAlt] -> WithDmdType [CoreAlt] - dmdAnalSumAlts _ _ _ [] = WithDmdType botDmdType [] -- Base case is botDmdType, for empty case alternatives -- This is a unit for lubDmdType, and the right result @@ -580,28 +580,29 @@ dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs) -- See Note [Demand on case-alternative binders] -- we can't use the scrut_sd, because it says 'Prod' and we'll use -- topSubDmd anyway for scrutinees of sum types. - (!_scrut_sd, dmds') = addCaseBndrDmd case_bndr_sd dmds + scrut_sd = scrutSubDmd case_bndr_sd dmds + dmds' = fieldBndrDmds scrut_sd (length dmds) -- Do not put a thunk into the Alt !new_ids = setBndrsDemandInfo bndrs dmds' = -- pprTrace "dmdAnalSumAlt" (ppr con $$ ppr case_bndr $$ ppr dmd $$ ppr alt_ty) $ WithDmdType alt_ty (Alt con new_ids rhs') --- Precondition: The SubDemand is not a Call -- See Note [Demand on the scrutinee of a product case] --- and Note [Demand on case-alternative binders] -addCaseBndrDmd :: SubDemand -- On the case binder - -> [Demand] -- On the fields of the constructor - -> (SubDemand, [Demand]) - -- SubDemand on the case binder incl. field demands - -- and final demands for the components of the constructor -addCaseBndrDmd case_sd fld_dmds - | Just (_, ds) <- viewProd (length fld_dmds) scrut_sd - -- , pprTrace "addCaseBndrDmd" (ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) True - = (scrut_sd, ds) - | otherwise - = pprPanic "was a call demand" (ppr case_sd $$ ppr fld_dmds) -- See the Precondition - where - scrut_sd = case_sd `plusSubDmd` mkProd Unboxed fld_dmds +scrutSubDmd :: SubDemand -> [Demand] -> SubDemand +scrutSubDmd case_sd fld_dmds = + -- pprTraceWith "scrutSubDmd" (\scrut_sd -> ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) $ + case_sd `plusSubDmd` mkProd Unboxed fld_dmds + +-- See Note [Demand on case-alternative binders] +fieldBndrDmds :: SubDemand -- on the scrutinee + -> Arity + -> [Demand] -- Final demands for the components of the DataCon +fieldBndrDmds scrut_sd n_flds = + case viewProd n_flds scrut_sd of + Just (_, ds) -> ds + Nothing -> replicate n_flds topDmd + -- Either an arity mismatch or scrut_sd was a call demand. + -- See Note [Untyped demand on case-alternative binders] {- Note [Anticipating ANF in demand analysis] @@ -830,6 +831,40 @@ thunk for a let binder that was an an absent case-alt binder during DmdAnal. This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. +Note [Untyped demand on case-alternative binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder +may be a call demand or have a different number of fields than the constructor +of the case alternative it is used in. From T22039: + + blarg :: (Int, Int) -> Int + blarg (x,y) = x+y + -- blarg :: <1!P(1L,1L)> + + f :: Either Int Int -> Int + f Left{} = 0 + f e = blarg (unsafeCoerce e) + ==> { desugars to } + f = \ (ds_d1nV :: Either Int Int) -> + case ds_d1nV of wild_X1 { + Left ds_d1oV -> lvl_s1Q6; + Right ipv_s1Pl -> + blarg + (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of + { UnsafeRefl co_a1oT -> + wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int)) + }) + } + +The case binder `e`/`wild_X1` has demand 1!P(1L,1L), with two fields, from the call +to `blarg`, but `Right` only has one field. Although the code will crash when +executed, we must be able to analyse it in 'fieldBndrDmds' and conservatively +approximate with Top instead of panicking because of the mismatch. +In #22039, this kind of code was guarded behind a safe `cast` and thus dead +code, but nevertheless led to a panic of the compiler. + +See also Note [mkWWstr and unsafeCoerce] for a related issue. + Note [Aggregated demand for cardinality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FIXME: This Note should be named [LetUp vs. LetDown] and probably predates ===================================== testsuite/tests/stranal/should_compile/T22039.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Bug where + +import Control.Exception +import Data.Typeable +import Unsafe.Coerce + +data Error + = Error Int String + | forall e . Exception e => SomeError Int e + deriving (Typeable) + +fromError :: Exception e => Error -> Maybe e +fromError e@(Error _ _) = cast e +fromError (SomeError _ e) = cast e +-- {-# NOINLINE fromError #-} + +instance Eq Error where + Error i s == Error i' s' = i == i' && s == s' + SomeError i e == SomeError i' e' = i == i' && show e == show e' + _ == _ = False + +instance Show Error where + show _ = "" + +instance Exception Error + +-- newtype +data + UniquenessError = UniquenessError [((String, String), Int)] + deriving (Show, Eq) + +instance Exception UniquenessError + +test :: SomeException -> IO () +test e = case fromError =<< fromException e :: Maybe UniquenessError of + Just err -> print err + _ -> pure () + +-- +-- Smaller reproducer by sgraf +-- + +blarg :: (Int,Int) -> Int +blarg (x,y) = x+y +{-# NOINLINE blarg #-} + +f :: Either Int Int -> Int +f Left{} = 0 +f e = blarg (unsafeCoerce e) + +blurg :: (Int -> Int) -> Int +blurg f = f 42 +{-# NOINLINE blurg #-} + +g :: Either Int Int -> Int +g Left{} = 0 +g e = blurg (unsafeCoerce e) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -85,3 +85,4 @@ test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) test('T21265', normal, compile, ['']) test('EtaExpansion', normal, compile, ['']) +test('T22039', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4aba9b09752dd1ff188548cddd3c5631a9354d7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4aba9b09752dd1ff188548cddd3c5631a9354d7c You're receiving 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 31 16:03:10 2022 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 31 Aug 2022 12:03:10 -0400 Subject: [Git][ghc/ghc][wip/T22039] DmdAnal: Don't panic in addCaseBndrDmd (#22039) Message-ID: <630f863ecb479_2f2e5848878943243@gitlab.mail> Sebastian Graf pushed to branch wip/T22039 at Glasgow Haskell Compiler / GHC Commits: 432ffa9d by Sebastian Graf at 2022-08-31T18:02:57+02:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 3 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - + testsuite/tests/stranal/should_compile/T22039.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -455,8 +455,9 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt_con bndrs rhs]) !(!bndrs', !scrut_sd) | DataAlt _ <- alt_con -- See Note [Demand on the scrutinee of a product case] + , let !scrut_sd = scrutSubDmd case_bndr_sd fld_dmds -- See Note [Demand on case-alternative binders] - , (!scrut_sd, fld_dmds') <- addCaseBndrDmd case_bndr_sd fld_dmds + , let !fld_dmds' = fieldBndrDmds scrut_sd (length fld_dmds) , let !bndrs' = setBndrsDemandInfo bndrs fld_dmds' = (bndrs', scrut_sd) | otherwise @@ -560,7 +561,6 @@ forcesRealWorld fam_envs ty = False dmdAnalSumAlts :: AnalEnv -> SubDemand -> Id -> [CoreAlt] -> WithDmdType [CoreAlt] - dmdAnalSumAlts _ _ _ [] = WithDmdType botDmdType [] -- Base case is botDmdType, for empty case alternatives -- This is a unit for lubDmdType, and the right result @@ -580,28 +580,29 @@ dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs) -- See Note [Demand on case-alternative binders] -- we can't use the scrut_sd, because it says 'Prod' and we'll use -- topSubDmd anyway for scrutinees of sum types. - (!_scrut_sd, dmds') = addCaseBndrDmd case_bndr_sd dmds + scrut_sd = scrutSubDmd case_bndr_sd dmds + dmds' = fieldBndrDmds scrut_sd (length dmds) -- Do not put a thunk into the Alt !new_ids = setBndrsDemandInfo bndrs dmds' = -- pprTrace "dmdAnalSumAlt" (ppr con $$ ppr case_bndr $$ ppr dmd $$ ppr alt_ty) $ WithDmdType alt_ty (Alt con new_ids rhs') --- Precondition: The SubDemand is not a Call -- See Note [Demand on the scrutinee of a product case] --- and Note [Demand on case-alternative binders] -addCaseBndrDmd :: SubDemand -- On the case binder - -> [Demand] -- On the fields of the constructor - -> (SubDemand, [Demand]) - -- SubDemand on the case binder incl. field demands - -- and final demands for the components of the constructor -addCaseBndrDmd case_sd fld_dmds - | Just (_, ds) <- viewProd (length fld_dmds) scrut_sd - -- , pprTrace "addCaseBndrDmd" (ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) True - = (scrut_sd, ds) - | otherwise - = pprPanic "was a call demand" (ppr case_sd $$ ppr fld_dmds) -- See the Precondition - where - scrut_sd = case_sd `plusSubDmd` mkProd Unboxed fld_dmds +scrutSubDmd :: SubDemand -> [Demand] -> SubDemand +scrutSubDmd case_sd fld_dmds = + -- pprTraceWith "scrutSubDmd" (\scrut_sd -> ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) $ + case_sd `plusSubDmd` mkProd Unboxed fld_dmds + +-- See Note [Demand on case-alternative binders] +fieldBndrDmds :: SubDemand -- on the scrutinee + -> Arity + -> [Demand] -- Final demands for the components of the DataCon +fieldBndrDmds scrut_sd n_flds = + case viewProd n_flds scrut_sd of + Just (_, ds) -> ds + Nothing -> replicate n_flds topDmd + -- Either an arity mismatch or scrut_sd was a call demand. + -- See Note [Untyped demand on case-alternative binders] {- Note [Anticipating ANF in demand analysis] @@ -830,6 +831,44 @@ thunk for a let binder that was an an absent case-alt binder during DmdAnal. This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. +Note [Untyped demand on case-alternative binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder +may be a call demand or have a different number of fields than the constructor +of the case alternative it is used in. From T22039: + + blarg :: (Int, Int) -> Int + blarg (x,y) = x+y + -- blarg :: <1!P(1L,1L)> + + f :: Either Int Int -> Int + f Left{} = 0 + f e = blarg (unsafeCoerce e) + ==> { desugars to } + f = \ (ds_d1nV :: Either Int Int) -> + case ds_d1nV of wild_X1 { + Left ds_d1oV -> lvl_s1Q6; + Right ipv_s1Pl -> + blarg + (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of + { UnsafeRefl co_a1oT -> + wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int)) + }) + } + +The case binder `e`/`wild_X1` has demand 1!P(1L,1L), with two fields, from the call +to `blarg`, but `Right` only has one field. Although the code will crash when +executed, we must be able to analyse it in 'fieldBndrDmds' and conservatively +approximate with Top instead of panicking because of the mismatch. +In #22039, this kind of code was guarded behind a safe `cast` and thus dead +code, but nevertheless led to a panic of the compiler. + +You might wonder why the same problem doesn't come up when scrutinising a +product type instead of a sum type. It appears that for products, `wild_X1` +will be inlined before DmdAnal. + +See also Note [mkWWstr and unsafeCoerce] for a related issue. + Note [Aggregated demand for cardinality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FIXME: This Note should be named [LetUp vs. LetDown] and probably predates ===================================== testsuite/tests/stranal/should_compile/T22039.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Bug where + +import Control.Exception +import Data.Typeable +import Unsafe.Coerce + +data Error + = Error Int String + | forall e . Exception e => SomeError Int e + deriving (Typeable) + +fromError :: Exception e => Error -> Maybe e +fromError e@(Error _ _) = cast e +fromError (SomeError _ e) = cast e +-- {-# NOINLINE fromError #-} + +instance Eq Error where + Error i s == Error i' s' = i == i' && s == s' + SomeError i e == SomeError i' e' = i == i' && show e == show e' + _ == _ = False + +instance Show Error where + show _ = "" + +instance Exception Error + +-- newtype +data + UniquenessError = UniquenessError [((String, String), Int)] + deriving (Show, Eq) + +instance Exception UniquenessError + +test :: SomeException -> IO () +test e = case fromError =<< fromException e :: Maybe UniquenessError of + Just err -> print err + _ -> pure () + +-- +-- Smaller reproducer by sgraf +-- + +blarg :: (Int,Int) -> Int +blarg (x,y) = x+y +{-# NOINLINE blarg #-} + +f :: Either Int Int -> Int +f Left{} = 0 +f e = blarg (unsafeCoerce e) + +blurg :: (Int -> Int) -> Int +blurg f = f 42 +{-# NOINLINE blurg #-} + +g :: Either Int Int -> Int +g Left{} = 0 +g e = blurg (unsafeCoerce e) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -85,3 +85,4 @@ test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) test('T21265', normal, compile, ['']) test('EtaExpansion', normal, compile, ['']) +test('T22039', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/432ffa9de2317d919af8d80af5ecca362cb5700e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/432ffa9de2317d919af8d80af5ecca362cb5700e You're receiving 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 31 18:14:22 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 Aug 2022 14:14:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/minor-cleanup-void Message-ID: <630fa4fea11d9_2f2e5848878961283@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/minor-cleanup-void at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/minor-cleanup-void You're receiving 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 31 18:45:51 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 Aug 2022 14:45:51 -0400 Subject: [Git][ghc/ghc][wip/21550-test] 265 commits: Vendor filepath inside template-haskell Message-ID: <630fac5f4ded7_2f2e58d8b793496738d@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/21550-test at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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 - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-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. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * 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]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_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 in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% 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% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - 269884b8 by Zubin Duggal at 2022-08-31T20:45:09+02:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 27 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 - − MAKEHELP.md - − Makefile - − bindisttest/ghc.mk - boot - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.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/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04efe8d267da7a03e20e576746cb3d2402d7d853...269884b8e233d0f629783f327e9b8af11e612252 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04efe8d267da7a03e20e576746cb3d2402d7d853...269884b8e233d0f629783f327e9b8af11e612252 You're receiving 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 31 18:59:03 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 31 Aug 2022 14:59:03 -0400 Subject: [Git][ghc/ghc][wip/js-staging] Testsuite: better fix for finding prefixed tools Message-ID: <630faf77ac45f_2f2e5848800971358@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 577b4845 by Sylvain Henry at 2022-08-31T21:00:30+02:00 Testsuite: better fix for finding prefixed tools - - - - - 2 changed files: - hadrian/src/Rules/Test.hs - testsuite/mk/boilerplate.mk Changes: ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -9,6 +9,7 @@ import Expression import Flavour import Hadrian.Haskell.Cabal.Type (packageDependencies) import Hadrian.Oracles.Cabal (readPackageData) +import Hadrian.Oracles.Path (fixAbsolutePathOnWindows) import Oracles.Setting import Oracles.TestSettings import Oracles.Flag @@ -191,9 +192,31 @@ testRules = do -- Prepare Ghc configuration file for input compiler. need [root -/- timeoutPath] + cross <- flag CrossCompiling + + -- get absolute path for the given program in the given stage + let absolute_path_stage s p = do + rel_path <- programPath =<< programContext s p + abs_path <- liftIO (IO.makeAbsolute rel_path) + fixAbsolutePathOnWindows abs_path + + -- get absolute path for the given program in the target stage + let absolute_path = absolute_path_stage stg + + -- get absolute path for the given program in stage1 (useful for + -- cross-compilers) + let absolute_path1 + | cross = absolute_path_stage (Stage0 InTreeLibs) + | otherwise = absolute_path_stage stg ghcPath <- getCompilerPath testCompilerArg + prog_ghc_pkg <- absolute_path ghcPkg + prog_hsc2hs <- absolute_path hsc2hs + prog_hp2ps <- absolute_path hp2ps + prog_hpc <- absolute_path1 hpc + prog_haddock <- absolute_path1 haddock + prog_runghc <- absolute_path1 runGhc makePath <- builderPath $ Make "" top <- topDirectory @@ -222,6 +245,14 @@ testRules = do setEnv "TEST_HC_OPTS_INTERACTIVE" ghciFlags setEnv "TEST_CC" ccPath setEnv "TEST_CC_OPTS" ccFlags + + setEnv "GHC_PKG" prog_ghc_pkg + setEnv "HSC2HS" prog_hsc2hs + setEnv "HP2PS_ABS" prog_hp2ps + setEnv "HPC" prog_hpc + setEnv "HADDOCK" prog_haddock + setEnv "RUNGHC" prog_runghc + setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -150,17 +150,7 @@ BIN_ROOT = $(shell dirname '$(TEST_HC)') ifeq "$(IMPLICIT_COMPILER)" "YES" find_tool = $(shell which $(1)) else -find_tool = $(BIN_ROOT)/$(PLATFORM_PREFIX)$(1) -endif - -ifeq "$(IMPLICIT_COMPILER)" "YES" -find_other_tool = $(shell which $(1)) -else - ifeq "$(TOOL_ROOT)" "" - find_other_tool = $(BIN_ROOT)/$(PLATFORM_PREFIX)$(1) - else - find_other_tool = $(TOOL_ROOT)/$(PLATFORM_PREFIX)$(1) - endif +find_tool = $(BIN_ROOT)/$(1) endif ifeq "$(GHC_PKG)" "" @@ -168,11 +158,11 @@ GHC_PKG := $(call find_tool,ghc-pkg) endif ifeq "$(RUNGHC)" "" -RUNGHC := $(call find_other_tool,runghc) +RUNGHC := $(call find_tool,runghc) endif ifeq "$(HADDOCK)" "" -HADDOCK := $(call find_other_tool,haddock) +HADDOCK := $(call find_tool,haddock) endif ifeq "$(HSC2HS)" "" @@ -184,7 +174,7 @@ HP2PS_ABS := $(call find_tool,hp2ps) endif ifeq "$(HPC)" "" -HPC := $(call find_other_tool,hpc) +HPC := $(call find_tool,hpc) endif $(eval $(call canonicaliseExecutable,TEST_HC)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/577b4845277443f721e394bd41621aee393efe9f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/577b4845277443f721e394bd41621aee393efe9f You're receiving 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 31 19:27:29 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 15:27:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Refine in-tree compiler args for --test-compiler=stage1 Message-ID: <630fb6219ada5_2f2e58488b4977263@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b8c46552 by Matthew Pickering at 2022-08-31T15:27:16-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - ab2ecfa2 by Matthew Pickering at 2022-08-31T15:27:16-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 7 changed files: - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -241,7 +241,10 @@ enableLateCCS = addArgs -- | Enable assertions for the stage2 compiler enableAssertions :: Flavour -> Flavour -enableAssertions flav = flav { ghcDebugAssertions = True } +enableAssertions flav = flav { ghcDebugAssertions = f } + where + f Stage2 = True + f st = ghcDebugAssertions flav st -- | Produce fully statically-linked executables and build libraries suitable -- for static linking. ===================================== hadrian/src/Flavour/Type.hs ===================================== @@ -35,7 +35,7 @@ data Flavour = Flavour { -- | Build GHC with the debug RTS. ghcDebugged :: Stage -> Bool, -- | Build GHC with debug assertions. - ghcDebugAssertions :: Bool, + ghcDebugAssertions :: Stage -> Bool, -- | Build the GHC executable against the threaded runtime system. ghcThreaded :: Stage -> Bool, -- | Whether to build docs and which ones ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -17,6 +17,8 @@ import qualified Data.Set as Set import Flavour import qualified Context.Type as C import System.Directory (findExecutable) +import Settings.Program +import qualified Context.Type getTestSetting :: TestSetting -> Action String getTestSetting key = testSetting key @@ -91,16 +93,14 @@ inTreeCompilerArgs stg = do return (dynamic `elem` ways, threaded `elem` ways) -- MP: We should be able to vary if stage1/stage2 is dynamic, ie a dynamic stage1 -- should be able to built a static stage2? - hasDynamic <- flavour >>= dynamicGhcPrograms + hasDynamic <- (dynamic ==) . Context.Type.way <$> (programContext stg ghc) -- LeadingUnderscore is a property of the system so if cross-compiling stage1/stage2 could -- have different values? Currently not possible to express. leadingUnderscore <- flag LeadingUnderscore - -- MP: This setting seems to only dictate whether we turn on optasm as a compiler - -- way, but a lot of tests which use only_ways(optasm) seem to not test the NCG? withInterpreter <- ghcWithInterpreter unregisterised <- flag GhcUnregisterised withSMP <- targetSupportsSMP - debugAssertions <- ghcDebugAssertions <$> flavour + debugAssertions <- ($ stg) . ghcDebugAssertions <$> flavour profiled <- ghcProfiled <$> flavour <*> pure stg os <- setting HostOs ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -240,7 +240,7 @@ defaultFlavour = Flavour , ghcProfiled = const False , ghcDebugged = const False , ghcThreaded = const True - , ghcDebugAssertions = False + , ghcDebugAssertions = const False , ghcDocs = cmdDocsArgs } -- | Default logic for determining whether to build ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug] , dynamicGhcPrograms = return False - , ghcDebugAssertions = True } + , ghcDebugAssertions = (>= Stage2) } where stageString Stage2 = "2" stageString Stage1 = "1" ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] ] + , ghcDebugAssertions = (<= Stage1) } validateArgs :: Args @@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs , notStage0 ? arg "-dno-debug-output" ] , hsLibrary = pure ["-O"] - , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"] + , hsCompiler = mconcat [ stage0 ? pure ["-O2"] , notStage0 ? pure ["-O" ] ] , hsGhc = pure ["-O"] } + slowValidateFlavour :: Flavour slowValidateFlavour = validateFlavour { name = "slow-validate" - , ghcDebugAssertions = True + , ghcDebugAssertions = const True } quickValidateArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -52,7 +52,7 @@ packageArgs = do [ builder Alex ? arg "--latin1" , builder (Ghc CompileHs) ? mconcat - [ debugAssertions ? notStage0 ? arg "-DDEBUG" + [ debugAssertions stage ? arg "-DDEBUG" , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto" , input "**/Parser.hs" ? @@ -83,7 +83,7 @@ packageArgs = do , package ghc ? mconcat [ builder Ghc ? mconcat [ arg ("-I" ++ compilerPath) - , debugAssertions ? notStage0 ? arg "-DDEBUG" ] + , debugAssertions stage ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f8a363df8c36067850f0f4f0772745a9dff8cef...ab2ecfa2f4707dbc8d8def19940884dde94cd4d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f8a363df8c36067850f0f4f0772745a9dff8cef...ab2ecfa2f4707dbc8d8def19940884dde94cd4d4 You're receiving 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 31 19:55:57 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 Aug 2022 15:55:57 -0400 Subject: [Git][ghc/ghc][wip/minor-cleanup-void] Minor cleanup Message-ID: <630fbccddf421_2f2e584909f1c982937@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/minor-cleanup-void at Glasgow Haskell Compiler / GHC Commits: 7c2d6a19 by Krzysztof Gogolewski at 2022-08-31T21:55:19+02:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 10 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -45,7 +45,6 @@ module GHC.Core.Coercion ( mkKindCo, castCoercionKind, castCoercionKind1, castCoercionKind2, - mkHeteroCoercionType, mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, mkHeteroPrimEqPred, mkHeteroReprPrimEqPred, @@ -77,7 +76,6 @@ module GHC.Core.Coercion ( -- ** Coercion variables mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique, - isCoVar_maybe, -- ** Free variables tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo, @@ -521,7 +519,9 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args -- didn't have enough binders go acc_arg_cos _ki1 co _ki2 _tys = (reverse acc_arg_cos, co) --- | Attempts to obtain the type variable underlying a 'Coercion' +-- | Extract a covar, if possible. This check is dirty. Be ashamed +-- of yourself. (It's dirty because it cares about the structure of +-- a coercion, which is morally reprehensible.) getCoVar_maybe :: Coercion -> Maybe CoVar getCoVar_maybe (CoVarCo cv) = Just cv getCoVar_maybe _ = Nothing @@ -953,13 +953,6 @@ it's a relatively expensive test and perhaps better done in optCoercion. Not a big deal either way. -} --- | Extract a covar, if possible. This check is dirty. Be ashamed --- of yourself. (It's dirty because it cares about the structure of --- a coercion, which is morally reprehensible.) -isCoVar_maybe :: Coercion -> Maybe CoVar -isCoVar_maybe (CoVarCo cv) = Just cv -isCoVar_maybe _ = Nothing - mkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Coercion -- mkAxInstCo can legitimately be called over-staturated; @@ -2558,11 +2551,6 @@ mkCoercionType Phantom = \ty1 ty2 -> in TyConApp eqPhantPrimTyCon [ki1, ki2, ty1, ty2] -mkHeteroCoercionType :: Role -> Kind -> Kind -> Type -> Type -> Type -mkHeteroCoercionType Nominal = mkHeteroPrimEqPred -mkHeteroCoercionType Representational = mkHeteroReprPrimEqPred -mkHeteroCoercionType Phantom = panic "mkHeteroCoercionType" - -- | Creates a primitive type equality predicate. -- Invariant: the types are not Coercions mkPrimEqPred :: Type -> Type -> Type ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Prelude import GHC.Platform -import GHC.Types.Id.Make ( voidPrimId ) +import GHC.Types.Id.Make ( unboxedUnitExpr ) import GHC.Types.Id import GHC.Types.Literal import GHC.Types.Name.Occurrence ( occNameFS ) @@ -2107,7 +2107,7 @@ builtinBignumRules = let ret n v = pure $ mkCoreUbxSum 2 n [unboxedUnitTy,naturalTy] v platform <- getPlatform if x < y - then ret 1 $ Var voidPrimId + then ret 1 unboxedUnitExpr else ret 2 $ mkNaturalExpr platform (x - y) -- unary operations ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -129,7 +129,6 @@ module GHC.Core.Type ( isUnliftedType, isBoxedType, isUnboxedTupleType, isUnboxedSumType, kindBoxedRepLevity_maybe, mightBeLiftedType, mightBeUnliftedType, - isStateType, isAlgType, isDataFamilyAppType, isPrimitiveType, isStrictType, isLevityTy, isLevityVar, @@ -2482,13 +2481,6 @@ isUnliftedType ty = Nothing -> pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty)) --- | State token type. -isStateType :: Type -> Bool -isStateType ty - = case tyConAppTyCon_maybe ty of - Just tycon -> tycon == statePrimTyCon - _ -> False - -- | Returns: -- -- * 'False' if the type is /guaranteed/ unlifted or ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -5023,7 +5023,6 @@ initSDocContext dflags style = SDC , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags , sdocErrorSpans = gopt Opt_ErrorSpans dflags , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocImpredicativeTypes = xopt LangExt.ImpredicativeTypes dflags , sdocLinearTypes = xopt LangExt.LinearTypes dflags , sdocListTuplePuns = True , sdocPrintTypeAbbreviations = True ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -795,7 +795,7 @@ dsHsConLike (PatSynCon ps) = do { builder_id <- dsLookupGlobalId builder_name ; return (if add_void then mkCoreApp (text "dsConLike" <+> ppr ps) - (Var builder_id) (Var voidPrimId) + (Var builder_id) unboxedUnitExpr else Var builder_id) } | otherwise = pprPanic "dsConLike" (ppr ps) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -917,7 +917,7 @@ mkFailurePair expr ; fail_fun_arg <- newSysLocalDs Many unboxedUnitTy ; let real_arg = setOneShotLambda fail_fun_arg ; return (NonRec fail_fun_var (Lam real_arg expr), - App (Var fail_fun_var) (Var voidPrimId)) } + App (Var fail_fun_var) unboxedUnitExpr) } where ty = exprType expr ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -56,7 +56,6 @@ import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin import GHC.Tc.TyCl.Build import GHC.Types.Var.Set -import GHC.Types.Id.Make import GHC.Tc.TyCl.Utils import GHC.Core.ConLike import GHC.Types.FieldLabel @@ -796,8 +795,8 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn res_ty = mkTyVarTy res_tv is_unlifted = null args && null prov_dicts (cont_args, cont_arg_tys) - | is_unlifted = ([nlHsVar voidPrimId], [unboxedUnitTy]) - | otherwise = (args, arg_tys) + | is_unlifted = ([nlHsDataCon unboxedUnitDataCon], [unboxedUnitTy]) + | otherwise = (args, arg_tys) cont_ty = mkInfSigmaTy ex_tvs prov_theta $ mkVisFunTysMany cont_arg_tys res_ty @@ -818,7 +817,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn inst_wrap = mkWpEvApps prov_dicts <.> mkWpTyApps ex_tys cont' = foldl' nlHsApp (mkLHsWrap inst_wrap (nlHsVar cont)) cont_args - fail' = nlHsApps fail [nlHsVar voidPrimId] + fail' = nlHsApps fail [nlHsDataCon unboxedUnitDataCon] args = map nlVarPat [scrutinee, cont, fail] lwpat = noLocA $ WildPat pat_ty ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Types.Id.Make ( DataConBoxer(..), vanillaDataConBoxer, mkDataConRep, mkDataConWorkId, DataConBangOpts (..), BangOpts (..), + unboxedUnitExpr, -- And some particular Ids; see below for why they are wired in wiredInIds, ghcPrimIds, @@ -1812,9 +1813,10 @@ voidPrimId :: Id -- Global constant :: Void# -- We cannot define it in normal Haskell, since it's -- a top-level unlifted value. voidPrimId = pcMiscPrelId voidPrimIdName unboxedUnitTy - (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs) - where rhs = Var (dataConWorkId unboxedUnitDataCon) + (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts unboxedUnitExpr) +unboxedUnitExpr :: CoreExpr +unboxedUnitExpr = Var (dataConWorkId unboxedUnitDataCon) voidArgId :: Id -- Local lambda-bound :: Void# voidArgId = mkSysLocal (fsLit "void") voidArgIdKey Many unboxedUnitTy ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -390,7 +390,6 @@ data SDocContext = SDC , sdocErrorSpans :: !Bool , sdocStarIsType :: !Bool , sdocLinearTypes :: !Bool - , sdocImpredicativeTypes :: !Bool , sdocListTuplePuns :: !Bool , sdocPrintTypeAbbreviations :: !Bool , sdocUnitIdForUser :: !(FastString -> SDoc) @@ -450,7 +449,6 @@ defaultSDocContext = SDC , sdocSuppressStgExts = False , sdocErrorSpans = False , sdocStarIsType = False - , sdocImpredicativeTypes = False , sdocLinearTypes = False , sdocListTuplePuns = True , sdocPrintTypeAbbreviations = True ===================================== ghc/GHCi/UI.hs ===================================== @@ -57,7 +57,7 @@ import GHC.Driver.Config.Diagnostic import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Resume, SingleStep, Ghc, - GetDocsFailure(..), putLogMsgM, pushLogHookM, + GetDocsFailure(..), pushLogHookM, getModuleGraph, handleSourceError, ms_mod ) import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation) import GHC.Hs.ImpExp @@ -3289,7 +3289,8 @@ showCmd str = do , action "bindings" $ showBindings , action "linker" $ do msg <- liftIO $ Loader.showLoaderState (hscInterp hsc_env) - putLogMsgM MCDump noSrcSpan msg + dflags <- getDynFlags + liftIO $ putStrLn $ showSDoc dflags msg , action "breaks" $ showBkptTable , action "context" $ showContext , action "packages" $ showUnits View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c2d6a19c74398e4bbb261c0566758dce29920c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c2d6a19c74398e4bbb261c0566758dce29920c7 You're receiving 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 31 21:11:34 2022 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 Aug 2022 17:11:34 -0400 Subject: [Git][ghc/ghc][wip/minor-cleanup-void] Minor cleanup Message-ID: <630fce8623032_2f2e58d8b79349935e6@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/minor-cleanup-void at Glasgow Haskell Compiler / GHC Commits: 40b5c4f8 by Krzysztof Gogolewski at 2022-08-31T23:11:08+02:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - ghc/GHCi/UI.hs - testsuite/tests/corelint/T21115b.stderr Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -772,7 +772,7 @@ However, join points have simpler invariants in other ways e.g. let j :: Int# = factorial x in ... 6. The RHS of join point is not required to have a fixed runtime representation, - e.g. let j :: r :: TYPE l = fail void# in ... + e.g. let j :: r :: TYPE l = fail (##) in ... This happened in an intermediate program #13394 Examples: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -45,7 +45,6 @@ module GHC.Core.Coercion ( mkKindCo, castCoercionKind, castCoercionKind1, castCoercionKind2, - mkHeteroCoercionType, mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, mkHeteroPrimEqPred, mkHeteroReprPrimEqPred, @@ -77,7 +76,6 @@ module GHC.Core.Coercion ( -- ** Coercion variables mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique, - isCoVar_maybe, -- ** Free variables tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo, @@ -521,7 +519,9 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args -- didn't have enough binders go acc_arg_cos _ki1 co _ki2 _tys = (reverse acc_arg_cos, co) --- | Attempts to obtain the type variable underlying a 'Coercion' +-- | Extract a covar, if possible. This check is dirty. Be ashamed +-- of yourself. (It's dirty because it cares about the structure of +-- a coercion, which is morally reprehensible.) getCoVar_maybe :: Coercion -> Maybe CoVar getCoVar_maybe (CoVarCo cv) = Just cv getCoVar_maybe _ = Nothing @@ -953,13 +953,6 @@ it's a relatively expensive test and perhaps better done in optCoercion. Not a big deal either way. -} --- | Extract a covar, if possible. This check is dirty. Be ashamed --- of yourself. (It's dirty because it cares about the structure of --- a coercion, which is morally reprehensible.) -isCoVar_maybe :: Coercion -> Maybe CoVar -isCoVar_maybe (CoVarCo cv) = Just cv -isCoVar_maybe _ = Nothing - mkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Coercion -- mkAxInstCo can legitimately be called over-staturated; @@ -2558,11 +2551,6 @@ mkCoercionType Phantom = \ty1 ty2 -> in TyConApp eqPhantPrimTyCon [ki1, ki2, ty1, ty2] -mkHeteroCoercionType :: Role -> Kind -> Kind -> Type -> Type -> Type -mkHeteroCoercionType Nominal = mkHeteroPrimEqPred -mkHeteroCoercionType Representational = mkHeteroReprPrimEqPred -mkHeteroCoercionType Phantom = panic "mkHeteroCoercionType" - -- | Creates a primitive type equality predicate. -- Invariant: the types are not Coercions mkPrimEqPred :: Type -> Type -> Type ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Prelude import GHC.Platform -import GHC.Types.Id.Make ( voidPrimId ) +import GHC.Types.Id.Make ( unboxedUnitExpr ) import GHC.Types.Id import GHC.Types.Literal import GHC.Types.Name.Occurrence ( occNameFS ) @@ -2107,7 +2107,7 @@ builtinBignumRules = let ret n v = pure $ mkCoreUbxSum 2 n [unboxedUnitTy,naturalTy] v platform <- getPlatform if x < y - then ret 1 $ Var voidPrimId + then ret 1 unboxedUnitExpr else ret 2 $ mkNaturalExpr platform (x - y) -- unary operations ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -129,7 +129,6 @@ module GHC.Core.Type ( isUnliftedType, isBoxedType, isUnboxedTupleType, isUnboxedSumType, kindBoxedRepLevity_maybe, mightBeLiftedType, mightBeUnliftedType, - isStateType, isAlgType, isDataFamilyAppType, isPrimitiveType, isStrictType, isLevityTy, isLevityVar, @@ -2482,13 +2481,6 @@ isUnliftedType ty = Nothing -> pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty)) --- | State token type. -isStateType :: Type -> Bool -isStateType ty - = case tyConAppTyCon_maybe ty of - Just tycon -> tycon == statePrimTyCon - _ -> False - -- | Returns: -- -- * 'False' if the type is /guaranteed/ unlifted or ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -5023,7 +5023,6 @@ initSDocContext dflags style = SDC , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags , sdocErrorSpans = gopt Opt_ErrorSpans dflags , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocImpredicativeTypes = xopt LangExt.ImpredicativeTypes dflags , sdocLinearTypes = xopt LangExt.LinearTypes dflags , sdocListTuplePuns = True , sdocPrintTypeAbbreviations = True ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -795,7 +795,7 @@ dsHsConLike (PatSynCon ps) = do { builder_id <- dsLookupGlobalId builder_name ; return (if add_void then mkCoreApp (text "dsConLike" <+> ppr ps) - (Var builder_id) (Var voidPrimId) + (Var builder_id) unboxedUnitExpr else Var builder_id) } | otherwise = pprPanic "dsConLike" (ppr ps) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -917,7 +917,7 @@ mkFailurePair expr ; fail_fun_arg <- newSysLocalDs Many unboxedUnitTy ; let real_arg = setOneShotLambda fail_fun_arg ; return (NonRec fail_fun_var (Lam real_arg expr), - App (Var fail_fun_var) (Var voidPrimId)) } + App (Var fail_fun_var) unboxedUnitExpr) } where ty = exprType expr ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -56,7 +56,6 @@ import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin import GHC.Tc.TyCl.Build import GHC.Types.Var.Set -import GHC.Types.Id.Make import GHC.Tc.TyCl.Utils import GHC.Core.ConLike import GHC.Types.FieldLabel @@ -796,8 +795,8 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn res_ty = mkTyVarTy res_tv is_unlifted = null args && null prov_dicts (cont_args, cont_arg_tys) - | is_unlifted = ([nlHsVar voidPrimId], [unboxedUnitTy]) - | otherwise = (args, arg_tys) + | is_unlifted = ([nlHsDataCon unboxedUnitDataCon], [unboxedUnitTy]) + | otherwise = (args, arg_tys) cont_ty = mkInfSigmaTy ex_tvs prov_theta $ mkVisFunTysMany cont_arg_tys res_ty @@ -818,7 +817,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn inst_wrap = mkWpEvApps prov_dicts <.> mkWpTyApps ex_tys cont' = foldl' nlHsApp (mkLHsWrap inst_wrap (nlHsVar cont)) cont_args - fail' = nlHsApps fail [nlHsVar voidPrimId] + fail' = nlHsApps fail [nlHsDataCon unboxedUnitDataCon] args = map nlVarPat [scrutinee, cont, fail] lwpat = noLocA $ WildPat pat_ty ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Types.Id.Make ( DataConBoxer(..), vanillaDataConBoxer, mkDataConRep, mkDataConWorkId, DataConBangOpts (..), BangOpts (..), + unboxedUnitExpr, -- And some particular Ids; see below for why they are wired in wiredInIds, ghcPrimIds, @@ -1812,9 +1813,10 @@ voidPrimId :: Id -- Global constant :: Void# -- We cannot define it in normal Haskell, since it's -- a top-level unlifted value. voidPrimId = pcMiscPrelId voidPrimIdName unboxedUnitTy - (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs) - where rhs = Var (dataConWorkId unboxedUnitDataCon) + (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts unboxedUnitExpr) +unboxedUnitExpr :: CoreExpr +unboxedUnitExpr = Var (dataConWorkId unboxedUnitDataCon) voidArgId :: Id -- Local lambda-bound :: Void# voidArgId = mkSysLocal (fsLit "void") voidArgIdKey Many unboxedUnitTy ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -390,7 +390,6 @@ data SDocContext = SDC , sdocErrorSpans :: !Bool , sdocStarIsType :: !Bool , sdocLinearTypes :: !Bool - , sdocImpredicativeTypes :: !Bool , sdocListTuplePuns :: !Bool , sdocPrintTypeAbbreviations :: !Bool , sdocUnitIdForUser :: !(FastString -> SDoc) @@ -450,7 +449,6 @@ defaultSDocContext = SDC , sdocSuppressStgExts = False , sdocErrorSpans = False , sdocStarIsType = False - , sdocImpredicativeTypes = False , sdocLinearTypes = False , sdocListTuplePuns = True , sdocPrintTypeAbbreviations = True ===================================== ghc/GHCi/UI.hs ===================================== @@ -57,7 +57,7 @@ import GHC.Driver.Config.Diagnostic import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Resume, SingleStep, Ghc, - GetDocsFailure(..), putLogMsgM, pushLogHookM, + GetDocsFailure(..), pushLogHookM, getModuleGraph, handleSourceError, ms_mod ) import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation) import GHC.Hs.ImpExp @@ -3289,7 +3289,8 @@ showCmd str = do , action "bindings" $ showBindings , action "linker" $ do msg <- liftIO $ Loader.showLoaderState (hscInterp hsc_env) - putLogMsgM MCDump noSrcSpan msg + dflags <- getDynFlags + liftIO $ putStrLn $ showSDoc dflags msg , action "breaks" $ showBkptTable , action "context" $ showContext , action "packages" $ showUnits ===================================== testsuite/tests/corelint/T21115b.stderr ===================================== @@ -22,7 +22,7 @@ foo case patError "T21115b.hs:(10,4)-(15,4)|\\case"# of wild { } } in let { fail = \ ds -> 5# } in case ds of ds { - __DEFAULT -> fail void#; + __DEFAULT -> fail (##); 0.0## -> 2#; 2.0## -> 3# } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40b5c4f86b5ed167f03a53d8cf02880a3e6b7dfa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40b5c4f86b5ed167f03a53d8cf02880a3e6b7dfa You're receiving 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 31 22:08:06 2022 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 31 Aug 2022 18:08:06 -0400 Subject: [Git][ghc/ghc][wip/T21470] 4 commits: Various Hadrian bootstrapping fixes Message-ID: <630fdbc65c6d4_2f2e58488b4101760@gitlab.mail> Simon Peyton Jones pushed to branch wip/T21470 at Glasgow Haskell Compiler / GHC Commits: 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 3b27ecba by Simon Peyton Jones at 2022-08-31T23:08:07+01:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T13056, because we generate more specialised code. This seems OK. Metric Increase: T13056 - - - - - cd3f0c27 by Simon Peyton Jones at 2022-08-31T23:08:07+01:00 Fix binder-swap bug This patch fixes #21229 / #21470 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. I als modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs - - - - - 15 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/Type.hs - hadrian/bootstrap/bootstrap.py - testsuite/tests/linters/notes.stdout - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -17,7 +17,7 @@ variables: # Overridden by individual jobs CONFIGURE_ARGS: "" - GIT_SUBMODULE_STRATEGY: "recursive" + GIT_SUBMODULE_STRATEGY: "normal" # Makes ci.sh isolate CABAL_DIR HERMETIC: "YES" ===================================== .gitlab/ci.sh ===================================== @@ -377,8 +377,8 @@ function cleanup_submodules() { # On Windows submodules can inexplicably get into funky states where git # believes that the submodule is initialized yet its associated repository # is not valid. Avoid failing in this case with the following insanity. - git submodule sync --recursive || git submodule deinit --force --all - git submodule update --init --recursive + git submodule sync || git submodule deinit --force --all + git submodule update --init git submodule foreach git clean -xdf else info "Not cleaning submodules, not in a git repo" ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -19,7 +19,7 @@ core expression with (hopefully) improved usage information. module GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr, - zapLambdaBndrs + zapLambdaBndrs, scrutBinderSwap_maybe ) where import GHC.Prelude @@ -27,11 +27,12 @@ import GHC.Prelude import GHC.Core import GHC.Core.FVs import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, - stripTicksTopE, mkTicks ) + mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion +import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type -import GHC.Core.TyCo.FVs( tyCoVarsOfMCo ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) import GHC.Data.Maybe( isJust, orElse ) import GHC.Data.Graph.Directed ( SCC(..), Node(..) @@ -2462,8 +2463,8 @@ data OccEnv -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, - -- then please replace x by (y |> sym mco) - -- Invariant of course: idType x = exprType (y |> sym mco) + -- then please replace x by (y |> mco) + -- Invariant of course: idType x = exprType (y |> mco) , occ_bs_env :: !(VarEnv (OutId, MCoercion)) , occ_bs_rng :: !VarSet -- Vars free in the range of occ_bs_env -- Domain is Global and Local Ids @@ -2669,7 +2670,7 @@ The binder-swap is implemented by the occ_bs_env field of OccEnv. There are two main pieces: * Given case x |> co of b { alts } - we add [x :-> (b, co)] to the occ_bs_env environment; this is + we add [x :-> (b, sym co)] to the occ_bs_env environment; this is done by addBndrSwap. * Then, at an occurrence of a variable, we look up in the occ_bs_env @@ -2737,30 +2738,8 @@ Some tricky corners: (BS5) We have to apply the occ_bs_env substitution uniformly, including to (local) rules and unfoldings. -Historical note ---------------- -We used to do the binder-swap transformation by introducing -a proxy let-binding, thus; - - case x of b { pi -> ri } - ==> - case x of b { pi -> let x = b in ri } - -But that had two problems: - -1. If 'x' is an imported GlobalId, we'd end up with a GlobalId - on the LHS of a let-binding which isn't allowed. We worked - around this for a while by "localising" x, but it turned - out to be very painful #16296, - -2. In CorePrep we use the occurrence analyser to do dead-code - elimination (see Note [Dead code in CorePrep]). But that - occasionally led to an unlifted let-binding - case x of b { DEFAULT -> let x::Int# = b in ... } - which disobeys one of CorePrep's output invariants (no unlifted - let-bindings) -- see #5433. - -Doing a substitution (via occ_bs_env) is much better. +(BS6) We must be very careful with dictionaries. + See Note [Care with binder-swap on dictionaries] Note [Case of cast] ~~~~~~~~~~~~~~~~~~~ @@ -2770,6 +2749,58 @@ We'd like to eliminate the inner case. That is the motivation for equation (2) in Note [Binder swap]. When we get to the inner case, we inline x, cancel the casts, and away we go. +Note [Care with binder-swap on dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This Note explains why we need isDictId in scrutBinderSwap_maybe. +Consider this tricky example (#21229, #21470): + + class Sing (b :: Bool) where sing :: Bool + instance Sing 'True where sing = True + instance Sing 'False where sing = False + + f :: forall a. Sing a => blah + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a dSing + +Now do a binder-swap on the case-expression: + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (wild |> sym the_co) + +And now substitute `False` for `wild` (since wild=False in the False branch): + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (False |> sym the_co) + +And now we have a problem. The specialiser will specialise (f @a d)a (for all +vtypes a and dictionaries d!!) with the dictionary (False |> sym the_co), using +Note [Specialising polymorphic dictionaries] in GHC.Core.Opt.Specialise. + +The real problem is the binder-swap. It swaps a dictionary variable $dSing +(of kind Constraint) for a term variable wild (of kind Type). And that is +dangerous: a dictionary is a /singleton/ type whereas a general term variable is +not. In this particular example, Bool is most certainly not a singleton type! + +Conclusion: + for a /dictionary variable/ do not perform + the clever cast version of the binder-swap + +Hence the subtle isDictId in scrutBinderSwap_maybe. + +What about Constraint/Constraint binder-swaps? Maybe that would be OK, but +I have never seen one, so I'm leaving the code as simple as possible Losing +the binder-swap in a rare case probably has very low impact. + Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From the original @@ -2784,8 +2815,83 @@ binding x = cb. See #5028. NB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier doesn't use it. So this is only to satisfy the perhaps-over-picky Lint. +-} + +addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv +-- See Note [The binder-swap substitution] +addBndrSwap scrut case_bndr + env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) + | Just (scrut_var, mco) <- scrutBinderSwap_maybe scrut + , scrut_var /= case_bndr + -- Consider: case x of x { ... } + -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop + = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) + , occ_bs_rng = rng_vars `extendVarSet` case_bndr' + `unionVarSet` tyCoVarsOfMCo mco } + + | otherwise + = env + where + case_bndr' = zapIdOccInfo case_bndr + -- See Note [Zap case binders in proxy bindings] + +scrutBinderSwap_maybe :: OutExpr -> Maybe (OutVar, MCoercion) +-- If (scrutBinderSwap_maybe e = Just (v, mco), then +-- v = e |> mco +-- See Note [Case of cast] +-- See Note [Care with binder-swap on dictionaries] +-- +-- We use this same function in SpecConstr, and Simplify.Iteration, +-- when something binder-swap-like is happening +scrutBinderSwap_maybe (Var v) = Just (v, MRefl) +scrutBinderSwap_maybe (Cast (Var v) co) + | not (isDictId v) = Just (v, MCo (mkSymCo co)) + -- Cast: see Note [Case of cast] + -- isDictId: see Note [Care with binder-swap on dictionaries] +scrutBinderSwap_maybe (Tick _ e) = scrutBinderSwap_maybe e -- Drop ticks +scrutBinderSwap_maybe _ = Nothing + +lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) +-- See Note [The binder-swap substitution] +-- Returns an expression of the same type as Id +lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr + = case lookupVarEnv bs_env bndr of { + Nothing -> (Var bndr, bndr) ; + Just (bndr1, mco) -> + + -- Why do we iterate here? + -- See (BS2) in Note [The binder-swap substitution] + case lookupBndrSwap env bndr1 of + (fun, fun_id) -> (mkCastMCo fun mco, fun_id) } + + +{- Historical note [Proxy let-bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We used to do the binder-swap transformation by introducing +a proxy let-binding, thus; + + case x of b { pi -> ri } + ==> + case x of b { pi -> let x = b in ri } + +But that had two problems: + +1. If 'x' is an imported GlobalId, we'd end up with a GlobalId + on the LHS of a let-binding which isn't allowed. We worked + around this for a while by "localising" x, but it turned + out to be very painful #16296, + +2. In CorePrep we use the occurrence analyser to do dead-code + elimination (see Note [Dead code in CorePrep]). But that + occasionally led to an unlifted let-binding + case x of b { DEFAULT -> let x::Int# = b in ... } + which disobeys one of CorePrep's output invariants (no unlifted + let-bindings) -- see #5433. + +Doing a substitution (via occ_bs_env) is much better. + Historical Note [no-case-of-case] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We *used* to suppress the binder-swap in case expressions when -fno-case-of-case is on. Old remarks: "This happens in the first simplifier pass, @@ -2844,53 +2950,8 @@ binder-swap in OccAnal: It's fixed by doing the binder-swap in OccAnal because we can do the binder-swap unconditionally and still get occurrence analysis information right. --} -addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv --- See Note [The binder-swap substitution] -addBndrSwap scrut case_bndr - env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) - | Just (scrut_var, mco) <- get_scrut_var (stripTicksTopE (const True) scrut) - , scrut_var /= case_bndr - -- Consider: case x of x { ... } - -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop - = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) - , occ_bs_rng = rng_vars `extendVarSet` case_bndr' - `unionVarSet` tyCoVarsOfMCo mco } - - | otherwise - = env - where - get_scrut_var :: OutExpr -> Maybe (OutVar, MCoercion) - get_scrut_var (Var v) = Just (v, MRefl) - get_scrut_var (Cast (Var v) co) = Just (v, MCo co) -- See Note [Case of cast] - get_scrut_var _ = Nothing - - case_bndr' = zapIdOccInfo case_bndr - -- See Note [Zap case binders in proxy bindings] - -lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) --- See Note [The binder-swap substitution] --- Returns an expression of the same type as Id -lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr - = case lookupVarEnv bs_env bndr of { - Nothing -> (Var bndr, bndr) ; - Just (bndr1, mco) -> - - -- Why do we iterate here? - -- See (BS2) in Note [The binder-swap substitution] - case lookupBndrSwap env bndr1 of - (fun, fun_id) -> (add_cast fun mco, fun_id) } - - where - add_cast fun MRefl = fun - add_cast fun (MCo co) = Cast fun (mkSymCo co) - -- We must switch that 'co' to 'sym co'; - -- see the comment with occ_bs_env - -- No need to test for isReflCo, because 'co' came from - -- a (Cast e co) and hence is unlikely to be Refl -{- ************************************************************************ * * \subsection[OccurAnal-types]{OccEnv} ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -51,17 +51,6 @@ The simplifier tries to get rid of occurrences of x, in favour of wild, in the hope that there will only be one remaining occurrence of x, namely the scrutinee of the case, and we can inline it. - - This can only work if @wild@ is an unrestricted binder. Indeed, even with the - extended typing rule (in the linter) for case expressions, if - case x of wild % 1 { p -> e} - is well-typed, then - case x of wild % 1 { p -> e[wild\x] } - is only well-typed if @e[wild\x] = e@ (that is, if @wild@ is not used in @e@ - at all). In which case, it is, of course, pointless to do the substitution - anyway. So for a linear binder (and really anything which isn't unrestricted), - doing this substitution would either produce ill-typed terms or be the - identity. -} module GHC.Core.Opt.SetLevels ( @@ -1602,7 +1591,9 @@ extendCaseBndrEnv :: LevelEnv -> LevelEnv extendCaseBndrEnv le@(LE { le_subst = subst, le_env = id_env }) case_bndr (Var scrut_var) - | Many <- varMult case_bndr + -- We could use OccurAnal. scrutBinderSwap_maybe here, and perhaps + -- get a bit more floating. But we didn't in the past and it's + -- an unforced change, so I'm leaving it. = le { le_subst = extendSubstWithVar subst case_bndr scrut_var , le_env = add_id id_env (case_bndr, scrut_var) } extendCaseBndrEnv env _ _ = env ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -71,7 +71,8 @@ import GHC.Core.Make ( mkWildValBinder, mkCoreLet ) import GHC.Builtin.Types import GHC.Core.TyCo.Rep ( TyCoBinder(..) ) import qualified GHC.Core.Type as Type -import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, extendTvSubst, extendCvSubst ) +import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo + , extendTvSubst, extendCvSubst ) import qualified GHC.Core.Coercion as Coercion import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr ) import GHC.Platform ( Platform ) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Utils -import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs ) +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutBinderSwap_maybe ) import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) @@ -3240,19 +3240,22 @@ zapIdOccInfoAndSetEvald str v = -- see Note [Case alternative occ info] addAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv -addAltUnfoldings env scrut case_bndr con_app +addAltUnfoldings env mb_scrut case_bndr con_app = do { let con_app_unf = mk_simple_unf con_app env1 = addBinderUnfolding env case_bndr con_app_unf -- See Note [Add unfolding for scrutinee] - env2 | Many <- idMult case_bndr = case scrut of - Just (Var v) -> addBinderUnfolding env1 v con_app_unf - Just (Cast (Var v) co) -> addBinderUnfolding env1 v $ - mk_simple_unf (Cast con_app (mkSymCo co)) - _ -> env1 + env2 | Just scrut <- mb_scrut + , Just (v,mco) <- scrutBinderSwap_maybe scrut + , ManyTy <- idMult case_bndr -- See discussion in #22123 + = addBinderUnfolding env1 v $ + if isReflMCo mco -- isReflMCo: avoid calling mk_simple_unf + then con_app_unf -- twice in the common case + else mk_simple_unf (mkCastMCo con_app mco) + | otherwise = env1 - ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr scrut, ppr con_app]) + ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr mb_scrut, ppr con_app]) ; return env2 } where -- Force the opts, so that the whole SimplEnv isn't retained @@ -3315,9 +3318,6 @@ it's also good for case-elimination -- suppose that 'f' was inlined and did multi-level case analysis, then we'd solve it in one simplifier sweep instead of two. -Exactly the same issue arises in GHC.Core.Opt.SpecConstr; -see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr - HOWEVER, given case x of y { Just a -> r1; Nothing -> r2 } we do not want to add the unfolding x -> y to 'x', which might seem cool, @@ -3328,8 +3328,11 @@ piece of information. So instead we add the unfolding x -> Just a, and x -> Nothing in the respective RHSs. -Since this transformation is tantamount to a binder swap, the same caveat as in -Note [Suppressing binder-swaps on linear case] in OccurAnal apply. +Since this transformation is tantamount to a binder swap, we use +GHC.Core.Opt.OccurAnal.scrutBinderSwap_maybe to do the check. + +Exactly the same issue arises in GHC.Core.Opt.SpecConstr; +see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr ************************************************************************ ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Core.Unfold import GHC.Core.FVs ( exprsFreeVarsList, exprFreeVars ) import GHC.Core.Opt.Monad import GHC.Core.Opt.WorkWrap.Utils +import GHC.Core.Opt.OccurAnal( scrutBinderSwap_maybe ) import GHC.Core.DataCon import GHC.Core.Class( classTyVars ) import GHC.Core.Coercion hiding( substCo ) @@ -1057,8 +1058,8 @@ extendCaseBndrs env scrut case_bndr con alt_bndrs = (env2, alt_bndrs') where live_case_bndr = not (isDeadBinder case_bndr) - env1 | Var v <- stripTicksTopE (const True) scrut - = extendValEnv env v cval + env1 | Just (v, mco) <- scrutBinderSwap_maybe scrut + , isReflMCo mco = extendValEnv env v cval | otherwise = env -- See Note [Add scrutinee to ValueEnv too] env2 | live_case_bndr = extendValEnv env1 case_bndr cval | otherwise = env1 @@ -1148,6 +1149,10 @@ though the simplifier has systematically replaced uses of 'x' with 'y' and 'b' with 'c' in the code. The use of 'b' in the ValueEnv came from outside the case. See #4908 for the live example. +It's very like the binder-swap story, so we use scrutBinderSwap_maybe +to identify suitable scrutinees -- but only if there is no cast +(isReflMCo) because that's all that the ValueEnv allows. + Note [Avoiding exponential blowup] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The sc_count field of the ScEnv says how many times we are prepared to ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -15,9 +15,7 @@ import GHC.Driver.Config import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Core.Rules ( initRuleOpts ) -import GHC.Tc.Utils.TcType hiding( substTy ) - -import GHC.Core.Type hiding( substTy, extendTvSubstList, zapSubst ) +import GHC.Core.Type hiding( substTy, substCo, extendTvSubstList, zapSubst ) import GHC.Core.Multiplicity import GHC.Core.Predicate import GHC.Core.Coercion( Coercion ) @@ -25,12 +23,15 @@ import GHC.Core.Opt.Monad import qualified GHC.Core.Subst as Core import GHC.Core.Unfold.Make import GHC.Core +import GHC.Core.Make ( mkLitRubbish ) +import GHC.Core.Unify ( tcMatchTy ) import GHC.Core.Rules import GHC.Core.Utils ( exprIsTrivial , mkCast, exprType , stripTicksTop ) import GHC.Core.FVs -import GHC.Core.TyCo.Rep (TyCoBinder (..)) +import GHC.Core.TyCo.Rep ( TyCoBinder (..) ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList ) import GHC.Core.Opt.Arity( collectBindersPushingCo ) import GHC.Builtin.Types ( unboxedUnitTy ) @@ -770,6 +771,10 @@ spec_import top_env callers rb dict_binds cis@(CIS fn _) canSpecImport :: DynFlags -> Id -> Maybe CoreExpr -- See Note [Specialise imported INLINABLE things] canSpecImport dflags fn + | isDataConWrapId fn + = Nothing -- Don't specialise data-con wrappers, even if they + -- have dict args; there is no benefit. + | CoreUnfolding { uf_src = src, uf_tmpl = rhs } <- unf , isStableSource src = Just rhs -- By default, specialise only imported things that have a stable @@ -1493,12 +1498,12 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs | otherwise -- No calls or RHS doesn't fit our preconceptions = warnPprTrace (not (exprIsTrivial rhs) && notNull calls_for_me) - "Missed specialisation opportunity" (ppr fn $$ _trace_doc) $ + "Missed specialisation opportunity for" (ppr fn $$ trace_doc) $ -- Note [Specialisation shape] -- pprTrace "specCalls: none" (ppr fn <+> ppr calls_for_me) $ return ([], [], emptyUDs) where - _trace_doc = sep [ ppr rhs_bndrs, ppr (idInlineActivation fn) ] + trace_doc = sep [ ppr rhs_bndrs, ppr (idInlineActivation fn) ] fn_type = idType fn fn_arity = idArity fn @@ -1562,8 +1567,16 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs else do { -- Run the specialiser on the specialised RHS -- The "1" suffix is before we maybe add the void arg - ; (spec_rhs1, rhs_uds) <- specLam rhs_env2 (spec_bndrs1 ++ leftover_bndrs) rhs_body - ; let spec_fn_ty1 = exprType spec_rhs1 + ; (rhs_body', rhs_uds) <- specExpr rhs_env2 rhs_body + -- Add the { d1' = dx1; d2' = dx2 } usage stuff + -- to the rhs_uds; see Note [Specialising Calls] + ; let rhs_uds_w_dx = foldr consDictBind rhs_uds dx_binds + spec_rhs_bndrs = spec_bndrs1 ++ leftover_bndrs + (spec_uds, dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds_w_dx + spec_rhs1 = mkLams spec_rhs_bndrs $ + wrapDictBindsE dumped_dbs rhs_body' + + spec_fn_ty1 = exprType spec_rhs1 -- Maybe add a void arg to the specialised function, -- to avoid unlifted bindings @@ -1597,10 +1610,6 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs herald fn rule_bndrs rule_lhs_args (mkVarApps (Var spec_fn) spec_bndrs) - -- Add the { d1' = dx1; d2' = dx2 } usage stuff - -- See Note [Specialising Calls] - spec_uds = foldr consDictBind rhs_uds dx_binds - simpl_opts = initSimpleOpts dflags -------------------------------------- @@ -1615,9 +1624,12 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs = (inl_prag { inl_inline = NoUserInlinePrag }, noUnfolding) | otherwise - = (inl_prag, specUnfolding simpl_opts spec_bndrs (`mkApps` spec_args) + = (inl_prag, specUnfolding simpl_opts spec_bndrs spec_unf_body rule_lhs_args fn_unf) + spec_unf_body body = wrapDictBindsE dumped_dbs $ + body `mkApps` spec_args + -------------------------------------- -- Adding arity information just propagates it a bit faster -- See Note [Arity decrease] in GHC.Core.Opt.Simplify @@ -1786,11 +1798,23 @@ in the specialisation: {-# RULE "SPEC f @Int" forall x. f @Int x $dShow = $sf #-} This doesn’t save us much, since the arg would be removed later by -worker/wrapper, anyway, but it’s easy to do. Note, however, that we -only drop dead arguments if: +worker/wrapper, anyway, but it’s easy to do. + +Wrinkles + +* Note that we only drop dead arguments if: + 1. We don’t specialise on them. + 2. They come before an argument we do specialise on. + Doing the latter would require eta-expanding the RULE, which could + make it match less often, so it’s not worth it. Doing the former could + be more useful --- it would stop us from generating pointless + specialisations --- but it’s more involved to implement and unclear if + it actually provides much benefit in practice. - 1. We don’t specialise on them. - 2. They come before an argument we do specialise on. +* If the function has a stable unfolding, specHeader has to come up with + arguments to pass to that stable unfolding, when building the stable + unfolding of the specialised function: this is the last field in specHeader's + big result tuple. The right thing to do is to produce a LitRubbish; it should rapidly disappear. Rather like GHC.Core.Opt.WorkWrap.Utils.mk_absent_let. @@ -2268,11 +2292,11 @@ instance Outputable SpecArg where ppr (SpecDict d) = text "SpecDict" <+> ppr d ppr UnspecArg = text "UnspecArg" -specArgFreeVars :: SpecArg -> VarSet -specArgFreeVars (SpecType ty) = tyCoVarsOfType ty -specArgFreeVars (SpecDict dx) = exprFreeVars dx -specArgFreeVars UnspecType = emptyVarSet -specArgFreeVars UnspecArg = emptyVarSet +specArgFreeIds :: SpecArg -> IdSet +specArgFreeIds (SpecType {}) = emptyVarSet +specArgFreeIds (SpecDict dx) = exprFreeIds dx +specArgFreeIds UnspecType = emptyVarSet +specArgFreeIds UnspecArg = emptyVarSet isSpecDict :: SpecArg -> Bool isSpecDict (SpecDict {}) = True @@ -2342,24 +2366,30 @@ specHeader , [OutBndr] -- Binders for $sf , [DictBind] -- Auxiliary dictionary bindings , [OutExpr] -- Specialised arguments for unfolding - -- Same length as "args for LHS of rule" + -- Same length as "Args for LHS of rule" ) -- We want to specialise on type 'T1', and so we must construct a substitution -- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding -- details. -specHeader env (bndr : bndrs) (SpecType t : args) - = do { let env' = extendTvSubstList env [(bndr, t)] - ; (useful, env'', leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) - <- specHeader env' bndrs args +specHeader env (bndr : bndrs) (SpecType ty : args) + = do { let in_scope = Core.getSubstInScope (se_subst env) + qvars = scopedSort $ + filterOut (`elemInScopeSet` in_scope) $ + tyCoVarsOfTypeList ty + (env1, qvars') = substBndrs env qvars + ty' = substTy env1 ty + env2 = extendTvSubstList env1 [(bndr, ty')] + ; (useful, env3, leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) + <- specHeader env2 bndrs args ; pure ( useful - , env'' + , env3 , leftover_bndrs - , rule_bs - , Type t : rule_es - , bs' + , qvars' ++ rule_bs + , Type ty' : rule_es + , qvars' ++ bs' , dx - , Type t : spec_args + , Type ty' : spec_args ) } @@ -2415,16 +2445,28 @@ specHeader env (bndr : bndrs) (UnspecArg : args) let (env', bndr') = substBndr env (zapIdOccInfo bndr) ; (useful, env'', leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) <- specHeader env' bndrs args + + ; let bndr_ty = idType bndr' + + -- See Note [Drop dead args from specialisations] + -- C.f. GHC.Core.Opt.WorkWrap.Utils.mk_absent_let + (mb_spec_bndr, spec_arg) + | isDeadBinder bndr + , Just lit_expr <- mkLitRubbish bndr_ty + = (Nothing, lit_expr) + | otherwise + = (Just bndr', varToCoreExpr bndr') + ; pure ( useful , env'' , leftover_bndrs , bndr' : rule_bs , varToCoreExpr bndr' : rule_es - , if isDeadBinder bndr - then bs' -- see Note [Drop dead args from specialisations] - else bndr' : bs' + , case mb_spec_bndr of + Just b' -> b' : bs' + Nothing -> bs' , dx - , varToCoreExpr bndr' : spec_args + , spec_arg : spec_args ) } @@ -2550,6 +2592,60 @@ successfully specialise 'f'. So the DictBinds in (ud_binds :: OrdList DictBind) may contain non-dictionary bindings too. + +Note [Specialising polymorphic dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + class M a where { foo :: a -> Int } + + instance M (ST s) where ... + -- dMST :: forall s. M (ST s) + + wimwam :: forall a. M a => a -> Int + wimwam = /\a \(d::M a). body + + f :: ST s -> Int + f = /\s \(x::ST s). wimwam @(ST s) (dMST @s) dx + 1 + +We'd like to specialise wimwam at (ST s), thus + $swimwam :: forall s. ST s -> Int + $swimwam = /\s. body[ST s/a, (dMST @s)/d] + + RULE forall s (d :: M (ST s)). + wimwam @(ST s) d = $swimwam @s + +Here are the moving parts: + +* We must /not/ dump the CallInfo + CIS wimwam (CI { ci_key = [@(ST s), dMST @s] + , ci_fvs = {dMST} }) + when we come to the /\s. Instead, we simply let it continue to float + upwards. Hence ci_fvs is an IdSet, listing the /Ids/ that + are free in the call, but not the /TyVars/. Hence using specArgFreeIds + in singleCall. + + NB to be fully kosher we should explicitly quantifying the CallInfo + over 's', but we don't bother. This would matter if there was an + enclosing binding of the same 's', which I don't expect to happen. + +* Whe we come to specialise the call, we must remember to quantify + over 's'. That is done in the SpecType case of specHeader, where + we add 's' (called qvars) to the binders of the RULE and the specialised + function. + +* If we have f :: forall m. Monoid m => blah, and two calls + (f @(Endo b) (d :: Monoid (Endo b)) + (f @(Endo (c->c)) (d :: Monoid (Endo (c->c))) + we want to generate a specialisation only for the first. The second + is just a substitution instance of the first, with no greater specialisation. + Hence the call to `remove_dups` in `filterCalls`. + +All this arose in #13873, in the unexpected form that a SPECIALISE +pragma made the program slower! The reason was that the specialised +function $sinsertWith arising from the pragma looked rather like `f` +above, and failed to specialise a call in its body like wimwam. +Without the pragma, the original call to `insertWith` was completely +monomorpic, and speciased in one go. -} instance Outputable DictBind where @@ -2588,8 +2684,9 @@ data CallInfoSet = CIS Id (Bag CallInfo) data CallInfo = CI { ci_key :: [SpecArg] -- All arguments , ci_fvs :: IdSet -- Free Ids of the ci_key call - -- _not_ including the main id itself, of course + -- /not/ including the main id itself, of course -- NB: excluding tyvars: + -- See Note [Specialising polymorphic dictionaries] } type DictExpr = CoreExpr @@ -2638,7 +2735,7 @@ singleCall id args unitBag (CI { ci_key = args -- used to be tys , ci_fvs = call_fvs }) } where - call_fvs = foldr (unionVarSet . specArgFreeVars) emptyVarSet args + call_fvs = foldr (unionVarSet . specArgFreeIds) emptyVarSet args -- The type args (tys) are guaranteed to be part of the dictionary -- types, because they are just the constrained types, -- and the dictionary is therefore sure to be bound @@ -2968,15 +3065,15 @@ callsForMe fn uds at MkUD { ud_binds = orig_dbs, ud_calls = orig_calls } ---------------------- filterCalls :: CallInfoSet -> FloatedDictBinds -> [CallInfo] --- Remove dominated calls +-- Remove dominated calls (Note [Specialising polymorphic dictionaries]) -- and loopy DFuns (Note [Avoiding loops (DFuns)]) filterCalls (CIS fn call_bag) (FDB { fdb_binds = dbs }) | isDFunId fn -- Note [Avoiding loops (DFuns)] applies only to DFuns - = filter ok_call unfiltered_calls - | otherwise -- Do not apply it to non-DFuns - = unfiltered_calls -- See Note [Avoiding loops (non-DFuns)] + = filter ok_call de_dupd_calls + | otherwise -- Do not apply (filter ok_call) to non-DFuns + = de_dupd_calls -- See Note [Avoiding loops (non-DFuns)] where - unfiltered_calls = bagToList call_bag + de_dupd_calls = remove_dups call_bag dump_set = foldl' go (unitVarSet fn) dbs -- This dump-set could also be computed by splitDictBinds @@ -2990,6 +3087,29 @@ filterCalls (CIS fn call_bag) (FDB { fdb_binds = dbs }) ok_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` dump_set +remove_dups :: Bag CallInfo -> [CallInfo] +remove_dups calls = foldr add [] calls + where + add :: CallInfo -> [CallInfo] -> [CallInfo] + add ci [] = [ci] + add ci1 (ci2:cis) | ci2 `beats_or_same` ci1 = ci2:cis + | ci1 `beats_or_same` ci2 = ci1:cis + | otherwise = ci2 : add ci1 cis + +beats_or_same :: CallInfo -> CallInfo -> Bool +beats_or_same (CI { ci_key = args1 }) (CI { ci_key = args2 }) + = go args1 args2 + where + go [] _ = True + go (arg1:args1) (arg2:args2) = go_arg arg1 arg2 && go args1 args2 + go (_:_) [] = False + + go_arg (SpecType ty1) (SpecType ty2) = isJust (tcMatchTy ty1 ty2) + go_arg UnspecType UnspecType = True + go_arg (SpecDict {}) (SpecDict {}) = True + go_arg UnspecArg UnspecArg = True + go_arg _ _ = False + ---------------------- splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, OrdList DictBind, IdSet) -- splitDictBinds dbs bndrs returns @@ -3020,15 +3140,18 @@ splitDictBinds (FDB { fdb_binds = dbs, fdb_bndrs = bs }) bndr_set ---------------------- deleteCallsMentioning :: VarSet -> CallDetails -> CallDetails --- Remove calls *mentioning* bs in any way -deleteCallsMentioning bs calls +-- Remove calls mentioning any Id in bndrs +-- NB: The call is allowed to mention TyVars in bndrs +-- Note [Specialising polymorphic dictionaries] +-- ci_fvs are just the free /Ids/ +deleteCallsMentioning bndrs calls = mapDVarEnv (ciSetFilter keep_call) calls where - keep_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` bs + keep_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` bndrs deleteCallsFor :: [Id] -> CallDetails -> CallDetails --- Remove calls *for* bs -deleteCallsFor bs calls = delDVarEnvList calls bs +-- Remove calls *for* bndrs +deleteCallsFor bndrs calls = delDVarEnvList calls bndrs {- ************************************************************************ ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -26,7 +26,8 @@ module GHC.Core.Subst ( extendIdSubstWithClone, extendSubst, extendSubstList, extendSubstWithVar, extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, - isInScope, setInScope, extendTvSubst, extendCvSubst, + isInScope, setInScope, getSubstInScope, + extendTvSubst, extendCvSubst, delBndr, delBndrs, zapSubst, -- ** Substituting and cloning binders @@ -41,7 +42,6 @@ import GHC.Core import GHC.Core.FVs import GHC.Core.Seq import GHC.Core.Utils -import GHC.Core.TyCo.Subst ( substCo ) -- We are defining local versions import GHC.Core.Type hiding ( substTy ) ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -231,7 +231,7 @@ Recall that foldType :: TyCoFolder env a -> env -> Type -> a newtype Endo a = Endo (a -> a) -- In Data.Monoid - instance Monoid a => Monoid (Endo a) where + instance Monoid (Endo a) where (Endo f) `mappend` (Endo g) = Endo (f.g) appEndo :: Endo a -> a -> a ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -219,7 +219,7 @@ module GHC.Core.Type ( substTyAddInScope, substTyUnchecked, substTysUnchecked, substScaledTyUnchecked, substScaledTysUnchecked, substThetaUnchecked, substTyWithUnchecked, - substCoUnchecked, substCoWithUnchecked, + substCo, substCoUnchecked, substCoWithUnchecked, substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars, substVarBndr, substVarBndrs, substTyCoBndr, ===================================== hadrian/bootstrap/bootstrap.py ===================================== @@ -86,14 +86,17 @@ class Compiler: self.ghc_path = ghc_path.resolve() + exe = '' + if platform.system() == 'Windows': exe = '.exe' + info = self._get_ghc_info() self.version = info['Project version'] #self.lib_dir = Path(info['LibDir']) #self.ghc_pkg_path = (self.lib_dir / 'bin' / 'ghc-pkg').resolve() - self.ghc_pkg_path = (self.ghc_path.parent / 'ghc-pkg').resolve() + self.ghc_pkg_path = (self.ghc_path.parent / ('ghc-pkg' + exe)).resolve() if not self.ghc_pkg_path.is_file(): raise TypeError(f'ghc-pkg {self.ghc_pkg_path} is not a file') - self.hsc2hs_path = (self.ghc_path.parent / 'hsc2hs').resolve() + self.hsc2hs_path = (self.ghc_path.parent / ('hsc2hs' + exe)).resolve() if not self.hsc2hs_path.is_file(): raise TypeError(f'hsc2hs {self.hsc2hs_path} is not a file') @@ -367,6 +370,11 @@ def main() -> None: help='path to GHC') parser.add_argument('-s', '--bootstrap-sources', type=Path, help='Path to prefetched bootstrap sources tarball') + parser.add_argument('--archive', dest='want_archive', action='store_true', + help='produce a Hadrian distribution archive (default)') + parser.add_argument('--no-archive', dest='want_archive', action='store_false', + help='do not produce a Hadrian distribution archive') + parser.set_defaults(want_archive=True) subparsers = parser.add_subparsers(dest="command") @@ -381,6 +389,9 @@ def main() -> None: ghc = None + sources_fmt = 'gztar' # The archive format for the bootstrap sources archive. + if platform.system() == 'Windows': sources_fmt = 'zip' + if args.deps is None: if args.bootstrap_sources is None: # find appropriate plan in the same directory as the script @@ -390,7 +401,7 @@ def main() -> None: # We have a tarball with all the required information, unpack it and use for further elif args.bootstrap_sources is not None and args.command != 'list-sources': print(f'Unpacking {args.bootstrap_sources} to {TARBALLS}') - shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, 'gztar') + shutil.unpack_archive(args.bootstrap_sources.resolve(), TARBALLS, sources_fmt) args.deps = TARBALLS / 'plan-bootstrap.json' print(f"using plan-bootstrap.json ({args.deps}) from {args.bootstrap_sources}") else: @@ -428,10 +439,7 @@ def main() -> None: shutil.copyfile(args.deps, rootdir / 'plan-bootstrap.json') - fmt = 'gztar' - if platform.system() == 'Windows': fmt = 'zip' - - archivename = shutil.make_archive(args.output, fmt, root_dir=rootdir) + archivename = shutil.make_archive(args.output, sources_fmt, root_dir=rootdir) print(f""" Bootstrap sources saved to {archivename} @@ -475,21 +483,21 @@ Alternatively, you could use `bootstrap.py -w {ghc.ghc_path} -d {args.deps} fetc bootstrap(info, ghc) hadrian_path = (BINDIR / 'hadrian').resolve() - archive = make_archive(hadrian_path) - print(dedent(f''' Bootstrapping finished! The resulting hadrian executable can be found at {hadrian_path} + ''')) - It has been archived for distribution in - - {archive} + if args.want_archive: + dist_archive = make_archive(hadrian_path) + print(dedent(f''' + The Hadrian executable has been archived for distribution in - You can use this executable to build GHC. - ''')) + {dist_archive} + ''')) else: print(f"No such command: {args.command}") ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -2,7 +2,6 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:458:2: Note [RoughMap and rm_empt ref compiler/GHC/Core/Opt/OccurAnal.hs:857:15: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1598:30: Note [Top level scope] ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2666:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:3288:0: Note [Suppressing binder-swaps on linear case] ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:3816:8: Note [Lambda-bound unfoldings] ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1282:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1611:28: Note [Arity decrease] ===================================== testsuite/tests/simplCore/should_compile/T8331.stderr ===================================== @@ -1,6 +1,103 @@ ==================== Tidy Core rules ==================== -"USPEC useAbstractMonad @(ReaderT Int (ST s))" +"SPEC $c*> @(ST s) _" + forall (@s) (@r) ($dApplicative :: Applicative (ST s)). + $fApplicativeReaderT_$c*> @(ST s) @r $dApplicative + = ($fApplicativeReaderT3 @s @r) + `cast` (forall (a :: <*>_N) (b :: <*>_N). + _R + %<'Many>_N ->_R _R + %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) + ; Sym (N:ReaderT[0] <*>_N _R _R _N) + :: Coercible + (forall {a} {b}. + ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b) + (forall {a} {b}. + ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b)) +"SPEC $c<* @(ST s) _" + forall (@s) (@r) ($dApplicative :: Applicative (ST s)). + $fApplicativeReaderT_$c<* @(ST s) @r $dApplicative + = ($fApplicativeReaderT2 @s @r) + `cast` (forall (a :: <*>_N) (b :: <*>_N). + _R + %<'Many>_N ->_R _R + %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) + ; Sym (N:ReaderT[0] <*>_N _R _R _N) + :: Coercible + (forall {a} {b}. + ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s a) + (forall {a} {b}. + ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) +"SPEC $c<*> @(ST s) _" + forall (@s) (@r) ($dApplicative :: Applicative (ST s)). + $fApplicativeReaderT5 @(ST s) @r $dApplicative + = ($fApplicativeReaderT6 @s @r) + `cast` (forall (a :: <*>_N) (b :: <*>_N). + b)>_R + %<'Many>_N ->_R _R + %<'Many>_N ->_R _R + %<'Many>_N ->_R Sym (N:ST[0] _N _R) + :: Coercible + (forall {a} {b}. + ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) + (forall {a} {b}. + ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> ST s b)) +"SPEC $c>> @(ST s) _" + forall (@s) (@r) ($dMonad :: Monad (ST s)). + $fMonadReaderT_$c>> @(ST s) @r $dMonad + = $fMonadAbstractIOSTReaderT_$s$c>> @s @r +"SPEC $c>>= @(ST s) _" + forall (@s) (@r) ($dMonad :: Monad (ST s)). + $fMonadReaderT1 @(ST s) @r $dMonad + = ($fMonadReaderT2 @s @r) + `cast` (forall (a :: <*>_N) (b :: <*>_N). + _R + %<'Many>_N ->_R ReaderT r (ST s) b>_R + %<'Many>_N ->_R _R + %<'Many>_N ->_R Sym (N:ST[0] _N _R) + :: Coercible + (forall {a} {b}. + ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> STRep s b) + (forall {a} {b}. + ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> ST s b)) +"SPEC $cliftA2 @(ST s) _" + forall (@s) (@r) ($dApplicative :: Applicative (ST s)). + $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative + = ($fApplicativeReaderT1 @s @r) + `cast` (forall (a :: <*>_N) (b :: <*>_N) (c :: <*>_N). + b -> c>_R + %<'Many>_N ->_R _R + %<'Many>_N ->_R _R + %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) + ; Sym (N:ReaderT[0] <*>_N _R _R _N) + :: Coercible + (forall {a} {b} {c}. + (a -> b -> c) + -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s c) + (forall {a} {b} {c}. + (a -> b -> c) + -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) c)) +"SPEC $cp1Applicative @(ST s) _" + forall (@s) (@r) ($dApplicative :: Applicative (ST s)). + $fApplicativeReaderT_$cp1Applicative @(ST s) @r $dApplicative + = $fApplicativeReaderT_$s$fFunctorReaderT @s @r +"SPEC $cp1Monad @(ST s) _" + forall (@s) (@r) ($dMonad :: Monad (ST s)). + $fMonadReaderT_$cp1Monad @(ST s) @r $dMonad + = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r +"SPEC $fApplicativeReaderT @(ST s) _" + forall (@s) (@r) ($dApplicative :: Applicative (ST s)). + $fApplicativeReaderT @(ST s) @r $dApplicative + = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r +"SPEC $fFunctorReaderT @(ST s) _" + forall (@s) (@r) ($dFunctor :: Functor (ST s)). + $fFunctorReaderT @(ST s) @r $dFunctor + = $fApplicativeReaderT_$s$fFunctorReaderT @s @r +"SPEC $fMonadReaderT @(ST s) _" + forall (@s) (@r) ($dMonad :: Monad (ST s)). + $fMonadReaderT @(ST s) @r $dMonad + = $fMonadAbstractIOSTReaderT_$s$fMonadReaderT @s @r +"SPEC useAbstractMonad" forall (@s) ($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))). useAbstractMonad @(ReaderT Int (ST s)) $dMonadAbstractIOST ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -359,7 +359,6 @@ test('T19586', normal, compile, ['']) test('T19599', normal, compile, ['-O -ddump-rules']) test('T19599a', normal, compile, ['-O -ddump-rules']) -test('T13873', [expect_broken(21229), grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) # Look for a specialisation rule for wimwam test('T19672', normal, compile, ['-O2 -ddump-rules']) @@ -428,3 +427,4 @@ test('T21948', [grep_errmsg(r'^ Arity=5') ], compile, ['-O -ddump-simpl']) test('T21763', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules']) test('T22028', normal, compile, ['-O -ddump-rule-firings']) +test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b7d4eb5b5f75a2e2b93ebbc5f3952c3ea2ace2c...cd3f0c275091944b9dc5ae4b2b5e5484cfd3b171 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b7d4eb5b5f75a2e2b93ebbc5f3952c3ea2ace2c...cd3f0c275091944b9dc5ae4b2b5e5484cfd3b171 You're receiving 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 31 22:27:56 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 18:27:56 -0400 Subject: [Git][ghc/ghc][master] 12 commits: Bump binary submodule to 0.8.9.1 Message-ID: <630fe06c72d99_2f2e58a70ea68102381c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - 18 changed files: - compiler/ghc.cabal.in - config.guess - config.sub - docs/users_guide/packages.rst - libraries/Cabal - libraries/binary - libraries/bytestring - libraries/containers - libraries/deepseq - libraries/directory - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-prim/changelog.md - libraries/ghc-prim/ghc-prim.cabal - libraries/process - libraries/stm - libraries/text - testsuite/tests/driver/T4437.hs - testsuite/tests/package/T4806a.stderr 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*) ;; -*) ===================================== docs/users_guide/packages.rst ===================================== @@ -1449,3 +1449,23 @@ The allowed fields, with their types, are: HTML for this package. .. [1] it used to in GHC 6.4, but not since 6.6 + + +.. _system-cxx-std-lib: + +Linking against C++ libraries +----------------------------- + +.. index:: + single: system-cxx-std-lib + single: packages; system-cxx-std-lib + single: C++; linking + +Use of C++ libraries requires that the user link against the host +system's C++ standard library. As the configuration necessary to +achieve this is generally quite platform-dependent, GHC provides a +built-in package, ``system-cxx-std-lib``. This package captures the +configuration necessary for linking against the C++ standard library +and can be used via the :ghc-flag:`-package ⟨pkg⟩` flag or the Cabal +``build-depends`` field to link code against the C++ standard +library. ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 18d801832a3ad5f346eeaaf3f8f3df1abd5a6b9d +Subproject commit 5d18b763356dca719f5286a52328cb41b9fa4192 ===================================== libraries/binary ===================================== @@ -1 +1 @@ -Subproject commit 6af054b4431fa7c20bf6309536cfef7d47f2c17f +Subproject commit 96599519783a5e02e9f050744a7ce5fb0940dc99 ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit acfe93480a15ecd373a5de5e423b1460749e52e1 +Subproject commit 1543e054a314865d89a259065921d5acba03d966 ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 5c1ce92782d89ecc44913834069c7b362b217191 +Subproject commit 50175b72dc781f82a419bddafba1bdd758fbee4b ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit f241315f4cc905076d5c988c27c7db9fbde8bbe7 +Subproject commit 38ab699cd5e08a85fdc9ac27f1612ce130e98a5a ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 4556d3cb689b8ef7c0f433de3c957559613e3429 +Subproject commit b33c1087d746389a687be42aa1fb73c12e3885d3 ===================================== 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 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit b95e5fbdeb74e0cc36b6878b60f9807bd0001fa8 +Subproject commit 2ac3ff366631a36d84101000045abbefa4415b15 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit d4da9d83d1eab562460aa89cedac61abc884d93e +Subproject commit f4eb5a85c2732f8f5a03ef8af88d6aff90945415 ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit 0fcf98843b7f03dd6741cfc730a55ad65748bea9 +Subproject commit fdb06ff327519f3c0fc6cc9997b7cb7fe8ab8178 ===================================== 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] ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -1,7 +1,7 @@ T4806a.hs:1:1: error: Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.0.1’ + It is a member of the package ‘containers-0.6.6’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: - deepseq-1.4.8.0 + deepseq-1.4.8.0 template-haskell-2.19.0.0 Use -v (or `:set -v` in ghci) to see a list of the files searched for. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f490b1333c17ed27b213d6af8c7275aa9b3de63...f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f490b1333c17ed27b213d6af8c7275aa9b3de63...f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02 You're receiving 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 31 22:28:14 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 18:28:14 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Refine in-tree compiler args for --test-compiler=stage1 Message-ID: <630fe07e7da10_2f2e58a70ea681029114@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 7 changed files: - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -241,7 +241,10 @@ enableLateCCS = addArgs -- | Enable assertions for the stage2 compiler enableAssertions :: Flavour -> Flavour -enableAssertions flav = flav { ghcDebugAssertions = True } +enableAssertions flav = flav { ghcDebugAssertions = f } + where + f Stage2 = True + f st = ghcDebugAssertions flav st -- | Produce fully statically-linked executables and build libraries suitable -- for static linking. ===================================== hadrian/src/Flavour/Type.hs ===================================== @@ -35,7 +35,7 @@ data Flavour = Flavour { -- | Build GHC with the debug RTS. ghcDebugged :: Stage -> Bool, -- | Build GHC with debug assertions. - ghcDebugAssertions :: Bool, + ghcDebugAssertions :: Stage -> Bool, -- | Build the GHC executable against the threaded runtime system. ghcThreaded :: Stage -> Bool, -- | Whether to build docs and which ones ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -17,6 +17,8 @@ import qualified Data.Set as Set import Flavour import qualified Context.Type as C import System.Directory (findExecutable) +import Settings.Program +import qualified Context.Type getTestSetting :: TestSetting -> Action String getTestSetting key = testSetting key @@ -91,16 +93,14 @@ inTreeCompilerArgs stg = do return (dynamic `elem` ways, threaded `elem` ways) -- MP: We should be able to vary if stage1/stage2 is dynamic, ie a dynamic stage1 -- should be able to built a static stage2? - hasDynamic <- flavour >>= dynamicGhcPrograms + hasDynamic <- (dynamic ==) . Context.Type.way <$> (programContext stg ghc) -- LeadingUnderscore is a property of the system so if cross-compiling stage1/stage2 could -- have different values? Currently not possible to express. leadingUnderscore <- flag LeadingUnderscore - -- MP: This setting seems to only dictate whether we turn on optasm as a compiler - -- way, but a lot of tests which use only_ways(optasm) seem to not test the NCG? withInterpreter <- ghcWithInterpreter unregisterised <- flag GhcUnregisterised withSMP <- targetSupportsSMP - debugAssertions <- ghcDebugAssertions <$> flavour + debugAssertions <- ($ stg) . ghcDebugAssertions <$> flavour profiled <- ghcProfiled <$> flavour <*> pure stg os <- setting HostOs ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -240,7 +240,7 @@ defaultFlavour = Flavour , ghcProfiled = const False , ghcDebugged = const False , ghcThreaded = const True - , ghcDebugAssertions = False + , ghcDebugAssertions = const False , ghcDocs = cmdDocsArgs } -- | Default logic for determining whether to build ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug] , dynamicGhcPrograms = return False - , ghcDebugAssertions = True } + , ghcDebugAssertions = (>= Stage2) } where stageString Stage2 = "2" stageString Stage1 = "1" ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] ] + , ghcDebugAssertions = (<= Stage1) } validateArgs :: Args @@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs , notStage0 ? arg "-dno-debug-output" ] , hsLibrary = pure ["-O"] - , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"] + , hsCompiler = mconcat [ stage0 ? pure ["-O2"] , notStage0 ? pure ["-O" ] ] , hsGhc = pure ["-O"] } + slowValidateFlavour :: Flavour slowValidateFlavour = validateFlavour { name = "slow-validate" - , ghcDebugAssertions = True + , ghcDebugAssertions = const True } quickValidateArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -52,7 +52,7 @@ packageArgs = do [ builder Alex ? arg "--latin1" , builder (Ghc CompileHs) ? mconcat - [ debugAssertions ? notStage0 ? arg "-DDEBUG" + [ debugAssertions stage ? arg "-DDEBUG" , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto" , input "**/Parser.hs" ? @@ -83,7 +83,7 @@ packageArgs = do , package ghc ? mconcat [ builder Ghc ? mconcat [ arg ("-I" ++ compilerPath) - , debugAssertions ? notStage0 ? arg "-DDEBUG" ] + , debugAssertions stage ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02...6b2f7ffea51304091bfa4bd1d88a58ea373ee551 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02...6b2f7ffea51304091bfa4bd1d88a58ea373ee551 You're receiving 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 31 23:20:35 2022 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 31 Aug 2022 19:20:35 -0400 Subject: [Git][ghc/ghc][wip/js-staging] 3 commits: Ppr: add hangBrace helper Message-ID: <630fecc360a9b_2f2e58487ec1035564@gitlab.mail> Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC Commits: 9350d2ae by Sylvain Henry at 2022-08-31T22:13:48+02:00 Ppr: add hangBrace helper - - - - - 5e90ac04 by Sylvain Henry at 2022-09-01T01:11:36+02:00 Only declare ccs var in profiling mode - - - - - 2b782512 by Sylvain Henry at 2022-09-01T01:12:20+02:00 Don't consider recursive bindings as inline nor as evaluated Fix mdo001 - - - - - 5 changed files: - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/StgUtils.hs Changes: ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -23,8 +23,7 @@ module GHC.JS.Ppr , pprStringLit , flattenBlocks , braceNest - , braceNest' - , braceNest'' + , hangBrace ) where @@ -88,12 +87,13 @@ renderPrefixJs' r pfx = jsToDocR r . jsSaturate (Just $ "jmId_" `mappend` pfx) braceNest :: Doc -> Doc braceNest x = char '{' <+> nest 2 x $$ char '}' -braceNest' :: Doc -> Doc -braceNest' x = nest 2 (char '{' $+$ x) $$ char '}' - --- somewhat more compact (egyptian style) braces -braceNest'' :: Doc -> Doc -braceNest'' x = nest 2 (char '{' $$ x) $$ char '}' +-- | Hang with braces: +-- +-- hdr { +-- body +-- } +hangBrace :: Doc -> Doc -> Doc +hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc instance JsToDoc JStat where jsToDocR r = renderJsS r r @@ -107,12 +107,14 @@ instance JsToDoc [JStat] where defRenderJsS :: RenderJs -> JStat -> Doc defRenderJsS r = \case - IfStat cond x y -> text "if" <> parens (jsToDocR r cond) $$ braceNest' (jsToDocR r x) $$ mbElse + IfStat cond x y -> hangBrace (text "if" <> parens (jsToDocR r cond)) + (jsToDocR r x) + $$ mbElse where mbElse | y == BlockStat [] = PP.empty - | otherwise = text "else" $$ braceNest' (jsToDocR r y) + | otherwise = hangBrace (text "else") (jsToDocR r y) DeclStat x -> text "var" <+> jsToDocR r x - WhileStat False p b -> text "while" <> parens (jsToDocR r p) $$ braceNest' (jsToDocR r b) - WhileStat True p b -> (text "do" $$ braceNest' (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p) + WhileStat False p b -> hangBrace (text "while" <> parens (jsToDocR r p)) (jsToDocR r b) + WhileStat True p b -> (hangBrace (text "do") (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p) UnsatBlock e -> jsToDocR r $ pseudoSaturate e BreakStat l -> maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l @@ -124,19 +126,19 @@ defRenderJsS r = \case interSemi [] = [] interSemi (x:xs) = (jsToDocR r x <> semi) : interSemi xs - ForInStat each i e b -> text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e) $$ braceNest' (jsToDocR r b) + ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) where txt | each = "for each" | otherwise = "for" - SwitchStat e l d -> text "switch" <+> parens (jsToDocR r e) $$ braceNest' cases + SwitchStat e l d -> hangBrace (text "switch" <+> parens (jsToDocR r e)) cases where l' = map (\(c,s) -> (text "case" <+> parens (jsToDocR r c) <> char ':') $$$ (jsToDocR r s)) l ++ [text "default:" $$$ (jsToDocR r d)] cases = vcat l' ReturnStat e -> text "return" <+> jsToDocR r e ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) - TryStat s i s1 s2 -> text "try" $$ braceNest' (jsToDocR r s) $$ mbCatch $$ mbFinally + TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally where mbCatch | s1 == BlockStat [] = PP.empty - | otherwise = text "catch" <> parens (jsToDocR r i) $$ braceNest' (jsToDocR r s1) + | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) mbFinally | s2 == BlockStat [] = PP.empty - | otherwise = text "finally" $$ braceNest' (jsToDocR r s2) + | otherwise = hangBrace (text "finally") (jsToDocR r s2) AssignStat i x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. @@ -198,7 +200,7 @@ defRenderJsV r = \case -- nonDetEltsUniqMap doesn't introduce non-determinism here -- because we sort the elements lexically $ sortOn (LexicalFastString . fst) (nonDetEltsUniqMap m) - JFunc is b -> parens $ text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) $$ braceNest' (jsToDocR r b) + JFunc is b -> parens $ hangBrace (text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) UnsatVal f -> jsToDocR r $ pseudoSaturate f defRenderJsI :: RenderJs -> Ident -> Doc ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -170,7 +170,7 @@ genApp ctx i args -- case of Id without args and known to be already evaluated: return fields -- individually | [] <- args - , ctxIsEvaluated ctx i || isStrictId i + , ctxIsEvaluated ctx i || isStrictType (idType i) = do a <- storeIdFields i (ctxTarget ctx) -- optional runtime assert for detecting unexpected thunks (unevaluated) ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -518,7 +518,7 @@ genCase :: HasDebugCallStack -> LiveVars -> G (JStat, ExprResult) genCase ctx bnd e at alts l - | snd (isInlineExpr (ctxEvaluatedIds ctx) e) = freshIdent >>= \ccsVar -> do + | snd (isInlineExpr (ctxEvaluatedIds ctx) e) = do bndi <- identsForId bnd let ctx' = ctxSetTop bnd $ ctxSetTarget (assocIdExprs bnd (map toJExpr bndi)) @@ -529,15 +529,17 @@ genCase ctx bnd e at alts l ExprCont -> pprPanic "genCase: expression was not inline" (pprStgExpr panicStgPprOpts e) - ww = mempty -- if snd (isInlineExpr emptyUniqSet e) then mempty else [j| h$log('danger will robinson'); |] (aj, ar) <- genAlts (ctxAssertEvaluated bnd ctx) bnd at d alts - saveCCS <- ifProfiling (toJExpr ccsVar |= toJExpr jCurrentCCS) - restoreCCS <- ifProfiling (toJExpr jCurrentCCS |= toJExpr ccsVar) + (declCCS,saveCCS,restoreCCS) <- ifProfilingM $ do + ccsVar <- freshIdent + pure ( DeclStat ccsVar + , toJExpr ccsVar |= toJExpr jCurrentCCS + , toJExpr jCurrentCCS |= toJExpr ccsVar + ) return ( mconcat - [ DeclStat ccsVar + [ declCCS , mconcat (map DeclStat bndi) , saveCCS - , ww , ej , restoreCCS , aj @@ -940,7 +942,7 @@ allocDynAll haveDecl middle cls = do dec i | haveDecl = DeclStat i | otherwise = mempty checkObjs | csAssertRts settings = mconcat $ - map (\(i,_,_,_) -> ApplStat (ValExpr (JVar (TxtI "h$checkObj"))) [toJExpr i] {-[j| h$checkObj(`i`); |]-}) cls + map (\(i,_,_,_) -> ApplStat (ValExpr (JVar (TxtI "h$checkObj"))) [toJExpr i]) cls | otherwise = mempty objs <- makeObjs ===================================== compiler/GHC/StgToJS/Printer.hs ===================================== @@ -105,9 +105,8 @@ prettyBlock' r ( (DeclStat i) : (AssignStat (ValExpr (JVar i')) (ValExpr (JFunc is b))) : xs ) - | i == i' = (text "function" <+> jsToDocR r i - <> parens (fsep . punctuate comma . map (jsToDocR r) $ is) - $$ braceNest' (jsToDocR r b) + | i == i' = (hangBrace (text "function" <+> jsToDocR r i <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) + (jsToDocR r b) ) : prettyBlock' r xs -- declare/assign prettyBlock' r ( (DeclStat i) @@ -140,7 +139,8 @@ prettyBlock' _ [] = [] -- build the for block mkFor :: RenderJs -> Bool -> Ident -> JExpr -> JExpr -> JStat -> [JStat] -> Doc -mkFor r decl i v0 p s1 sb = text "for" <> forCond <+> braceNest'' (jsToDocR r $ BlockStat sb) +mkFor r decl i v0 p s1 sb = hangBrace (text "for" <> forCond) + (jsToDocR r $ BlockStat sb) where c0 | decl = text "var" <+> jsToDocR r i <+> char '=' <+> jsToDocR r v0 | otherwise = jsToDocR r i <+> char '=' <+> jsToDocR r v0 ===================================== compiler/GHC/StgToJS/StgUtils.hs ===================================== @@ -255,8 +255,8 @@ isInlineApp v i = \case _ | isJoinId i -> False [] -> isUnboxedTupleType (idType i) || isStrictType (idType i) || - i `elementOfUniqSet` v || - isStrictId i + i `elementOfUniqSet` v + [StgVarArg a] | DataConWrapId dc <- idDetails i , isNewTyCon (dataConTyCon dc) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/577b4845277443f721e394bd41621aee393efe9f...2b782512356aeded56d8191f1fe51348fecb69be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/577b4845277443f721e394bd41621aee393efe9f...2b782512356aeded56d8191f1fe51348fecb69be You're receiving 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 31 23:29:05 2022 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 Aug 2022 19:29:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Refine in-tree compiler args for --test-compiler=stage1 Message-ID: <630feec11c9af_2f2e58487d8103700@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 5371a3af by Zubin Duggal at 2022-08-31T19:28:43-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 4307eb2f by Krzysztof Gogolewski at 2022-08-31T19:28:44-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 21 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - ghc/GHCi/UI.hs - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs - testsuite/tests/corelint/T21115b.stderr - + testsuite/tests/typecheck/should_compile/T21550.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -772,7 +772,7 @@ However, join points have simpler invariants in other ways e.g. let j :: Int# = factorial x in ... 6. The RHS of join point is not required to have a fixed runtime representation, - e.g. let j :: r :: TYPE l = fail void# in ... + e.g. let j :: r :: TYPE l = fail (##) in ... This happened in an intermediate program #13394 Examples: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -45,7 +45,6 @@ module GHC.Core.Coercion ( mkKindCo, castCoercionKind, castCoercionKind1, castCoercionKind2, - mkHeteroCoercionType, mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, mkHeteroPrimEqPred, mkHeteroReprPrimEqPred, @@ -77,7 +76,6 @@ module GHC.Core.Coercion ( -- ** Coercion variables mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique, - isCoVar_maybe, -- ** Free variables tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo, @@ -521,7 +519,9 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args -- didn't have enough binders go acc_arg_cos _ki1 co _ki2 _tys = (reverse acc_arg_cos, co) --- | Attempts to obtain the type variable underlying a 'Coercion' +-- | Extract a covar, if possible. This check is dirty. Be ashamed +-- of yourself. (It's dirty because it cares about the structure of +-- a coercion, which is morally reprehensible.) getCoVar_maybe :: Coercion -> Maybe CoVar getCoVar_maybe (CoVarCo cv) = Just cv getCoVar_maybe _ = Nothing @@ -953,13 +953,6 @@ it's a relatively expensive test and perhaps better done in optCoercion. Not a big deal either way. -} --- | Extract a covar, if possible. This check is dirty. Be ashamed --- of yourself. (It's dirty because it cares about the structure of --- a coercion, which is morally reprehensible.) -isCoVar_maybe :: Coercion -> Maybe CoVar -isCoVar_maybe (CoVarCo cv) = Just cv -isCoVar_maybe _ = Nothing - mkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Coercion -- mkAxInstCo can legitimately be called over-staturated; @@ -2558,11 +2551,6 @@ mkCoercionType Phantom = \ty1 ty2 -> in TyConApp eqPhantPrimTyCon [ki1, ki2, ty1, ty2] -mkHeteroCoercionType :: Role -> Kind -> Kind -> Type -> Type -> Type -mkHeteroCoercionType Nominal = mkHeteroPrimEqPred -mkHeteroCoercionType Representational = mkHeteroReprPrimEqPred -mkHeteroCoercionType Phantom = panic "mkHeteroCoercionType" - -- | Creates a primitive type equality predicate. -- Invariant: the types are not Coercions mkPrimEqPred :: Type -> Type -> Type ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Prelude import GHC.Platform -import GHC.Types.Id.Make ( voidPrimId ) +import GHC.Types.Id.Make ( unboxedUnitExpr ) import GHC.Types.Id import GHC.Types.Literal import GHC.Types.Name.Occurrence ( occNameFS ) @@ -2107,7 +2107,7 @@ builtinBignumRules = let ret n v = pure $ mkCoreUbxSum 2 n [unboxedUnitTy,naturalTy] v platform <- getPlatform if x < y - then ret 1 $ Var voidPrimId + then ret 1 unboxedUnitExpr else ret 2 $ mkNaturalExpr platform (x - y) -- unary operations ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -129,7 +129,6 @@ module GHC.Core.Type ( isUnliftedType, isBoxedType, isUnboxedTupleType, isUnboxedSumType, kindBoxedRepLevity_maybe, mightBeLiftedType, mightBeUnliftedType, - isStateType, isAlgType, isDataFamilyAppType, isPrimitiveType, isStrictType, isLevityTy, isLevityVar, @@ -2482,13 +2481,6 @@ isUnliftedType ty = Nothing -> pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty)) --- | State token type. -isStateType :: Type -> Bool -isStateType ty - = case tyConAppTyCon_maybe ty of - Just tycon -> tycon == statePrimTyCon - _ -> False - -- | Returns: -- -- * 'False' if the type is /guaranteed/ unlifted or ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -5023,7 +5023,6 @@ initSDocContext dflags style = SDC , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags , sdocErrorSpans = gopt Opt_ErrorSpans dflags , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocImpredicativeTypes = xopt LangExt.ImpredicativeTypes dflags , sdocLinearTypes = xopt LangExt.LinearTypes dflags , sdocListTuplePuns = True , sdocPrintTypeAbbreviations = True ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -795,7 +795,7 @@ dsHsConLike (PatSynCon ps) = do { builder_id <- dsLookupGlobalId builder_name ; return (if add_void then mkCoreApp (text "dsConLike" <+> ppr ps) - (Var builder_id) (Var voidPrimId) + (Var builder_id) unboxedUnitExpr else Var builder_id) } | otherwise = pprPanic "dsConLike" (ppr ps) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -917,7 +917,7 @@ mkFailurePair expr ; fail_fun_arg <- newSysLocalDs Many unboxedUnitTy ; let real_arg = setOneShotLambda fail_fun_arg ; return (NonRec fail_fun_var (Lam real_arg expr), - App (Var fail_fun_var) (Var voidPrimId)) } + App (Var fail_fun_var) unboxedUnitExpr) } where ty = exprType expr ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -56,7 +56,6 @@ import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin import GHC.Tc.TyCl.Build import GHC.Types.Var.Set -import GHC.Types.Id.Make import GHC.Tc.TyCl.Utils import GHC.Core.ConLike import GHC.Types.FieldLabel @@ -796,8 +795,8 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn res_ty = mkTyVarTy res_tv is_unlifted = null args && null prov_dicts (cont_args, cont_arg_tys) - | is_unlifted = ([nlHsVar voidPrimId], [unboxedUnitTy]) - | otherwise = (args, arg_tys) + | is_unlifted = ([nlHsDataCon unboxedUnitDataCon], [unboxedUnitTy]) + | otherwise = (args, arg_tys) cont_ty = mkInfSigmaTy ex_tvs prov_theta $ mkVisFunTysMany cont_arg_tys res_ty @@ -818,7 +817,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn inst_wrap = mkWpEvApps prov_dicts <.> mkWpTyApps ex_tys cont' = foldl' nlHsApp (mkLHsWrap inst_wrap (nlHsVar cont)) cont_args - fail' = nlHsApps fail [nlHsVar voidPrimId] + fail' = nlHsApps fail [nlHsDataCon unboxedUnitDataCon] args = map nlVarPat [scrutinee, cont, fail] lwpat = noLocA $ WildPat pat_ty ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Types.Id.Make ( DataConBoxer(..), vanillaDataConBoxer, mkDataConRep, mkDataConWorkId, DataConBangOpts (..), BangOpts (..), + unboxedUnitExpr, -- And some particular Ids; see below for why they are wired in wiredInIds, ghcPrimIds, @@ -1812,9 +1813,10 @@ voidPrimId :: Id -- Global constant :: Void# -- We cannot define it in normal Haskell, since it's -- a top-level unlifted value. voidPrimId = pcMiscPrelId voidPrimIdName unboxedUnitTy - (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs) - where rhs = Var (dataConWorkId unboxedUnitDataCon) + (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts unboxedUnitExpr) +unboxedUnitExpr :: CoreExpr +unboxedUnitExpr = Var (dataConWorkId unboxedUnitDataCon) voidArgId :: Id -- Local lambda-bound :: Void# voidArgId = mkSysLocal (fsLit "void") voidArgIdKey Many unboxedUnitTy ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -390,7 +390,6 @@ data SDocContext = SDC , sdocErrorSpans :: !Bool , sdocStarIsType :: !Bool , sdocLinearTypes :: !Bool - , sdocImpredicativeTypes :: !Bool , sdocListTuplePuns :: !Bool , sdocPrintTypeAbbreviations :: !Bool , sdocUnitIdForUser :: !(FastString -> SDoc) @@ -450,7 +449,6 @@ defaultSDocContext = SDC , sdocSuppressStgExts = False , sdocErrorSpans = False , sdocStarIsType = False - , sdocImpredicativeTypes = False , sdocLinearTypes = False , sdocListTuplePuns = True , sdocPrintTypeAbbreviations = True ===================================== ghc/GHCi/UI.hs ===================================== @@ -57,7 +57,7 @@ import GHC.Driver.Config.Diagnostic import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Resume, SingleStep, Ghc, - GetDocsFailure(..), putLogMsgM, pushLogHookM, + GetDocsFailure(..), pushLogHookM, getModuleGraph, handleSourceError, ms_mod ) import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation) import GHC.Hs.ImpExp @@ -3289,7 +3289,8 @@ showCmd str = do , action "bindings" $ showBindings , action "linker" $ do msg <- liftIO $ Loader.showLoaderState (hscInterp hsc_env) - putLogMsgM MCDump noSrcSpan msg + dflags <- getDynFlags + liftIO $ putStrLn $ showSDoc dflags msg , action "breaks" $ showBkptTable , action "context" $ showContext , action "packages" $ showUnits ===================================== hadrian/src/Flavour.hs ===================================== @@ -241,7 +241,10 @@ enableLateCCS = addArgs -- | Enable assertions for the stage2 compiler enableAssertions :: Flavour -> Flavour -enableAssertions flav = flav { ghcDebugAssertions = True } +enableAssertions flav = flav { ghcDebugAssertions = f } + where + f Stage2 = True + f st = ghcDebugAssertions flav st -- | Produce fully statically-linked executables and build libraries suitable -- for static linking. ===================================== hadrian/src/Flavour/Type.hs ===================================== @@ -35,7 +35,7 @@ data Flavour = Flavour { -- | Build GHC with the debug RTS. ghcDebugged :: Stage -> Bool, -- | Build GHC with debug assertions. - ghcDebugAssertions :: Bool, + ghcDebugAssertions :: Stage -> Bool, -- | Build the GHC executable against the threaded runtime system. ghcThreaded :: Stage -> Bool, -- | Whether to build docs and which ones ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -17,6 +17,8 @@ import qualified Data.Set as Set import Flavour import qualified Context.Type as C import System.Directory (findExecutable) +import Settings.Program +import qualified Context.Type getTestSetting :: TestSetting -> Action String getTestSetting key = testSetting key @@ -91,16 +93,14 @@ inTreeCompilerArgs stg = do return (dynamic `elem` ways, threaded `elem` ways) -- MP: We should be able to vary if stage1/stage2 is dynamic, ie a dynamic stage1 -- should be able to built a static stage2? - hasDynamic <- flavour >>= dynamicGhcPrograms + hasDynamic <- (dynamic ==) . Context.Type.way <$> (programContext stg ghc) -- LeadingUnderscore is a property of the system so if cross-compiling stage1/stage2 could -- have different values? Currently not possible to express. leadingUnderscore <- flag LeadingUnderscore - -- MP: This setting seems to only dictate whether we turn on optasm as a compiler - -- way, but a lot of tests which use only_ways(optasm) seem to not test the NCG? withInterpreter <- ghcWithInterpreter unregisterised <- flag GhcUnregisterised withSMP <- targetSupportsSMP - debugAssertions <- ghcDebugAssertions <$> flavour + debugAssertions <- ($ stg) . ghcDebugAssertions <$> flavour profiled <- ghcProfiled <$> flavour <*> pure stg os <- setting HostOs ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -240,7 +240,7 @@ defaultFlavour = Flavour , ghcProfiled = const False , ghcDebugged = const False , ghcThreaded = const True - , ghcDebugAssertions = False + , ghcDebugAssertions = const False , ghcDocs = cmdDocsArgs } -- | Default logic for determining whether to build ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug] , dynamicGhcPrograms = return False - , ghcDebugAssertions = True } + , ghcDebugAssertions = (>= Stage2) } where stageString Stage2 = "2" stageString Stage1 = "1" ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] ] + , ghcDebugAssertions = (<= Stage1) } validateArgs :: Args @@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs , notStage0 ? arg "-dno-debug-output" ] , hsLibrary = pure ["-O"] - , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"] + , hsCompiler = mconcat [ stage0 ? pure ["-O2"] , notStage0 ? pure ["-O" ] ] , hsGhc = pure ["-O"] } + slowValidateFlavour :: Flavour slowValidateFlavour = validateFlavour { name = "slow-validate" - , ghcDebugAssertions = True + , ghcDebugAssertions = const True } quickValidateArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -52,7 +52,7 @@ packageArgs = do [ builder Alex ? arg "--latin1" , builder (Ghc CompileHs) ? mconcat - [ debugAssertions ? notStage0 ? arg "-DDEBUG" + [ debugAssertions stage ? arg "-DDEBUG" , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto" , input "**/Parser.hs" ? @@ -83,7 +83,7 @@ packageArgs = do , package ghc ? mconcat [ builder Ghc ? mconcat [ arg ("-I" ++ compilerPath) - , debugAssertions ? notStage0 ? arg "-DDEBUG" ] + , debugAssertions stage ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" ===================================== testsuite/tests/corelint/T21115b.stderr ===================================== @@ -22,7 +22,7 @@ foo case patError "T21115b.hs:(10,4)-(15,4)|\\case"# of wild { } } in let { fail = \ ds -> 5# } in case ds of ds { - __DEFAULT -> fail void#; + __DEFAULT -> fail (##); 0.0## -> 2#; 2.0## -> 3# } ===================================== testsuite/tests/typecheck/should_compile/T21550.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} + +module Main where + +import Data.Function +import Data.Kind +import GHC.Generics +import GHC.TypeLits + +-- inlined generic-data imports: +from' :: Generic a => a -> Rep a () +from' = from + +geq :: (Generic a, Eq (Rep a ())) => a -> a -> Bool +geq = (==) `on` from' + +gcompare :: (Generic a, Ord (Rep a ())) => a -> a -> Ordering +gcompare = compare `on` from' + + +-- test case: +data A (v :: Symbol -> Type -> Type) a b deriving (Generic,Generic1) + +instance (Eq a , (forall w z . Eq z => Eq (v w z)) , Eq b) => Eq (A v a b) where + {-# INLINE (==) #-} + (==) = geq + +instance (Ord a , (forall w z . Eq z => Eq (v w z)) , (forall w z . Ord z => Ord (v w z)) , Ord b) => Ord (A v a b) where + {-# INLINE compare #-} + compare = gcompare + +main :: IO () +main = pure () ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -855,3 +855,4 @@ test('DeepSubsumption08', normal, compile, ['']) test('DeepSubsumption09', normal, compile, ['']) test('T21951a', normal, compile, ['-Wredundant-strictness-flags']) test('T21951b', normal, compile, ['-Wredundant-strictness-flags']) +test('T21550', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab2ecfa2f4707dbc8d8def19940884dde94cd4d4...4307eb2f67e08ed761469949ed8d8379d1decc0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab2ecfa2f4707dbc8d8def19940884dde94cd4d4...4307eb2f67e08ed761469949ed8d8379d1decc0f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: