我正在寻找如何将简单的 Haskell 程序(没有导入的库,只有数据类型和纯函数)转换为无类型 lambda 演算的术语的方法。一种有前途的方法似乎是使用GHC API将程序编译为GHC 核心,然后可以将其转换为无类型的 lambda 演算。
如何使用 GHC API 加载 Haskell 程序并将其编译成 Core?
从ghc 文档中的GHC
模块文档:
compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
这是访问与模块对应的核心绑定的方法。
compileToCore
解析、类型检查和脱糖模块,然后如果成功则返回生成的核心模块(由模块名称、类型声明和函数声明组成)。
compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
Like
compileToCoreModule
,但调用了简化器,从而返回简化和整洁的 Core。
我通过查看模块列表GHC
、注意Desugar
模块、注意ModGuts
的结果deSugar
、下载所有文档并在文本中搜索ModGuts
.
我们的示例将编译一个简单的模块,以便我们可以看到核心的样子。它使用ghc-paths来提供 ghc libs 目录的位置。核心将在内存中由CoreModule
包含CoreBind
s列表的 a 表示。我们不能直接转储 AST,因为没有Show
AST 中描述CoreSyn
的实例,但是Outputable
实例CoreModule
将漂亮地打印核心,因此我们可以看到我们编译到核心。
import GHC
import DynFlags
import Outputable (Outputable, showPpr)
import qualified GHC.Paths as Paths
import Data.Functor
runGhc'
负责编译核心模块所需的所有设置,没有import
s 和 no TemplateHaskell
。我们用 完全关闭链接器NoLink
并告诉编译器用HscNothing
.
runGhc' :: Ghc a -> IO a
runGhc' ga = do
runGhc (Just Paths.libdir) $ do
dflags <- getDynFlags
let dflags2 = dflags { ghcLink = NoLink
, hscTarget = HscNothing
}
setSessionDynFlags dflags2
ga
将模块编译为核心包括使用guessTarget
和设置目标addTarget
,可选地使用 加载依赖项load
,使用 构建模块图depanel
,在模块图find
中正确ModSummary
设置,使用 解析模块parseModule
,使用 类型检查,使用typecheckModule
去糖desugarModule
,将其转换ModGuts
为coreModule
从DesugaredMod
实例中获取脱糖结果,并从ModGuts
. 所有这些都被包裹在一个漂亮的包装中compileToCoreModule
。
compileExample :: Ghc CoreModule
compileExample = compileToCoreModule "prettyPrint2dList.hs"
我们的整个示例程序将输出带有showPpr
.
showPpr' :: (Functor m, Outputable a, HasDynFlags m) => a -> m String
showPpr' a = (flip showPpr) a <$> getDynFlags
main = runGhc' (compileExample >>= showPpr') >>= putStrLn
编译上面的例子需要-package ghc
flag 暴露通常隐藏的 ghc api 包。
我们将编译为核心的示例模块"prettyPrint2dList.hs"
,包含一个数据类型和一些使用前奏中函数的代码。
data X = Y | Z
deriving (Eq, Show)
type R = [X]
type W = [R]
example = map (\x -> take x (cycle [Y, Z])) [0..]
main = undefined
这会产生大量印刷精美的核心。
%module main:Main (Safe-Inferred) [01D :-> Identifier `:Main.main',
a1f2 :-> Identifier `$c==', a1f5 :-> Identifier `$c/=',
a1fb :-> Identifier `$cshowsPrec', a1fh :-> Identifier `$cshow',
a1fk :-> Identifier `$cshowList',
r0 :-> Identifier `Main.$fShowX', r1 :-> Identifier `Main.$fEqX',
r2 :-> Type constructor `Main.R',
r3 :-> Type constructor `Main.X', r4 :-> Identifier `Main.main',
rqS :-> Type constructor `Main.W',
rrS :-> Data constructor `Main.Y', rrV :-> Identifier `Main.Y',
rrW :-> Data constructor `Main.Z', rrX :-> Identifier `Main.Z',
rL2 :-> Identifier `Main.example']
Main.example :: [[Main.X]]
[LclIdX, Str=DmdType]
Main.example =
GHC.Base.map
@ GHC.Types.Int
@ [Main.X]
(\ (x :: GHC.Types.Int) ->
GHC.List.take
@ Main.X
x
(GHC.List.cycle
@ Main.X
(GHC.Types.:
@ Main.X
Main.Y
(GHC.Types.: @ Main.X Main.Z (GHC.Types.[] @ Main.X)))))
(GHC.Enum.enumFrom
@ GHC.Types.Int GHC.Enum.$fEnumInt (GHC.Types.I# 0))
Main.main :: forall t. t
[LclIdX, Str=DmdType]
Main.main = GHC.Err.undefined
$cshowsPrec :: GHC.Types.Int -> Main.X -> GHC.Show.ShowS
[LclId, Str=DmdType]
$cshowsPrec =
\ _ [Occ=Dead] (ds_d1gG :: Main.X) ->
case ds_d1gG of _ [Occ=Dead] {
Main.Y ->
GHC.Show.showString
(GHC.Types.:
@ GHC.Types.Char
(GHC.Types.C# 'Y')
(GHC.Types.[] @ GHC.Types.Char));
Main.Z ->
GHC.Show.showString
(GHC.Types.:
@ GHC.Types.Char
(GHC.Types.C# 'Z')
(GHC.Types.[] @ GHC.Types.Char))
}
Main.$fShowX [InlPrag=[ALWAYS] CONLIKE] :: GHC.Show.Show Main.X
[LclIdX[DFunId],
Str=DmdType,
Unf=DFun: \ ->
GHC.Show.D:Show TYPE Main.X $cshowsPrec $cshow $cshowList]
Main.$fShowX =
GHC.Show.D:Show @ Main.X $cshowsPrec $cshow $cshowList;
$cshowList [Occ=LoopBreaker] :: [Main.X] -> GHC.Show.ShowS
[LclId, Str=DmdType]
$cshowList =
GHC.Show.showList__
@ Main.X
(GHC.Show.showsPrec @ Main.X Main.$fShowX (GHC.Types.I# 0));
$cshow [Occ=LoopBreaker] :: Main.X -> GHC.Base.String
[LclId, Str=DmdType]
$cshow = GHC.Show.$dmshow @ Main.X Main.$fShowX;
$c== :: Main.X -> Main.X -> GHC.Types.Bool
[LclId, Str=DmdType]
$c== =
\ (ds_d1gB :: Main.X) (ds_d1gC :: Main.X) ->
let {
fail_d1gD :: GHC.Prim.Void# -> GHC.Types.Bool
[LclId, Str=DmdType]
fail_d1gD = \ _ [Occ=Dead, OS=OneShot] -> GHC.Types.False } in
case ds_d1gB of _ [Occ=Dead] {
Main.Y ->
case ds_d1gC of _ [Occ=Dead] {
__DEFAULT -> fail_d1gD GHC.Prim.void#;
Main.Y -> GHC.Types.True
};
Main.Z ->
case ds_d1gC of _ [Occ=Dead] {
__DEFAULT -> fail_d1gD GHC.Prim.void#;
Main.Z -> GHC.Types.True
}
}
Main.$fEqX [InlPrag=[ALWAYS] CONLIKE] :: GHC.Classes.Eq Main.X
[LclIdX[DFunId],
Str=DmdType,
Unf=DFun: \ -> GHC.Classes.D:Eq TYPE Main.X $c== $c/=]
Main.$fEqX = GHC.Classes.D:Eq @ Main.X $c== $c/=;
$c/= [Occ=LoopBreaker] :: Main.X -> Main.X -> GHC.Types.Bool
[LclId, Str=DmdType]
$c/= =
\ (a :: Main.X) (b :: Main.X) ->
GHC.Classes.not (GHC.Classes.== @ Main.X Main.$fEqX a b);
:Main.main :: GHC.Types.IO GHC.Prim.Any
[LclIdX, Str=DmdType]
:Main.main =
GHC.TopHandler.runMainIO
@ GHC.Prim.Any (Main.main @ (GHC.Types.IO GHC.Prim.Any))