* removed some junk from ikarus.syntax
This commit is contained in:
parent
085a0c14ed
commit
2eb451febe
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -15,17 +15,10 @@
|
|||
|
||||
(library (ikarus library-manager)
|
||||
(export imported-label->binding library-subst/env
|
||||
current-library-collection
|
||||
installed-libraries
|
||||
current-library-collection installed-libraries
|
||||
find-library-by-name imported-loc->library install-library
|
||||
library-spec invoke-library)
|
||||
(import (except (ikarus) imported-label->binding library-subst/env
|
||||
current-library-collection
|
||||
installed-libraries
|
||||
find-library-by-name imported-loc->library install-library
|
||||
library-spec invoke-library))
|
||||
|
||||
|
||||
(import (except (ikarus) current-library-collection))
|
||||
|
||||
(define (make-collection)
|
||||
(let ([set '()])
|
||||
|
|
|
@ -7,14 +7,6 @@
|
|||
(ikarus library-manager)
|
||||
(only (ikarus compiler) eval-core)
|
||||
(rename (except (ikarus) boot-library-expand syntax-error
|
||||
library-subst/env
|
||||
find-library-by-name
|
||||
imported-label->binding
|
||||
imported-loc->library
|
||||
library-spec
|
||||
current-library-collection
|
||||
invoke-library
|
||||
installed-libraries
|
||||
eval-top-level)
|
||||
(free-identifier=? sys:free-identifier=?)
|
||||
(identifier? sys:identifier?)
|
||||
|
|
|
@ -401,15 +401,15 @@
|
|||
[compile-core-expr-to-port $boot]
|
||||
[current-primitive-locations $boot]
|
||||
[boot-library-expand $boot]
|
||||
; (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]
|
||||
|
@ -418,17 +418,17 @@
|
|||
[$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]
|
||||
|
@ -448,7 +448,7 @@
|
|||
[$fx+ $fx]
|
||||
[$fx* $fx]
|
||||
[$fx- $fx]
|
||||
; (ikarus system $symbols)
|
||||
|
||||
[$make-symbol $symbols]
|
||||
[$symbol-unique-string $symbols]
|
||||
[$symbol-value $symbols]
|
||||
|
@ -459,7 +459,7 @@
|
|||
[$set-symbol-unique-string! $symbols]
|
||||
[$set-symbol-plist! $symbols]
|
||||
[$unbound-object? $symbols]
|
||||
; (ikarus system $records)
|
||||
|
||||
[base-rtd $records]
|
||||
[$record-set! $records]
|
||||
[$record-ref $records]
|
||||
|
@ -468,7 +468,7 @@
|
|||
[$make-record $records]
|
||||
[$record? $records]
|
||||
[$record/rtd? $records]
|
||||
; (ikarus system $ports)
|
||||
|
||||
[$make-port/input $ports]
|
||||
[$make-port/output $ports]
|
||||
[$make-port/both $ports]
|
||||
|
@ -483,7 +483,7 @@
|
|||
[$set-port-input-size! $ports]
|
||||
[$set-port-output-index! $ports]
|
||||
[$set-port-output-size! $ports]
|
||||
; (ikarus system $codes)
|
||||
|
||||
[$closure-code $codes]
|
||||
[$code->closure $codes]
|
||||
[$code-reloc-vector $codes]
|
||||
|
@ -491,7 +491,7 @@
|
|||
[$code-size $codes]
|
||||
[$code-ref $codes]
|
||||
[$code-set! $codes]
|
||||
; (ikarus system $tcbuckets)
|
||||
|
||||
[$make-tcbucket $tcbuckets]
|
||||
[$tcbucket-key $tcbuckets]
|
||||
[$tcbucket-val $tcbuckets]
|
||||
|
@ -499,7 +499,7 @@
|
|||
[$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]
|
||||
|
@ -508,9 +508,9 @@
|
|||
[$read-char $io]
|
||||
[$peek-char $io]
|
||||
[$unread-char $io]
|
||||
; (ikarus system $arg-list)
|
||||
|
||||
[$arg-list $arg-list]
|
||||
; (ikarus system $stack)
|
||||
|
||||
[$$apply $stack]
|
||||
[$fp-at-base $stack]
|
||||
[$primitive-call/cc $stack]
|
||||
|
@ -519,7 +519,7 @@
|
|||
[$seal-frame-and-call $stack]
|
||||
[$make-call-with-values-procedure $stack]
|
||||
[$make-values-procedure $stack]
|
||||
; (ikarus system $interrupts)
|
||||
|
||||
[$interrupted? $interrupts]
|
||||
[$unset-interrupted! $interrupts]
|
||||
;;; the following must be defined but they don't have
|
||||
|
@ -549,15 +549,15 @@
|
|||
[syntax-dispatch ]
|
||||
))
|
||||
|
||||
(define (verify-procedures-map)
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(define (verify-map)
|
||||
(define (f 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))
|
||||
(for-each f ikarus-procedures-map)
|
||||
(for-each f ikarus-macros-map))
|
||||
|
||||
(define (make-collection)
|
||||
(let ([set '()])
|
||||
|
@ -667,7 +667,7 @@
|
|||
[env '()])
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(printf "expanding ~s\n" file)
|
||||
;(printf "expanding ~s\n" file)
|
||||
(load file
|
||||
(lambda (x)
|
||||
(let-values ([(code export-subst export-env)
|
||||
|
@ -684,7 +684,7 @@
|
|||
(reverse (list* (car code*) code (cdr code*)))
|
||||
export-locs)))))
|
||||
|
||||
(verify-procedures-map)
|
||||
(verify-map)
|
||||
|
||||
(printf "expanding ...\n")
|
||||
|
||||
|
|
Loading…
Reference in New Issue