Objects and records.

[Wade Humeniuk <humeniuw@cadvision.com>]

Here is an example of a reimplementation of Guile records using
GOOS.  Full error checking is not implemented and the behaviour 
is not fully compliant with the Guile version.


(define (record? obj)
  (and (object? obj)
       (let ((special (object-specialization obj)))
	 (or (eq? special 'record)
	     (record? special)))))

(define make-record-type
  (lambda (name fields)
    (make-object 'record name '() 
		 (cons 'fields fields))))

(define (record-constructor rtd)
  (lambda fields
    (let ((rec (make-object rtd (object-name rtd) '())))
      (for-each
       (lambda (field-name init)
	 (slot-define! rec field-name init))
       (slot-ref rtd 'fields)
       fields)
       rec)))

(define (record-predicate rtd)
  (lambda (rec)
    (and (record? rec)
	 (eq? (object-name rtd) (object-name rec)))))

(define (record-accessor rtd field-name)
  (lambda (rec)
    (object-ref rec field-name)))

(define (record-modifier rtd field-name)
  (lambda (rec newval)
    (object-set! rec field-name newval)))

;; works on record-types or records
(define (record-type-descriptor rec) 
  (if (record? (object-specialization rec))
      (object-specialization rec)
      rec))

(define (record-type-name rtd) (object-name rtd))

;; works on record-types or records
(define (record-type-fields rtd) 
  (if (record? (object-specialization rtd))
      (object-ref (object-specialization rtd) 'fields)
      (object-ref rtd 'fields)))


;; Examples

(define person (make-record-type "person" '(name age address)))
(define make-person (record-constructor person))
(define person-name (record-accessor person 'name))
(define person-age (record-accessor person 'age))
(define person-address (record-accessor person 'address))
(define person? (record-predicate person))
(define person-change-address (record-modifier person 'address))
(define wade (make-person 'wade 38 "58 MacEwan Ridge Pl"))     

;; and ...

(eval-in-object 'name wade)

;; and ... class inheriting from a record ... however person? does not
;; work on it.  Maybe with a little fiddling ...

(slot-define! person 'initialize-instance
	      (lambda (inst . args)
		(for-each
		 (lambda (field)
		   (initargs->slot-define! inst args field (symbol->keyword field)))
		 (object-ref person 'fields))))

(define wise-person 
  (make-class 'wise-person 
	      (list person the-standard-class)))

(define bo (make-instance wise-person :name 'bo-lozoff :age 52 :address "nfa"))