Is it possible to "extend" a function / lambda / macro in Scheme?

Question

For example: if I want the function equal? recognize my own type or record, can I add a new behavior of equal?? without erasing or overwriting the old one?

Or for example if I want to make the function "+" accept also string?

Answer 1

Rather than using import, a better solution is to keep track of the original function by let-binding it. It's also better to check that the type of the argument is a string, rather than that it is not a number. Using both of these approaches means that it's possible to compose the technique.

(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)))))

The above will produce a + function that works on numbers, strings, or vectors. In general, this is a more extensible approach.

---

I was able to verify that the above works correctly in MIT/GNU Scheme, Guile, Racket, Chicken, TinyScheme, and SCSH. However, in some implementations, such as Biwa Scheme, it is necessary to use set! instead of define. In Ikarus, set! cannot be used on an imported primitive, and define messes up the environment, so it is necessary to do this in two steps:

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

---

Note that according to R5RS, define and set! are supposed to be equivalent in this case:

At the top level of a program, a definition

(define <variable> <expression>)

has essentially the same effect as the assignment expression

(set! <variable> <expression>)

if <variable> is bound.

Answer 2

You can't use

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

because define sets up a recursive environment for its init form. Thus when evaluating + in (old+ +) it will be unbound. As such:

> (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: (+)

The following works:

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

although it is not so pretty.

Answer 3

Not pure Scheme, but in Guile for example you can use the CLOS-like OO system:

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

Answer 4

The trick is to define your own, extended function so it shadows the standard function but calls the standard function when it's needed. Inside your extended function, you can do an import to get at the standard function. Here's a version of + that also accepts strings:

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

(This is a little sloppy in that it assumes there is at least one argument and it only checks the type of the first argument. But it illustrates the technique.)

Answer 5

So far the solutions work less than optimal in an R6RS / R7RS environment. I was thinking generics when I started playing around with this, but I didn't want to roll my own type system. Instead you supply a predicate procedure that should ensure the arguments are good for this particular procedure. It's not perfect but it works similar to the other R5RS answers and you never redefine procedures.

I've written everything in R6RS but I imagine it's easily ported to R7RS. Here's an example:

#!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)

As you can see I import + by a different name so I don't need to redefine it (which is not allowed).

Here's the library implementation:

#!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)))

As you can see I use message passing to add more methods.

Answer 6

In R7RS-large (or in any Scheme, really), you can use SRFI 128 comparators, which package up the ideas of equality, ordering, and hashing, in order to make generic comparisons possible. SRFI 128 allows you to create your own comparators and use them in comparator-aware functions. For example, <? takes a comparator object and two or more objects of the type associated with the comparator, and returns #t if the first object is less than the second object in the sense of the comparator's ordering predicate.