* added the $unbound-object? prim to the (ikarus system $symbols)

library.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-06 18:43:04 -04:00
parent 00075f13d0
commit e3ddd4d0e6
11 changed files with 44 additions and 46 deletions

Binary file not shown.

View File

@ -4,9 +4,10 @@
console-output-port current-output-port console-output-port current-output-port
open-output-file with-output-to-file call-with-output-file) open-output-file with-output-to-file call-with-output-file)
(import (import
(only (scheme) $set-port-output-size! $write-char $string-set! (ikarus system $ports)
$port-output-buffer $set-port-output-index! $fxadd1 $fx< (ikarus system $io)
$port-output-size $port-output-index) (ikarus system $strings)
(ikarus system $fx)
(except (ikarus) (except (ikarus)
standard-output-port standard-error-port standard-output-port standard-error-port
console-output-port current-output-port console-output-port current-output-port

View File

@ -1,7 +1,9 @@
(library (ikarus multiple-values) (library (ikarus multiple-values)
(export call-with-values values) (export call-with-values values)
(import (except (scheme) call-with-values values)) (import
(ikarus system $stack)
(except (ikarus) call-with-values values))
(define call-with-values (define call-with-values
($make-call-with-values-procedure)) ($make-call-with-values-procedure))

View File

@ -25,10 +25,9 @@
(export + - * = < <= > >= add1 sub1 quotient remainder (export + - * = < <= > >= add1 sub1 quotient remainder
quotient+remainder number->string string->number) quotient+remainder number->string string->number)
(import (import
(only (scheme) $fxlogand $fx= $fx< $fx<= $fx> $fx>= $fxzero? (ikarus system $fx)
$fxsll $fxsra $fxmodulo $string-ref $string-length (ikarus system $chars)
$fxadd1 $fx- (ikarus system $strings)
$char->fixnum $char= $char<=)
(except (ikarus) + - * = < <= > >= add1 sub1 quotient remainder (except (ikarus) + - * = < <= > >= add1 sub1 quotient remainder
quotient+remainder number->string string->number)) quotient+remainder number->string string->number))

View File

@ -2,15 +2,18 @@
(library (ikarus pairs) (library (ikarus pairs)
(export (export
cons weak-cons set-car! set-cdr! cons weak-cons set-car! set-cdr! car cdr caar cdar cadr cddr
car cdr caar cdar cadr cddr caaar cdaar cadar cddar caadr cdadr caaar cdaar cadar cddar caadr cdadr caddr cdddr caaaar cdaaar
caddr cdddr caaaar cdaaar cadaar cddaar caadar cdadar caddar cadaar cddaar caadar cdadar caddar cdddar caaadr cdaadr cadadr
cdddar caaadr cdaadr cadadr cddadr caaddr cdaddr cadddr cddddr) cddadr caaddr cdaddr cadddr cddddr)
(import (import
(only (ikarus) define if lambda pair? error quote let unless (except (ikarus) cons weak-cons set-car! set-cdr! car cdr caar
foreign-call) cdar cadr cddr caaar cdaar cadar cddar caadr cdadr caddr
(rename (only (scheme) cons $car $cdr $set-car! $set-cdr!) cdddr caaaar cdaaar cadaar cddaar caadar cdadar caddar
(cons sys:cons))) cdddar caaadr cdaadr cadadr cddadr caaddr cdaddr cadddr
cddddr)
(rename (only (ikarus) cons) (cons sys:cons))
(ikarus system $pairs))
(define cons (lambda (x y) (sys:cons x y))) (define cons (lambda (x y) (sys:cons x y)))

View File

@ -2,20 +2,22 @@
(library (ikarus predicates) (library (ikarus predicates)
(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?
char? vector? string? procedure? null? pair? symbol? not boolean? char? vector? string? procedure? null? pair?
weak-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?
boolean? char? vector? string? procedure? null? immediate? boolean? char? vector? string? procedure?
pair? weak-pair? symbol? not eq? eqv? equal? null? pair? weak-pair? symbol? not eq? eqv? equal?
port? input-port? output-port?) port? input-port? output-port?)
(only (scheme) $fxadd1 $vector-ref $fx= $char= $string-ref (ikarus system $fx)
$string-length $vector-length $car $cdr) (ikarus system $pairs)
(ikarus system $chars)
(ikarus system $strings)
(ikarus system $vectors)
(rename (only (ikarus) fixnum? flonum? bignum? eof-object? (rename (only (ikarus) fixnum? flonum? bignum? eof-object?
bwp-object? immediate? boolean? char? vector? string? bwp-object? immediate? boolean? char? vector? string?
procedure? null? pair? symbol? eq? procedure? null? pair? symbol? eq?

View File

@ -2,7 +2,7 @@
(library (ikarus reader) (library (ikarus reader)
(export read read-token comment-handler load) (export read read-token comment-handler load)
(import (import
(only (scheme) $char->fixnum $char= $char<=) (ikarus system $chars)
(except (ikarus) read read-token comment-handler load)) (except (ikarus) read read-token comment-handler load))
(define delimiter? (define delimiter?

View File

@ -17,9 +17,7 @@
record-type-field-names record-constructor record-predicate record-type-field-names record-constructor record-predicate
record-field-accessor record-field-mutator record? record-rtd record-field-accessor record-field-mutator record? record-rtd
record-type-descriptor record-name record-printer record-length record-type-descriptor record-name record-printer record-length
record-ref record-set!) record-ref record-set!))
(only (scheme)
set-top-level-value! top-level-value top-level-bound?))
@ -102,7 +100,7 @@
(for-each verify-field fields) (for-each verify-field fields)
(let ([g (gensym name)]) (let ([g (gensym name)])
(let ([rtd (make-rtd name fields #f g)]) (let ([rtd (make-rtd name fields #f g)])
(set-top-level-value! g rtd) (set-symbol-value! g rtd)
rtd))] rtd))]
[(name fields g) [(name fields g)
(unless (string? name) (unless (string? name)
@ -111,15 +109,15 @@
(error 'make-record-type "fields must be a list, got ~s" fields)) (error 'make-record-type "fields must be a list, got ~s" fields))
(for-each verify-field fields) (for-each verify-field fields)
(cond (cond
[(top-level-bound? g) [(symbol-bound? g)
(let ([rtd (top-level-value g)]) (let ([rtd (symbol-value g)])
(unless (and (string=? name (record-type-name rtd)) (unless (and (string=? name (record-type-name rtd))
(equal? fields (record-type-field-names rtd))) (equal? fields (record-type-field-names rtd)))
(error 'make-record-type "definition mismatch")) (error 'make-record-type "definition mismatch"))
rtd)] rtd)]
[else [else
(let ([rtd (make-rtd name fields #f g)]) (let ([rtd (make-rtd name fields #f g)])
(set-top-level-value! g rtd) (set-symbol-value! g rtd)
rtd)])])) rtd)])]))
(define record-type-name (define record-type-name

View File

@ -9,12 +9,7 @@
(ikarus system $pairs) (ikarus system $pairs)
(except (ikarus) string-length string-ref string-set! make-string (except (ikarus) string-length string-ref string-set! make-string
string->list string=? string-append substring string string->list string=? string-append substring string
list->string uuid) list->string uuid))
#;(only (scheme)
$fx+ $fxsub1 $fxadd1 $char= $car $cdr
$fxzero? $fx= $fx<= $fx< $fx>= $fx-
$string-length $string-ref
$make-string $string-set!))
(define string-length (define string-length

View File

@ -6,11 +6,9 @@
top-level-value top-level-bound? set-top-level-value! top-level-value top-level-bound? set-top-level-value!
symbol-value symbol-bound? set-symbol-value!) symbol-value symbol-bound? set-symbol-value!)
(import (import
(only (scheme) $make-symbol $symbol-string $set-symbol-string! (ikarus system $symbols)
$symbol-unique-string $set-symbol-unique-string! (ikarus system $pairs)
$symbol-value $set-symbol-value! (ikarus system $fx)
$set-symbol-plist! $symbol-plist
$car $cdr $fx>= $fxadd1 $set-cdr! $unbound-object?)
(except (ikarus) gensym gensym? gensym->unique-string (except (ikarus) gensym gensym? gensym->unique-string
gensym-prefix gensym-count print-gensym gensym-prefix gensym-count print-gensym
string->symbol symbol->string string->symbol symbol->string

View File

@ -483,6 +483,7 @@
[$set-symbol-string! $symbols] [$set-symbol-string! $symbols]
[$set-symbol-unique-string! $symbols] [$set-symbol-unique-string! $symbols]
[$set-symbol-plist! $symbols] [$set-symbol-plist! $symbols]
[$unbound-object? $symbols]
; (ikarus system $records) ; (ikarus system $records)
[base-rtd $records] [base-rtd $records]
[$record-set! $records] [$record-set! $records]
@ -546,7 +547,6 @@
[$make-values-procedure $stack] [$make-values-procedure $stack]
; (ikarus system) ; (ikarus system)
[$forward-ptr? s ] [$forward-ptr? s ]
[$unbound-object? s ]
[$interrupted? s ] [$interrupted? s ]
[$unset-interrupted! s ] [$unset-interrupted! s ]
[$apply-nonprocedure-error-handler s] [$apply-nonprocedure-error-handler s]