From c557c02fc88f18644b1ab0aa85756af09585ed47 Mon Sep 17 00:00:00 2001
From: Gabriel Dos Reis <GabrielDosReis@users.noreply.github.com>
Date: Tue, 30 Aug 2022 02:37:21 -0700
Subject: Do not generate `SPADLET` opcode (#23)

This patch makes the Spad compiler no longer generate `SPADLET`.
---
 src/interp/debug.lisp        |  6 ++++++
 src/interp/lisp-backend.boot |  4 ++--
 src/interp/sys-macros.lisp   | 18 +++++-------------
 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| '||)
-- 
cgit v1.2.3