diff options
| -rw-r--r-- | src/interp/debug.lisp | 6 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 4 | ||||
| -rw-r--r-- | src/interp/sys-macros.lisp | 18 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 12 |
4 files changed, 19 insertions, 21 deletions
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp index e091b57f..2e425aa1 100644 --- a/src/interp/debug.lisp +++ b/src/interp/debug.lisp @@ -46,6 +46,12 @@ (import-module "sys-macros") (import-module "lexing") (in-package "BOOT") + +(defmacro SPADLET (A B) + (if (ATOM A) + `(SETQ ,A ,B) + `(OR (IS ,B ,A) + (LET_ERROR ,(MK_LEFORM A) ,(MKQ B) )))) (defvar S-SPADKEY NIL) ;" this is augmented by MAKESPADOP" diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 722fa9b0..76f1a663 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -843,8 +843,8 @@ massageBackendCode x == -- temporarily have TRACELET report MAKEPROPs. if (u := first x) = "MAKEPROP" and $TRACELETFLAG then x.op := "MAKEPROP-SAY" - u in '(DCQ SPADLET SETQ %LET) => - if u in '(SPADLET %LET) then + u in '(DCQ SETQ %LET) => + if u = '%LET then if x.args is [y,.] and ident? y then x.op := "SETQ" else diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp index a1f5161d..17ebdccf 100644 --- a/src/interp/sys-macros.lisp +++ b/src/interp/sys-macros.lisp @@ -296,14 +296,6 @@ ,var)) ('T (ERROR "Cannot compileLET construct")))) - -(defmacro SPADLET (A B) - (if (ATOM A) - `(SETQ ,A ,B) - `(OR (IS ,B ,A) - (LET_ERROR ,(MK_LEFORM A) ,(MKQ B) )))) - - ;; ;; -*- Helper Functions For Iteration Control Structures -*- ;; @@ -664,7 +656,7 @@ (MK_LEFORM (SECOND U))) ((EQ (FIRST U) 'EQUAL) (STRCONC "=" (MK_LEFORM (SECOND U)) )) - ((EQ (FIRST U) 'SPADLET) + ((EQ (FIRST U) 'SETQ) (MK_LEFORM (THIRD U))) ((ERRHUH)))) @@ -687,7 +679,7 @@ (if (OR (NULL VARS) (NULL INITS)) NIL - (CONS (LIST 'SPADLET (CAR VARS) (CAR INITS)) + (CONS (LIST 'SETQ (CAR VARS) (CAR INITS)) (DO_LET (CDR VARS) (CDR INITS))))) @@ -805,8 +797,8 @@ ;; create preset of accumulate (SETQ PRESET (COND ((EQ Y 'NO_THETA_PROPERTY) - (LIST 'SPADLET G (MKQ G))) - ((LIST 'SPADLET G Y)) )) + (LIST 'SETQ G (MKQ G))) + ((LIST 'SETQ G Y)) )) (SETQ EXIT (COND ((SETQ X (ASSOC 'EXIT SPL)) (SETQ SPL (DELASC 'EXIT SPL)) @@ -841,7 +833,7 @@ (COND ((EQ VALUE BODY) RESETCODE) ((LIST 'PROGN - (LIST 'SPADLET VALUE BODY) + (LIST 'SETQ VALUE BODY) RESETCODE)) )) (SETQ AUX (CONS (LIST 'EXIT EXIT) diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index 6a087932..fcf415f6 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -1503,11 +1503,11 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (RETURN (SEQ (COND ((> 1 N) NIL) - ('T (SPADLET |l| (SPADDIFFERENCE (|#| |str|) 1)) + ('T (SETQ |l| (SPADDIFFERENCE (|#| |str|) 1)) (COND ((EQL |l| 0) NIL) - ('T (SPADLET |n| 0) (SPADLET |word| '||) - (SPADLET |inWord| NIL) + ('T (SETQ |n| 0) (SETQ |word| '||) + (SETQ |inWord| NIL) (DO ((|i| 0 (1+ |i|))) ((> |i| |l|) NIL) (declare (fixnum |i|)) (SEQ (EXIT (COND @@ -1515,12 +1515,12 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (COND ((NULL |inWord|) NIL) ((eql |n| N) (RETURN |word|)) - ('T (SPADLET |inWord| NIL)))) + ('T (SETQ |inWord| NIL)))) ('T (COND ((NULL |inWord|) - (SPADLET |inWord| 'T) - (SPADLET |n| (PLUS |n| 1)))) + (SETQ |inWord| 'T) + (SETQ |n| (PLUS |n| 1)))) (COND ((eql |n| N) (cond ((eq |word| '||) |