5

例如:如果我想让函数equal?识别我自己的类型或记录,我可以添加一个新的行为equal?吗?不擦除或覆盖旧的?

或者例如,如果我想让函数"+"也接受字符串?

4

6 回答 6

4

与使用 相比,更好的解决方案是通过-bindingimport来跟踪原始函数。let最好检查参数的类型是字符串,而不是不是数字。使用这两种方法意味着可以组合该技术。

(define +
  (let ((old+ +))
    (lambda args
      (if (string? (car args))
          (apply string-append args)
          (apply old+ args)))))

(define +
  (let ((old+ +))
    (lambda args
      (if (vector? (car args))
          (apply vector-append args)
          (apply old+ args)))))

以上将产生一个+适用于数字、字符串或向量的函数。一般来说,这是一种更可扩展的方法。


我能够验证上述在 MIT/GNU Scheme、Guile、Racket、Chicken、TinyScheme 和 SCSH 中是否正常工作。但是,在某些实现中,例如 Biwa Scheme,需要set!使用define. 在 Ikarus 中,set!不能在导入的图元上使用,并且define会破坏环境,因此需要分两步执行此操作:

(define new+
  (let ((old+ +))
    (lambda args
      (if (string? (car args))
          (apply string-append args)
          (apply old+ args)))))
(define + new+)

请注意,根据R5RSdefine并且set!在这种情况下应该是等效的:

在程序的顶层,定义

(define <variable> <expression>)

与赋值表达式的效果基本相同

(set! <variable> <expression>)

如果<variable>是绑定的。

于 2014-05-27T01:09:21.430 回答
1

到目前为止,这些解决方案在 R6RS / R7RS 环境中的效果并不理想。当我开始玩这个时,我正在考虑泛型,但我不想推出自己的类型系统。相反,您提供一个谓词过程,该过程应确保参数适用于该特定过程。它并不完美,但它与其他 R5RS 答案类似,而且您永远不会重新定义程序。

我已经用 R6RS 编写了所有内容,但我想它很容易移植到 R7RS。这是一个例子:

#!r6rs

(import (sylwester generic)
        (rename (rnrs) (+ rnrs:+))
        (only (srfi :43) vector-append))

(define-generic + rnrs:+)
(add-method + (lambda x (string? (car x))) string-append)
(add-method + (lambda x (vector? (car x))) vector-append)
(+ 4 5)                ; ==> 9
(+ "Hello," " world!") ; ==> "Hello, world!"
(+ '#(1) '#(2))        ; ==> #(1 2)

如您所见,我+使用不同的名称导入,因此我不需要重新定义它(这是不允许的)。

这是库的实现:

#!r6rs

(library (sylwester generic)         
  (export define-generic add-method)
  (import (rnrs))

  (define add-method-tag (make-vector 1))

  (define-syntax define-generic
    (syntax-rules ()
      ((_ name default-procedure)
       (define name 
         (let ((procs (list (cons (lambda x #t) default-procedure))))
           (define (add-proc id pred proc)
             (set! procs (cons (cons pred proc) procs)))

           (add-proc #t
                 (lambda x (eq? (car x) add-method-tag))
                 add-proc)
           (lambda x
             (let loop ((procs procs))
               (if (apply (caar procs) x)
                   (apply (cdar procs) x)
                   (loop (cdr procs))))))))))

  (define (add-method name pred proc)
    (name add-method-tag pred proc)))

如您所见,我使用消息传递来添加更多方法。

于 2014-05-30T19:31:44.073 回答
0

诀窍是定义您自己的扩展函数,以便它隐藏标准函数,但在需要时调用标准函数。在您的扩展功能中,您可以执行import标准功能。这是一个+也接受字符串的版本:

(define +
  (lambda args
    (if (number? (car args))
        (let ()
          (import (scheme))
          (apply + args))
        (apply string-append args))))

(这有点草率,因为它假设至少有一个参数,并且只检查第一个参数的类型。但它说明了该技术。)

于 2014-05-27T00:55:39.153 回答
0

不是纯 Scheme,但例如在Guile中,您可以使用类似 CLOS的 OO 系统:

scheme@(guile-user)> (use-modules (oop goops))
scheme@(guile-user)> (define-method (+ (x <string>) ...) (string-append x ...))
scheme@(guile-user)> (+ "a" "b")
$1 = "ab"
scheme@(guile-user)> (+ "a" "b" "c")
$2 = "abc"
scheme@(guile-user)> (+ 1 2)
$3 = 3
scheme@(guile-user)> (+ 1 2 3)
$4 = 6
于 2014-05-27T09:32:56.387 回答
0

你不能使用

(define +
  (let ((old+ +))
    ...))

因为define为其初始化形式设置了递归环境。因此,在评估+(old+ +)它将不受约束。像这样:

> (define + 
   (let ((old+ +))
     (lambda (a b) (display "my+") (old+ a b))))
Unhandled exception
 Condition components:
   1. &undefined
   2. &who: eval
   3. &message: "unbound variable"
   4. &irritants: (+)

以下作品:

> (define old+ +)
> (define + (lambda (a b) (display "my+\n") (old+ a b)))
> (+ 1 2)
my+
3

虽然它不是那么漂亮。

于 2014-05-27T14:18:31.153 回答
0

在 R7RS-large 中(或者实际上在任何 Scheme 中),您可以使用 SRFI 128 比较器,它封装了相等、排序和散列的思想,以便使通用比较成为可能。SRFI 128 允许您创建自己的比较器并将它们用于比较器感知功能。例如,<?获取一个比较器对象和两个或多个与比较器关联的类型的对象,#t如果在比较器的排序谓词的意义上,第一个对象小于第二个对象,则返回。

于 2018-10-14T03:59:29.197 回答