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

问题描述

我想知道将类 Haskell 数据类型转换为 Scheme 的最佳方法是什么。我目前的计划是用 vector 表示构造函数，第一个元素是表示变体的 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))

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

解决方法

从广义上讲，我认为您有两种方法：一种“正”编码，​​就像您在此处所做的那样，其中您有向量表示包含（动态）标签以区分和的产品，以及“负”编码（{{3} } /visitor) 在这里，您通过递归方案来表示数据类型以使用它们。

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 中学习这项技术时，我还发现了 Böhm–Berarducci 一个有用的资源。