[Git][ghc/ghc][wip/T21623] Improve boxing-data-con API
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Mon Oct 3 08:35:28 UTC 2022
Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC
Commits:
720fa45f by Simon Peyton Jones at 2022-10-03T09:37:25+01:00
Improve boxing-data-con API
- - - - -
3 changed files:
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/SetLevels.hs
Changes:
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -34,7 +34,7 @@ module GHC.Builtin.Types (
promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
-- * Boxing primitive types
- boxingDataCon_maybe, boxingDataConUnlifted_maybe,
+ boxingDataCon, BoxingInfo(..),
-- * Char
charTyCon, charDataCon, charTyCon_RDR,
@@ -1937,14 +1937,25 @@ Wrinkles
So we treat Int# and Char# specially, in specialBoxingDataCon_maybe
-}
-type BoxingInfo b = (DataCon, Expr b, Type)
- -- (K, K ty, boxed type)
- -- e.g. (I#, I#, Int)
- -- recall: data Int = I# Int#
- -- or (MkInt8Box, MkInt8Box @ty, Int8Box ty)
- -- recall: data Int8Box (a :: TYPE Int8Rep) = MkIntBox a
-
-boxingDataCon_maybe :: HasDebugCallStack => Type -> Maybe (BoxingInfo b)
+data BoxingInfo b
+ = BI_NoBoxNeeded -- The type has kind Type, so there is nothing to do
+
+ | BI_NoBoxAvailable -- The type does not have kind Type, but sadly we
+ -- don't have a boxing data constructor either
+
+ | BI_Box -- The type does not have kind Type, and we do have a
+ -- boxing data constructor; here it is
+ { bi_data_con :: DataCon
+ , bi_inst_con :: Expr b
+ , bi_boxed_type :: Type }
+ -- e.g. BI_Box { bi_data_con = I#, bi_inst_con = I#, bi_boxed_type = Int }
+ -- recall: data Int = I# Int#
+ --
+ -- BI_Box { bi_data_con = MkInt8Box, bi_inst_con = MkInt8Box @ty
+ -- , bi_boxed_type = Int8Box ty }A
+ -- recall: data Int8Box (a :: TYPE Int8Rep) = MkIntBox a
+
+boxingDataCon :: Type -> BoxingInfo b
-- ^ Given a type 'ty', if 'ty' is not of kind Type, return a data constructor that
-- will box it, and the type of the boxed thing, which /does/ now have kind Type.
--
@@ -1953,46 +1964,23 @@ boxingDataCon_maybe :: HasDebugCallStack => Type -> Maybe (BoxingInfo b)
-- This variant panics if it is given a non-TYPE type
-- that it does not know how to box.
-- See Note [Boxing constructors]
-boxingDataCon_maybe ty
+boxingDataCon ty
| tcIsLiftedTypeKind kind
- = Nothing -- Fast path for Type
-
- | Just stuff <- get_boxing_data_con ty kind
- = Just stuff
-
- | otherwise
- = pprPanic "boxingDataCon_maybe" (ppr ty <+> dcolon <+> ppr kind)
- where
- kind = typeKind ty
+ = BI_NoBoxNeeded -- Fast path for Type
-boxingDataConUnlifted_maybe :: HasDebugCallStack => Type -> Maybe (BoxingInfo b)
--- ^ Given a type 'ty', if 'ty' is not of kind Type, return a data constructor that
--- will box it, and the type of the boxed thing, which /does/ now have kind Type.
---
--- Nothing => no boxing necessary (already of kind Type)
--- or no suitable boxing data constructor is available.
---
--- This variant expects the type to be unlifted, and does not
--- fail if there is no suitable DataCon (it returns Nothing instead);
--- used in SetLevels
--- See Note [Boxing constructors]
-boxingDataConUnlifted_maybe ty
- = assertPpr (not (isLiftedTypeKind kind)) (ppr ty $$ ppr kind)
- get_boxing_data_con ty (typeKind ty)
- where
- kind = typeKind ty
-
-get_boxing_data_con :: Type -> Kind -> Maybe (BoxingInfo b)
--- See Note [Boxing constructors]
-get_boxing_data_con ty kind
| Just box_con <- specialBoxingDataCon_maybe ty
- = Just (box_con, mkConApp box_con [], tyConNullaryTy (dataConTyCon box_con))
+ = BI_Box { bi_data_con = box_con, bi_inst_con = mkConApp box_con []
+ , bi_boxed_type = tyConNullaryTy (dataConTyCon box_con) }
| Just box_con <- lookupTypeMap boxingDataConMap kind
- = Just (box_con, mkConApp box_con [Type ty], mkTyConApp (dataConTyCon box_con) [ty])
+ = BI_Box { bi_data_con = box_con, bi_inst_con = mkConApp box_con [Type ty]
+ , bi_boxed_type = mkTyConApp (dataConTyCon box_con) [ty] }
| otherwise
- = Nothing
+ = BI_NoBoxAvailable
+
+ where
+ kind = typeKind ty
specialBoxingDataCon_maybe :: Type -> Maybe DataCon
-- ^ See Note [Boxing constructors] wrinkle (W1)
=====================================
compiler/GHC/Core/Make.hs
=====================================
@@ -464,7 +464,7 @@ mkBigCoreVarTup ids = mkBigCoreTup (map Var ids)
-- | Build a "big" tuple holding the specified expressions
-- One-tuples are flattened; see Note [Flattening one-tuples]
-- Arguments don't have to have kind Type; ones that do not are boxed
--- This function crashes (in boxingDataCon_maybe) if given a non-Type
+-- This function crashes (in wrapBox) if given a non-Type
-- argument that it doesn't know how to box.
mkBigCoreTup :: [CoreExpr] -> CoreExpr
mkBigCoreTup exprs = mkChunkified mkCoreTup (map wrapBox exprs)
@@ -491,12 +491,12 @@ wrapBox :: CoreExpr -> CoreExpr
-- which has kind Type
-- where K is the boxing data constructor for ki
-- See Note [Boxing constructors] in GHC.Builtin.Types
--- Crashes in boxingDataCon_maybe if there /is/ no boxing data con
+-- Panics if there /is/ no boxing data con
wrapBox e
- | Just (_, boxing_expr, _) <- boxingDataCon_maybe e_ty
- = App boxing_expr e
- | otherwise
- = e
+ = case boxingDataCon e_ty of
+ BI_NoBoxNeeded -> e
+ BI_Box { bi_inst_con = boxing_expr } -> App boxing_expr e
+ BI_NoBoxAvailable -> pprPanic "wrapBox" (ppr e $$ ppr (exprType e))
where
e_ty = exprType e
@@ -506,10 +506,10 @@ boxTy :: Type -> Type
-- of (K @ty e), where K is the boxing data constructor for ki
-- See Note [Boxing constructors] in GHC.Builtin.Types
boxTy ty
- | Just (_, _, box_ty) <- boxingDataCon_maybe ty
- = box_ty
- | otherwise
- = ty
+ = case boxingDataCon ty of
+ BI_NoBoxNeeded -> ty
+ BI_Box { bi_boxed_type = box_ty } -> box_ty
+ BI_NoBoxAvailable -> pprPanic "boxTy" (ppr ty)
unwrapBox :: UniqSupply -> Id -> CoreExpr
-> (UniqSupply, Id, CoreExpr)
@@ -520,15 +520,18 @@ unwrapBox :: UniqSupply -> Id -> CoreExpr
-- where box_v is a fresh variable
-- Otherwise unwrapBox is a no-op
unwrapBox us var body
- | let var_ty = idType var
- , Just (box_con, _, box_ty) <- boxingDataCon_maybe var_ty
- , let var' = mkSysLocal (fsLit "uc") uniq ManyTy box_ty
- body' = Case (Var var') var' (exprType body)
+ = case boxingDataCon var_ty of
+ BI_NoBoxNeeded -> (us, var, body)
+ BI_NoBoxAvailable -> pprPanic "unwrapBox" (ppr var $$ ppr var_ty)
+ BI_Box { bi_data_con = box_con, bi_boxed_type = box_ty }
+ -> (us', var', body')
+ where
+ var' = mkSysLocal (fsLit "uc") uniq ManyTy box_ty
+ body' = Case (Var var') var' (exprType body)
[Alt (DataAlt box_con) [var] body]
- (uniq, us') = takeUniqFromSupply us
- = (us', var', body')
-
- | otherwise = (us, var, body)
+ where
+ var_ty = idType var
+ (uniq, us') = takeUniqFromSupply us
-- | Lifts a \"small\" constructor into a \"big\" constructor by recursive decomposition
mkChunkified :: ([a] -> a) -- ^ \"Small\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'
=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -672,7 +672,8 @@ lvlMFE env strict_ctxt ann_expr
| escapes_value_lam
, not expr_ok_for_spec -- Boxing/unboxing isn't worth it for cheap expressions
-- See Note [Test cheapness with exprOkForSpeculation]
- , Just (box_dc, boxing_expr, box_ty) <- boxingDataConUnlifted_maybe expr_ty
+ , BI_Box { bi_data_con = box_dc, bi_inst_con = boxing_expr
+ , bi_boxed_type = box_ty } <- boxingDataCon expr_ty
, let [bx_bndr, ubx_bndr] = mkTemplateLocals [box_ty, expr_ty]
= do { expr1 <- lvlExpr rhs_env ann_expr
; let l1r = incMinorLvlFrom rhs_env
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/720fa45f07397c22bbd45f20065c0beb3f78d585
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/720fa45f07397c22bbd45f20065c0beb3f78d585
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221003/ef910bd2/attachment-0001.html>
More information about the ghc-commits
mailing list