Можно ли расширить функцию/лямбда/макрос в схеме?

Вместо использования import лучшим решением будет отслеживать исходную функцию, связывая ее 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. В Икарусе set! нельзя использовать на импортированном примитиве, а define портит окружение, поэтому необходимо сделать это в два этапа:

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

Обратите внимание, что согласно R5RS, define и set! должны быть эквивалентны в этот случай:

На верхнем уровне программы определение

(define <variable> <expression>)

имеет практически тот же эффект, что и выражение присваивания

(set! <variable> <expression>)

если <variable> привязан.

Пока решения работают менее чем оптимально в среде 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)))

Как видите, я использую передачу сообщений для добавления дополнительных методов.

Хитрость заключается в том, чтобы определить свою собственную расширенную функцию, чтобы она затмевала стандартную функцию, но вызывала стандартную функцию, когда это необходимо. Внутри вашей расширенной функции вы можете сделать import, чтобы получить доступ к стандартной функции. Вот версия +, которая также принимает строки:

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

(Это немного неаккуратно, поскольку предполагается, что есть по крайней мере один аргумент, и проверяется только тип первого аргумента. Но это иллюстрирует технику.)

Не чистая схема, но в Guile, например, вы можете использовать CLOS-подобная объектно-ориентированная система:

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

Вы не можете использовать

(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

хотя это не так красиво.

В R7RS-large (или вообще в любой схеме) вы можете использовать компараторы SRFI 128, которые объединяют идеи равенства, упорядочения и хеширования, чтобы сделать возможным общее сравнение. SRFI 128 позволяет создавать собственные компараторы и использовать их в функциях, поддерживающих компараторы. Например, <? принимает объект компаратора и два или более объектов типа, связанного с компаратором, и возвращает #t, если первый объект меньше второго объекта в смысле предиката упорядочивания компаратора.