From da7c52a39bd14d147c3c6462a3b18d8acb60cbb7 Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Sun, 29 Dec 2024 23:17:56 +0900 Subject: [PATCH] Fix --- prelude.scm | 42 ++++++++++++++--------------- r7rs/src/small.rs | 54 +++++++------------------------------ r7rs/src/small/primitive.rs | 10 +++---- 3 files changed, 36 insertions(+), 70 deletions(-) diff --git a/prelude.scm b/prelude.scm index 74248528d3..92894c03ee 100644 --- a/prelude.scm +++ b/prelude.scm @@ -564,27 +564,27 @@ ($$rib id '() procedure-type)) (define rib $$rib) - (define cons (primitive 1)) - (define close (primitive 2)) - (define rib? (primitive 3)) - (define rib-car (primitive 4)) - (define rib-cdr (primitive 5)) - (define rib-tag (primitive 7)) - (define rib-set-car! (primitive 8)) - (define rib-set-cdr! (primitive 9)) - (define eq? (primitive 10)) - (define $< (primitive 11)) - (define $+ (primitive 12)) - (define $- (primitive 13)) - (define $* (primitive 14)) - (define $/ (primitive 15)) - (define remainder (primitive 16)) - (define exp (primitive 17)) - (define $log (primitive 18)) - (define null? (primitive 20)) - (define pair? (primitive 21)) - (define memq (primitive 22)) - (define assq (primitive 23)) + (define close (primitive 1)) + (define rib? (primitive 2)) + (define rib-car (primitive 3)) + (define rib-cdr (primitive 4)) + (define rib-tag (primitive 6)) + (define rib-set-car! (primitive 7)) + (define rib-set-cdr! (primitive 8)) + (define eq? (primitive 9)) + (define $< (primitive 10)) + (define $+ (primitive 11)) + (define $- (primitive 12)) + (define $* (primitive 13)) + (define $/ (primitive 14)) + (define remainder (primitive 15)) + (define exp (primitive 16)) + (define $log (primitive 17)) + (define null? (primitive 50)) + (define pair? (primitive 51)) + (define assq (primitive 60)) + (define cons (primitive 61)) + (define memq (primitive 62)) (define (data-rib type car cdr) (rib car cdr type)) diff --git a/r7rs/src/small.rs b/r7rs/src/small.rs index b367d120c3..e27ab6ddf9 100644 --- a/r7rs/src/small.rs +++ b/r7rs/src/small.rs @@ -6,6 +6,7 @@ use self::primitive::Primitive; use core::ops::{Add, Div, Mul, Rem, Sub}; use stak_device::{Device, DevicePrimitiveSet}; use stak_file::{FilePrimitiveSet, FileSystem}; +use stak_native::{ListPrimitiveSet, TypeCheckPrimitiveSet}; use stak_process_context::{ProcessContext, ProcessContextPrimitiveSet}; use stak_time::{Clock, TimePrimitiveSet}; use stak_vm::{Memory, Number, NumberRepresentation, PrimitiveSet, Tag, Type, Value}; @@ -16,6 +17,8 @@ pub struct SmallPrimitiveSet, process_context: ProcessContextPrimitiveSet

, time: TimePrimitiveSet, + type_check: TypeCheckPrimitiveSet, + list: ListPrimitiveSet, } impl SmallPrimitiveSet { @@ -26,6 +29,8 @@ impl SmallPrimitiveSet PrimitiveSet Self::rib(memory, car, cdr, tag.assume_number().to_i64() as _)?; } - // Optimize a cons. - Primitive::CONS => { - let [car, cdr] = memory.pop_many(); - - Self::rib(memory, car, cdr, Type::Pair as _)?; - } Primitive::CLOSE => { let closure = memory.pop(); @@ -178,44 +177,11 @@ impl PrimitiveSet Self::operate_unary(memory, |x| Number::from_f64(libm::log(x.to_f64())))? } Primitive::HALT => return Err(Error::Halt), - // TODO Add a `stak-optimal` crate. - Primitive::NULL => Self::operate_top(memory, |memory, value| { - memory.boolean(value == memory.null().into()).into() - })?, - Primitive::PAIR => Self::check_type(memory, Type::Pair)?, - Primitive::MEMQ => { - let [x, xs] = memory.pop_many(); - let mut xs = xs.assume_cons(); - let mut y = memory.boolean(false); - - while xs != memory.null() { - if x == memory.car(xs) { - y = xs; - break; - } - - xs = memory.cdr(xs).assume_cons(); - } - - memory.push(y.into())?; - } - Primitive::ASSQ => { - let [x, xs] = memory.pop_many(); - let mut xs = xs.assume_cons(); - let mut y = memory.boolean(false); - - while xs != memory.null() { - let cons = memory.car(xs).assume_cons(); - - if x == memory.car(cons) { - y = cons; - break; - } - - xs = memory.cdr(xs).assume_cons(); - } - - memory.push(y.into())?; + Primitive::NULL | Primitive::PAIR => self + .type_check + .operate(memory, primitive - Primitive::NULL)?, + Primitive::ASSQ | Primitive::CONS | Primitive::MEMQ => { + self.list.operate(memory, primitive - Primitive::ASSQ)? } Primitive::READ | Primitive::WRITE | Primitive::WRITE_ERROR => { self.device.operate(memory, primitive - Primitive::READ)? diff --git a/r7rs/src/small/primitive.rs b/r7rs/src/small/primitive.rs index a48e5a9e3d..48493e6826 100644 --- a/r7rs/src/small/primitive.rs +++ b/r7rs/src/small/primitive.rs @@ -1,7 +1,6 @@ #[derive(Clone, Copy, Debug, Eq, PartialEq)] pub(super) enum Primitive { Rib, - Cons, Close, IsRib, Car, @@ -21,10 +20,11 @@ pub(super) enum Primitive { Exponentiation, Logarithm, Halt, - Null, + Null = 50, Pair, + Assq = 60, + Cons, Memq, - Assq, Read = 100, Write, WriteError, @@ -41,7 +41,6 @@ pub(super) enum Primitive { impl Primitive { pub const RIB: usize = Self::Rib as _; - pub const CONS: usize = Self::Cons as _; pub const CLOSE: usize = Self::Close as _; pub const IS_RIB: usize = Self::IsRib as _; pub const CAR: usize = Self::Car as _; @@ -61,8 +60,9 @@ impl Primitive { pub const HALT: usize = Self::Halt as _; pub const NULL: usize = Self::Null as _; pub const PAIR: usize = Self::Pair as _; - pub const MEMQ: usize = Self::Memq as _; pub const ASSQ: usize = Self::Assq as _; + pub const CONS: usize = Self::Cons as _; + pub const MEMQ: usize = Self::Memq as _; pub const READ: usize = Self::Read as _; pub const WRITE: usize = Self::Write as _; pub const WRITE_ERROR: usize = Self::WriteError as _;