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) (export fasl-write)
(import (import
(only (scheme) $closure-code ) (only (scheme) $closure-code )
(ikarus system $records)
(except (ikarus) fasl-write)) (except (ikarus) fasl-write))
(define write-fixnum (define write-fixnum

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

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

9
src/ikarus.records.ss
View File

@ -9,15 +9,16 @@
record-name record-printer record-length record-ref record-set!) record-name record-printer record-length record-ref record-set!)
(import (import
(ikarus system $records)
(ikarus system $pairs)
(ikarus system $fx)
(except (ikarus) (except (ikarus)
make-record-type record-type-name record-type-symbol make-record-type record-type-name record-type-symbol
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) $record? $record-rtd $record-ref (only (scheme)
$record-set! $record $make-record $car $cdr $fxadd1
$fx< $fx= $fx+ $fx>=
set-top-level-value! top-level-value top-level-bound?)) 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) (library (ikarus singular-objects)
(export base-rtd eof-object) (export base-rtd eof-object)
(import (import
(rename (ikarus) (rename (ikarus system $records) (base-rtd sys:base-rtd))
(eof-object sys:eof-object) (rename (ikarus) (eof-object sys:eof-object)))
(base-rtd sys:base-rtd)))
(define (eof-object) (sys:eof-object)) (define (eof-object) (sys:eof-object))
(define (base-rtd) (sys:base-rtd))) (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=? (export string-length string-ref string-set! make-string string->list string=?
string-append substring string list->string uuid) string-append substring string list->string uuid)
(import (import
(ikarus system $strings)
(ikarus system $fx)
(ikarus system $chars)
(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) #;(only (scheme)
$fx+ $fxsub1 $fxadd1 $char= $car $cdr $fx+ $fxsub1 $fxadd1 $char= $car $cdr
$fxzero? $fx= $fx<= $fx< $fx>= $fx- $fxzero? $fx= $fx<= $fx< $fx>= $fx-
$string-length $string-ref $string-length $string-ref

246
src/makefile.ss
View File

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