在Core中合成一个函数绑定

我正在编写一个GHC 核心插件，它最终会向它调用的模块添加新的函数声明。

目前我正在努力结合核心助手来生成Expr与 lambda 函数对应的函数。

例如，假设我们要合成术语(x :: Double) -> x + x。

如果我们看一下印刷精美的 Core ：

f  (x [Dmd=<S,U(U)>] :: Double) -> plusDouble x x

将该术语的 AST 复制到一个有Show能力的 AST 后，我们可以看到它的 lambda 抽象和函数应用程序的结构，我的目标是使用 Core 组合器手动复制：

DLam "x::Double" 
  (DApp 
    (DApp (DVar "plusDouble::Double -> Double -> Double") (DVar "x::Double")) (DVar "x::Double"))

长话短说，我无法综合该术语 L0L。

我生成了一个看起来正确的术语 (?)，GHC 在我的新术语中拼接后没有错误地完成，具有新声明的模块正确加载，但当我尝试使用它时 GHCi 崩溃。

我的问题：

• 为什么会出现那些空的 ( DEFAULT) 案例？我怀疑它们是由于我的使用方式mkCoreApps
• 我如何将结果装箱，使其成为一个Double而不是原始的Double#？

新声明的 GHCi 签名：

PluginTest.f_new :: Double -> ghc-prim-0.7.0:GHC.Prim.Double#

漂亮的核心：

f_new  (x :: Double) ->
  case x of x_ { D# x_ ->
  case x_ of wild_00 { __DEFAULT ->
  (case x_ of wild_00 { __DEFAULT -> +## wild_00 }) wild_00
  }
  } 

Show 上面的例子：

DLam "x::Double" 
  (DCase (DVar "x::Double") "Double#" [
    ("D#",["x_"], DCase (DVar "x_::Double") "Double#" [
      ("__DEFAULT",[], DApp (DCase (DVar "x_::Double") "Double# -> Double#" [
        ("__DEFAULT",[], DApp (DVar "+##::Double# -> Double# -> Double#") (DVar "wild_00::Double#"))]) (DVar "wild_00::Double#"))])])

完整的重现步骤和代码：

我进入ghc9.0.1 API并在声明导入和几个助手之后：

import GHC.Core.Make (mkCoreLams, mkSingleAltCase, mkCoreApps, mkCoreConApps) -- Core syntax combinators
import qualified GHC.Types.Name.Occurrence as ON (varName, mkOccName)
import GHC.Core.Opt.Monad (CoreM)
import GHC.Types.Unique.Supply (MonadUnique(..))
import GHC.Types.SrcLoc (noSrcSpan)
import GHC.Builtin.Types (manyDataConTy)
import GHC.Types.Id.Info (vanillaIdInfo)
import GHC.Types.Id.Make (mkPrimOpId)
import GHC.Builtin.PrimOps (PrimOp(..))
import GHC.Builtin.Types (doubleTy, floatTy, doubleDataCon, floatDataCon)
import GHC.Core.Utils (exprType)


-- | fresh name using the supply of unique symbols provided by MonadUnique
mkNameM :: String -> CoreM Name
mkNameM n = do
  u <- getUniqueM
  pure $ mkInternalName u (ON.mkOccName ON.varName n) noSrcSpan

-- | an external (= exported) name
mkExtNameM :: Module -- ^ module that will export this
           -> String -> CoreM Name
mkExtNameM modl n = do
  u <- getUniqueM
  pure $ mkExternalName u modl (ON.mkOccName ON.varName n) noSrcSpan

-- | variable identifier (of multiplicity "Many" which is the default)
mkId :: Name -> Type -> Id
mkId xname tyvar = mkLocalVar VanillaId xname manyDataConTy tyvar vanillaIdInfo

mkGlobalId :: Name -> Type -> Id
mkGlobalId xname tyvar = mkGlobalVar VanillaId xname tyvar vanillaIdInfo

我还编写了用于声明二元数学运算符的助手，它使用内置的 primops 并将它们包装起来：

-- | apply an Expr corresponding to a binary operator to two argument expressions
appBin :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
appBin f e1 e2 = mkCoreApps f [e1, e2]

-- | primop corrsponding to (+) :: Double -> Double -> Double
d_add :: CoreExpr
d_add = Var (mkPrimOpId DoubleAddOp)

现在我们准备编写一个函数，该函数获取模块 Core ( ModGuts)的当前内容，声明新变量并将新声明附加到模块中。

此函数testAddLambda可用作附加的 Core 插件通道，如 GHC 用户手册中所示。

我已经分离出应该声明术语的部分(x :: Double) -> x + x。

-- | add a single new binding corresponding to a lambda expression to ModGuts
testAddLambda :: ModGuts -> CoreM ModGuts
testAddLambda guts = do
  let
    modl = mg_module guts
    binds = mg_binds guts
    exports = mg_exports guts
  xn <- mkNameM "x"
  xn_ <- mkNameM "x_"
  fn <- mkExtNameM modl "f_new" -- new name to be exported
  let
    x = mkId xn doubleTy
    x_ = mkId xn_ doubleTy

    f = mkCoreLams [x] $
          mkSingleAltCase (Var x) x_ (DataAlt doubleDataCon) [x_] $
            appBin d_add (Var x_) (Var x_)
    fty = exprType f -- type of 'f'

    fv = mkGlobalId fn fty
    fbind = NonRec fv f
    fexp = Avail fn
    guts' = guts {
      mg_binds = binds ++ [fbind]
      , mg_exports = exports ++ [fexp]
      }
  pure guts'