* moved weak-cons to ikarus.pairs

* moved weak-pair? to ikarus.predicates
This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 06:18:29 -04:00
parent 24ce3f42ca
commit 5150058773
4 changed files with 17 additions and 13 deletions

Binary file not shown.

View File

@ -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 (primitive-set! 'pointer-value
(lambda (x) (lambda (x)
(pointer-value x))) (pointer-value x)))

View File

@ -2,17 +2,22 @@
(library (ikarus pairs) (library (ikarus pairs)
(export (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 car cdr caar cdar cadr cddr caaar cdaar cadar cddar caadr cdadr
caddr cdddr caaaar cdaaar cadaar cddaar caadar cdadar caddar caddr cdddr caaaar cdaaar cadaar cddaar caadar cdadar caddar
cdddar caaadr cdaadr cadadr cddadr caaddr cdaddr cadddr cddddr) cdddar caaadr cdaadr cadadr cddadr caaddr cdaddr cadddr cddddr)
(import (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!) (rename (only (scheme) cons $car $cdr $set-car! $set-cdr!)
(cons sys:cons))) (cons sys:cons)))
(define cons (lambda (x y) (sys:cons x y))) (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! (define set-car!
(lambda (x y) (lambda (x y)
(unless (pair? x) (unless (pair? x)

View File

@ -4,14 +4,15 @@
(export fixnum? flonum? bignum? number? complex? real? rational? (export fixnum? flonum? bignum? number? complex? real? rational?
integer? exact? eof-object? bwp-object? immediate? boolean? integer? exact? eof-object? bwp-object? immediate? boolean?
char? vector? string? procedure? null? pair? symbol? not char? vector? string? procedure? null? pair? symbol? not
weak-pair?
eq? eqv? equal?) eq? eqv? equal?)
(import (import
(except (ikarus) fixnum? flonum? bignum? number? complex? real? (except (ikarus) fixnum? flonum? bignum? number? complex? real?
rational? integer? exact? eof-object? bwp-object? immediate? rational? integer? exact? eof-object? bwp-object? immediate?
boolean? char? vector? string? procedure? null? boolean? char? vector? string? procedure? null?
pair? symbol? not eq? eqv? equal?) pair? weak-pair? symbol? not eq? eqv? equal?)
(only (scheme) $fxadd1 $vector-ref $fx= $char= $string-ref (only (scheme) $fxadd1 $vector-ref $fx= $char= $string-ref
$string-length $vector-length $car $cdr) $string-length $vector-length $car $cdr)
(rename (only (ikarus) fixnum? flonum? bignum? eof-object? (rename (only (ikarus) fixnum? flonum? bignum? eof-object?
@ -91,6 +92,13 @@
(define pair? (lambda (x) (sys:pair? x))) (define pair? (lambda (x) (sys:pair? x)))
(define symbol? (lambda (x) (sys:symbol? 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 not (lambda (x) (if x #f #t)))
(define eq? (lambda (x y) (sys:eq? x y))) (define eq? (lambda (x y) (sys:eq? x y)))