diff --git a/src/ikarus.boot b/src/ikarus.boot index 1ca5552..a79c21f 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.core.ss b/src/ikarus.core.ss index c2d9b8d..d1c4cf9 100644 --- a/src/ikarus.core.ss +++ b/src/ikarus.core.ss @@ -211,15 +211,6 @@ -(primitive-set! 'weak-cons - (lambda (a d) - (foreign-call "ikrt_weak_cons" a d))) - -(primitive-set! 'weak-pair? - (lambda (x) - (and (pair? x) - (foreign-call "ikrt_is_weak_pair" x)))) - (primitive-set! 'pointer-value (lambda (x) (pointer-value x))) diff --git a/src/ikarus.pairs.ss b/src/ikarus.pairs.ss index 425c718..dcd0829 100644 --- a/src/ikarus.pairs.ss +++ b/src/ikarus.pairs.ss @@ -2,17 +2,22 @@ (library (ikarus pairs) (export - cons set-car! set-cdr! + cons weak-cons set-car! set-cdr! car cdr caar cdar cadr cddr caaar cdaar cadar cddar caadr cdadr caddr cdddr caaaar cdaaar cadaar cddaar caadar cdadar caddar cdddar caaadr cdaadr cadadr cddadr caaddr cdaddr cadddr cddddr) (import - (only (ikarus) define if lambda pair? error quote let unless) + (only (ikarus) define if lambda pair? error quote let unless + foreign-call) (rename (only (scheme) cons $car $cdr $set-car! $set-cdr!) (cons sys:cons))) (define cons (lambda (x y) (sys:cons x y))) + (define weak-cons + (lambda (a d) + (foreign-call "ikrt_weak_cons" a d))) + (define set-car! (lambda (x y) (unless (pair? x) diff --git a/src/ikarus.predicates.ss b/src/ikarus.predicates.ss index c027743..f85a233 100644 --- a/src/ikarus.predicates.ss +++ b/src/ikarus.predicates.ss @@ -4,14 +4,15 @@ (export fixnum? flonum? bignum? number? complex? real? rational? integer? exact? eof-object? bwp-object? immediate? boolean? char? vector? string? procedure? null? pair? symbol? not + weak-pair? eq? eqv? equal?) (import (except (ikarus) fixnum? flonum? bignum? number? complex? real? rational? integer? exact? eof-object? bwp-object? immediate? - boolean? char? vector? string? procedure? null? - pair? symbol? not eq? eqv? equal?) + boolean? char? vector? string? procedure? null? + pair? weak-pair? symbol? not eq? eqv? equal?) (only (scheme) $fxadd1 $vector-ref $fx= $char= $string-ref $string-length $vector-length $car $cdr) (rename (only (ikarus) fixnum? flonum? bignum? eof-object? @@ -91,6 +92,13 @@ (define pair? (lambda (x) (sys:pair? x))) (define symbol? (lambda (x) (sys:symbol? x))) + + + (define weak-pair? + (lambda (x) + (and (pair? x) + (foreign-call "ikrt_is_weak_pair" x)))) + (define not (lambda (x) (if x #f #t))) (define eq? (lambda (x y) (sys:eq? x y)))