Commit 13a85211 authored by Facundo Domínguez's avatar Facundo Domínguez

Desugar static forms to makeStatic calls.

Summary:
Using makeStatic instead of applications of the StaticPtr data
constructor makes possible linting core when unboxing strict
fields.

Test Plan: ./validate

Reviewers: simonpj, goldfire, austin, bgamari, hvr

Reviewed By: simonpj

Subscribers: RyanGlScott, mboes, thomie

Differential Revision: https://phabricator.haskell.org/D2930

GHC Trac Issues: #12622
parent dde63e00
......@@ -67,7 +67,6 @@ import Control.Monad
import qualified Control.Monad.Fail as MonadFail
#endif
import MonadUtils
import Data.Function (fix)
import Data.Maybe
import Pair
import qualified GHC.LanguageExtensions as LangExt
......@@ -390,12 +389,12 @@ lintCoreBindings dflags pass local_in_scope binds
_ -> True
-- See Note [Checking StaticPtrs]
check_static_ptrs = xopt LangExt.StaticPointers dflags &&
case pass of
CoreDoFloatOutwards _ -> True
CoreTidy -> True
CorePrep -> True
_ -> False
check_static_ptrs | not (xopt LangExt.StaticPointers dflags) = AllowAnywhere
| otherwise = case pass of
CoreDoFloatOutwards _ -> AllowAtTopLevel
CoreTidy -> RejectEverywhere
CorePrep -> AllowAtTopLevel
_ -> AllowAnywhere
binders = bindersOfBinds binds
(_, dups) = removeDups compare binders
......@@ -536,28 +535,32 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
| otherwise = return ()
-- | Checks the RHS of top-level bindings. It only differs from 'lintCoreExpr'
-- in that it doesn't reject applications of the data constructor @StaticPtr@
-- when they appear at the top level.
-- in that it doesn't reject occurrences of the function 'makeStatic' when they
-- appear at the top level and @lf_check_static_ptrs == AllowAtTopLevel@.
--
-- See Note [Checking StaticPtrs].
lintRhs :: CoreExpr -> LintM OutType
-- Allow applications of the data constructor @StaticPtr@ at the top
-- but produce errors otherwise.
lintRhs rhs
| (binders0, rhs') <- collectTyBinders rhs
, Just (fun, args) <- collectStaticPtrSatArgs rhs'
= flip fix binders0 $ \loopBinders binders -> case binders of
lintRhs rhs = fmap lf_check_static_ptrs getLintFlags >>= go
where
-- Allow occurrences of 'makeStatic' at the top-level but produce errors
-- otherwise.
go AllowAtTopLevel
| (binders0, rhs') <- collectTyBinders rhs
, Just (fun, t, info, e) <- collectMakeStaticArgs rhs'
= foldr
-- imitate @lintCoreExpr (Lam ...)@
var : vars -> addLoc (LambdaBodyOf var) $
lintBinder var $ \var' ->
do { body_ty <- loopBinders vars
; return $ mkLamType var' body_ty }
(\var loopBinders ->
addLoc (LambdaBodyOf var) $
lintBinder var $ \var' ->
do { body_ty <- loopBinders
; return $ mkLamType var' body_ty }
)
-- imitate @lintCoreExpr (App ...)@
[] -> do
fun_ty <- lintCoreExpr fun
addLoc (AnExpr rhs') $ lintCoreArgs fun_ty args
-- Rejects applications of the data constructor @StaticPtr@ if it finds any.
lintRhs rhs = lintCoreExpr rhs
(do fun_ty <- lintCoreExpr fun
addLoc (AnExpr rhs') $ lintCoreArgs fun_ty [Type t, info, e]
)
binders0
go _ = lintCoreExpr rhs
lintIdUnfolding :: Id -> Type -> Unfolding -> LintM ()
lintIdUnfolding bndr bndr_ty (CoreUnfolding { uf_tmpl = rhs, uf_src = src })
......@@ -673,11 +676,10 @@ lintCoreExpr e@(App _ _)
-- Check for a nested occurrence of the StaticPtr constructor.
-- See Note [Checking StaticPtrs].
case fun of
Var b | lf_check_static_ptrs lf
, Just con <- isDataConId_maybe b
, dataConName con == staticPtrDataConName
Var b | lf_check_static_ptrs lf /= AllowAnywhere
, idName b == makeStaticName
-> do
failWithL $ text "Found StaticPtr nested in an expression: " <+>
failWithL $ text "Found makeStatic nested in an expression: " <+>
ppr e
_ -> go
where
......@@ -1609,13 +1611,24 @@ data LintEnv
data LintFlags
= LF { lf_check_global_ids :: Bool -- See Note [Checking for global Ids]
, lf_check_inline_loop_breakers :: Bool -- See Note [Checking for INLINE loop breakers]
, lf_check_static_ptrs :: Bool -- See Note [Checking StaticPtrs]
, lf_check_static_ptrs :: StaticPtrCheck
-- ^ See Note [Checking StaticPtrs]
}
-- See Note [Checking StaticPtrs]
data StaticPtrCheck
= AllowAnywhere
-- ^ Allow 'makeStatic' to occur anywhere.
| AllowAtTopLevel
-- ^ Allow 'makeStatic' calls at the top-level only.
| RejectEverywhere
-- ^ Reject any 'makeStatic' occurrence.
deriving Eq
defaultLintFlags :: LintFlags
defaultLintFlags = LF { lf_check_global_ids = False
, lf_check_inline_loop_breakers = True
, lf_check_static_ptrs = False
, lf_check_static_ptrs = AllowAnywhere
}
newtype LintM a =
......@@ -1633,32 +1646,19 @@ top-level ones. See Note [Exported LocalIds] and Trac #9857.
Note [Checking StaticPtrs]
~~~~~~~~~~~~~~~~~~~~~~~~~~
See SimplCore Note [Grand plan for static forms] for an overview.
See Note [Grand plan for static forms] in StaticPtrTable for an overview.
Every occurrence of the data constructor @StaticPtr@ should be moved
to the top level by the FloatOut pass. It's vital that we don't have
nested StaticPtr uses after CorePrep, because we populate the Static
Every occurrence of the function 'makeStatic' should be moved to the
top level by the FloatOut pass. It's vital that we don't have nested
'makeStatic' occurrences after CorePrep, because we populate the Static
Pointer Table from the top-level bindings. See SimplCore Note [Grand
plan for static forms].
The linter checks that no occurrence is left behind, nested within an
expression. The check is enabled only:
* After the FloatOut, CorePrep, and CoreTidy passes.
We could check more often, but the condition doesn't hold until
after the first FloatOut pass.
* When the module uses the StaticPointers language extension. This is
a little hack. This optimization arose from the need to compile
GHC.StaticPtr, which otherwise would be rejected because of the
following binding for the StaticPtr data constructor itself:
StaticPtr = \a b1 b2 b3 b4 -> StaticPtr a b1 b2 b3 b4
which contains an application of `StaticPtr` nested within the
lambda abstractions. This binding is injected by CorePrep.
Note that GHC.StaticPtr is itself compiled without -XStaticPointers.
expression. The check is enabled only after the FloatOut, CorePrep,
and CoreTidy passes and only if the module uses the StaticPointers
language extension. Checking more often doesn't help since the condition
doesn't hold until after the first FloatOut pass.
Note [Type substitution]
~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -48,13 +48,13 @@ module CoreUtils (
stripTicksE, stripTicksT,
-- * StaticPtr
collectStaticPtrSatArgs
collectMakeStaticArgs
) where
#include "HsVersions.h"
import CoreSyn
import PrelNames ( staticPtrDataConName )
import PrelNames ( makeStaticName )
import PprCore
import CoreFVs( exprFreeVars )
import Var
......@@ -2215,16 +2215,13 @@ isEmptyTy ty
*****************************************************
-}
-- | @collectStaticPtrSatArgs e@ yields @Just (s, args)@ when @e = s args@
-- and @s = StaticPtr@ and the application of @StaticPtr@ is saturated.
-- | @collectMakeStaticArgs (makeStatic t srcLoc e)@ yields
-- @Just (makeStatic, t, srcLoc, e)@.
--
-- Yields @Nothing@ otherwise.
collectStaticPtrSatArgs :: Expr b -> Maybe (Expr b, [Arg b])
collectStaticPtrSatArgs e
| (fun@(Var b), args, _) <- collectArgsTicks (const True) e
, Just con <- isDataConId_maybe b
, dataConName con == staticPtrDataConName
, length args == 5
= Just (fun, args)
collectStaticPtrSatArgs _
= Nothing
-- Returns @Nothing@ for every other expression.
collectMakeStaticArgs
:: CoreExpr -> Maybe (CoreExpr, Type, CoreExpr, CoreExpr)
collectMakeStaticArgs e
| (fun@(Var b), [Type t, loc, arg], _) <- collectArgsTicks (const True) e
, idName b == makeStaticName = Just (fun, t, loc, arg)
collectMakeStaticArgs _ = Nothing
......@@ -14,7 +14,7 @@ module MkCore (
mkIntExpr, mkIntExprInt,
mkIntegerExpr,
mkFloatExpr, mkDoubleExpr,
mkCharExpr, mkStringExpr, mkStringExprFS,
mkCharExpr, mkStringExpr, mkStringExprFS, mkStringExprFSWith,
-- * Floats
FloatBind(..), wrapFloat,
......@@ -270,16 +270,19 @@ mkStringExprFS :: MonadThings m => FastString -> m CoreExpr -- Result :: String
mkStringExpr str = mkStringExprFS (mkFastString str)
mkStringExprFS str
mkStringExprFS = mkStringExprFSWith lookupId
mkStringExprFSWith :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr
mkStringExprFSWith lookupM str
| nullFS str
= return (mkNilExpr charTy)
| all safeChar chars
= do unpack_id <- lookupId unpackCStringName
= do unpack_id <- lookupM unpackCStringName
return (App (Var unpack_id) lit)
| otherwise
= do unpack_utf8_id <- lookupId unpackCStringUtf8Name
= do unpack_utf8_id <- lookupM unpackCStringUtf8Name
return (App (Var unpack_utf8_id) lit)
where
......
......@@ -27,7 +27,6 @@ import FamInstEnv( topNormaliseType )
import DsMeta
import HsSyn
import Platform
-- NB: The desugarer, which straddles the source and Core worlds, sometimes
-- needs to see source types
import TcType
......@@ -56,11 +55,7 @@ import Bag
import Outputable
import PatSyn
import Data.List ( intercalate )
import Data.IORef ( atomicModifyIORef' )
import Control.Monad
import GHC.Fingerprint
{-
************************************************************************
......@@ -423,24 +418,17 @@ dsExpr (PArrSeq _ _)
Static Pointers
~~~~~~~~~~~~~~~
See Note [Grand plan for static forms] in StaticPtrTable for an overview.
g = ... static f ...
==>
g = ... StaticPtr
w0 w1
(StaticPtrInfo "current pkg key" "current module" "N")
f
...
Where we obtain w0 and w1 from
Fingerprint w0 w1 = fingerprintString "pkgKey:module:N"
g = ... makeStatic loc f ...
-}
dsExpr (HsStatic _ expr@(L loc _)) = do
expr_ds <- dsLExpr expr
let ty = exprType expr_ds
staticPtrInfoDataCon <- dsLookupDataCon staticPtrInfoDataConName
staticPtrDataCon <- dsLookupDataCon staticPtrDataConName
makeStaticId <- dsLookupGlobalId makeStaticName
dflags <- getDynFlags
let (line, col) = case loc of
......@@ -452,48 +440,9 @@ dsExpr (HsStatic _ expr@(L loc _)) = do
[ Type intTy , Type intTy
, mkIntExprInt dflags line, mkIntExprInt dflags col
]
this_mod <- getModule
info <- mkConApp staticPtrInfoDataCon <$>
(++[srcLoc]) <$>
mapM mkStringExprFS
[ unitIdFS $ moduleUnitId this_mod
, moduleNameFS $ moduleName this_mod
]
Fingerprint w0 w1 <- mkStaticPtrFingerprint this_mod
putSrcSpanDs loc $ return $
mkConApp staticPtrDataCon [ Type ty
, mkWord64LitWordRep dflags w0
, mkWord64LitWordRep dflags w1
, info
, expr_ds
]
where
-- | Choose either 'Word64#' or 'Word#' to represent the arguments of the
-- 'Fingerprint' data constructor.
mkWord64LitWordRep dflags
| platformWordSize (targetPlatform dflags) < 8 = mkWord64LitWord64
| otherwise = mkWordLit dflags . toInteger
mkStaticPtrFingerprint :: Module -> DsM Fingerprint
mkStaticPtrFingerprint this_mod = do
n <- mkGenPerModuleNum this_mod
return $ fingerprintString $ intercalate ":"
[ unitIdString $ moduleUnitId this_mod
, moduleNameString $ moduleName this_mod
, show n
]
mkGenPerModuleNum :: Module -> DsM Int
mkGenPerModuleNum this_mod = do
dflags <- getDynFlags
let -- Note [Generating fresh names for ccall wrapper]
-- in compiler/typecheck/TcEnv.hs
wrapperRef = nextWrapperNum dflags
wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \mod_env ->
let num = lookupWithDefaultModuleEnv mod_env 0 this_mod
in (extendModuleEnv mod_env this_mod (num + 1), num)
return wrapperNum
putSrcSpanDs loc $ return $
mkCoreApps (Var makeStaticId) [ Type ty, srcLoc, expr_ds ]
{-
\noindent
......
......@@ -28,7 +28,7 @@
--
-- The linker must find the definitions matching the @extern StgPtr <name>@
-- declarations. For this to work, the identifiers of static pointers need to be
-- exported. This is done in TidyPgm.chooseExternalIds.
-- exported. This is done in SetLevels.newLvlVar.
--
-- There is also a finalization function for the time when the module is
-- unloaded.
......@@ -46,79 +46,240 @@
--
{-# LANGUAGE ViewPatterns #-}
module StaticPtrTable (sptModuleInitCode) where
module StaticPtrTable (sptCreateStaticBinds) where
-- See SimplCore Note [Grand plan for static forms]
{- Note [Grand plan for static forms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Static forms go through the compilation phases as follows.
Here is a running example:
f x = let k = map toUpper
in ...(static k)...
* The renamer looks for out-of-scope names in the body of the static
form, as always If all names are in scope, the free variables of the
body are stored in AST at the location of the static form.
* The typechecker verifies that all free variables occurring in the
static form are closed (see Note [Bindings with closed types] in
TcRnTypes). In our example, 'k' is closed, even though it is bound
in a nested let, we are fine.
The typechecker also surrounds the static form with a call to
`GHC.StaticPtr.fromStaticPtr`.
f x = let k = map toUpper
in ...fromStaticPtr (static k)...
* The desugarer replaces the static form with an application of the
function 'makeStatic' (defined in module GHC.StaticPtr.Internal of
base). So we get
f x = let k = map toUpper
in ...fromStaticPtr (makeStatic location k)...
* The simplifier runs the FloatOut pass which moves the calls to 'makeStatic'
to the top level. Thus the FloatOut pass is always executed, even when
optimizations are disabled. So we get
k = map toUpper
static_ptr = makeStatic location k
f x = ...fromStaticPtr static_ptr...
The FloatOut pass is careful to produce an /exported/ Id for a floated
'makeStatic' call, so the binding is not removed or inlined by the
simplifier.
E.g. the code for `f` above might look like
static_ptr = makeStatic location k
f x = ...(case static_ptr of ...)...
which might be simplified to
f x = ...(case makeStatic location k of ...)...
BUT the top-level binding for static_ptr must remain, so that it can be
collected to populate the Static Pointer Table.
Making the binding exported also has a necessary effect during the
CoreTidy pass.
* The CoreTidy pass replaces all bindings of the form
b = /\ ... -> makeStatic location value
with
b = /\ ... -> StaticPtr key (StaticPtrInfo "pkg key" "module" location) value
where a distinct key is generated for each binding.
We produce also a C function which inserts all these bindings in the static
pointer table (see the call to StaticPtrTable.sptCreateStaticBinds in
TidyPgm). As the Ids of floated static pointers are exported, they can be
linked with the C function.
-}
import CLabel
import CoreSyn
import CoreUtils (collectMakeStaticArgs)
import DataCon
import DynFlags
import HscTypes
import Id
import Literal
import MkCore (mkStringExprFSWith)
import Module
import Name
import Outputable
import Platform
import PrelNames
import TcEnv (lookupGlobal)
import Type
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State
import Data.List
import Data.Maybe
import GHC.Fingerprint
import qualified GHC.LanguageExtensions as LangExt
-- | @sptModuleInitCode module binds@ is a C stub to insert the static entries
-- found in @binds@ of @module@ into the static pointer table.
-- | Replaces all bindings of the form
--
-- > b = /\ ... -> makeStatic location value
--
-- with
--
-- > b = /\ ... ->
-- > StaticPtr key (StaticPtrInfo "pkg key" "module" location) value
--
-- A bind is considered a static entry if it is an application of the
-- data constructor @StaticPtr@.
-- where a distinct key is generated for each binding.
--
sptModuleInitCode :: Module -> CoreProgram -> SDoc
sptModuleInitCode this_mod binds =
sptInitCode $ catMaybes
$ map (\(b, e) -> ((,) b) <$> staticPtrFp e)
$ flattenBinds binds
-- It also yields the C stub that inserts these bindings into the static
-- pointer table.
sptCreateStaticBinds :: HscEnv -> Module -> CoreProgram
-> IO (SDoc, CoreProgram)
sptCreateStaticBinds hsc_env this_mod binds
| not (xopt LangExt.StaticPointers dflags) =
return (Outputable.empty, binds)
| otherwise = do
-- Make sure the required interface files are loaded.
_ <- lookupGlobal hsc_env unpackCStringName
(fps, binds') <- evalStateT (go [] [] binds) 0
return (sptModuleInitCode this_mod fps, binds')
where
staticPtrFp :: CoreExpr -> Maybe Fingerprint
staticPtrFp (collectTyBinders -> (_, e))
| (Var v, _ : Lit lit0 : Lit lit1 : _) <- collectArgs e
, Just con <- isDataConId_maybe v
, dataConName con == staticPtrDataConName
, Just w0 <- fromPlatformWord64Rep lit0
, Just w1 <- fromPlatformWord64Rep lit1
= Just $ Fingerprint (fromInteger w0) (fromInteger w1)
staticPtrFp _ = Nothing
fromPlatformWord64Rep (MachWord w) = Just w
fromPlatformWord64Rep (MachWord64 w) = Just w
fromPlatformWord64Rep _ = Nothing
sptInitCode :: [(Id, Fingerprint)] -> SDoc
sptInitCode [] = Outputable.empty
sptInitCode entries = vcat
[ text "static void hs_spt_init_" <> ppr this_mod
<> text "(void) __attribute__((constructor));"
, text "static void hs_spt_init_" <> ppr this_mod <> text "(void)"
, braces $ vcat $
[ text "static StgWord64 k" <> int i <> text "[2] = "
<> pprFingerprint fp <> semi
$$ text "extern StgPtr "
<> (ppr $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
$$ text "hs_spt_insert" <> parens
(hcat $ punctuate comma
[ char 'k' <> int i
, char '&' <> ppr (mkClosureLabel (idName n) (idCafInfo n))
]
)
<> semi
| (i, (n, fp)) <- zip [0..] entries
]
, text "static void hs_spt_fini_" <> ppr this_mod
<> text "(void) __attribute__((destructor));"
, text "static void hs_spt_fini_" <> ppr this_mod <> text "(void)"
, braces $ vcat $
[ text "StgWord64 k" <> int i <> text "[2] = "
<> pprFingerprint fp <> semi
$$ text "hs_spt_remove" <> parens (char 'k' <> int i) <> semi
| (i, (_, fp)) <- zip [0..] entries
]
]
go fps bs xs = case xs of
[] -> return (reverse fps, reverse bs)
bnd : xs' -> do
(fps', bnd') <- replaceStaticBind bnd
go (reverse fps' ++ fps) (bnd' : bs) xs'
dflags = hsc_dflags hsc_env
-- Generates keys and replaces 'makeStatic' with 'StaticPtr'.
--
-- The 'Int' state is used to produce a different key for each binding.
replaceStaticBind :: CoreBind
-> StateT Int IO ([(Id, Fingerprint)], CoreBind)
replaceStaticBind (NonRec b e) = do (mfp, (b', e')) <- replaceStatic b e
return (maybeToList mfp, NonRec b' e')
replaceStaticBind (Rec rbs) = do
(mfps, rbs') <- unzip <$> mapM (uncurry replaceStatic) rbs
return (catMaybes mfps, Rec rbs')
replaceStatic :: Id -> CoreExpr
-> StateT Int IO (Maybe (Id, Fingerprint), (Id, CoreExpr))
replaceStatic b e@(collectTyBinders -> (tvs, e0)) =
case collectMakeStaticArgs e0 of
Nothing -> return (Nothing, (b, e))
Just (_, t, info, arg) -> do
(fp, e') <- mkStaticBind t info arg
return (Just (b, fp), (b, foldr Lam e' tvs))
mkStaticBind :: Type -> CoreExpr -> CoreExpr
-> StateT Int IO (Fingerprint, CoreExpr)
mkStaticBind t srcLoc e = do
i <- get
put (i + 1)
staticPtrInfoDataCon <-
lift $ lookupDataConHscEnv staticPtrInfoDataConName
let fp@(Fingerprint w0 w1) = mkStaticPtrFingerprint i
info <- mkConApp staticPtrInfoDataCon <$>
(++[srcLoc]) <$>
mapM (mkStringExprFSWith (lift . lookupIdHscEnv))
[ unitIdFS $ moduleUnitId this_mod
, moduleNameFS $ moduleName this_mod
]
-- The module interface of GHC.StaticPtr should be loaded at least
-- when looking up 'fromStatic' during type-checking.
staticPtrDataCon <- lift $ lookupDataConHscEnv staticPtrDataConName
return (fp, mkConApp staticPtrDataCon
[ Type t
, mkWord64LitWordRep dflags w0
, mkWord64LitWordRep dflags w1
, info
, e ])
mkStaticPtrFingerprint :: Int -> Fingerprint
mkStaticPtrFingerprint n = fingerprintString $ intercalate ":"
[ unitIdString $ moduleUnitId this_mod
, moduleNameString $ moduleName this_mod
, show n
]
-- Choose either 'Word64#' or 'Word#' to represent the arguments of the
-- 'Fingerprint' data constructor.
mkWord64LitWordRep dflags
| platformWordSize (targetPlatform dflags) < 8 = mkWord64LitWord64
| otherwise = mkWordLit dflags . toInteger
lookupIdHscEnv :: Name -> IO Id
lookupIdHscEnv n = lookupTypeHscEnv hsc_env n >>=
maybe (getError n) (return . tyThingId)
lookupDataConHscEnv :: Name -> IO DataCon
lookupDataConHscEnv n = lookupTypeHscEnv hsc_env n >>=
maybe (getError n) (return . tyThingDataCon)
getError n = pprPanic "sptCreateStaticBinds.get: not found" $
text "Couldn't find" <+> ppr n
-- | @sptModuleInitCode module fps@ is a C stub to insert the static entries
-- of @module@ into the static pointer table.
--
-- @fps@ is a list associating each binding corresponding to a static entry with
-- its fingerprint.
sptModuleInitCode :: Module -> [(Id, Fingerprint)] -> SDoc
sptModuleInitCode _ [] = Outputable.empty
sptModuleInitCode this_mod entries = vcat
[ text "static void hs_spt_init_" <> ppr this_mod
<> text "(void) __attribute__((constructor));"
, text "static void hs_spt_init_" <> ppr this_mod <> text "(void)"
, braces $ vcat $
[ text "static StgWord64 k" <> int i <> text "[2] = "
<> pprFingerprint fp <> semi
$$ text "extern StgPtr "
<> (ppr $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
$$ text "hs_spt_insert" <> parens
(hcat $ punctuate comma
[ char 'k' <> int i
, char '&' <> ppr (mkClosureLabel (idName n) (idCafInfo n))
]
)
<> semi
| (i, (n, fp)) <- zip [0..] entries
]
, text "static void hs_spt_fini_" <> ppr this_mod
<> text "(void) __attribute__((destructor));"
, text "static void hs_spt_fini_" <> ppr this_mod <> text "(void)"
, braces $ vcat $
[ text "StgWord64 k" <> int i <> text "[2] = "
<> pprFingerprint fp <> semi
$$ text "hs_spt_remove" <> parens (char 'k' <> int i) <> semi
| (i, (_, fp)) <- zip [0..] entries
]
]
where