- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/haddock-move-binary-instances] compiler: move Binary instance of Map to GHC.Utils.Binary
by Cheng Shao (＠TerrorJack) 19 Jun '25

19 Jun '25

Cheng Shao pushed to branch wip/haddock-move-binary-instances at Glasgow Haskell Compiler / GHC Commits: 0523deff by Cheng Shao at 2025-06-19T02:12:57+00:00 compiler: move Binary instance of Map to GHC.Utils.Binary This patch moves `Binary` instance of `Map` from `haddock-api` to `GHC.Utils.Binary`. This also allows us to remove a redundant instance defined for `NameEntityInfo`, which is a type synonym for `Map`. - - - - - 3 changed files: - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Utils/Binary.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs Changes: ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -98,10 +98,6 @@ data HieFile = HieFile type NameEntityInfo = M.Map Name (S.Set EntityInfo) -instance Binary NameEntityInfo where - put_ bh m = put_ bh $ M.toList m - get bh = fmap M.fromList (get bh) - instance Binary HieFile where put_ bh hf = do put_ bh $ hie_hs_file hf ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -2131,6 +2131,13 @@ instance (Binary v) => Binary (IntMap v) where put_ bh m = put_ bh (IntMap.toAscList m) get bh = IntMap.fromAscList <$> get bh +instance (Ord k, Binary k, Binary v) => Binary (Map k v) where + put_ bh m = put_ bh $ Map.toList m + -- Unfortunately, we can't use fromAscList, since k is often + -- instantiated to Name which has a non-deterministic Ord instance + -- that only compares the Uniques, and the Uniques are likely + -- changed when deserializing! + get bh = Map.fromList <$> get bh {- Note [FingerprintWithValue] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs ===================================== @@ -40,7 +40,6 @@ import Data.Coerce (coerce) import Data.Function ((&)) import Data.IORef import Data.Map (Map) -import qualified Data.Map as Map import Data.Version import Data.Word import GHC hiding (NoLink) @@ -319,10 +318,6 @@ data BinDictionary = BinDictionary ------------------------------------------------------------------------------- -instance (Ord k, Binary k, Binary v) => Binary (Map k v) where - put_ bh m = put_ bh (Map.toList m) - get bh = fmap (Map.fromList) (get bh) - instance Binary PackageInfo where put_ bh PackageInfo{piPackageName, piPackageVersion} = do put_ bh (unPackageName piPackageName) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0523deffe6e002bad869caa9458c60c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0523deffe6e002bad869caa9458c60c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26115] Wibbles
by Simon Peyton Jones (＠simonpj) 18 Jun '25

18 Jun '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: 50938910 by Simon Peyton Jones at 2025-06-18T23:22:55+01:00 Wibbles - - - - - 1 changed file: - compiler/GHC/HsToCore/Binds.hs Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -1079,14 +1079,15 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call ; let simpl_opts = initSimpleOpts dflags core_call = simpleOptExprNoInline simpl_opts ds_call - ; case decomposeCall poly_id [] core_call of { + ; case decomposeCall poly_id core_call of { Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) ; return Nothing } ; Just (rev_binds, rule_lhs_args) -> do { let orig_bndr_set = mkVarSet orig_bndrs - rule_bndrs = scopedSort (exprsSomeFreeVarsList (`elemVarSet` orig_bndr_set) + locally_bound = orig_bndr_set `extendVarSetList` bindersOfBinds rev_binds + rule_bndrs = scopedSort (exprsSomeFreeVarsList (`elemVarSet` locally_bound) rule_lhs_args) spec_binds = grabSpecBinds orig_bndr_set (mkVarSet rule_bndrs) rev_binds spec_binds_bndr_set = mkVarSet (bindersOfBinds spec_binds) @@ -1100,17 +1101,14 @@ dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call ; tracePm "dsSpec(new route)" $ vcat [ text "poly_id" <+> ppr poly_id , text "unfolding" <+> ppr (realIdUnfolding poly_id) - , text "bndrs" <+> ppr bndrs + , text "orig_bndrs" <+> ppr orig_bndrs , text "ds_call" <+> ppr ds_call , text "core_call" <+> ppr core_call - , text "bndr_set" <+> ppr bndr_set - , text "all_bndrs" <+> ppr all_bndrs + , text "rev_binds" <+> ppr rev_binds , text "rule_bndrs" <+> ppr rule_bndrs , text "rule_lhs_args" <+> ppr rule_lhs_args - , text "const_bndrs" <+> ppr const_bndrs , text "spec_bndrs" <+> ppr spec_bndrs - , text "core_call fvs" <+> ppr (exprFreeVars core_call) - , text "spec_const_binds" <+> ppr spec_const_binds ] + , text "spec_binds" <+> ppr spec_binds ] ; finishSpecPrag poly_nm poly_rhs rule_bndrs poly_id rule_lhs_args @@ -1124,8 +1122,8 @@ decomposeCall poly_id binds where go acc (Let bind body) = go (bind:acc) body - go add e - | Just (Var fun, args) <- collectArgs e + go acc e + | (Var fun, args) <- collectArgs e = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ Just (acc, args) | otherwise @@ -1134,44 +1132,55 @@ decomposeCall poly_id binds grabSpecBinds :: VarSet -> VarSet -> [CoreBind] -> [CoreBind] grabSpecBinds orig_bndrs rule_bndrs rev_binds - = rename_binds ++ spec_binds + = reverse rename_binds ++ spec_binds where - (known_bndrs, rename_binds, other_binds) - = get_renamings rule_bndrs ([],[]) rev_binds + (known_bndrs, (rename_binds, other_binds)) + = get_renamings orig_bndrs rule_bndrs ([],[]) rev_binds spec_binds = pick_spec_binds known_bndrs other_binds ------------------------ - get_renamings :: VarSet -- Variables bound by a successful match on the call + get_renamings :: VarSet -- Locally bound variables + -> VarSet -- Variables bound by a successful match on the call -> ([CoreBind],[CoreBind]) -- Accumulating parameter, in order -> [CoreBind] -- Reversed, innermost first -> ( VarSet - , [CoreBind] -- Renamings, in order - , [CoreBind]) -- Other bindings, in order - get_renamings _ acc [] acc + , ([CoreBind] -- Renamings, in order + , [CoreBind])) -- Other bindings, in order + get_renamings _ bndrs acc [] = (bndrs, acc) - get_renamings bndrs (rn_binds, other_binds) (bind : binds) + get_renamings locals bndrs (rn_binds, other_binds) (bind : binds) | NonRec d r <- bind , d `elemVarSet` bndrs , Just (v, mco) <- getCastedVar r + , v `elemVarSet` locals , let flipped_bind = NonRec v (mkCastMCo (Var d) (mkSymMCo mco)) = get_renamings (bndrs `extendVarSet` v) + (locals `extendVarSet` d) (flipped_bind:rn_binds, other_binds) binds | otherwise - = get_renamings bndrs (rn_binds, bind:other_binds) binds + = get_renamings bndrs + (locals `extendVarSetList` bindersOf bind) + (rn_binds, bind:other_binds) + binds ------------------------ pick_spec_binds :: VarSet -> [CoreBind] -> [CoreBind] - pick_spec_binds known_bndrs [] = [] + pick_spec_binds _ [] = [] pick_spec_binds known_bndrs (bind:binds) | all keep_me (rhssOfBind bind) - , let known_bndrs' = known_bndrs `extendVarSetList` bindersOfBind bind + , let known_bndrs' = known_bndrs `extendVarSetList` bindersOf bind = bind : pick_spec_binds known_bndrs' binds | otherwise = pick_spec_binds known_bndrs binds where - keep_me rhs = isEmptyVarSet (exprSomFreeVars bad_var rhs) - bad_var v = v `elemVarSet` orig_bndrs && not (bndr `elemVarSet` known_bndrs) + keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) + bad_var v = v `elemVarSet` orig_bndrs && not (v `elemVarSet` known_bndrs) + +getCastedVar :: CoreExpr -> Maybe (Var, MCoercionR) +getCastedVar (Var v) = Just (v, MRefl) +getCastedVar (Cast (Var v) co) = Just (v, MCo co) +getCastedVar _ = Nothing {- where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50938910c2f24225d8f2b547abf534c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50938910c2f24225d8f2b547abf534c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/fix-25406
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/fix-25406 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/rm-ci-timings
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/rm-ci-timings at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/fix-912-bootstrap
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/fix-912-bootstrap at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/rm-showBreakArray
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/rm-showBreakArray at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/fix-putWithTables
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/fix-putWithTables at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/wasm-jsffi-sync-export
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/wasm-jsffi-sync-export at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/wasm-jsffi-interruptible
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/wasm-jsffi-interruptible at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/wasm-fix-chrome-ci
by Cheng Shao (＠TerrorJack) 18 Jun '25

18 Jun '25

Cheng Shao deleted branch wip/wasm-fix-chrome-ci at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0