[Git][ghc/ghc][wip/T26314] 5 commits: configure: Allow use of LLVM 20

Simon Peyton Jones pushed to branch wip/T26314 at Glasgow Haskell Compiler / GHC Commits: ca03226d by Ben Gamari at 2025-08-18T13:43:20+00:00 configure: Allow use of LLVM 20 - - - - - 783cd7d6 by Cheng Shao at 2025-08-18T20:13:14-04:00 compiler: use `UniqMap` instead of `Map` for `BCEnv` in bytecode compiler The bytecode compiler maintains a `BCEnv` which was previously `Map Id StackDepth`. Given `Id` is `Uniquable`, we might as well use `UniqMap` here as a more efficient data structure, hence this patch. Co-authored-by: Codex - - - - - 58e46da9 by fendor at 2025-08-18T20:13:56-04:00 rts: Strip lower three bits when hashing Word instead of lower eight bits - - - - - 45dbfa23 by Cheng Shao at 2025-08-18T20:14:37-04:00 libffi: update to 3.5.2 Bumps libffi submodule. - - - - - ebc187bc by Simon Peyton Jones at 2025-08-19T14:24:42+01:00 Start with empty inerts in shortcut solving When short-cut solving we were starting with an inert set that had unsolved Wanteds. This caused an infinite loop (#26314), because a typechecker plugin kept being given that unsolved Wanted. It's better just to start with an empty inert set - - - - - 7 changed files: - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - configure.ac - libffi-tarballs - rts/Hash.c Changes: ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -84,11 +84,11 @@ import Data.Coerce (coerce) #if MIN_VERSION_rts(1,0,3) import qualified Data.ByteString.Char8 as BS #endif -import Data.Map (Map) import Data.IntMap (IntMap) import qualified Data.Map as Map import qualified Data.IntMap as IntMap -import qualified GHC.Data.FiniteMap as Map +import GHC.Types.Unique.Map (UniqMap) +import qualified GHC.Types.Unique.Map as UniqMap import Data.Ord import Data.Either ( partitionEithers ) @@ -209,7 +209,7 @@ type StackDepth = ByteOff -- | Maps Ids to their stack depth. This allows us to avoid having to mess with -- it after each push/pop. -type BCEnv = Map Id StackDepth -- To find vars on the stack +type BCEnv = UniqMap Id StackDepth -- To find vars on the stack {- ppBCEnv :: BCEnv -> SDoc @@ -379,7 +379,7 @@ schemeR_wrk fvs nm original_body (args, body) sum_szsb_args = sum szsb_args -- Make a stack offset for each argument or free var -- they should -- appear contiguous in the stack, in order. - p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args)) + p_init = UniqMap.listToUniqMap (zip all_args (mkStackOffsets 0 szsb_args)) -- make the arg bitmap bits = argBits platform (reverse (map (idArgRep platform) all_args)) @@ -442,7 +442,7 @@ fvsToEnv :: BCEnv -> CgStgRhs -> [Id] -- it, have to agree about this layout fvsToEnv p rhs = [v | v <- dVarSetElems $ freeVarsOfRhs rhs, - v `Map.member` p] + v `UniqMap.elemUniqMap` p] -- ----------------------------------------------------------------------------- -- schemeE @@ -533,7 +533,7 @@ schemeE d s p (StgLet _xlet alloc_code <- mkConAppCode d s p data_con args platform <- targetPlatform <$> getDynFlags let !d2 = d + wordSize platform - body_code <- schemeE d2 s (Map.insert x d2 p) body + body_code <- schemeE d2 s (UniqMap.addToUniqMap p x d2) body return (alloc_code `appOL` body_code) -- General case for let. Generates correct, if inefficient, code in -- all situations. @@ -557,7 +557,7 @@ schemeE d s p (StgLet _ext binds body) = do -- after the closures have been allocated in the heap (but not -- filled in), and pointers to them parked on the stack. offsets = mkStackOffsets d (genericReplicate n_binds (wordSize platform)) - p' = Map.insertList (zipEqual xs offsets) p + p' = UniqMap.addListToUniqMap p $ zipEqual xs offsets d' = d + wordsToBytes platform n_binds -- ToDo: don't build thunks for things with no free variables @@ -1180,7 +1180,7 @@ doCase d s p scrut bndr alts -- Env in which to compile the alts, not including -- any vars bound by the alts themselves - p_alts = Map.insert bndr d_bndr p + p_alts = UniqMap.addToUniqMap p bndr d_bndr bndr_ty = idType bndr isAlgCase = isAlgType bndr_ty @@ -1208,12 +1208,11 @@ doCase d s p scrut bndr alts stack_bot = d_alts - p' = Map.insertList + p' = UniqMap.addListToUniqMap p_alts [ (arg, tuple_start - wordsToBytes platform (nativeCallSize call_info) + offset) | (NonVoid arg, offset) <- args_offsets] - p_alts in do rhs_code <- schemeE stack_bot s p' rhs return (NoDiscr, rhs_code) @@ -1227,10 +1226,9 @@ doCase d s p scrut bndr alts stack_bot = d_alts + wordsToBytes platform size -- convert offsets from Sp into offsets into the virtual stack - p' = Map.insertList + p' = UniqMap.addListToUniqMap p_alts [ (arg, stack_bot - ByteOff offset) | (NonVoid arg, offset) <- args_offsets ] - p_alts in do massert isAlgCase @@ -1312,12 +1310,13 @@ doCase d s p scrut bndr alts -- NB: unboxed tuple cases bind the scrut binder to the same offset -- as one of the alt binders, so we have to remove any duplicates here: -- 'toAscList' takes care of sorting the result, which was previously done after the application of 'filter'. - rel_slots = IntSet.toAscList $ IntSet.fromList $ Map.elems $ Map.mapMaybeWithKey spread p - spread id offset | isUnboxedTupleType (idType id) || - isUnboxedSumType (idType id) = Nothing - | isFollowableArg (idArgRep platform id) = Just (fromIntegral rel_offset) - | otherwise = Nothing - where rel_offset = bytesToWords platform (d - offset) + rel_slots = IntSet.toAscList $ UniqMap.nonDetFoldUniqMap go IntSet.empty p + go (var, offset) !acc + | isUnboxedTupleType (idType var) || isUnboxedSumType (idType var) + = acc + | isFollowableArg (idArgRep platform var) + = fromIntegral (bytesToWords platform (d - offset)) `IntSet.insert` acc + | otherwise = acc bitmap = intsToReverseBitmap platform bitmap_size' pointers @@ -2546,7 +2545,7 @@ instance Outputable Discr where lookupBCEnv_maybe :: Id -> BCEnv -> Maybe ByteOff -lookupBCEnv_maybe = Map.lookup +lookupBCEnv_maybe v env = UniqMap.lookupUniqMap env v idSizeW :: Platform -> Id -> WordOff idSizeW platform = WordOff . argRepSizeW platform . idArgRep platform ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -588,22 +588,24 @@ solving fails and we use the superclass of C: The moving parts are relatively simple: * To attempt to solve the constraint completely, we just recursively - call the constraint solver. See the use of `tryTcS` in + call the constraint solver. See the use of `tryShortCutTcS` in `tcShortCutSolver`. -* When this attempted recursive solving, we set a special mode - `TcSShortCut`, which signals that we are trying to solve using only - top-level instances. We switch on `TcSShortCut` mode in - `tryShortCutSolver`. +* When this attempted recursive solving, in `tryShortCutTcS`, we + - start with an empty inert set: no Givens and no Wanteds + - set a special mode `TcSShortCut`, which signals that we are trying to solve + using only top-level instances. -* When in TcSShortCut mode, we behave specially in a few places: - - `tryInertDicts`, where we would otherwise look for a Given to solve our Wanted - - `GHC.Tc.Solver.Monad.lookupInertDict` similarly - - `noMatchableGivenDicts`, which also consults the Givens - - `matchLocalInst`, which would otherwise consult Given quantified constraints - - `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, don't - pick overlappable top-level instances - - `GHC.Tc.Solver.Solve.runTcPluginsWanted`: don't pass any Givens to the plugin +* When in TcSShortCut mode, since there are no Givens we can short-circuit; + these are all just optimisations: + - `tryInertDicts` + - `GHC.Tc.Solver.Monad.lookupInertDict` + - `noMatchableGivenDicts` + - `matchLocalInst` + - `GHC.Tc.Solver.Solve.runTcPluginsWanted` + +* In `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, + don't pick overlappable top-level instances Some wrinkles: @@ -770,14 +772,14 @@ tryInertDicts dict_ct try_inert_dicts :: TcSMode -> InertCans -> DictCt -> TcS (StopOrContinue ()) try_inert_dicts mode inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys }) - | not (mode == TcSShortCut) -- Ignore the inerts (esp Givens) in short-cut mode - -- See Note [Shortcut solving] + | not (mode == TcSShortCut) -- Optimisation: ignore the inerts (esp Givens) in + -- short-cut mode. See Note [Shortcut solving] , Just dict_i <- lookupInertDict inerts cls tys , let ev_i = dictCtEvidence dict_i loc_i = ctEvLoc ev_i loc_w = ctEvLoc ev_w = -- There is a matching dictionary in the inert set - do { -- First to try to solve it /completely/ from top level instances + do { -- For a Wanted, first to try to solve it /completely/ from top level instances -- See Note [Shortcut solving] ; short_cut_worked <- tryShortCutSolver (isGiven ev_i) dict_w @@ -833,11 +835,7 @@ tryShortCutSolver try_short_cut dict_w@(DictCt { di_ev = ev_w }) , gopt Opt_SolveConstantDicts dflags -- Enabled by the -fsolve-constant-dicts flag - -> tryTcS $ -- tryTcS tries to completely solve some contraints - -- Inherit the current solved_dicts, so that one invocation of - -- tryShortCutSolver can benefit from the work of earlier invocations - -- See wrinkle (SCS3) of Note [Shortcut solving] - setTcSMode TcSShortCut $ + -> tryShortCutTcS $ -- tryTcS tries to completely solve some contraints do { residual <- solveSimpleWanteds (unitBag (CDictCan dict_w)) ; return (isEmptyBag residual) } @@ -977,7 +975,7 @@ matchClassInst dflags mode inerts clas tys loc noMatchableGivenDicts :: TcSMode -> InertSet -> CtLoc -> Class -> [TcType] -> Bool noMatchableGivenDicts mode inerts@(IS { inert_cans = inert_cans }) loc_w clas tys | TcSShortCut <- mode - = True -- In TcSShortCut mode we behave as if there were no Givens at all + = True -- Optimisation: in TcSShortCut mode there are no Givens | otherwise = not $ anyBag matchable_given $ findDictsByClass (inert_dicts inert_cans) clas @@ -1153,8 +1151,7 @@ matchLocalInst :: TcPredType -> CtLoc -> TcS ClsInstResult -- Look up the predicate in Given quantified constraints, -- which are effectively just local instance declarations. matchLocalInst body_pred loc - = do { -- In TcSShortCut mode we do not look at Givens; - -- c.f. tryInertDicts + = do { -- Optimisation: in TcSShortCut mode there are no Givens (c.f. tryInertDicts) mode <- getTcSMode ; case mode of { TcSShortCut -> do { traceTcS "matchLocalInst:TcSShortCut" (ppr body_pred) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Tc.Solver.Monad ( runTcS, runTcSEarlyAbort, runTcSWithEvBinds, runTcSInerts, failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS, runTcSEqualities, - nestTcS, nestImplicTcS, tryTcS, + nestTcS, nestImplicTcS, tryShortCutTcS, setEvBindsTcS, setTcLevelTcS, emitFunDepWanteds, @@ -1259,20 +1259,31 @@ nestTcS (TcS thing_inside) ; return res } -tryTcS :: TcS Bool -> TcS Bool +tryShortCutTcS :: TcS Bool -> TcS Bool -- Like nestTcS, but --- (a) be a no-op if the nested computation returns Nothing +-- (a) be a no-op if the nested computation returns False -- (b) if (but only if) success, propagate nested bindings to the caller -- Use only by the short-cut solver; -- see Note [Shortcut solving] in GHC.Tc.Solver.Dict -tryTcS (TcS thing_inside) +tryShortCutTcS (TcS thing_inside) = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var , tcs_ev_binds = old_ev_binds_var }) -> - do { old_inerts <- TcM.readTcRef inerts_var - ; new_inert_var <- TcM.newTcRef old_inerts + do { -- Initialise a fresh inert set, with no Givens and no Wanteds + -- (i.e. empty `inert_cans`) + -- But inherit all the InertSet cache fields; in particular + -- * the given_eq_lvl, so we don't accidentally unify a + -- unification variable from outside a GADT match + -- * the `solved_dicts`; see wrinkle (SCS3) of Note [Shortcut solving] + -- * the `famapp_cache`; similarly + old_inerts <- TcM.readTcRef inerts_var + ; let given_eq_lvl = inert_given_eq_lvl (inert_cans old_inerts) + new_inerts = old_inerts { inert_cans = emptyInertCans given_eq_lvl } + ; new_inert_var <- TcM.newTcRef new_inerts + ; new_wl_var <- TcM.newTcRef emptyWorkList ; new_ev_binds_var <- TcM.cloneEvBindsVar old_ev_binds_var - ; let nest_env = env { tcs_ev_binds = new_ev_binds_var + ; let nest_env = env { tcs_mode = TcSShortCut + , tcs_ev_binds = new_ev_binds_var , tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -1679,8 +1679,9 @@ runTcPluginsWanted wanted ; if null solvers then return (False, wanted) else do { -- Find the set of Givens to give to the plugin. - -- If TcSMode = TcSShortCut, we are solving with - -- no Givens so don't return any (#26258)! + -- Optimisation: if TcSMode = TcSShortCut, we are solving with + -- no Givens so don't bother to look (#26258 was a bug in an earlier + -- version when we left the Givens in the inert set) -- See Note [Shortcut solving] in GHC.Tc.Solver.Dict mode <- getTcSMode ; given <- case mode of ===================================== configure.ac ===================================== @@ -536,7 +536,7 @@ AC_SUBST(InstallNameToolCmd) # versions of LLVM simultaneously, but that stopped working around # 3.5/3.6 release of LLVM. LlvmMinVersion=13 # inclusive -LlvmMaxVersion=20 # not inclusive +LlvmMaxVersion=21 # not inclusive AC_SUBST([LlvmMinVersion]) AC_SUBST([LlvmMaxVersion]) ===================================== libffi-tarballs ===================================== @@ -1 +1 @@ -Subproject commit a5480d7e7f86a9bb5b44dd1156a92f69f7c185ec +Subproject commit 7c51059557b68d29820a0a87cebfa6fe73c8adf5 ===================================== rts/Hash.c ===================================== @@ -81,7 +81,7 @@ hashWord(const HashTable *table, StgWord key) int bucket; /* Strip the boring zero bits */ - key >>= sizeof(StgWord); + key /= sizeof(StgWord); /* Mod the size of the hash table (a power of 2) */ bucket = key & table->mask1; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f298e03045864942f359862576b90d8... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f298e03045864942f359862576b90d8... You're receiving this email because of your account on gitlab.haskell.org.