Email list hosting service & mailing list manager

Internal defines/reference implementations erik hilsdale (13 Jul 1999 13:49 UTC)
Re: Internal defines/reference implementations Sergei Egorov (13 Jul 1999 19:22 UTC)
Re: Internal defines/reference implementations erik hilsdale (13 Jul 1999 22:44 UTC)

Internal defines/reference implementations erik hilsdale 13 Jul 1999 13:49 UTC

I want to bring up the internal definition issue.  The current
proposal disallows internal record-type definitions because such
definitions `would require a more complex implementation'.  I'm not
sure this is true in an interesting sense.

In any Scheme where letrec happens to bind left to right (allowed by
the `is an error' language of r5rs 4.2.2, perhaps discouraged by the
syntax-rules definition of r5rs 7.3), the implementation required for
internal record-type definition does not, in fact, require a more
complex implementation.  That's as maybe.

Certainly, a portable _reference implementation_ would, indeed,
require a more complex implementation... the various record-?
procedure constructors would have to be macros if we wanted to get the
same efficiency that the current reference implementation has (though
I would argue that this doesn't make the code much more difficult to
read; see below for the obvious lifting of these procedures to
macros).

I guess the real question is whether SRFI's primarily exist to define
features or libraries.  I've got to believe it's the former, otherwise
we would be talking about slib.  And if it's the former, the
restriction to top-level seems pretty arbitrary.

-erik

P.S. Just to toss in my two cents, I'd also like Olin's extra two
parentheses to group the field specs (though I didn't put them in the
following code).

(define-syntax define-record-type
  (syntax-rules ()
    ((define-record-type type
       (constructor constructor-tag ...)
       predicate
       (field-tag accessor . more) ...)
     (begin
       (define type
	 (make-record-type 'type '(field-tag ...)))
       (define constructor
	 (record-constructor type '(field-tag ...) '(constructor-tag ...)))
       (define predicate
	 (record-predicate type))
       (define-record-field type 'field-tag '(field-tag ...) accessor . more)
       ...
       ))))

(define-syntax define-record-field
  (syntax-rules ()
    ((define-record-field type all-tags field-tag accessor)
     (define accessor (record-accessor type all-tags field-tag)))
    ((define-record-field type all-tags field-tag accessor modifier)
     (begin
       (define accessor (record-accessor type all-tags field-tag))
       (define modifier (record-modifier type all-tags field-tag))))))

(define-syntax record-constructor
  (syntax-rules ()
    ((record-constructor type all-tags constructor-tags)
     (let ((size (length all-tags))
	   (arg-count (length constructor-tags))
	   (indexes (map (lambda (tag)
			   (list-index tag all-tags))
			 constructor-tags)))
       (lambda args
	 (if (= (length args) arg-count)
	     (let ((new (make-record (+ size 1))))
	       (record-set! new 0 type)
	       (for-each (lambda (arg i)
			   (record-set! new i arg))
			 args
			 indexes)
	       new)
	     (error "wrong number of arguments to constructor" type args)))))))

(define-syntax record-predicate
  (syntax-rules ()
    ((record-predicate type)
     (lambda (thing)
       (and (record? thing)
	    (eq? (record-type thing)
		 type))))))

(define-syntax record-accessor
  (syntax-rules ()
    ((record-accessor type all-tags tag)
     (let ((index (list-index tag all-tags)))
       (lambda (thing)
	 (if (and (record? thing)
		  (eq? (record-type thing)
		       type))
	     (record-ref thing index)
	     (error "accessor applied to bad value" type tag thing)))))))

(define-syntax record-modifier
  (syntax-rules ()
    ((record-modifier type all-tags tag)
     (let ((index (list-index tag all-tags)))
       (lambda (thing value)
	 (if (and (record? thing)
		  (eq? (record-type thing)
		       type))
	     (record-set! thing index value)
	     (error "modifier applied to bad value" type tag thing)))))))