aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bytecode/src/encoding.rs5
-rw-r--r--lib/csc/cps-test.csc12
-rw-r--r--lib/csc/cps.csc4
-rw-r--r--lib/csc/encoding.csc7
-rw-r--r--lib/csc/ir1.csc3
-rw-r--r--lib/csc/macros.csc23
6 files changed, 33 insertions, 21 deletions
diff --git a/bytecode/src/encoding.rs b/bytecode/src/encoding.rs
index 6e86103..8fccc1a 100644
--- a/bytecode/src/encoding.rs
+++ b/bytecode/src/encoding.rs
@@ -108,6 +108,11 @@ fn op_decoding<T: Read>(prog: &mut T) -> Result<Option<Op>, String> {
read_arg(prog, arg1_const)?,
read_arg(prog, arg2_const)?,
),
+ 17 => Op::Equal(
+ read_local(prog)?,
+ read_arg(prog, arg1_const)?,
+ read_arg(prog, arg2_const)?,
+ ),
_ => {
return Err(String::from("invalid opcode"));
}
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)))))))
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-04 05:10:52 +0000