Where do I put the *definition* of a DFunId?

Simon Peyton Jones simon.peytonjones at gmail.com
Fri Feb 11 10:03:41 UTC 2022


A `ModDetails` gives the type signatures for everything, but no actual
code.  For example if you have `f :: Int -> Int` in the `md_types`, the
`ModDetails` doesn't include the binding `f = rhs` for `f`.

Presumably you must also be generating these bindings (in a `ModGuts`
perhaps?) and generating code for them that will ultimately be linked into
the program to run.

Well, put the `DFunId` binding in the same place, alongside `f`.

Does that help?

Simon

On Thu, 10 Feb 2022 at 09:49, Erdi, Gergo via ghc-devs <ghc-devs at haskell.org>
wrote:

> PUBLIC
>
> PUBLIC
>
> Hi,
>
>
>
> I’m trying to make a module out of thin air and register it to GHC so that
> other modules can import it. So far, I have had success with making a
> ModIface and a ModDetails, and then registering them using the following
> function:
>
>
>
> registerModule :: (GhcMonad m) => ModIface -> ModDetails -> m ()
>
> registerModule iface details = modifySession $ extendHpt . addModule
>
>   where
>
>     mod_info = HomeModInfo iface details Nothing
>
>
>
>     mod = mi_module iface
>
>     modOrig = ModOrigin (Just True) [] [] True
>
>
>
>     addModule = modifyUnitState $ \us -> us
>
>         { moduleNameProvidersMap = M.insert (moduleName mod) (M.singleton
> mod modOrig) $ moduleNameProvidersMap us
>
>         }
>
>
>
>     extendHpt env = env
>
>         { hsc_unit_env = let ue = hsc_unit_env env in ue
>
>             { ue_hpt = hpt
>
>             }
>
>         }
>
>
>
>       where
>
>         hpt = addToHpt (hsc_HPT env) (moduleName mod) mod_info
>
>
>
>
>
> This worked when I was only _*declaring*_ functions and TyCons in these
> modules. However, now I would also like to add instances. And I’m hitting a
> problem here, because I don’t know where to put the actual definitions of
> the instance. I’m completely lost here.
>
>
>
> Here’s what I’m doing in detail. First, I make a fresh DFunId from a fresh
> Unique:
>
>
>
>         let tag = occNameString . getDFunTyKey $ ty
>
>             occ = mkDFunOcc (occNameString (getOccName showClass) <> tag)
> False emptyOccSet
>
>             name = mkExternalName uniq mod occ loc
>
>             dfun = mkDictFunId name [] [] showClass [ty]
>
>
>
> Then, I make a ClsInst that describes my instance:
>
>
>
>         return ClsInst
>
>             { is_cls_nm = getName showClass
>
>             , is_tcs = [KnownTc $ getName tycon]
>
>             , is_dfun_name = getName dfun
>
>             , is_tvs = []
>
>             , is_cls = showClass
>
>             , is_tys = [ty]
>
>             , is_dfun = dfun
>
>             , is_flag = OverlapFlag (NoOverlap NoSourceText) False
>
>             , is_orphan = NotOrphan (getOccName $ getName tycon)
>
>             }
>
>
>
> And then I add ‘AnId dfun’ to my ModDetails’s type env in ‘md_types’,, add
> the instance to the ‘md_insts’, and fill the ‘mi_decls’ and ‘mi_insts’ of
> the ModIface accordingly. This gives me a ModIface/ModDetails pair just
> like before – but I never said what the definition of ‘dfun’ is!
>
>
>
> When I try compiling a real source module that imports this synthetic
> module and tries to use the instance, it gets as far as the “Desugar (after
> optimization)” step, and then fails with:
>
>
>
> ghc-mu-core-to-exp: panic! (the 'impossible' happened)
>
>   GHC version 9.3.20211130:
>
>         lookupIdSubst
>
>
>
> $fShowOrderPolicy
>
> InScope {foo mapM_}
>
> Call stack:
>
>     CallStack (from HasCallStack):
>
>       callStackDoc, called at compiler/GHC/Utils/Panic.hs:181:37 in
> ghc-lib-0.20211130-7QA7vLTw0OYJmMsraoHe3v:GHC.Utils.Panic
>
>       pprPanic, called at compiler/GHC/Core/Subst.hs:260:17 in
> ghc-lib-0.20211130-7QA7vLTw0OYJmMsraoHe3v:GHC.Core.Subst
>
>
>
>
>
> I’m not surprised that eventually it crashes and burns, because, again, I
> have only declared my DFunId (‘$fShowOrderPolicy’ in this case), but never
> defined it. Its definition would be a CoreExpr, right? So where would I put
> the pair of ‘(dfun, myCoreExprOfTheRightType)’ for GHC to pick it up? Or is
> it the case that GHC would only need an ‘Id’s definition if it is trying to
> inline/specialize it, i.e. should I just attach the definition to the
> DFunId as an unfolding? Or is ‘registerModule’ already incomplete and it
> should put the ‘CoreProgram’ of the module to somewhere deep in the GHC
> state?
>
>
>
> Thanks,
>
>             Gergo
>
> This email and any attachments are confidential and may also be
> privileged. If you are not the intended recipient, please delete all copies
> and notify the sender immediately. You may wish to refer to the
> incorporation details of Standard Chartered PLC, Standard Chartered Bank
> and their subsidiaries at https: //www.sc.com/en/our-locations
>
> Where you have a Financial Markets relationship with Standard Chartered
> PLC, Standard Chartered Bank and their subsidiaries (the "Group"),
> information on the regulatory standards we adhere to and how it may affect
> you can be found in our Regulatory Compliance Statement at https: //
> www.sc.com/rcs/ and Regulatory Compliance Disclosures at http: //
> www.sc.com/rcs/fm
>
> Insofar as this communication is not sent by the Global Research team and
> contains any market commentary, the market commentary has been prepared by
> the sales and/or trading desk of Standard Chartered Bank or its affiliate.
> It is not and does not constitute research material, independent research,
> recommendation or financial advice. Any market commentary is for
> information purpose only and shall not be relied on for any other purpose
> and is subject to the relevant disclaimers available at https: //
> www.sc.com/en/regulatory-disclosures/#market-disclaimer.
>
> Insofar as this communication is sent by the Global Research team and
> contains any research materials prepared by members of the team, the
> research material is for information purpose only and shall not be relied
> on for any other purpose, and is subject to the relevant disclaimers
> available at https: //
> research.sc.com/research/api/application/static/terms-and-conditions.
>
> Insofar as this e-mail contains the term sheet for a proposed transaction,
> by responding affirmatively to this e-mail, you agree that you have
> understood the terms and conditions in the attached term sheet and
> evaluated the merits and risks of the transaction. We may at times also
> request you to sign the term sheet to acknowledge the same.
>
> Please visit https: //www.sc.com/en/regulatory-disclosures/dodd-frank/
> for important information with respect to derivative products.
> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20220211/83fdf0a4/attachment.html>


More information about the ghc-devs mailing list