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

removed some more imports of (scheme)

This commit is contained in:
Abdulaziz Ghuloum 2007-05-06 17:41:59 -04:00
parent 3764fcbdad
commit 4afe70f770
7 changed files with 159 additions and 118 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.

1
src/ikarus.fasl.ss
View File

@ -34,6 +34,7 @@
(export fasl-write)
(import
(only (scheme) $closure-code )
(ikarus system $records)
(except (ikarus) fasl-write))
(define write-fixnum

10
src/ikarus.io.output-strings.ss
View File

@ -2,11 +2,11 @@
(library (ikarus io output-strings)
(export open-output-string get-output-string with-output-to-string)
(import
(only (scheme) $string-length $string-ref $string-set! $car $cdr
$fx+ $fxadd1 $fxsub1 $fx= $fx<
$port-output-buffer $port-output-index $port-output-size
$port-handler
$set-port-output-size! $write-char $set-port-output-index!)
(ikarus system $strings)
(ikarus system $fx)
(ikarus system $pairs)
(ikarus system $ports)
(ikarus system $io)
(except (ikarus) open-output-string get-output-string with-output-to-string))
(define-syntax message-case

7
src/ikarus.records.ss
View File

@ -9,15 +9,16 @@
record-name record-printer record-length record-ref record-set!)
(import
(ikarus system $records)
(ikarus system $pairs)
(ikarus system $fx)
(except (ikarus)
make-record-type record-type-name record-type-symbol
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) $record? $record-rtd $record-ref
$record-set! $record $make-record $car $cdr $fxadd1
$fx< $fx= $fx+ $fx>=
(only (scheme)
set-top-level-value! top-level-value top-level-bound?))

5
src/ikarus.singular-objects.ss
View File

@ -2,9 +2,8 @@
(library (ikarus singular-objects)
(export base-rtd eof-object)
(import
(rename (ikarus)
(eof-object sys:eof-object)
(base-rtd sys:base-rtd)))
(rename (ikarus system $records) (base-rtd sys:base-rtd))
(rename (ikarus) (eof-object sys:eof-object)))
(define (eof-object) (sys:eof-object))
(define (base-rtd) (sys:base-rtd)))

6
src/ikarus.strings.ss
View File

@ -3,10 +3,14 @@
(export string-length string-ref string-set! make-string string->list string=?
string-append substring string list->string uuid)
(import
(ikarus system $strings)
(ikarus system $fx)
(ikarus system $chars)
(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)
#;(only (scheme)
$fx+ $fxsub1 $fxadd1 $char= $car $cdr
$fxzero? $fx= $fx<= $fx< $fx>= $fx-
$string-length $string-ref

246
src/makefile.ss
View File

@ -98,7 +98,25 @@
'([s (ikarus system)]
[u (ikarus system unsafe)]
[i (ikarus)]
[r (r6rs)]))
[r (r6rs)]
[$pairs (ikarus system $pairs)]
[$lists (ikarus system $lists)]
[$chars (ikarus system $chars)]
[$strings (ikarus system $strings)]
[$vectors (ikarus system $vectors)]
[$fx (ikarus system $fx)]
[$symbols (ikarus system $symbols)]
[$records (ikarus system $records)]
[$ports (ikarus system $ports)]
[$codes (ikarus system $codes)]
[$tcbuckets (ikarus system $tcbuckets)]
[$io (ikarus system $io)]
;[$lists (ikarus system $lists)]
;[$lists (ikarus system $lists)]
;[$lists (ikarus system $lists)]
;[$lists (ikarus system $lists)]
;[$lists (ikarus system $lists)]
))
(define ikarus-macros-map
'([define s i r]
@ -406,104 +424,114 @@
[library-spec s i]
[current-library-collection s i]
[invoke-library s i]
[$car u ]
[$cdr u ]
[$set-car! u ]
[$set-cdr! u ]
[$memq u ]
[$memv u ]
[$char? s ]
[$char= s ]
[$char< s ]
[$char> s ]
[$char<= s ]
[$char>= s ]
[$char->fixnum s ]
[$fixnum->char s ]
[$make-string s i]
[$string-ref s ]
[$string-set! s ]
[$string-length s ]
[$make-vector s ]
[$vector-length s ]
[$vector-ref s ]
[$vector-set! s ]
[$fxzero? s ]
[$fxadd1 s ]
[$fxsub1 s ]
[$fx>= s ]
[$fx<= s ]
[$fx> s ]
[$fx< s ]
[$fx= s ]
[$fxsll s ]
[$fxsra s ]
[$fxquotient s ]
[$fxmodulo s ]
[$fxlogxor s ]
[$fxlogor s ]
[$fxlognot s ]
[$fxlogand s ]
[$fx+ s ]
[$fx* s ]
[$fx- s ]
[$make-symbol s ]
[$symbol-unique-string s ]
[$symbol-value s ]
[$symbol-string s ]
[$symbol-plist s ]
[$set-symbol-value! s ]
[$set-symbol-string! s ]
[$set-symbol-unique-string! s ]
[$set-symbol-plist! s ]
[$record-set! s ]
[$record-ref s ]
[$record-rtd s ]
[$record s ]
[$make-record s ]
[$record? s ]
[$record/rtd? s ]
[$make-port/input s ]
[$make-port/output s ]
[$make-port/both s ]
[$port-handler s ]
[$port-input-buffer s ]
[$port-input-index s ]
[$port-input-size s ]
[$port-output-buffer s ]
[$port-output-index s ]
[$port-output-size s ]
[$set-port-input-index! s ]
[$set-port-input-size! s ]
[$set-port-output-index! s ]
[$set-port-output-size! s ]
; [$make-input-port s ]
; [$make-output-port s ]
; [$make-input/output-port s ]
[$flush-output-port s ]
[$reset-input-port! s ]
[$close-input-port s ]
[$close-output-port s ]
[$write-char s ]
[$read-char s ]
[$peek-char s ]
[$unread-char s ]
[$closure-code s ]
[$code? s ]
[$code->closure s ]
[$code-reloc-vector s ]
[$code-freevars s ]
[$code-size s ]
[$code-ref s ]
[$code-set! s ]
[$make-tcbucket s ]
[$tcbucket-key s ]
[$tcbucket-val s ]
[$tcbucket-next s ]
[$set-tcbucket-val! s ]
[$set-tcbucket-next! s ]
[$set-tcbucket-tconc! s ]
; (ikarus system $pairs)
[$car $pairs]
[$cdr $pairs]
[$set-car! $pairs]
[$set-cdr! $pairs]
; (ikarus system $lists)
[$memq $lists]
[$memv $lists]
; (ikarus system $chars)
[$char? $chars]
[$char= $chars]
[$char< $chars]
[$char> $chars]
[$char<= $chars]
[$char>= $chars]
[$char->fixnum $chars]
[$fixnum->char $chars]
; (ikarus system $strings)
[$make-string $strings]
[$string-ref $strings]
[$string-set! $strings]
[$string-length $strings]
; (ikarus system $vectors)
[$make-vector $vectors]
[$vector-length $vectors]
[$vector-ref $vectors]
[$vector-set! $vectors]
; (ikarus system $fx)
[$fxzero? $fx]
[$fxadd1 $fx]
[$fxsub1 $fx]
[$fx>= $fx]
[$fx<= $fx]
[$fx> $fx]
[$fx< $fx]
[$fx= $fx]
[$fxsll $fx]
[$fxsra $fx]
[$fxquotient $fx]
[$fxmodulo $fx]
[$fxlogxor $fx]
[$fxlogor $fx]
[$fxlognot $fx]
[$fxlogand $fx]
[$fx+ $fx]
[$fx* $fx]
[$fx- $fx]
; (ikarus system $symbols)
[$make-symbol $symbols]
[$symbol-unique-string $symbols]
[$symbol-value $symbols]
[$symbol-string $symbols]
[$symbol-plist $symbols]
[$set-symbol-value! $symbols]
[$set-symbol-string! $symbols]
[$set-symbol-unique-string! $symbols]
[$set-symbol-plist! $symbols]
; (ikarus system $records)
[base-rtd $records]
[$record-set! $records]
[$record-ref $records]
[$record-rtd $records]
[$record $records]
[$make-record $records]
[$record? $records]
[$record/rtd? $records]
; (ikarus system $ports)
[$make-port/input $ports]
[$make-port/output $ports]
[$make-port/both $ports]
[$port-handler $ports]
[$port-input-buffer $ports]
[$port-input-index $ports]
[$port-input-size $ports]
[$port-output-buffer $ports]
[$port-output-index $ports]
[$port-output-size $ports]
[$set-port-input-index! $ports]
[$set-port-input-size! $ports]
[$set-port-output-index! $ports]
[$set-port-output-size! $ports]
; (ikarus system $codes)
[$closure-code $codes]
[$code? $codes]
[$code->closure $codes]
[$code-reloc-vector $codes]
[$code-freevars $codes]
[$code-size $codes]
[$code-ref $codes]
[$code-set! $codes]
; (ikarus system $tcbuckets)
[$make-tcbucket $tcbuckets]
[$tcbucket-key $tcbuckets]
[$tcbucket-val $tcbuckets]
[$tcbucket-next $tcbuckets]
[$set-tcbucket-val! $tcbuckets]
[$set-tcbucket-next! $tcbuckets]
[$set-tcbucket-tconc! $tcbuckets]
; (ikarus system $io)
[$flush-output-port $io]
[$reset-input-port! $io]
[$close-input-port $io]
[$close-output-port $io]
[$write-char $io]
[$read-char $io]
[$peek-char $io]
[$unread-char $io]
; (ikarus system)
[$forward-ptr? s ]
[$unbound-object? s ]
[$make-call-with-values-procedure s ]
@ -538,14 +566,19 @@
[collect s]
[do-stack-overflow s]
[syntax-dispatch s]
[base-rtd s i]
))
(define (verify-procedures-map)
(for-each
(lambda (x)
(for-each
(lambda (x)
(unless (assq x library-legend)
(error 'verify "~s is not in the libraries list" x)))
(cdr x)))
ikarus-procedures-map))
(define scheme-env-junk
'([define define-label (define)]
@ -1093,6 +1126,7 @@
[env '()])
(for-each
(lambda (file)
(printf "expanding ~s\n" file)
(load file
(lambda (x)
; (pretty-print x)
@ -1111,6 +1145,8 @@
(reverse (list* (car code*) code (cdr code*)))
export-locs)))))
(verify-procedures-map)
(printf "expanding ...\n")
(let-values ([(core* locs) (expand-all scheme-library-files)])