Polymorphism in Scheme (Re: records)

[forcer <forcer@mindless.com>]

Jost Boekemeier <jostobfe@calvados.zrz.TU-Berlin.DE> writes:

> My point was that polymorphism is superior to genericity. You can
> easily emulate genericity by using polymorphism.  Unfortunately scheme
> is functional language and the authors of scheme choose genericity in
> favor of polymorphism.  

Quoting foldoc (#):

# polymorphism:
# A concept first identified by Christopher Strachey (1967) and
# developed by Hindley and Milner, allowing types such as list of
# anything. E.g. in Haskell:
#
#	length :: [a] -> Int
#
# is a function which operates on a list of objects of any type,
# a (a is a type variable). This is known as parametric
# polymorphism.  Polymorphic typing allows strong type checking
# as well as generic functions.

I doubt that this is what you're referring to (Scheme handles
that quite well, except for the Polymorphic typing part)

# In object-oriented programming, the term is used to describe
# variables which may refer at run-time to objects of different
# classes.

This is given in Scheme anyways.

# Ad-hoc polymorphism (better described as overloading) is the
# ability to use the same syntax for objects of different types,
# e.g. "+" for addition of reals and integers or "-" for unary
# negation or diadic subtraction. Parametric polymorphism allows
# the same object code for a function to handle arguments of many
# types but overloading only reuses syntax and requires different
# code to handle different types.

So i guess that you're referring to ad-hoc
polymorphism/overloading.

> (define-polymorph foo)
> (define-polymorph foo ((negative? bar)) (- bar 1))
> (define-polymorph foo ((positive? bar)) (+ bar 1))
> (foo -1)
-2
> (foo 1)
2
> (foo 0)
Error: No signatures match

I'd call this quite nice ad-hoc polymorphism.
This implementation uses define-syntax which guile still lacks,
sadly. It's tested with Scheme48, though :]

(define (make-polymorph)
  (define (make-polyentry predlis func)
    (vector (length predlis) predlis func))
  (define (poly->argn poly) (vector-ref poly 0))
  (define (poly->pred poly) (vector-ref poly 1))
  (define (poly->func poly) (vector-ref poly 2))

  (let ((polylis '()))
    (lambda args
      (define (add predlis func)
	(set! polylis (cons (make-polyentry predlis func)
			    polylis)))
      (define (sigmatch? predlis arglis)
	(cond
	 ((or (null? predlis) (null? arglis))
	  #t)
	 (((car predlis) (car arglis))
	  (sigmatch? (cdr predlis) (cdr arglis)))
	 (else
	  #f)))
      (define (find-func argn arglis)
	(let loop ((lis polylis))
	  (cond
	   ((null? lis)
	    (error "No signatures match"))
	   ((and (= (poly->argn (car lis)) argn)
		 (sigmatch? (poly->pred (car lis)) arglis))
	    (poly->func (car lis)))
	   (else
	    (loop (cdr lis))))))
      (if (null? args)
	  add
	  (apply (find-func (length args) args) args)))))

(define-syntax define-polymorph
  (syntax-rules ()
    ((_ name)
     (define name (make-polymorph)))
    ((_ name ((pred1 arg1) ...) expr ...)
     ((name) (list pred1 ...) (lambda (arg1 ...) expr ...)))))

Have fun :)
	-forcer

-- 
((email . "forcer@mindless.com")       (www . "http://forcix.cx/")
 (irc   . "forcer@#StarWars (IRCnet)") (gpg . "/other/forcer.gpg"))