From d0d952a10d8060a05d1885fa919bdef7d3e62fd0 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Tue, 25 Oct 2022 15:40:41 -0700 Subject: [PATCH] make SETQ and typed in calls undoable (first steps) (#996) * First steps to make UNDO to work again * make sure the right SETQ (CL vs IL) is used * The change surfaced a irritating warning about the variable presumed to be SPECIAL --- sources/CMLUNDO | 277 +++++++++++++++++++++++------------------- sources/CMLUNDO.DFASL | Bin 17810 -> 17829 bytes 2 files changed, 149 insertions(+), 128 deletions(-) diff --git a/sources/CMLUNDO b/sources/CMLUNDO index 4e56ea3b..4a5fd40d 100644 --- a/sources/CMLUNDO +++ b/sources/CMLUNDO @@ -1,13 +1,13 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL") -(IL:FILECREATED "16-May-90 14:54:01" IL:|{DSK}local>lde>lispcore>sources>CMLUNDO.;2| 30797 +(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10) - IL:|changes| IL:|to:| (IL:VARS IL:CMLUNDOCOMS) +(IL:FILECREATED "18-Oct-2022 16:24:32" IL:|{DSK}larry>ilisp>medley>sources>CMLUNDO.;2| 31891 - IL:|previous| IL:|date:| "29-Feb-88 19:40:15" IL:|{DSK}local>lde>lispcore>sources>CMLUNDO.;1| -) + :CHANGES-TO (IL:FUNCTIONS UNDOABLY) + + :PREVIOUS-DATE "15-Oct-2022 17:21:17" IL:|{DSK}larry>ilisp>medley>sources>CMLUNDO.;1|) -; Copyright (c) 1986, 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. +; Copyright (c) 1986-1988, 1990, 2022 by Venue & Xerox Corporation. (IL:PRETTYCOMPRINT IL:CMLUNDOCOMS) @@ -38,7 +38,7 @@ (PSETF . UNDOABLY-PSETF) (PUSH . UNDOABLY-PUSH) (PUSHNEW . UNDOABLY-PUSHNEW) - ((REMF) . UNDOABLY-REMF) + (REMF . UNDOABLY-REMF) (ROTATEF . UNDOABLY-ROTATEF) (SHIFTF . UNDOABLY-SHIFTF) (DECF . UNDOABLY-DECF) @@ -69,60 +69,75 @@ (DEFUN NOHOOK (FN ARGS &OPTIONAL ENV &AUX (*EVALHOOK* NIL)) (APPLY FN ARGS)) -(DEFMACRO UNDOABLY (&REST FORMS &ENVIRONMENT ENV) - (WALK-FORM - (IL:MKPROGN FORMS) - :ENVIRONMENT ENV :WALK-FUNCTION - #'(LAMBDA - (X CONTEXT) - (COND - ((NOT (CONSP X)) - X) - ((NOT (SYMBOLP (CAR X))) - X) - (T - (CASE (CAR X) - ((SETQ SETQ SETF) - (VALUES - (IL:MKPROGN - (WITH-COLLECTION - (DO ((TAIL (CDR X) - (CDDR TAIL))) - ((NULL TAIL)) - (COLLECT - (IF (SYMBOLP (CAR TAIL)) - (IF (VARIABLE-LEXICAL-P (CAR TAIL)) - `(SETQ ,(CAR TAIL) - ,(WALK-FORM-INTERNAL (CADR TAIL))) - (PROGN (WARN "Variable ~S presumed special in UNDOABLY.. SETQ" - (CAR TAIL)) - `(UNDOABLY-SET-SYMBOL ',(CAR TAIL) - ,(WALK-FORM-INTERNAL (CADR TAIL))))) - (MULTIPLE-VALUE-BIND - (FORMALS ACTUALS NEW-VALUE SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD (CAR TAIL)) - `(,'LET* (,@(MAPCAR #'(LAMBDA (X Y) - (LIST X (WALK-FORM-INTERNAL Y))) - FORMALS ACTUALS) - (,(WALK-FORM-INTERNAL (CAR NEW-VALUE)) - ,(CADR TAIL))) - ,SETTER))))))) - T)) - (STOP-UNDOABLY (VALUES (IL:MKPROGN (CDR X)) - T)) - (T (LET ((UNDONAME (CDR (MEMBER (CAR X) - IL:LISPXFNS :TEST #'EQ)))) - (IF UNDONAME - (CONS UNDONAME (CDR X)) - (IF (AND (OR (GET (CAR X) - ':DEFINER-FOR) - (GET (CAR X) - 'IL:DEFINER-FOR)) - (NOT *IN-DEFINER*)) - (LET ((*IN-DEFINER* T)) - (VALUES (WALK-FORM-INTERNAL (MACROEXPAND-1 X)) - T)) - X)))))))))) +(DEFMACRO UNDOABLY (&REST FORMS &ENVIRONMENT ENV) (IL:* IL:\; "Edited 18-Oct-2022 16:20 by lmm") + (IL:* IL:\; "Edited 15-Oct-2022 11:47 by lmm") + (IF (NULL IL:LISPXHIST) + (IL:MKPROGN FORMS) + (WALK-FORM + (IL:MKPROGN FORMS) + :ENVIRONMENT ENV :WALK-FUNCTION + #'(LAMBDA + (X CONTEXT) + (COND + ((NOT (CONSP X)) + X) + ((NOT (SYMBOLP (CAR X))) + X) + (T + (CASE (CAR X) + ((SETQ IL:SETQ SETF) + (VALUES + (IL:MKPROGN + (WITH-COLLECTION + (DO ((TAIL (CDR X) + (CDDR TAIL))) + ((NULL TAIL)) + (COLLECT + (IF (SYMBOLP (CAR TAIL)) + (IF (VARIABLE-LEXICAL-P (CAR TAIL)) + `(,(CAR X) + ,(CAR TAIL) + ,(WALK-FORM-INTERNAL (CADR TAIL))) + (PROGN (COND + ((NOT (OR (VARIABLE-SPECIAL-P (CAR TAIL)) + (BOUNDP (CAR TAIL)))) + + (IL:* IL:|;;| "should possibly spelling correct? ") + + (WHEN NIL + + (IL:* IL:|;;| "this warning just seems uselsss; it doesn't proclaim anything or mark it as changed in FILEPKG or ...") + + (WARN + "Variable ~S proclaimed SPECIAL UNDOABLY.. SETQ" + (CAR TAIL))))) + `(UNDOABLY-SET-SYMBOL ',(CAR TAIL) + ,(WALK-FORM-INTERNAL (CADR TAIL))))) + (MULTIPLE-VALUE-BIND + (FORMALS ACTUALS NEW-VALUE SETTER GETTER) + (GET-UNDOABLE-SETF-METHOD (CAR TAIL)) + `(,'LET* (,@(MAPCAR #'(LAMBDA (X Y) + (LIST X (WALK-FORM-INTERNAL Y))) + FORMALS ACTUALS) + (,(WALK-FORM-INTERNAL (CAR NEW-VALUE)) + ,(CADR TAIL))) + ,SETTER))))))) + T)) + (STOP-UNDOABLY (VALUES (IL:MKPROGN (CDR X)) + T)) + (T (LET ((UNDONAME (CDR (ASSOC (CAR X) + IL:LISPXFNS :TEST #'EQ)))) + (IF UNDONAME + (CONS UNDONAME (CDR X)) + (IF (AND (OR (GET (CAR X) + ':DEFINER-FOR) + (GET (CAR X) + 'IL:DEFINER-FOR)) + (NOT *IN-DEFINER*)) + (LET ((*IN-DEFINER* T)) + (VALUES (WALK-FORM-INTERNAL (MACROEXPAND-1 X)) + T)) + X))))))))))) (DEFUN UNDOABLY-FMAKUNBOUND (SYMBOL) (IL:/PUTD SYMBOL NIL) @@ -137,11 +152,9 @@ (IL:* IL:|;;| "Make a symbol unbound.") (IL:SAVESET SYMBOL 'IL:NOBIND) (IL:* IL:\; - " unbound symbols are set to IL:NOBIND") - (IL:/PUTHASH SYMBOL NIL IL:COMPVARMACROHASH) (IL:* IL:\; - "remove any constant entry") - (IL:/REMPROP SYMBOL 'IL:GLOBALLY-SPECIAL) (IL:* IL:\; - " left by PROCLAIM special") + " unbound symbols are set to IL:NOBIND") + (IL:/PUTHASH SYMBOL NIL IL:COMPVARMACROHASH) (IL:* IL:\; "remove any constant entry") + (IL:/REMPROP SYMBOL 'IL:GLOBALLY-SPECIAL) (IL:* IL:\; " left by PROCLAIM special") (IL:/REMPROP SYMBOL 'IL:GLOBALVAR) (IL:* IL:\; "") SYMBOL) @@ -155,19 +168,19 @@ (IL:* IL:|;;| "assumes variable is not lexical !") - `(UNDOABLY-SET-SYMBOL ',PLACE ,NEW-VALUE)) + `(UNDOABLY-SET-SYMBOL ',PLACE ,NEW-VALUE)) (T (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD PLACE ENV) + (GET-UNDOABLE-SETF-METHOD PLACE ENV) `(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS) (,(CAR NEWVAL) ,NEW-VALUE)) ,SETTER))))) -(DEFUN UNDOHOOK (FORM ENV &AUX (*APPLYHOOK* NIL)) +(DEFUN UNDOHOOK (FORM ENV &AUX (*APPLYHOOK* NIL)) (IL:* IL:\; "Edited 14-Oct-2022 13:54 by lmm") (IF (ATOM FORM) (EVAL FORM ENV) (CASE (CAR FORM) - ((SETQ SETQ SETF) + ((SETQ IL:SETQ SETF) (DO ((TAIL (CDR FORM)) VALUE) ((NULL TAIL) @@ -175,8 +188,8 @@ (SETQ VALUE (IF (SYMBOLP (CAR TAIL)) - (UNDOABLY-SET-SYMBOL (POP TAIL) - (UNDOHOOK (POP TAIL) + (UNDOABLY-SET-SYMBOL (POP TAIL) + (UNDOHOOK (POP TAIL) ENV) ENV) (EVAL @@ -184,13 +197,13 @@ (MULTIPLE-VALUE-BIND (FORMALS VALS NEW-VALUE SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD (POP TAIL) + (GET-UNDOABLE-SETF-METHOD (POP TAIL) ENV) `(,'LET* (,@(MAPCAR #'(LAMBDA (X Y) (LIST X (LIST 'UNDOABLY Y))) FORMALS VALS) (,(CAR NEW-VALUE) - (UNDOABLY ,(POP TAIL)))) + (UNDOABLY ,(POP TAIL)))) ,SETTER)) ENV))))) (STOP-UNDOABLY @@ -199,7 +212,7 @@ (IL:\\EVAL-PROGN (CDR FORM) ENV)) - (T (LET ((UNDONAME (CDR (MEMBER (CAR FORM) + (T (LET ((UNDONAME (CDR (ASSOC (CAR FORM) IL:LISPXFNS :TEST #'EQ)))) (IF UNDONAME (EVALHOOK (CONS UNDONAME (CDR FORM)) @@ -215,16 +228,16 @@ ((NULL ARGS) NIL) (T `(PROG1 NIL - (UNDOABLY-SETF ,(POP ARGS) + (UNDOABLY-SETF ,(POP ARGS) (PROG1 ,(POP ARGS) - (UNDOABLY-PSETF ,@ARGS))))))) + (UNDOABLY-PSETF ,@ARGS))))))) (DEFMACRO UNDOABLY-POP (PLACE &ENVIRONMENT ENV) (IF (SYMBOLP PLACE) `(PROG1 (CAR ,PLACE) (UNDOABLY-SETQ ,PLACE (CDR ,PLACE))) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD PLACE ENV) + (GET-UNDOABLE-SETF-METHOD PLACE ENV) `(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS) ,(LIST (CAR NEWVAL) GETTER)) @@ -240,7 +253,7 @@ (IF (SYMBOLP PLACE) `(UNDOABLY-SETQ ,PLACE (CONS ,OBJ ,PLACE)) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD PLACE ENV) + (GET-UNDOABLE-SETF-METHOD PLACE ENV) `(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS) (,(CAR NEWVAL) (CONS ,OBJ ,GETTER))) @@ -250,7 +263,7 @@ (IF (SYMBOLP PLACE) `(UNDOABLY-SETQ ,PLACE (ADJOIN ,OBJ ,PLACE ,@KEYS)) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD PLACE ENV) + (GET-UNDOABLE-SETF-METHOD PLACE ENV) `(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS) (,(CAR NEWVAL) (ADJOIN ,OBJ ,GETTER ,@KEYS))) @@ -258,7 +271,7 @@ (DEFMACRO UNDOABLY-REMF (PLACE INDICATOR &ENVIRONMENT ENV) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD PLACE ENV) + (GET-UNDOABLE-SETF-METHOD PLACE ENV) (LET ((IND-TEMP (GENSYM)) (LOCAL1 (GENSYM)) (LOCAL2 (GENSYM))) @@ -303,7 +316,7 @@ ,@(REVERSE SETF-LIST) NIL)) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD (CAR A) + (GET-UNDOABLE-SETF-METHOD (CAR A) ENV) (DO ((D DUMMIES (CDR D)) (V VALS (CDR V))) @@ -335,7 +348,7 @@ ,@(REVERSE SETF-LIST) ,RESULT)) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD (CAR A) + (GET-UNDOABLE-SETF-METHOD (CAR A) ENV) (DO ((D DUMMIES (CDR D)) (V VALS (CDR V))) @@ -348,8 +361,8 @@ (PUSH SETTER SETF-LIST) (SETQ NEXT-VAR (CAR NEWVAL))))))) -(DEFDEFINER DEFINE-UNDOABLE-MODIFY-MACRO IL:FUNCTIONS (NAME LAMBDA-LIST FUNCTION &OPTIONAL - DOC-STRING) +(DEFDEFINER DEFINE-UNDOABLE-MODIFY-MACRO IL:FUNCTIONS (NAME LAMBDA-LIST FUNCTION &OPTIONAL DOC-STRING + ) (LET ((OTHER-ARGS NIL) (REST-ARG NIL)) @@ -371,7 +384,7 @@ SI::%$$MODIFY-MACRO-ENVIRONMENT) ,DOC-STRING (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) - (GET-UNDOABLE-SETF-METHOD SI::%$$MODIFY-MACRO-FORM + (GET-UNDOABLE-SETF-METHOD SI::%$$MODIFY-MACRO-FORM SI::%$$MODIFY-MACRO-ENVIRONMENT) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVALS SETTER GETTER) @@ -384,10 +397,10 @@ ,SETTER)))))) (DEFINE-UNDOABLE-MODIFY-MACRO UNDOABLY-DECF (&OPTIONAL (DELTA 1)) - -) + -) (DEFINE-UNDOABLE-MODIFY-MACRO UNDOABLY-INCF (&OPTIONAL (DELTA 1)) - +) + +) (DEFUN UNDOABLY-PROCLAIM (PROCLAMATION) @@ -396,34 +409,34 @@ (WHEN (CONSP PROCLAMATION) (CASE (CAR PROCLAMATION) (SPECIAL (DOLIST (X (CDR PROCLAMATION)) - (UNDOABLY (SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X) + (UNDOABLY (SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X) T) (SETF (IL:VARIABLE-GLOBAL-P X) NIL) (SETF (CONSTANTP X) NIL)))) (GLOBAL (DOLIST (X (CDR PROCLAMATION)) - (UNDOABLY (SETF (IL:VARIABLE-GLOBAL-P X) + (UNDOABLY (SETF (IL:VARIABLE-GLOBAL-P X) T) (SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X) NIL) (SETF (CONSTANTP X) NIL)))) (SI::CONSTANT (DOLIST (X (CDR PROCLAMATION)) - (UNDOABLY (SETF (CONSTANTP X) + (UNDOABLY (SETF (CONSTANTP X) T) (SETF (IL:VARIABLE-GLOBAL-P X) NIL) (SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X) NIL)))) (DECLARATION (DOLIST (X (CDR PROCLAMATION)) - (UNDOABLY (SETF (DECL-SPECIFIER-P X) + (UNDOABLY (SETF (DECL-SPECIFIER-P X) T)))) (NOTINLINE (DOLIST (X (CDR PROCLAMATION)) - (UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X) + (UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X) T)))) (INLINE (DOLIST (X (CDR PROCLAMATION)) - (UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X) + (UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X) NIL))))))) (DEFUN MAKE-UNDOABLE (FORM &OPTIONAL ENV) @@ -438,7 +451,7 @@ (DEFUN UNDOABLY-SETF-SYMBOL-FUNCTION (SYMBOL DEFINITION) (IL:* IL:|;;| - "NOTE: If you change this version, be sure to change the not-undoable version on LLSYMBOL!") + "NOTE: If you change this version, be sure to change the not-undoable version on LLSYMBOL!") (IL:* IL:|;;| " undoable inverse of SYMBOL-FUNCTION") @@ -449,9 +462,9 @@ (IL:* IL:|;;| "Either it's a LAMBDA form or one of the special lists put together by SYMBOL-FUNCTION for macros and special forms.") (CASE (CAR DEFINITION) - (:MACRO (UNDOABLY-SETF (MACRO-FUNCTION SYMBOL) + (:MACRO (UNDOABLY-SETF (MACRO-FUNCTION SYMBOL) (CDR DEFINITION))) - (:SPECIAL-FORM (UNDOABLY-SETF (GET SYMBOL 'IL:SPECIAL-FORM) + (:SPECIAL-FORM (UNDOABLY-SETF (GET SYMBOL 'IL:SPECIAL-FORM) (CDR DEFINITION))) (T (IL:/PUTD SYMBOL DEFINITION T)))) @@ -480,14 +493,14 @@ (IL:* IL:|;;| "undoable setf of macro-function") (IL:* IL:|;;| - "NOTE: If you change this, be sure to change the not-undoable version on CMLMACROS!") + "NOTE: If you change this, be sure to change the not-undoable version on CMLMACROS!") - (PROG1 (UNDOABLY-SETF (GET X 'IL:MACRO-FN) + (PROG1 (UNDOABLY-SETF (GET X 'IL:MACRO-FN) BODY) (AND (IL:GETD X) (CASE (IL:ARGTYPE X) ((1 3) (IL:* IL:\; - "Leave Interlisp nlambda definition alone") + "Leave Interlisp nlambda definition alone") ) (OTHERWISE (IL:/PUTD X NIL)))))) (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY @@ -498,18 +511,18 @@ ) (IL:ADDTOVAR IL:LISPXFNS (PROCLAIM . UNDOABLY-PROCLAIM) - (POP . UNDOABLY-POP) - (PSETF . UNDOABLY-PSETF) - (PUSH . UNDOABLY-PUSH) - (PUSHNEW . UNDOABLY-PUSHNEW) - ((REMF) . UNDOABLY-REMF) - (ROTATEF . UNDOABLY-ROTATEF) - (SHIFTF . UNDOABLY-SHIFTF) - (DECF . UNDOABLY-DECF) - (INCF . UNDOABLY-INCF) - (SET . UNDOABLY-SET-SYMBOL) - (MAKUNBOUND . UNDOABLY-MAKUNBOUND) - (FMAKUNBOUND . UNDOABLY-FMAKUNBOUND)) + (POP . UNDOABLY-POP) + (PSETF . UNDOABLY-PSETF) + (PUSH . UNDOABLY-PUSH) + (PUSHNEW . UNDOABLY-PUSHNEW) + (REMF . UNDOABLY-REMF) + (ROTATEF . UNDOABLY-ROTATEF) + (SHIFTF . UNDOABLY-SHIFTF) + (DECF . UNDOABLY-DECF) + (INCF . UNDOABLY-INCF) + (SET . UNDOABLY-SET-SYMBOL) + (MAKUNBOUND . UNDOABLY-MAKUNBOUND) + (FMAKUNBOUND . UNDOABLY-FMAKUNBOUND)) (DEFUN GET-UNDOABLE-SETF-METHOD (FORM &OPTIONAL ENVIRONMENT &AUX TEMP) (COND @@ -524,7 +537,7 @@ (IL:* IL:|;;| "always expand local macros") - (GET-UNDOABLE-SETF-METHOD (FUNCALL TEMP FORM ENVIRONMENT) + (GET-UNDOABLE-SETF-METHOD (FUNCALL TEMP FORM ENVIRONMENT) ENVIRONMENT)) ((SETQ TEMP (GET (CAR FORM) ':UNDOABLE-SETF-INVERSE)) @@ -553,12 +566,12 @@ (T (MULTIPLE-VALUE-BIND (MAC MORE) (MACROEXPAND-1 FORM ENVIRONMENT) (IF (AND MORE (NOT (EQ MAC FORM))) - (RETURN-FROM DONE (GET-UNDOABLE-SETF-METHOD MAC ENVIRONMENT)) + (RETURN-FROM DONE (GET-UNDOABLE-SETF-METHOD MAC ENVIRONMENT)) (ERROR "~S is not a known location specifier for SETF." (CAR FORM)))))) (IL:* IL:|;;| - "this is lexically correct, but doesn't work in bytecompiler, interlisp") + "this is lexically correct, but doesn't work in bytecompiler, interlisp") (IL:* IL:|;;| "(cl:values dummies vals newval `(cl:labels ((undostore (,@newval) (undosave (list #'undostore ,getter)) ,setter)) (undostore ,@newval)) getter)") @@ -580,7 +593,7 @@ (WHEN ENVIRONMENT (IL:* IL:|;;| - "This function only saves undo info when there is no lexical binding for the variable.") + "This function only saves undo info when there is no lexical binding for the variable.") (SETQ ENVIRONMENT (IL:ENVIRONMENT-VARS ENVIRONMENT)) (LOOP (IF (NULL ENVIRONMENT) @@ -593,7 +606,7 @@ IL:*SPECIAL-BINDING-MARK*) (IL:* IL:|;;| - "it is a special binding, or a mark that we are using the special value") + "it is a special binding, or a mark that we are using the special value") (RETURN NIL) (IL:* IL:\; "return from WHILE") ) @@ -634,26 +647,25 @@ (IL:\\RPLPTR VP 0 VALUE)))))) (IL:DEFINEQ -(undoably-setq - (il:nlambda varvalue (il:* il:\; "Edited 8-Oct-87 18:54 by jop") - (il:* il:\; "Interlisp version") - - (undoably-set-symbol (car varvalue) - (il:\\evprog1 (cdr varvalue))))) +(UNDOABLY-SETQ + (IL:NLAMBDA VARVALUE (IL:* IL:\; "Edited 8-Oct-87 18:54 by jop") + (IL:* IL:\; "Interlisp version") + (UNDOABLY-SET-SYMBOL (CAR VARVALUE) + (IL:\\EVPROG1 (CDR VARVALUE))))) ) (DEFINE-SPECIAL-FORM UNDOABLY (&REST FORMS &ENVIRONMENT ENV) (LOOP (IF (NULL (CDR FORMS)) - (RETURN (UNDOHOOK (CAR FORMS) + (RETURN (UNDOHOOK (CAR FORMS) ENV)) - (UNDOHOOK (POP FORMS) + (UNDOHOOK (POP FORMS) ENV)))) (DEFINE-SPECIAL-FORM UNDOABLY-SETQ (&REST TAIL &ENVIRONMENT ENV) (LET (VALUE) (LOOP (IF (NULL TAIL) (RETURN NIL) - (SETQ VALUE (UNDOABLY-SET-SYMBOL (POP TAIL) + (SETQ VALUE (UNDOABLY-SET-SYMBOL (POP TAIL) (EVAL (POP TAIL) ENV) ENV)))) @@ -678,7 +690,16 @@ (IL:ADDTOVAR IL:LAMA ) ) -(IL:PUTPROPS IL:CMLUNDO IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990)) +(IL:PUTPROPS IL:CMLUNDO IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 2022)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (29112 29437 (UNDOABLY-SETQ 29125 . 29435))))) + (IL:FILEMAP (NIL (4227 4310 (NOHOOK 4227 . 4310)) (4312 7992 (UNDOABLY 4312 . 7992)) (7994 8214 ( +UNDOABLY-FMAKUNBOUND 7994 . 8214)) (8216 8792 (UNDOABLY-MAKUNBOUND 8216 . 8792)) (8794 9521 ( +UNDOABLY-SETF 8794 . 9521)) (9523 11417 (UNDOHOOK 9523 . 11417)) (11419 11766 (UNDOABLY-PSETF 11419 . +11766)) (11768 12368 (UNDOABLY-POP 11768 . 12368)) (12370 12930 (UNDOABLY-PUSH 12370 . 12930)) (12932 +13391 (UNDOABLY-PUSHNEW 12932 . 13391)) (13393 14759 (UNDOABLY-REMF 13393 . 14759)) (14761 15907 ( +UNDOABLY-ROTATEF 14761 . 15907)) (15909 17049 (UNDOABLY-SHIFTF 15909 . 17049)) (18845 20667 ( +UNDOABLY-PROCLAIM 18845 . 20667)) (20669 20740 (MAKE-UNDOABLE 20669 . 20740)) (20742 20888 ( +STOP-UNDOABLY 20742 . 20888)) (20890 22570 (UNDOABLY-SETF-SYMBOL-FUNCTION 20890 . 22570)) (22572 23161 + (UNDOABLY-SETF-MACRO-FUNCTION 22572 . 23161)) (24059 27459 (GET-UNDOABLE-SETF-METHOD 24059 . 27459)) +(27461 30185 (UNDOABLY-SET-SYMBOL 27461 . 30185)) (30186 30514 (UNDOABLY-SETQ 30199 . 30512))))) IL:STOP diff --git a/sources/CMLUNDO.DFASL b/sources/CMLUNDO.DFASL index 4b2c378ec6736ed6bac92ab48fb616e1bd0599f2..694b8592fe6ce19168b5d5b04ab5b5b67a816cfc 100644 GIT binary patch delta 6023 zcma)Adu-dq9sk|Wj`MKSBz0bPUQV3EdDx9(=bbj>7yFmQjbF8$wi%Q*O+piqwrNXQ z3*B1w&?tnp^h)JpsgTen4U)mqG6aPc%0^#8u!;$!O%+T?pi!VyLgEiv*!O#9=UJp# z^6&1x_r1^eao@Z9-W`9O{NZtO%zkKe*N%~n@xeWN4s?u-kL{i4*fBCZK60RA@2-7& zhDP>wxc$EVfG4=R-I*5QB=db^<0IywJtKn;j0~IWTkOH12kcIV(`l}6YI8QUxtwX; zO2oIAExK=H@9^LO8}OTff7iB=J!TwZ%bFkc!>QOw*|LigkKxI8Pp#3#j!hkAwu<92A6PyF~a4@PwRYA>|6B6n5cB5`|v!;|=Gq1Eqbqnr! zk~a`1Wz7ME!a=uB@%ljls$qp_Hn>5x#~DedAUbw;|=Z$Ta4~cGW(2zmbM@O%z~uvUO+2J*qz^_ zMicH(?P$B*uSR==7&r8hq&%?yR#IUH`YHC*WO^i|y1k0e-W?44BdnNhkI^L7$eLI) zYe84EF7VB8+-H*pdQ~ydF`bL#(o?z~4e-;?bWWmDQ}XJ@>^m*ArzRZ_dm?>5Tk|7} zm_C%;MojcC$*T)`$O>j61cZU_lj909lQhMO==aH`q==eR0_n!sN#g31Ur}BSpRS<$ zQ!FLDsS^A$C5;S*rQ*8V)a#8z*)M>~WI}h>)QxED(3kA*gV5>;R6<0hZd81I+1-(Duj(UTE44~-Mzy@zP81SosC@F^Z54hy-oth`d4v#)NOU`zZVOQtZ zPOv`SJ%|CUy1F=?`yDK=>wAKbBRc+fny(>$_&VsPhhVy*|W3C+}39(oCk zS~X{s-5ZFi;eg^}MpXAj@F=VycQ~kS3Mm1Py&kD!!fveg&sQ6PSEqzRYQTd%RlMgp zs7l|?S5Kll@9}Q{Z%47~Ngo@+@|S|;epF_I687T8XHUc$>^+-Be{fO1Pu=8oLo7mn z8j57}rrr=bg1+~t-QIv2#)-n7eXJXct;~VKUItCIJ~dkNAZy>vhU>72fnN^FVP$=O zoU$IqnCP!pY$XQz>53|Sv5u?32rH(>^t$Ad*h#6qbCi~@G|-*t`S4$%&6HRPeJs5? zsRvAf@5wjn2`nSn6pgy;uiB&5}ezE3>!S#2~XMvO%$w zx=??#SBdl{qYER-1{E~bTA`8J;|q2vK5$zBv@%7@H;`~&1`^?L2>}D2N(7-VuC&6+ z{&3~{@&^VwQRAQ)rli8NT-~mXlwrWTm;_ zs+8_{*k`d);h_%*E2Yz!#pE2ll3B5;4Avg{|G}(GsZ#?1zWofza*;&PHm_0-u`+`s z$xIWYd?8P2af5-Q4;B%h+XU-RY3GX;X{EgT zI#zRdby|e*%rF~@vf%(L8(4vz+gK46n^_qaA<^m+t+gVAYDEZr&x(OXx+IDt9CWsv z7pIN9IFrtcm*{#!5qNr+!6V<$pr=iewt`uVU_ufqSf9>HlR4`*5>?7pQ+swrqe0Ip zXSKP!d@YMvgkx_IW+4SJs^#?8W0P7X+!NuAbM!aaW@0?^$LtIu-&&QJRQgqpE@gTR zXPKe5a!f5Rq2~Vt`5L!^t3!H^cYZU-i&+a6gcPyu*}Nu;0FG;SFxTQ(u3fp%?iOL? zsGTMTw)qsd$`Q}e-PMIUkucDkxu20Vx~rxh1CD0ogKqVlYlar(=dGAEahVy}Y`gHr z&iwMC%5A)w{&$5RJw>5o?v{D)9E5BanbjSPOMq(0;_O=l`t!h zzl8Cz$y9H^1KV&k7)D?Tr=pO)QJezPajEztS;g(8UiI?M84nxcmPpgM>n4ZQ4Qe=| zR&$lspp!0p`I0TK~oKkgNtF(R8ZOQ$Q%WH)`Mvi#5l5}w0M69EqJ??e2%kAL^_ zFE{EL%s+>CdpH079LGMrWGwncD9nsY5gtvbdrpj(PSIV~A>%fQKw60B(_u|J?}Jjc(XI`+4N!_XcuXd8ix5Jn60y#BbR_weTb}O~jW|@|w*9!D0dd%Jg(7&x+ z8;5=#p>21DHn1VSl4l_MUvujI2^EfDbCi`R+{4|0o5BFR*MmM z2_OG5e#vDKYnOS0Bk2$+xBv+dTyZ3)ri3$I$m7LDt_iuc1oJ(C$&XvEo%Hci?VPPG zO#-u}kq*`uD8>XL7@7%}KA%YIy1kIxLf*SX!iPe_hjUs>XX%#K-m*nnH@6B2%`I{@ zGZYGq=_3t!Mq&Cj0dj2~Z6mXbL1t)UKb+7(e~y+bY#RBTnhofX>owt0^qg)=vZ!% zt62cJn*JY)WDUoYH3HAMTp?F{DL7k~C?sZ4P89&D0)P%Sc^8M0Grj(_}c_r|DCj;WtuqY#TI+}+dB|Yy1B45XC1~Mf z^r(VtW-ff*NP!!Bk2laA;OXKC-gkx8wN|86;_U=gs-pL{de<$8Gnb>DuLUR@N-ooUihvUz$M%em^5ESWOX612;Gyc1oY~>hoCr&peffnlwYr9o1xpuIuQv z*)nka!?3TU;;SCK_=Vx|4`~B9j9{8W_(Ko5NY8b=YG}`9<2UFq zdYYc@^plInl_2??hLls;Vs1!ml5Bz`3nAqllyvoym+88$h8!c@CL|5PWC8O9-v1D# zU2SmIyxUbPAJ)*T?joIum1VLrTI^nDFu-|_D2Ii>%lN?Xup7^&-?W+PvM1A!}hZWnahf`pF+)9$j7j~c;VEGhiH~6$}G{f2NIqY_`2YQ2b*sA NNKd07&;Ibk{{Y%S`BMM@ delta 5974 zcmbUlYiyg<^}C-PCr+A2^K_h-Q#TJMabi1uBxy+F*k2MSe${p#X`!ugGFnKRE}|JH42kiP_?;uehK(b`yGJI5sFROOX(Ni;8*}&g zmE@FalgAIB^sw7A=w#R0e7ch(iolg>x%&Z@@jcKG+ii0MpUuWZfk0 zXV33Pl~^w);SBmip+UaNnMVlEW2{(!g~A+bflYXQw4a0W7LWiGR5mU_jFc$>A#edR z5{kKF3P5RGRhWkQmD9?`^7G}+ z&wR4%GFxh(AF9ohP02%Y^5B#z4E7tv zJWcp#l~}2{A6AP+Ixf%yHMph(DAf_PzBaW#XLp@gYoh(WUO0_*1-E{od%{J)L_e#=Azx67kWl(czJGxSh~F+*baOOnK7dZoy+RW^cE z+Kq1ipt&~`2{2tc7@Hm#3`atJK{+4NDO+r=4|-z0P;do6vXtNkUnCR^D8U#hOCC`H zKk`Pm>d~F|?s)n%Ip0l&Tf4u2*(|+XYwWb{IJ4tyxBSu|K=gxr?|J_q(Sj1v^Saw` z7$k$T0PN7~^{1t)V*;8&wW_uf!UD&N}w7;SIQi=v~*6n)I&bVovMCKt_{OEgRzFJL9)Pz5aRBuxET^V(%`f z*%Nz45t>U%M}B?lD)R5DtUxhy7@6@g2K}I?j7MQx-GkMZJwl(z*%{oP#_E*;D^xfhB8?t z5s5GrRs{H)(uh=4*9)%YV#uR=a&)UzM&O|B^M`uee&A7p{KU#XWKJaneKn^J%Gbv^ zZ^>^LK-4?R&vF*0TKF*Cz!Iu;d^%GKwJkUA4ls3pUU}^qO(O@Nt!0K{aA-zvDhpOJ zgYd%Jgc<0$yh?J8zL!^%Uk&#Y9?rzdJgHj+@jg6Tu(Fk?HrAF?f4<^V6)=TW7Z6EK zStlo_)R=d0c|lU~Bj1H5r)+ThkYF z!$DS^g?rmrIS!jyH4Xu>>KCg<5kLQ76|g5=62k$`Wk$rz^QC-sI$I2qbQD6hXd%Vu z&k9z6TYp*Ll|NHqF)5YQHEdNWsGNr7!74dUx>esomBJcFeijFuQ5W;^>`Jyu zIPx>XRzWSHY7T!1+~SV(31iREZMA8QGT~a;SA5w z1Ez9~xYDV%$DTh$Ql2YR$sG)It z2SUE!twNDXu1GoEq93YQF1tp^E+MRjUeW7v@H7UMp}EsQ)A=o}n=LInO5|FUZP}_p zi~k@L@S(&$B?yV@=As(g#gNbUr?Xii7f&S49pvQ)M~3*`X@q+?b`wqop+uF6x{U+@ zI-rr2bvRAqXcA5(bwa3@u(}^iiVFrK7B#~)Ifg~e;!GDe%JdeN2%}8tRKF12 zBZfLYH1ZNnTtuYM47IMh+r2yn>V*a|!s>rW15vXi=*gu%dZMlf{&Q)*akD)?kL7DS zn90ISCb+pW#m(h4_Y4_WnGl~SW@TBdj0=&TBg{lk7~3Gn|7z?dWP}=OIwwz|2@eTF z?i3c}0f=Nl6@u7`!6hzkaOg)7^;?X9xl8vWPH;QIuZr!zq3dzG0fB$!`*+~<^@Zs< zoJw5qtg!zM`aw-C*+nyI*R;JP(u!imAqKpeKoPhg=M<5yV5f(hxRVZjE!6EO^oaXw z_0ji*6x{Hx4+MM)Y`{V-P*CiPyiepB%;5T2EIJ3La=}zHNa-~Plvsbr%lYg9(lYwn z#1k7$}WHGD`e$pNSBt#5$vK2g6)eptfrE|yeT%%ovu+_?*QTlHq%hmkngk&-JL*z$-5 zTJ+At7;Lwhsv(gNz^{%@o8Bc)K>4;h)6f;E3RZ*2(zJoo+%3AN=>nGEX?z;ag_wgJ zWrlv%aNGCPjRqm^3Bnraw7C_;T{W+!e`+jEi9Gp#h-_RCxq;qeUa4PhWup*#l8!Yx zxy%~UG@I7kM@SP5wCpgB`SEN;hs1O_+=PcDNu2U|bWjuB;^-=QhBsf(o}{@QZLMvo z(M8RcDli~msWa*@&^i4J+)0;2^j+c$&Pjuu25#VFZ55oXHdPfzyimf2i(C`(`VyXR z3Z8EYp0vv9xj`{kn^4Tv=A!$oWu3Y?W?*9;JP!S$1MKxd+YBA`66Ws+=I^AKU$zET zE!Nd#b8uZ0D&DEP9_yq8Ge$Llu$D!V~7BAVk~Yg0{@vQAsY)?Hxwhp0>=hZS6LG zG;QtHMH1)-?Ii`mvmJt82X-k<)NRnyecn9kS!0=O&tmQH46&_bHVx|}%u1@0G>0j8 zBlR-;kj47>H!L>5@Z%NpGyH7Df^%Q1SeSpOVo`>lr`US_S&D6B_(6&dF@CjeVZ*q( zh2iHXwvAPSs}rEg{nG5`YyLsDW3K^Ed2~0Qh8Cv$u^>$&LJ>lV3x6`i$Ar&09&SoJ zucebX{a^w5doiVsE)$ui+q(Lj8hOXPABu<;ANcUWF9P5GkSA}v2{uC{#wA^(Z*`q1 z=qO~P{589EE@0lDJ-)V#WaEn)I;rrcerTuYE8PJoi#hHP`Iv5XA1f541)l9>6Ethc zPu@*)d-}->bW@MLNXH<$Rs40Yf;)!q@25}obilRpUQeTZpNd}fRA}_9I*(P;CeJ`Y zK3x3BQXTJOHzv;R0asU7T