您如何从 lambda 术语转换为交互网络？

Question

在这篇论文中，作者建议在 lambda 术语之间进行翻译：

data Term = Zero | Succ Term | App Term Term | Lam Term

和交互网络：

data Net = -- if I understood correctly
    Apply Net Net Net 
    | Abstract Net Net Net
    | Delete Net Net Int
    | Duplicate Net Net Net Int
    | Erase Net

不幸的是我无法理解他的编译算法。似乎缺少实际的算法，我不知道他对第三页上的图像是什么意思。我已经尝试通过查看已发布的源代码来理解它，但是作者使用他自己的图形重写 DSL 来定义它，所以我必须先学习它。翻译是如何作为普通 Haskell 函数实现的？

Answer 1

我在 Haskell 中有一个交互网络归约的实现，它使用STRefs 以可变的方式表示网络图结构：

data NodeType = NRot
              | NLam
              | NApp
              | NDup Int
              | NEra
             deriving (Show)

type NodeID = Int
type Port s = STRef s (Node s, PortNum)

data Node s = Node
    { nodeType :: !NodeType
    , nodeID :: !NodeID
    , nodePort0, nodePort1, nodePort2 :: !(Port s)
    }

lambda 项的转换是在单独的模块中实现的。这不是我写过的最好的代码，因为它是Javascript 实现的直接音译，我并没有真正花时间去理解 JS 版本在做什么：

encodeLam :: Lam -> IntNet s (Node s)
encodeLam lam = do
    nextTag <- do
        ref <- lift $ newSTRef 0
        return $ lift $ do
            modifySTRef ref succ
            readSTRef ref

    let go scope up (Lam body) = do
            del <- mkNode NEra
            lam <- mkNode NLam
            linkHalf lam P0 up
            link (lam, P1) (del, P0)
            link (del, P1) (del, P2)
            bod <- go (lam:scope) (lam, P2) body
            linkHalf lam P2 bod
            return (lam, P0)
        go scope up (App f e) = do
            app <- mkNode NApp
            linkHalf app P2 up
            linkHalf app P0 =<< go scope (app, P0) f
            linkHalf app P1 =<< go scope (app, P1) e
            return (app, P2)
        go scope up (Var v) = do
            let lam = scope !! v
            (target, targetPort) <- readPort lam P1
            case nodeType target of
                NEra -> do
                    linkHalf lam P1 up
                    return (lam, P1)
                _ -> do
                    dup <- mkNode . NDup =<< nextTag
                    linkHalf dup P0 (lam, P1)
                    linkHalf dup P1 up
                    link (dup, P2) =<< readPort lam P1
                    linkHalf lam P1 (dup, P0)
                    return (dup, P1)

    root <- asks root
    enc <- go [] (root, P0) lam
    linkHalf root P0 enc
    return root

它还实现了逆向变换：

decodeLam :: Node s -> IntNet s Lam
decodeLam root = do
    (setDepth, getDepth) <- do
        ref <- lift $ newSTRef mempty
        let set node depth = lift $ modifySTRef ref $
                             IntMap.insertWith (\ _new old -> old) (nodeID node) depth
            get node = lift $ (! nodeID node) <$> readSTRef ref
        return (set, get)

    let go depth exit (node, port) = do
            setDepth node depth
            case nodeType node of
                NDup _ -> do
                    let (port', exit') = case port of
                            P0 -> (head exit, tail exit)
                            _ -> (P0, port:exit)
                    go depth exit' =<< readPort node port'
                NLam -> case port of
                    P1 -> do
                        depth' <- getDepth node
                        return $ Var (depth - depth' - 1)
                    _ -> Lam <$> (go (succ depth) exit =<< readPort node P2)
                NApp -> do
                    f <- go depth exit =<< readPort node P0
                    e <- go depth exit =<< readPort node P1
                    return $ App f e
    go 0 [] =<< readPort root P0