conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

7
src/ikarus.io.output-files.ss
View File

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

4
src/ikarus.multiple-values.ss
View File

@ -1,7 +1,9 @@
(library (ikarus multiple-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
($make-call-with-values-procedure))

7
src/ikarus.numerics.ss
View File

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

21
src/ikarus.pairs.ss
View File

@ -1,16 +1,19 @@
(library (ikarus pairs)
(export
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)
(export
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
foreign-call)
(rename (only (scheme) cons $car $cdr $set-car! $set-cdr!)
(cons sys:cons)))
(except (ikarus) 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)
(rename (only (ikarus) cons) (cons sys:cons))
(ikarus system $pairs))
(define cons (lambda (x y) (sys:cons x y)))

20
src/ikarus.predicates.ss
View File

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

2
src/ikarus.reader.ss
View File

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

12
src/ikarus.records.ss
View File

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

7
src/ikarus.strings.ss
View File

@ -9,12 +9,7 @@
(ikarus system $pairs)
(except (ikarus) string-length string-ref string-set! make-string
string->list string=? string-append substring string
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!))
list->string uuid))
(define string-length

8
src/ikarus.symbols.ss
View File

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

2
src/makefile.ss
View File

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