From 6a585100d3e5b9c2001c583cc26a92cf7f9a79eb Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Sun, 16 Feb 2025 19:01:35 +0900 Subject: [PATCH 1/7] Fix --- native/src/equal.rs | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/native/src/equal.rs b/native/src/equal.rs index ce67a615a..e8fde8461 100644 --- a/native/src/equal.rs +++ b/native/src/equal.rs @@ -4,10 +4,13 @@ use stak_vm::{Error, Memory, PrimitiveSet, Type}; pub enum EqualPrimitive { /// An `eqv` procedure. Eqv, + /// A primitive to check equality of rib inners. + EqualInner, } impl EqualPrimitive { const EQV: usize = Self::Eqv as _; + const EQUAL_INNER: usize = Self::EqualInner as _; } /// An equality primitive set. @@ -44,6 +47,25 @@ impl PrimitiveSet for EqualPrimitiveSet { .into(), )?; } + EqualPrimitive::EQUAL_INNER => { + let [x, y] = memory.pop_many(); + + memory.push( + memory + .boolean( + x.is_cons() && y.is_cons() && x.tag() == y.tag() + || if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) { + memory.cdr(x).tag() == Type::Character as _ + && memory.cdr(y).tag() == Type::Character as _ + && memory.car(x) == memory.car(y) + } else { + false + }, + ) + .into(), + )?; + } + _ => return Err(Error::IllegalPrimitive), } From 11cff21e909a0ba4c1984d61b63c7d6d42712c08 Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Mon, 17 Feb 2025 19:03:30 +0900 Subject: [PATCH 2/7] Fix --- native/src/equal.rs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/native/src/equal.rs b/native/src/equal.rs index e8fde8461..7ef1d059b 100644 --- a/native/src/equal.rs +++ b/native/src/equal.rs @@ -55,9 +55,9 @@ impl PrimitiveSet for EqualPrimitiveSet { .boolean( x.is_cons() && y.is_cons() && x.tag() == y.tag() || if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) { - memory.cdr(x).tag() == Type::Character as _ - && memory.cdr(y).tag() == Type::Character as _ - && memory.car(x) == memory.car(y) + memory.cdr(x).tag() == memory.cdr(y).tag() + && (memory.cdr(y).tag() == Type::Character as _ + || memory.car(x) == memory.car(y)) } else { false }, From 0f4f8cea6a6463299d3728e4110ebcabdca9647e Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Mon, 17 Feb 2025 19:04:38 +0900 Subject: [PATCH 3/7] Fix --- native/src/equal.rs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/native/src/equal.rs b/native/src/equal.rs index 7ef1d059b..dd63774b1 100644 --- a/native/src/equal.rs +++ b/native/src/equal.rs @@ -56,7 +56,7 @@ impl PrimitiveSet for EqualPrimitiveSet { x.is_cons() && y.is_cons() && x.tag() == y.tag() || if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) { memory.cdr(x).tag() == memory.cdr(y).tag() - && (memory.cdr(y).tag() == Type::Character as _ + && (memory.car(x).is_cons() || memory.car(x) == memory.car(y)) } else { false From 6b79ef635d2f11693c6b752af24f76b37557181e Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Mon, 17 Feb 2025 19:15:49 +0900 Subject: [PATCH 4/7] Fix --- native/src/equal.rs | 20 ++++++++++---------- prelude.scm | 11 ++--------- 2 files changed, 12 insertions(+), 19 deletions(-) diff --git a/native/src/equal.rs b/native/src/equal.rs index dd63774b1..7382b4e66 100644 --- a/native/src/equal.rs +++ b/native/src/equal.rs @@ -52,16 +52,16 @@ impl PrimitiveSet for EqualPrimitiveSet { memory.push( memory - .boolean( - x.is_cons() && y.is_cons() && x.tag() == y.tag() - || if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) { - memory.cdr(x).tag() == memory.cdr(y).tag() - && (memory.car(x).is_cons() - || memory.car(x) == memory.car(y)) - } else { - false - }, - ) + .boolean(if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) { + // - Optimize checks for unique values. + // - Optimize checks for strings and vectors where `car`s are length integers. + memory.cdr(x).tag() == memory.cdr(y).tag() + && ![Type::Boolean as _, Type::Null as _, Type::Symbol as _] + .contains(&memory.cdr(x).tag()) + && (memory.car(x).is_cons() || memory.car(x) == memory.car(y)) + } else { + false + }) .into(), )?; } diff --git a/prelude.scm b/prelude.scm index ed65c1117..d9e503b06 100644 --- a/prelude.scm +++ b/prelude.scm @@ -602,6 +602,7 @@ (define cons (primitive 61)) (define memq (primitive 62)) (define eqv? (primitive 70)) + (define equal-inner? (primitive 71)) (define (data-rib type car cdr) (rib car cdr type)) @@ -626,15 +627,7 @@ (boolean-or (eq? x y) (and - (rib? x) - (rib? y) - (eq? (rib-tag x) (rib-tag y)) - ; Avoid checking values in global variables. - (not (eq? (rib-tag x) symbol-type)) - ; Optimize for the cases of strings and vectors where `car`s are integers. - (boolean-or - (rib? (rib-car x)) - (eq? (rib-car x) (rib-car y))) + (equal-inner? x y) (equal? (rib-car x) (rib-car y)) (equal? (rib-cdr x) (rib-cdr y))))) From 5bd099b9b62fb4aa6acfd928bca681b2732d6458 Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Mon, 17 Feb 2025 19:16:12 +0900 Subject: [PATCH 5/7] Fix --- r7rs/src/small.rs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/r7rs/src/small.rs b/r7rs/src/small.rs index 21b70b3c7..27db9ae40 100644 --- a/r7rs/src/small.rs +++ b/r7rs/src/small.rs @@ -146,7 +146,9 @@ impl PrimitiveSet Primitive::ASSQ | Primitive::CONS | Primitive::MEMQ => { self.list.operate(memory, primitive - Primitive::ASSQ)? } - Primitive::EQV => self.equal.operate(memory, primitive - Primitive::EQV)?, + Primitive::EQV | Primitive::EQUAL_INNER => { + self.equal.operate(memory, primitive - Primitive::EQV)? + } Primitive::READ | Primitive::WRITE | Primitive::WRITE_ERROR => { self.device.operate(memory, primitive - Primitive::READ)? } From dedd090ebbe33c27ae2ef208b8b64e342cf11879 Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Mon, 17 Feb 2025 19:20:02 +0900 Subject: [PATCH 6/7] Fix --- r7rs/src/small/primitive.rs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/r7rs/src/small/primitive.rs b/r7rs/src/small/primitive.rs index 0dde64aa1..358b51289 100644 --- a/r7rs/src/small/primitive.rs +++ b/r7rs/src/small/primitive.rs @@ -24,6 +24,7 @@ pub(super) enum Primitive { Cons, Memq, Eqv = 70, + EqualInner, Read = 100, Write, WriteError, @@ -63,6 +64,7 @@ impl Primitive { pub const CONS: usize = Self::Cons as _; pub const MEMQ: usize = Self::Memq as _; pub const EQV: usize = Self::Eqv as _; + pub const EQUAL_INNER: usize = Self::EqualInner as _; pub const READ: usize = Self::Read as _; pub const WRITE: usize = Self::Write as _; pub const WRITE_ERROR: usize = Self::WriteError as _; From 7477f88a0a848eb5d9c1c1fb20c77c0e46dc3332 Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Mon, 17 Feb 2025 19:23:08 +0900 Subject: [PATCH 7/7] Fix comment --- native/src/equal.rs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/native/src/equal.rs b/native/src/equal.rs index 7382b4e66..140e6fa03 100644 --- a/native/src/equal.rs +++ b/native/src/equal.rs @@ -54,7 +54,7 @@ impl PrimitiveSet for EqualPrimitiveSet { memory .boolean(if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) { // - Optimize checks for unique values. - // - Optimize checks for strings and vectors where `car`s are length integers. + // - Optimize checks for strings and vectors where `car`s are integers. memory.cdr(x).tag() == memory.cdr(y).tag() && ![Type::Boolean as _, Type::Null as _, Type::Symbol as _] .contains(&memory.cdr(x).tag())