Add to DEFINE-RECORD expansion providing of arglist info for generated macros. (#2415)
**NOTE:** This uses the function `IL:CLSMARTEN` which is from the file `CLSMARTARGS`. The file `CLSMARTARGS` isn't loaded until almost immediately **after** `XCL-EXTRAS`. There are no uses of `DEFINE-RECORD` in making the `lisp.sysout` loadup, so this _ought_ to be safe, but this must be verified!
This commit is contained in:
Matt Heffron
GitHub
parent
721bcecbc0
commit
50ab6599ae
@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
|
||||
(IL:FILECREATED "18-May-90 01:15:40" IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;2| 15315
|
||||
(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:XCL-EXTRASCOMS)
|
||||
(IL:FILECREATED "11-Dec-2025 22:27:58" IL:|{DSK}<home>matt>Interlisp>medley>sources>XCL-EXTRAS.;2| 15547
|
||||
|
||||
IL:|previous| IL:|date:| "11-Jan-88 16:59:17"
|
||||
IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (IL:FUNCTIONS DEFINE-RECORD)
|
||||
|
||||
:PREVIOUS-DATE "18-May-90 01:15:40" IL:|{DSK}<home>matt>Interlisp>medley>sources>XCL-EXTRAS.;1|
|
||||
)
|
||||
|
||||
; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:XCL-EXTRASCOMS)
|
||||
|
||||
@ -145,8 +146,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
IL:*INTERLISP-PACKAGE*))
|
||||
(COLLECT KEYWORD-SYMBOL)
|
||||
(IF (NOT (MEMBER KEYWORD-SYMBOL '(IL:USING IL:COPYING
|
||||
IL:REUSING IL:SMASHING
|
||||
)
|
||||
IL:REUSING IL:SMASHING)
|
||||
:TEST
|
||||
#'EQ))
|
||||
(COLLECT 'IL:_))
|
||||
@ -162,12 +162,12 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
|
||||
|
||||
(DEFDEFINER DEFINE-RECORD IL:STRUCTURES (RECORD-NAME INTERLISP-RECORD-NAME &KEY (CONC-NAME NIL
|
||||
CONC-NAME-P
|
||||
)
|
||||
(CONSTRUCTOR NIL CONSTRUCTOR-P)
|
||||
(PREDICATE NIL PREDICATE-P)
|
||||
(FAST-ACCESSORS NIL)
|
||||
(PACKAGE *PACKAGE*))
|
||||
CONC-NAME-P)
|
||||
(CONSTRUCTOR NIL CONSTRUCTOR-P)
|
||||
(PREDICATE NIL PREDICATE-P)
|
||||
(FAST-ACCESSORS NIL)
|
||||
(PACKAGE *PACKAGE*))
|
||||
(IL:* IL:\; "Edited 11-Dec-2025 21:43 by mth")
|
||||
(IF (NOT (PACKAGEP PACKAGE))
|
||||
(SETQ PACKAGE (FIND-PACKAGE PACKAGE)))
|
||||
(SETQ CONC-NAME (IF CONC-NAME-P
|
||||
@ -195,7 +195,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
'SETF-RECORD-ACCESS-MACRO)
|
||||
(SETF (GET ',NEW-NAME :SLOT-INFO)
|
||||
',`((,INTERLISP-RECORD-NAME ,FIELD-NAME)
|
||||
,FAST-ACCESSORS))))))
|
||||
,FAST-ACCESSORS))
|
||||
(IL:CLSMARTEN '((,NEW-NAME IL:OBJECT)))))))
|
||||
FIELD-NAMES)
|
||||
,@(LET ((NEW-NAME (IF PREDICATE-P
|
||||
PREDICATE
|
||||
@ -214,7 +215,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
`((SETF (MACRO-FUNCTION ',NEW-NAME)
|
||||
'RECORD-PREDICATE-MACRO)
|
||||
(SETF (GET ',NEW-NAME :TYPE-INFO)
|
||||
',INTERLISP-RECORD-NAME))))
|
||||
',INTERLISP-RECORD-NAME)
|
||||
(IL:CLSMARTEN '((,NEW-NAME IL:OBJECT))))))
|
||||
,@(LET ((NEW-NAME (IF CONSTRUCTOR-P
|
||||
CONSTRUCTOR
|
||||
(INTERN (CONCATENATE 'STRING "MAKE-" (STRING RECORD-NAME))
|
||||
@ -234,7 +236,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
`((SETF (MACRO-FUNCTION ',NEW-NAME)
|
||||
'RECORD-CONSTRUCTOR-MACRO)
|
||||
(SETF (GET ',NEW-NAME :FIELD-INFO)
|
||||
'(,INTERLISP-RECORD-NAME ,FIELD-NAMES))))))))
|
||||
'(,INTERLISP-RECORD-NAME ,FIELD-NAMES))
|
||||
(IL:CLSMARTEN '((,NEW-NAME &KEY ,@FIELD-NAMES)))))))))
|
||||
|
||||
(DEFUN RECORD-ACCESS-MACRO (FORM &OPTIONAL ENV)
|
||||
(DECLARE (IGNORE ENV))
|
||||
@ -257,8 +260,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
(DEFUN RECORD-PREDICATE-MACRO (FORM &OPTIONAL ENV)
|
||||
(DECLARE (IGNORE ENV))
|
||||
`(IL:|type?| ,(OR (GET (CAR FORM)
|
||||
:TYPE-INFO)
|
||||
(ERROR "No type information cached."))
|
||||
:TYPE-INFO)
|
||||
(ERROR "No type information cached."))
|
||||
,(SECOND FORM)))
|
||||
|
||||
(DEFUN RECORD-CONSTRUCTOR-MACRO (FORM &OPTIONAL ENV)
|
||||
@ -267,32 +270,35 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
(OR (GET (CAR FORM)
|
||||
:FIELD-INFO)
|
||||
(ERROR "No field information cached."))
|
||||
`(IL:|create| ,TYPE
|
||||
,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM)
|
||||
(CDDR KEYWORD))
|
||||
(KEYWORD-SYMBOL (CAR KEYWORD)
|
||||
(CAR KEYWORD))
|
||||
(VALUE (CADR KEYWORD)
|
||||
(CADR KEYWORD))
|
||||
RESERVED-WORD)
|
||||
((NULL KEYWORD))
|
||||
(SETQ RESERVED-WORD
|
||||
(CAR (MEMBER KEYWORD-SYMBOL
|
||||
'(IL:USING IL:COPYING IL:REUSING
|
||||
IL:SMASHING)
|
||||
:TEST
|
||||
'STRING=)))
|
||||
(COLLECT (OR RESERVED-WORD (CAR (MEMBER KEYWORD-SYMBOL
|
||||
FIELD-NAMES :TEST
|
||||
'STRING=))))
|
||||
(IF (NOT RESERVED-WORD)
|
||||
(COLLECT 'IL:_))
|
||||
(COLLECT VALUE))))))
|
||||
`(IL:|create| ,TYPE ,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM)
|
||||
(CDDR KEYWORD))
|
||||
(KEYWORD-SYMBOL (CAR KEYWORD)
|
||||
(CAR KEYWORD))
|
||||
(VALUE (CADR KEYWORD)
|
||||
(CADR KEYWORD))
|
||||
RESERVED-WORD)
|
||||
((NULL KEYWORD))
|
||||
(SETQ RESERVED-WORD
|
||||
(CAR (MEMBER KEYWORD-SYMBOL
|
||||
'(IL:USING IL:COPYING
|
||||
IL:REUSING IL:SMASHING)
|
||||
:TEST
|
||||
'STRING=)))
|
||||
(COLLECT (OR RESERVED-WORD
|
||||
(CAR (MEMBER KEYWORD-SYMBOL
|
||||
FIELD-NAMES :TEST
|
||||
'STRING=))))
|
||||
(IF (NOT RESERVED-WORD)
|
||||
(COLLECT 'IL:_))
|
||||
(COLLECT VALUE))))))
|
||||
|
||||
(IL:PUTPROPS IL:XCL-EXTRAS IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:XCL-EXTRAS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "XCL"))
|
||||
(IL:PUTPROPS IL:XCL-EXTRAS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
(IL:FILEMAP (NIL (2264 4771 (ONCE-ONLY 2264 . 4771)) (4828 5137 (RECORD-FETCH 4828 . 5137)) (5139 5483
|
||||
(SETF-FETCH 5139 . 5483)) (5485 5796 (RECORD-FFETCH 5485 . 5796)) (5798 6144 (SETF-FFETCH 5798 . 6144
|
||||
)) (6146 7341 (RECORD-CREATE 6146 . 7341)) (12279 12699 (RECORD-ACCESS-MACRO 12279 . 12699)) (13146
|
||||
13397 (RECORD-PREDICATE-MACRO 13146 . 13397)) (13399 15360 (RECORD-CONSTRUCTOR-MACRO 13399 . 15360))))
|
||||
)
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user