From b81426bb210ea5fca6d841e4dfeb38d83e1a6554 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 7 Aug 2022 19:42:35 -0700
Subject: Misc test fixup in the compiler.

---
 lib/csc/cps-test.csc | 12 ++++++------
 lib/csc/cps.csc      |  4 ++--
 lib/csc/encoding.csc |  7 ++++++-
 lib/csc/ir1.csc      |  3 ++-
 lib/csc/macros.csc   | 23 ++++++++++++-----------
 5 files changed, 28 insertions(+), 21 deletions(-)

(limited to 'lib/csc')

diff --git a/lib/csc/cps-test.csc b/lib/csc/cps-test.csc
index 7aab023..ab92646 100644
--- a/lib/csc/cps-test.csc
+++ b/lib/csc/cps-test.csc
@@ -206,7 +206,7 @@
           (list (make-closure (test-ref 'generated-symbol)
                                       (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
                   (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                    (make-primitive 'int<? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                    (make-primitive 'lt (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
                       (make-fix (list (make-closure (test-ref 'generated-symbol)
                                                     (list (test-ref 'generated-symbol))
                                         (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -256,7 +256,7 @@
           (list
             (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
               (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
                   (make-fix
                     (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                             (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -322,7 +322,7 @@
         (make-fix
           (list (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
                   (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                    (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                    (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
                       (make-fix
                         (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                                 (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -357,7 +357,7 @@
             (list
               (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
                 (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                  (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                  (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
                     (make-fix
                       (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                               (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -404,7 +404,7 @@
             (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
                                               (test-ref 'generated-symbol))
               (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
                   (make-fix
                     (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                             (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -443,7 +443,7 @@
           (make-fix
             (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
                     (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                      (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
                         (make-fix
                           (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                                   (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
diff --git a/lib/csc/cps.csc b/lib/csc/cps.csc
index 65bca89..ca6dbf4 100644
--- a/lib/csc/cps.csc
+++ b/lib/csc/cps.csc
@@ -131,7 +131,7 @@
           (define argvec (new-ref))
           (define nargs (length args))
           (make-lambda (list argvec) #f
-            (make-if (make-call-builtin 'int<? (list (make-call-builtin 'peek (list argvec (make-constant 1)))
+            (make-if (make-call-builtin 'lt (list (make-call-builtin 'peek (list argvec (make-constant 1)))
                                                      (make-constant nargs)))
               (make-call (make-library-ref 'wrong-number-of-arguments '(csc based)) (list argvec))
               (loop for arg in (reverse args)
@@ -151,7 +151,7 @@
           (define argvec (new-ref))
           (define nargs (length args))
           (make-lambda (list argvec) #f
-            (make-if (make-call-builtin 'eq? (list (make-call-builtin 'peek (list argvec (make-constant 1)))
+            (make-if (make-call-builtin 'eq (list (make-call-builtin 'peek (list argvec (make-constant 1)))
                                                      (make-constant nargs)))
               (loop for arg in (reverse args)
                     for i downfrom (+ 1 nargs)
diff --git a/lib/csc/encoding.csc b/lib/csc/encoding.csc
index 83258c8..aceedc8 100644
--- a/lib/csc/encoding.csc
+++ b/lib/csc/encoding.csc
@@ -175,11 +175,16 @@
           (make-opcode w 15 (is-const? x) #f)
           (arg->le-bytes w dest)
           (arg->le-bytes w x))
-        (('int<? dest x y)
+        (('lt dest x y)
           (make-opcode w 16 (is-const? x) (is-const? y))
           (arg->le-bytes w dest)
           (arg->le-bytes w x)
           (arg->le-bytes w y))
+        (('eq dest x y)
+          (make-opcode w 17 (is-const? x) (is-const? y))
+          (arg->le-bytes w dest)
+          (arg->le-bytes w x)
+          (arg->le-bytes w y))
         (_ (error "invalid opcode" opcode))))
 
 
diff --git a/lib/csc/ir1.csc b/lib/csc/ir1.csc
index a39c07d..5cc0bf0 100644
--- a/lib/csc/ir1.csc
+++ b/lib/csc/ir1.csc
@@ -168,7 +168,8 @@
     ;   - alloc: size -> result
     ;   - peek: pointer * offset -> result
     ;   - poke: word * pointer * offset -> ()
-    ;   - int<?: int * int -> bool
+    ;   - lt: int * int -> bool
+    ;   - eq: obj * obj -> bool
     ;   - call-with-current-continuation: proc -> result
     ;   - call-with-values: producer * consumer -> result
     ;   - apply: proc * args -> result
diff --git a/lib/csc/macros.csc b/lib/csc/macros.csc
index 4463f91..739f532 100644
--- a/lib/csc/macros.csc
+++ b/lib/csc/macros.csc
@@ -837,14 +837,15 @@
                       (set! ident-map (insert ident-map k v)))
         env)
       (define environment (make-environment ident-map name))
-      (loop for expr in body
-            for expanded-expr = (expand expr environment)
-            with res = (make-constant #f)
-            do (set! res (make-sequence res expanded-expr))
-            finally (return res)
-            if (define-syntax? expanded-expr)
-              do (set! environment
-                   (add-binding
-                     (define-syntax-name expanded-expr)
-                     (define-syntax-transformer expanded-expr)
-                     environment))))))
+      (if (null? body)
+        (make-constant #f)
+        (loop for expr in body
+              for expanded-expr = (expand expr environment)
+              for res = expanded-expr then (make-sequence res expanded-expr)
+              finally (return res)
+              if (define-syntax? expanded-expr)
+                do (set! environment
+                     (add-binding
+                       (define-syntax-name expanded-expr)
+                       (define-syntax-transformer expanded-expr)
+                       environment)))))))
-- 
cgit v1.3.1