From 898417f2820bbeae3457f4dfdfc76cb24b696107 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Mon, 31 Jan 1994 02:51:37 +0000 Subject: [PATCH] define-structure expands into only definitions, so it can be used at the beginning of a body. In particular, the print method is now always declared by passing it along to the type constructor, fixing a problem introduced by the reordering of the definitions in the last change. --- v7/src/runtime/defstr.scm | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/v7/src/runtime/defstr.scm b/v7/src/runtime/defstr.scm index 3b6b0623d..10183115c 100644 --- a/v7/src/runtime/defstr.scm +++ b/v7/src/runtime/defstr.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: defstr.scm,v 14.26 1994/01/14 03:26:56 gjr Exp $ +$Id: defstr.scm,v 14.27 1994/01/31 02:51:37 gjr Exp $ Copyright (c) 1988-1994 Massachusetts Institute of Technology @@ -112,7 +112,6 @@ differences: ,@(modifier-definitions structure) ,@(predicate-definitions structure) ,@(copier-definitions structure) - ,@(print-procedure-definitions structure) ,@(type-definitions structure))))) ;;;; Parse Options @@ -621,14 +620,6 @@ differences: ,tag-expression))))))) '()))) -(define (print-procedure-definitions structure) - (let ((print-procedure (structure/print-procedure structure))) - (if (and print-procedure (eq? (structure/type structure) 'RECORD)) - `((,(absolute 'SET-RECORD-TYPE-UNPARSER-METHOD!) - ,(structure/type-name structure) - ,print-procedure)) - '()))) - (define (type-definitions structure) (if (structure/named? structure) (let ((type (structure/type structure)) @@ -637,7 +628,13 @@ differences: (field-names (map slot/name (structure/slots structure)))) (if (eq? type 'RECORD) `((DEFINE ,type-name - (,(absolute 'MAKE-RECORD-TYPE) ',name ',field-names))) + (,(absolute 'MAKE-RECORD-TYPE) + ',name ',field-names + ,@(let ((print-procedure + (structure/print-procedure structure))) + (if (not print-procedure) + `() + `(,print-procedure)))))) (let ((type-expression `(,(absolute 'MAKE-DEFINE-STRUCTURE-TYPE) ',type @@ -647,9 +644,10 @@ differences: ,(structure/print-procedure structure)))) (if type-name `((DEFINE ,type-name ,type-expression)) - `((NAMED-STRUCTURE/SET-TAG-DESCRIPTION! - ,(structure/tag-expression structure) - ,type-expression)))))) + `((DEFINE ,(string->uninterned-symbol name) + (NAMED-STRUCTURE/SET-TAG-DESCRIPTION! + ,(structure/tag-expression structure) + ,type-expression))))))) '())) (define structure-type-rtd -- 2.25.1