davidson (02/08/83)
The record-type macro in the ucifnc package included with the standard
release of Franz Lisp has two serious bugs. The bugs are listed below,
and the corrected code follows my signature.
Bug 1: (record-type foo (one two three)) gives an inconsistent record
tag. (foo one two three) tags the record with '(one two three),
which is an error, while (is-foo x) correctly looks for the tag
foo.
Bug 2: (record-type foo (one two three)) expands to a
(progn 'compile
(defun foo ...)
(defun is-foo ...)
)
structure, with the macros one, two and three simply evaled as
side effects of the macro. The correct behavior is to expand to
(progn 'compile
(defun foo ...)
(defun is-foo ...)
(defun one ...)
(defun two ...)
(defun three ...)
)
This bug causes trouble when interpreted and compiled code are mixed.
-Greg (corrected code follows)
;
; ucilisp record-type package to declare records and field extraction
; macros.
;
; Modified to fix two bugs and reduce problems with the let macro by
; J. Greg Davidson on 8 February, 1983
;
(declare (special *type*))
(def record-type
(macro (l)
((lambda (*type* *flag* slots slot-macs)
(cond ((dtpr *flag*) (setq *flag* *type*)))
`(progn 'compile
(defun ,*type*
,(slot-funs-extract slots (and *flag* '(d)))
,(cond ((null *flag*) (struc-cons-form slots))
(t (append `(cons ',*flag*)
(list (struc-cons-form slots)
) ) ) ) )
,(cond (*flag*
(cond ((dtpr *flag*) (setq *flag* *type*)))
`(defun ,(concat 'is- *type*)
macro
(l)
(list 'and (list 'dtpr (cadr l))
(list 'eq (list 'car (cadr l))
'',*flag*)))))
,@(car slot-macs)
) )
(cadr l) (caddr l) (car (last l)) (ncons nil)
) ) )
(defun slot-funs-extract (slots path)
(cond ((null slots) nil)
((atom slots)
(tconc slot-macs `(defun ,(concat slots ': *type*)
macro
(l)
(list ',(readlist `(c ,@path r))
(cadr l))))
(list slots))
((nconc (slot-funs-extract (car slots) (cons 'a path))
(slot-funs-extract (cdr slots) (cons 'd path))))))
(defun struc-cons-form (struc)
(cond ((null struc) nil)
((atom struc) struc)
(t `(cons ,(struc-cons-form (car struc))
,(struc-cons-form (cdr struc))))))