在 Scheme (R6RS) 中表示代数数据类型构造函数的惯用方式是啥？

Posted 2023-02-22

【中文标题】在 Scheme (R6RS) 中表示代数数据类型构造函数的惯用方式是啥？

【英文标题】：What is the idiomatic way to represent algebraic datatype constructors in Scheme (R6RS)?在 Scheme (R6RS) 中表示代数数据类型构造函数的惯用方式是什么？

【发布时间】：2021-07-06 21:46:19

【问题描述】：

我想知道将类似 Haskell 的数据类型转换为 Scheme 的最佳方法是什么。我目前的计划是用vectors 表示构造函数，第一个元素是label 表示变体。因此，例如，下面的 Haskell 程序：

data Bits       = O Bits | I Bits | E deriving Show
data Nat        = S Nat  | Z          deriving Show
inc (O pred)    = I pred
inc (I pred)    = O (inc pred)
inc E           = E
dup (S pred)    = let (x,y) = dup pred in (S x, S y)
dup Z           = (Z, Z)
bus Z        bs = inc bs
bus (S pred) bs = let (x,y) = (pred,pred) in (bus pred (bus pred bs))
o32             = (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O E))))))))))))))))))))))))))))))))
n26             = (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S Z))))))))))))))))))))))))))
main            = print (bus n26 o32)

将被翻译为：

(define (O pred)   (vector 'O pred))
(define (I pred)   (vector 'I pred))
(define E          (vector 'E))
(define (S pred)   (vector 'S pred))
(define Z          (vector 'Z))
(define (Inc bits) (case (vector-ref bits 0) ('O (I (vector-ref bits 1))) ('I (O (Inc (vector-ref bits 1)))) ('E E)))
(define (Dup val)  (case (vector-ref val 0) ('S (let ((xy (Dup (vector-ref val 1)))) (cons (S (car xy)) (S (cdr xy))))) ('Z (cons Z Z))))
(define (Bus n bs) (case (vector-ref n 0) ('Z (Inc bs)) ('S (let ((xy (Dup (vector-ref n 1)))) (Bus (car xy) (Bus (cdr xy) bs))))))
(define O32        (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O (O E)))))))))))))))))))))))))))))))))
(define N26        (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S Z)))))))))))))))))))))))))))
(display (Bus N26 O32))

令我惊讶的是，这实际上表现得非常好（这里的方案比 Haskell 快）。但我想知道这是否是最好的方法？这是合理的，还是有一些更“惯用”的翻译，预期效果会更好？

【问题讨论】：

是的，标记向量是惯用的，例如使用在 EOPL 第 1 版中。 （1992 年）。

【参考方案1】：

总的来说，我认为您有两种方法：一种“正”编码，​​就像您在此处所做的那样，其中有表示包含（动态）标签的产品的向量以区分总和，以及“负”编码（Böhm–Berarducci/访问者），您可以在其中通过递归方案表示数据类型以使用它们。

Haskell 中 BB 编码版本的示例：

-# Language RankNTypes #-

-- The type of /folds/ that consume bits.
newtype Bits = Bits
   matchBits
    :: forall r.  -- Caller-specified result type.
       (r -> r)   -- O: 1 recursive field
    -> (r -> r)   -- I: 1 recursive field
    -> r          -- E: no fields; could be ‘() -> r’
    -> r
  

-- The type of one /recursive unrolling/ of bits.
newtype Bits' = Bits'
   matchBits'
    :: forall r.    -- Also any result type.
       (Bits -> r)  -- But note! ‘Bits’ instead of ‘r’.
    -> (Bits -> r)
    -> r
    -> r
  

-- Basic constructors retain their types.
mkI, mkO :: Bits -> Bits
mkE :: Bits

mkI', mkO' :: Bits' -> Bits'
mkE' :: Bits'

-- Constructor functions perform visitor dispatch.
-- This is where the recursion happens in ‘matchBits’.
mkO pred = Bits $ \  o  i e -> o (matchBits pred o i e)
mkI pred = Bits $ \  o  i e -> i (matchBits pred o i e)
mkE      = Bits $ \ _o _i e -> e

-- General recursive dispatch is similar.
mkO' pred = Bits' $ \  o  i e -> o (matchBits' pred mkO mkI mkE)
mkI' pred = Bits' $ \  o  i e -> i (matchBits' pred mkO mkI mkE)
mkE'      = Bits' $ \ _o _i e -> e

-- Recursive deconstruction, used below.
recurBits :: Bits -> Bits'
recurBits bits = matchBits bits mkO' mkI' mkE'

-- We only need a fold for nats here.
newtype Nat = Nat
   matchNat
    :: forall r.  -- Result type.
       (r -> r)   -- S: 1 recursive field
    -> r          -- Z: no fields; also could be ‘() -> r’
    -> r
  

mkS :: Nat -> Nat
mkZ :: Nat

mkS pred = Nat $ \  s z -> s (matchNat pred s z)
mkZ      = Nat $ \ _s z -> z

-- Case branches with ‘matchBits’ receive the /result/
-- of the recursive call on a recursive field. So this
-- is /not/ what we want:
--
-- > inc bits = matchBits bits mkI (mkO . inc) mkE
--
-- Instead, we want the field itself, so we must use
-- the recursive ‘matchBits'’.
inc :: Bits -> Bits
inc bits = matchBits' (recurBits bits) mkI (mkO . inc) mkE

-- Or: ‘dup nat = matchNat nat (mkS *** mkS) (mkZ, mkZ)’
-- Or: ‘dup nat = (nat, nat)’ = ‘dup = join (,)’
dup :: Nat -> (Nat, Nat)
dup nat = matchNat nat
  (\ (x, y) -> (mkS x, mkS y))  -- S
  (mkZ, mkZ)                    -- Z

-- NB: think of as ‘Nat -> (Bits -> Bits)’.
bus :: Nat -> Bits -> Bits
bus n = matchNat n
  (\ f -> f . f)  -- S
  inc             -- Z

您可以或多或少地将其直接转换为 Scheme。这是一个未经测试并且可能不正确的翻译草图，只是为了说明一个起点：

(define (O pred)  (lambda (o i e) (o (pred o i e))))
(define (I pred)  (lambda (o i e) (i (pred o i e))))
(define E         (lambda (o i e) (e)))

(define (O_ pred) (lambda (o i e) (o (pred O I E))))
(define (I_ pred) (lambda (o i e) (i (pred O I E))))
(define E_        (lambda (o i e) (e)))

(define (S pred)  (lambda (s z) (s (pred s z))))
(define Z         (lambda (s z) (z)))

(define (recurBits bits) (bits O_ I_ E_))

(define (Inc bits)
  ((recurBits bits)
     I
     (lambda (pred) (O (Inc pred)))
     E))

(define (Dup val)
  (val (lambda (p)
         (let ((x (car p))
               (y (cdr p)))
           (cons (S x) (S y))))
       (cons Z Z)))

(define (Bus n bs)
  ((Bus_ n) bs))
(define (Bus_ n)
  (n (lambda (pred) (lambda (bs) (pred (pred bs))))
     inc))

您可能需要在几个地方添加一些显式参数或额外的 lambda，以处理部分应用程序和惰性求值的差异，例如 Bus_ 的尴尬。

不过，总的来说，我希望这种方法在许多应用程序中具有可比或更好的性能特征。它依赖于闭包而不是向量，因为语言实现对它们的结构了解得更多，所以它可能会被更好地编译。它不是在值上动态分派，而是在要（尾）调用的函数中进行选择，避免构造某些值。

当我在 Haskell 中学习这项技术时，我还发现 Oleg Kiselyov’s notes on BB-encoding 是一个有用的资源。

【讨论】：

消除器在以一种避免跳转到未知代码的方式进行编译/JIT 化时往往工作得很好。否则，与标签上的案例分析相比，它们往往表现不佳。

@dfeuer：是的，我很想看看在不同的非/优化方案实现中的基准测试，但我希望相同：如果编译器看到它可以使用直接调用，然后打开内联和删除分支以及其他所有内容，但如果没有，“直接”样式几乎肯定会更好。

哦，但有趣的是，我实际上正在执行整个编译过程，以便避免编译成访问者模式，因为Kind 上的每个数据类型都是 λ 编码的默认情况下（这会导致您所描述的内容）。不过，使用这种模式时，Scheme 的性能确实会差一些（比如 2 倍）。但无论如何，这是一个很好的答案，很高兴在这里看到它！