1171 lines
57 KiB
Scheme
Executable File
1171 lines
57 KiB
Scheme
Executable File
#!/usr/bin/env ikarus -b ikarus.boot --script
|
|
|
|
(library (ikarus makefile)
|
|
(export)
|
|
(import (ikarus))
|
|
|
|
(define scheme-library-files
|
|
;;; Listed in the order in which they're loaded.
|
|
;;;
|
|
;;; Loading of the boot file may segfault if a library is
|
|
;;; loaded before its dependencies are loaded first.
|
|
;;;
|
|
;;; reason is that the base libraries are not a hierarchy of
|
|
;;; dependencies but rather an eco system in which every
|
|
;;; part depends on the other.
|
|
;;;
|
|
;;; For example, the printer may call error if it finds
|
|
;;; an error (e.g. "not an output port"), while the error
|
|
;;; procedure may call the printer to display the message.
|
|
;;; This works fine as long as error does not itself cause
|
|
;;; an error (which may lead to the infamous Error: Error:
|
|
;;; Error: Error: Error: Error: Error: Error: Error: ...).
|
|
;;;
|
|
'("ikarus.singular-objects.ss"
|
|
"ikarus.handlers.ss"
|
|
"ikarus.multiple-values.ss"
|
|
"ikarus.control.ss"
|
|
"ikarus.collect.ss"
|
|
"ikarus.void.ss"
|
|
"ikarus.apply.ss"
|
|
"ikarus.predicates.ss"
|
|
"ikarus.pairs.ss"
|
|
"ikarus.lists.ss"
|
|
"ikarus.fixnums.ss"
|
|
"ikarus.chars.ss"
|
|
"ikarus.records.ss"
|
|
"ikarus.strings.ss"
|
|
"ikarus.date-string.ss"
|
|
"ikarus.symbols.ss"
|
|
"ikarus.vectors.ss"
|
|
"ikarus.numerics.ss"
|
|
"ikarus.guardians.ss"
|
|
"ikarus.command-line.ss"
|
|
"ikarus.io-ports.ss"
|
|
"ikarus.io-primitives.unsafe.ss"
|
|
"ikarus.io-primitives.ss"
|
|
"ikarus.io.input-files.ss"
|
|
"ikarus.io.output-files.ss"
|
|
"ikarus.io.output-strings.ss"
|
|
"ikarus.hash-tables.ss"
|
|
"ikarus.writer.ss"
|
|
"ikarus.reader.ss"
|
|
"ikarus.code-objects.ss"
|
|
"ikarus.trace.ss"
|
|
"ikarus.intel-assembler.ss"
|
|
"ikarus.fasl.ss"
|
|
"ikarus.compiler.ss"
|
|
"ikarus.syntax.ss"
|
|
"ikarus.pretty-print.ss"
|
|
"ikarus.cafe.ss"
|
|
"ikarus.posix.ss"
|
|
"ikarus.timer.ss"
|
|
"ikarus.library-manager.ss"
|
|
"libtoplevel.ss"))
|
|
|
|
(define ikarus-system-macros
|
|
'([define (define)]
|
|
[define-syntax (define-syntax)]
|
|
[module (module)]
|
|
[begin (begin)]
|
|
[set! (set!)]
|
|
[foreign-call (core-macro . foreign-call)]
|
|
[quote (core-macro . quote)]
|
|
[syntax-case (core-macro . syntax-case)]
|
|
[syntax (core-macro . syntax)]
|
|
[lambda (core-macro . lambda)]
|
|
[case-lambda (core-macro . case-lambda)]
|
|
[type-descriptor (core-macro . type-descriptor)]
|
|
[letrec (core-macro . letrec)]
|
|
[if (core-macro . if)]
|
|
[when (core-macro . when)]
|
|
[unless (core-macro . unless)]
|
|
[parameterize (core-macro . parameterize)]
|
|
[case (core-macro . case)]
|
|
[let-values (core-macro . let-values)]
|
|
[define-record (macro . define-record)]
|
|
[include (macro . include)]
|
|
[syntax-rules (macro . syntax-rules)]
|
|
[quasiquote (macro . quasiquote)]
|
|
[with-syntax (macro . with-syntax)]
|
|
[let (macro . let)]
|
|
[let* (macro . let*)]
|
|
[cond (macro . cond)]
|
|
[and (macro . and)]
|
|
[or (macro . or)]))
|
|
|
|
(define library-legend
|
|
'([s (ikarus system)]
|
|
[u (ikarus system unsafe)]
|
|
[i (ikarus)]
|
|
[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)]
|
|
[$arg-list (ikarus system $arg-list)]
|
|
[$stack (ikarus system $stack)]
|
|
;[$lists (ikarus system $lists)]
|
|
;[$lists (ikarus system $lists)]
|
|
))
|
|
|
|
(define ikarus-macros-map
|
|
'([define s i r]
|
|
[define-syntax s i r]
|
|
[module s i ]
|
|
[begin s i r]
|
|
[set! s i r]
|
|
[foreign-call s i r]
|
|
[quote s i r]
|
|
[syntax-case s i r]
|
|
[syntax s i r]
|
|
[lambda s i r]
|
|
[case-lambda s i r]
|
|
[type-descriptor s i ]
|
|
[letrec s i r]
|
|
[if s i r]
|
|
[when s i r]
|
|
[unless s i r]
|
|
[parameterize s i ]
|
|
[case s i r]
|
|
[let-values s i r]
|
|
[define-record s i r]
|
|
[include s i r]
|
|
[syntax-rules s i r]
|
|
[quasiquote s i r]
|
|
[with-syntax s i r]
|
|
[let s i r]
|
|
[let* s i r]
|
|
[cond s i r]
|
|
[and s i r]
|
|
[or s i r]))
|
|
|
|
(define ikarus-procedures-map
|
|
'([void s i]
|
|
[not s i]
|
|
[boolean? s i]
|
|
[null? s i]
|
|
[procedure? s i]
|
|
[eof-object? s i]
|
|
[eof-object s i]
|
|
[eq? s i]
|
|
[eqv? s i]
|
|
[equal? s i]
|
|
[cons s i]
|
|
[pair? s i]
|
|
[car s i]
|
|
[cdr s i]
|
|
[set-car! s i]
|
|
[set-cdr! s i]
|
|
[caar s i]
|
|
[cdar s i]
|
|
[cadr s i]
|
|
[cddr s i]
|
|
[caaar s i]
|
|
[cdaar s i]
|
|
[cadar s i]
|
|
[cddar s i]
|
|
[caadr s i]
|
|
[cdadr s i]
|
|
[caddr s i]
|
|
[cdddr s i]
|
|
[caaaar s i]
|
|
[cdaaar s i]
|
|
[cadaar s i]
|
|
[cddaar s i]
|
|
[caadar s i]
|
|
[cdadar s i]
|
|
[caddar s i]
|
|
[cdddar s i]
|
|
[caaadr s i]
|
|
[cdaadr s i]
|
|
[cadadr s i]
|
|
[cddadr s i]
|
|
[caaddr s i]
|
|
[cdaddr s i]
|
|
[cadddr s i]
|
|
[cddddr s i]
|
|
[list s i]
|
|
[list-ref s i]
|
|
[make-list s i]
|
|
[list* s i]
|
|
[list? s i]
|
|
[append s i]
|
|
[last-pair s i]
|
|
[reverse s i]
|
|
[length s i]
|
|
[assq s i]
|
|
[assv s i]
|
|
[assoc s i]
|
|
[memq s i]
|
|
[memv s i]
|
|
[member s i]
|
|
[bwp-object? s i]
|
|
[weak-cons s i]
|
|
[weak-pair? s i]
|
|
[char? s i]
|
|
[char=? s i]
|
|
[char<? s i]
|
|
[char>? s i]
|
|
[char<=? s i]
|
|
[char>=? s i]
|
|
[integer->char s i]
|
|
[char->integer s i]
|
|
[char-whitespace? s i]
|
|
[string? s i]
|
|
[string s i]
|
|
[make-string s i]
|
|
[string-ref s i]
|
|
[string-set! s i]
|
|
[string-length s i]
|
|
[string=? s i]
|
|
[substring s i]
|
|
[string-append s i]
|
|
[string->list s i]
|
|
[list->string s i]
|
|
[uuid s i]
|
|
[date-string s i]
|
|
[vector s i]
|
|
[make-vector s i]
|
|
[vector-ref s i]
|
|
[vector-set! s i]
|
|
[vector? s i]
|
|
[vector-length s i]
|
|
[list->vector s i]
|
|
[vector->list s i]
|
|
[for-each s i]
|
|
[map s i]
|
|
[andmap s i]
|
|
[ormap s i]
|
|
[fixnum? s i]
|
|
[fx< s i]
|
|
[fx<= s i]
|
|
[fx> s i]
|
|
[fx>= s i]
|
|
[fx= s i]
|
|
[fx- s i]
|
|
[fx+ s i]
|
|
[fx* s i]
|
|
[fxzero? s i]
|
|
[fxadd1 s i]
|
|
[fxsub1 s i]
|
|
[fxquotient s i]
|
|
[fxremainder s i]
|
|
[fxmodulo s i]
|
|
[fxsll s i]
|
|
[fxsra s i]
|
|
[fxlogand s i]
|
|
[fxlogxor s i]
|
|
[fxlogor s i]
|
|
[fxlognot s i]
|
|
[fixnum->string s i]
|
|
[string->flonum s i]
|
|
[- s i]
|
|
[= s i]
|
|
[< s i]
|
|
[> s i]
|
|
[<= s i]
|
|
[>= s i]
|
|
[* s i]
|
|
[+ s i]
|
|
[add1 s i]
|
|
[sub1 s i]
|
|
[number? s i]
|
|
[bignum? s i]
|
|
[integer? s i]
|
|
[flonum? s i]
|
|
[quotient s i]
|
|
[remainder s i]
|
|
[quotient+remainder s i]
|
|
[number->string s i]
|
|
[string->number s i]
|
|
[flonum->string s i]
|
|
[symbol? s i]
|
|
[gensym? s i]
|
|
[gensym s i]
|
|
[getprop s i]
|
|
[putprop s i]
|
|
[remprop s i]
|
|
[property-list s i]
|
|
[string->symbol s i]
|
|
[symbol->string s i]
|
|
[gensym->unique-string s i]
|
|
[top-level-bound? s ]
|
|
[top-level-value s ]
|
|
[set-top-level-value! s ]
|
|
[make-guardian s i]
|
|
[make-input-port s i]
|
|
[make-output-port s i]
|
|
[make-input/output-port s i]
|
|
[port-output-index s i]
|
|
[port-output-size s i]
|
|
[port-output-buffer s i]
|
|
[set-port-output-index! s i]
|
|
[set-port-output-size! s i]
|
|
[port-input-buffer s i]
|
|
[port-input-index s i]
|
|
[port-input-size s i]
|
|
[set-port-input-index! s i]
|
|
[set-port-input-size! s i]
|
|
[*standard-input-port* s i]
|
|
[*standard-output-port* s i]
|
|
[*standard-error-port* s i]
|
|
[*current-input-port* s i]
|
|
[*current-output-port* s i]
|
|
[output-port? s i]
|
|
[input-port? s i]
|
|
[port? s i]
|
|
[port-name s i]
|
|
[input-port-name s i]
|
|
[output-port-name s i]
|
|
[open-input-file s i]
|
|
[with-input-from-file s i]
|
|
[with-output-to-file s i]
|
|
[open-output-file s i]
|
|
[open-output-string s i]
|
|
[get-output-string s i]
|
|
[close-input-port s i]
|
|
[close-output-port s i]
|
|
[console-input-port s i]
|
|
[console-output-port s i]
|
|
[current-input-port s i]
|
|
[current-output-port s i]
|
|
[standard-input-port s i]
|
|
[standard-output-port s i]
|
|
[standard-error-port s i]
|
|
[flush-output-port s i]
|
|
[reset-input-port! s i]
|
|
[display s i]
|
|
[write s i]
|
|
[write-char s i]
|
|
[read s i]
|
|
[read-char s i]
|
|
[read-token s i]
|
|
[peek-char s i]
|
|
[unread-char s i]
|
|
[newline s i]
|
|
[printf s i]
|
|
[format s i]
|
|
[pretty-print s i]
|
|
[comment-handler s i]
|
|
[print-gensym s i]
|
|
[gensym-count s i]
|
|
[gensym-prefix s i]
|
|
[make-hash-table s i]
|
|
[hash-table? s i]
|
|
[get-hash-table s i]
|
|
[put-hash-table! s i]
|
|
[make-parameter s i]
|
|
[apply s i]
|
|
[values s i]
|
|
[call-with-values s i]
|
|
[call/cc s i]
|
|
[call/cf s i]
|
|
[dynamic-wind s i]
|
|
[error s i]
|
|
[print-error s i]
|
|
[error-handler s i]
|
|
[interrupt-handler s i]
|
|
[exit s i]
|
|
[compile-core-expr-to-port s i]
|
|
[eval-core s i]
|
|
[load s i]
|
|
[assembler-output s i]
|
|
;[fasl-write s i]
|
|
[new-cafe s i]
|
|
[command-line-arguments s i]
|
|
[list*->code* s i]
|
|
[install-library s i]
|
|
[eval-top-level s i]
|
|
[current-primitive-locations s i]
|
|
[record? s i]
|
|
[make-record-type s i]
|
|
[record-type-descriptor s i]
|
|
[record-type-field-names s i]
|
|
[record-type-symbol s i]
|
|
[record-type-name s i]
|
|
[record-name s i]
|
|
[record-constructor s i]
|
|
[record-predicate s i]
|
|
[record-length s i]
|
|
[record-printer s i]
|
|
[record-ref s i]
|
|
[record-field-accessor s i]
|
|
[record-field-mutator s i]
|
|
[identifier? s i]
|
|
[syntax-error s i]
|
|
[generate-temporaries s i]
|
|
[free-identifier=? s i]
|
|
[boot-library-expand s i]
|
|
[code? s i]
|
|
[make-code s i]
|
|
[code-reloc-vector s i]
|
|
[set-code-reloc-vector! s i]
|
|
[code-size s i]
|
|
[code-freevars s i]
|
|
[code-ref s i]
|
|
[code-set! s i]
|
|
[immediate? s i]
|
|
[pointer-value s i]
|
|
[installed-libraries s i]
|
|
[library-subst/env s i]
|
|
[find-library-by-name s i]
|
|
[imported-label->binding s i]
|
|
[imported-loc->library s i]
|
|
[library-spec s i]
|
|
[current-library-collection s i]
|
|
[invoke-library s i]
|
|
; (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 $arg-list)
|
|
[$arg-list $arg-list]
|
|
; (ikarus system $stack)
|
|
[$$apply $stack]
|
|
[$fp-at-base $stack]
|
|
[$primitive-call/cc $stack]
|
|
[$frame->continuation $stack]
|
|
[$current-frame $stack]
|
|
[$seal-frame-and-call $stack]
|
|
[$make-call-with-values-procedure $stack]
|
|
[$make-values-procedure $stack]
|
|
; (ikarus system)
|
|
[$forward-ptr? s ]
|
|
[$unbound-object? s ]
|
|
[$interrupted? s ]
|
|
[$unset-interrupted! s ]
|
|
[$apply-nonprocedure-error-handler s]
|
|
[$incorrect-args-error-handler s]
|
|
[$multiple-values-error s]
|
|
[$debug s]
|
|
[$underflow-misaligned-error s]
|
|
[top-level-value-error s]
|
|
[car-error s]
|
|
[cdr-error s]
|
|
[fxadd1-error s]
|
|
[fxsub1-error s]
|
|
[cadr-error s]
|
|
[fx+-type-error s]
|
|
[fx+-types-error s]
|
|
[fx+-overflow-error s]
|
|
[$do-event s]
|
|
[do-overflow s]
|
|
[do-overflow-words s]
|
|
[do-vararg-overflow s]
|
|
[collect s]
|
|
[do-stack-overflow s]
|
|
[syntax-dispatch s]
|
|
))
|
|
|
|
(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)]
|
|
[define-syntax define-syntax-label (define-syntax)]
|
|
[module module-label (module)]
|
|
[begin begin-label (begin)]
|
|
[set! set!-label (set!)]
|
|
[define-record define-record-label (macro . define-record)]
|
|
[include include-label (macro . include)]
|
|
[syntax-rules syntax-rules-macro (macro . syntax-rules)]
|
|
[quasiquote quasiquote-macro (macro . quasiquote)]
|
|
[with-syntax with-syntax-label (macro . with-syntax)]
|
|
[let let-label (macro . let)]
|
|
[let* let*-label (macro . let*)]
|
|
[cond cond-label (macro . cond)]
|
|
[and and-label (macro . and)]
|
|
[or or-label (macro . or)]
|
|
[case case-label (core-macro . case)]
|
|
[foreign-call foreign-call-label (core-macro . foreign-call)]
|
|
[quote quote-label (core-macro . quote)]
|
|
[syntax-case syntax-case-label (core-macro . syntax-case)]
|
|
[syntax syntax-label (core-macro . syntax)]
|
|
[lambda lambda-label (core-macro . lambda)]
|
|
[case-lambda case-lambda-label (core-macro . case-lambda)]
|
|
[let-values let-values-label (core-macro . let-values)]
|
|
[type-descriptor type-descriptor-label (core-macro . type-descriptor)]
|
|
[letrec letrec-label (core-macro . letrec)]
|
|
[if if-label (core-macro . if)]
|
|
[when when-label (core-macro . when)]
|
|
[unless unless-label (core-macro . unless)]
|
|
[parameterize parameterize-label (core-macro . parameterize)]
|
|
;;; prims
|
|
[void void-label (core-prim . void)]
|
|
[not not-label (core-prim . not)]
|
|
[boolean? boolean-label (core-prim . boolean?)]
|
|
[null? null?-label (core-prim . null?)]
|
|
[procedure? procedure?-label (core-prim . procedure?)]
|
|
[eof-object? eof-object?-label (core-prim . eof-object?)]
|
|
[eof-object eof-object-label (core-prim . eof-object)]
|
|
;;; comparison
|
|
[eq? eq?-label (core-prim . eq?)]
|
|
[eqv? eqv?-label (core-prim . eqv?)]
|
|
[equal? equal?-label (core-prim . equal?)]
|
|
;;; pairs/lists
|
|
[cons cons-label (core-prim . cons)]
|
|
[pair? pair?-label (core-prim . pair?)]
|
|
[car car-label (core-prim . car)]
|
|
[cdr cdr-label (core-prim . cdr)]
|
|
[set-car! set-car!-label (core-prim . set-car!)]
|
|
[set-cdr! set-cdr!-label (core-prim . set-cdr!)]
|
|
[caar caar-label (core-prim . caar)]
|
|
[cdar cdar-label (core-prim . cdar)]
|
|
[cadr cadr-label (core-prim . cadr)]
|
|
[cddr cddr-label (core-prim . cddr)]
|
|
[caaar caaar-label (core-prim . caaar)]
|
|
[cdaar cdaar-label (core-prim . cdaar)]
|
|
[cadar cadar-label (core-prim . cadar)]
|
|
[cddar cddar-label (core-prim . cddar)]
|
|
[caadr caadr-label (core-prim . caadr)]
|
|
[cdadr cdadr-label (core-prim . cdadr)]
|
|
[caddr caddr-label (core-prim . caddr)]
|
|
[cdddr cdddr-label (core-prim . cdddr)]
|
|
[caaaar caaaar-label (core-prim . caaaar)]
|
|
[cdaaar cdaaar-label (core-prim . cdaaar)]
|
|
[cadaar cadaar-label (core-prim . cadaar)]
|
|
[cddaar cddaar-label (core-prim . cddaar)]
|
|
[caadar caadar-label (core-prim . caadar)]
|
|
[cdadar cdadar-label (core-prim . cdadar)]
|
|
[caddar caddar-label (core-prim . caddar)]
|
|
[cdddar cdddar-label (core-prim . cdddar)]
|
|
[caaadr caaadr-label (core-prim . caaadr)]
|
|
[cdaadr cdaadr-label (core-prim . cdaadr)]
|
|
[cadadr cadadr-label (core-prim . cadadr)]
|
|
[cddadr cddadr-label (core-prim . cddadr)]
|
|
[caaddr caaddr-label (core-prim . caaddr)]
|
|
[cdaddr cdaddr-label (core-prim . cdaddr)]
|
|
[cadddr cadddr-label (core-prim . cadddr)]
|
|
[cddddr cddddr-label (core-prim . cddddr)]
|
|
[list list-label (core-prim . list)]
|
|
[list-ref list-ref-label (core-prim . list-ref)]
|
|
[make-list make-list-label (core-prim . make-list)]
|
|
[list* list*-label (core-prim . list*)]
|
|
[list? list?-label (core-prim . list?)]
|
|
[append append-label (core-prim . append)]
|
|
[last-pair last-pair-label (core-prim . last-pair)]
|
|
[reverse reverse-label (core-prim . reverse)]
|
|
[length length-label (core-prim . length)]
|
|
[assq assq-label (core-prim . assq)]
|
|
[assv assv-label (core-prim . assv)]
|
|
[assoc assoc-label (core-prim . assoc)]
|
|
[memq memq-label (core-prim . memq)]
|
|
[memv memv-label (core-prim . memv)]
|
|
[member member-label (core-prim . member)]
|
|
[$car $car-label (core-prim . $car)]
|
|
[$cdr $cdr-label (core-prim . $cdr)]
|
|
[$set-car! $set-car!-label (core-prim . $set-car!)]
|
|
[$set-cdr! $set-cdr!-label (core-prim . $set-cdr!)]
|
|
[$memq $memq-label (core-prim . $memq)]
|
|
[$memv $memv-label (core-prim . $memv)]
|
|
;;; weak conses
|
|
[bwp-object? bwp-object?-label (core-prim . bwp-object?)]
|
|
[weak-cons weak-cons-label (core-prim . weak-cons)]
|
|
[weak-pair? weak-pair?-label (core-prim . weak-pair?)]
|
|
;;; chars
|
|
[char? char?-label (core-prim . char?)]
|
|
[char=? char=?-label (core-prim . char=?)]
|
|
[char<? char<?-label (core-prim . char<?)]
|
|
[char>? char>?-label (core-prim . char>?)]
|
|
[char<=? char<=?-label (core-prim . char<=?)]
|
|
[char>=? char>=?-label (core-prim . char>=?)]
|
|
[integer->char integer->char-label (core-prim . integer->char)]
|
|
[char->integer char->integer-label (core-prim . char->integer)]
|
|
[char-whitespace? char-whitespace?-label (core-prim . char-whitespace?)]
|
|
[$char? $char?-label (core-prim . $char?)]
|
|
[$char= $char=-label (core-prim . $char=)]
|
|
[$char< $char<-label (core-prim . $char<)]
|
|
[$char> $char>-label (core-prim . $char>)]
|
|
[$char<= $char<=-label (core-prim . $char<=)]
|
|
[$char>= $char>=-label (core-prim . $char>=)]
|
|
[$char->fixnum $char->fixnum-label (core-prim . $char->fixnum)]
|
|
[$fixnum->char $fixnum->char-label (core-prim . $fixnum->char)]
|
|
;;; strings
|
|
[string? string?-label (core-prim . string?)]
|
|
[string string-label (core-prim . string)]
|
|
[make-string make-string-label (core-prim . make-string)]
|
|
[string-ref string-ref-label (core-prim . string-ref)]
|
|
[string-set! string-set!-label (core-prim . string-set!)]
|
|
[string-length string-length-label (core-prim . string-length)]
|
|
[string=? string=?-label (core-prim . string=?)]
|
|
[substring substring-label (core-prim . substring)]
|
|
[string-append string-append-label (core-prim . string-append)]
|
|
[string->list string->list-label (core-prim . string->list)]
|
|
[list->string list->string-label (core-prim . list->string)]
|
|
[uuid uuid-label (core-prim . uuid)]
|
|
[date-string date-string-label (core-prim . date-string)]
|
|
[$make-string $make-string-label (core-prim . $make-string)]
|
|
[$string-ref $string-ref-label (core-prim . $string-ref)]
|
|
[$string-set! $string-set!-label (core-prim . $string-set!)]
|
|
[$string-length $string-length-label (core-prim . $string-length)]
|
|
;;; vectors
|
|
[vector vector-label (core-prim . vector)]
|
|
[make-vector make-vector-label (core-prim . make-vector)]
|
|
[vector-ref vector-ref-label (core-prim . vector-ref)]
|
|
[vector-set! vector-set!-label (core-prim . vector-set!)]
|
|
[vector? vector?-label (core-prim . vector?)]
|
|
[vector-length vector-length-label (core-prim . vector-length)]
|
|
[list->vector list->vector-label (core-prim . list->vector)]
|
|
[vector->list vector->list-label (core-prim . vector->list)]
|
|
[$make-vector $make-vector-label (core-prim . $make-vector)]
|
|
[$vector-length $vector-length-label (core-prim . $vector-length)]
|
|
[$vector-ref $vector-ref-label (core-prim . $vector-ref)]
|
|
[$vector-set! $vector-set!-label (core-prim . $vector-set!)]
|
|
;;; iterators
|
|
[for-each for-each-label (core-prim . for-each)]
|
|
[map map-label (core-prim . map)]
|
|
[andmap andmap-label (core-prim . andmap)]
|
|
[ormap ormap-label (core-prim . ormap)]
|
|
;;; fixnums
|
|
[fixnum? fixnum-label (core-prim . fixnum?)]
|
|
[fx< fx<-label (core-prim . fx<)]
|
|
[fx<= fx<=-label (core-prim . fx<=)]
|
|
[fx> fx>-label (core-prim . fx>)]
|
|
[fx>= fx>=-label (core-prim . fx>=)]
|
|
[fx= fx=-label (core-prim . fx=)]
|
|
[fx- fx--label (core-prim . fx-)]
|
|
[fx+ fx+-label (core-prim . fx+)]
|
|
[fx* fx*-label (core-prim . fx*)]
|
|
[fxzero? fxzero?-label (core-prim . fxzero?)]
|
|
[fxadd1 fxadd1-label (core-prim . fxadd1)]
|
|
[fxsub1 fxsub1-label (core-prim . fxsub1)]
|
|
[fxquotient fxquotient-label (core-prim . fxquotient)]
|
|
[fxremainder fxremainder-label (core-prim . fxremainder)]
|
|
[fxmodulo fxmodulo-label (core-prim . fxmodulo)]
|
|
[fxsll fxsll-label (core-prim . fxsll)]
|
|
[fxsra fxsra-label (core-prim . fxsra)]
|
|
[fxlogand fxlogand-label (core-prim . fxlogand)]
|
|
[fxlogxor fxlogxor-label (core-prim . fxlogxor)]
|
|
[fxlogor fxlogor-label (core-prim . fxlogor)]
|
|
[fxlognot fxlognot-label (core-prim . fxlognot)]
|
|
[fixnum->string fixnum->string-label (core-prim . fixnum->string)]
|
|
[$fxzero? $fxzero?-label (core-prim . $fxzero?)]
|
|
[$fxadd1 $fxadd1-label (core-prim . $fxadd1)]
|
|
[$fxsub1 $fxsub1-label (core-prim . $fxsub1)]
|
|
[$fx>= $fx>=-label (core-prim . $fx>=)]
|
|
[$fx<= $fx<=-label (core-prim . $fx<=)]
|
|
[$fx> $fx>-label (core-prim . $fx>)]
|
|
[$fx< $fx<-label (core-prim . $fx<)]
|
|
[$fx= $fx=-label (core-prim . $fx=)]
|
|
[$fxsll $fxsll-label (core-prim . $fxsll)]
|
|
[$fxsra $fxsra-label (core-prim . $fxsra)]
|
|
[$fxquotient $fxquotient-label (core-prim . $fxquotient)]
|
|
[$fxmodulo $fxmodulo-label (core-prim . $fxmodulo)]
|
|
[$fxlogxor $fxlogxor-label (core-prim . $fxlogxor)]
|
|
[$fxlogor $fxlogor-label (core-prim . $fxlogor)]
|
|
[$fxlognot $fxlognot-label (core-prim . $fxlognot)]
|
|
[$fxlogand $fxlogand-label (core-prim . $fxlogand)]
|
|
[$fx+ $fx+-label (core-prim . $fx+)]
|
|
[$fx* $fx*-label (core-prim . $fx*)]
|
|
[$fx- $fx--label (core-prim . $fx-)]
|
|
;;; flonum
|
|
[string->flonum string->flonum-label (core-prim . string->flonum)]
|
|
;;; generic arithmetic
|
|
[- minus-label (core-prim . -)]
|
|
[= =-label (core-prim . =)]
|
|
[< <-label (core-prim . <)]
|
|
[> >-label (core-prim . >)]
|
|
[<= <=-label (core-prim . <=)]
|
|
[>= >=-label (core-prim . >=)]
|
|
[* *-label (core-prim . *)]
|
|
[+ plus-label (core-prim . +)]
|
|
[add1 add1-label (core-prim . add1)]
|
|
[sub1 sub1-label (core-prim . sub1)]
|
|
[number? number?-label (core-prim . number?)]
|
|
[bignum? bignum?-label (core-prim . bignum?)]
|
|
[integer? integer?-label (core-prim . integer?)]
|
|
[flonum? flonum?-label (core-prim . flonum?)]
|
|
[quotient quotient-label (core-prim . quotient)]
|
|
[remainder remainder-label (core-prim . remainder)]
|
|
[quotient+remainder quotient+remainder-label (core-prim . quotient+remainder)]
|
|
[number->string number->string-label (core-prim . number->string)]
|
|
[string->number string->number-label (core-prim . string->number)]
|
|
;;; other numerics
|
|
[flonum->string flonum->string-label (core-prim . flonum->string)]
|
|
;;; symbols/gensyms
|
|
[symbol? symbol?-label (core-prim . symbol?)]
|
|
[gensym? gensym?-label (core-prim . gensym?)]
|
|
[gensym gensym-label (core-prim . gensym)]
|
|
[getprop getprop-label (core-prim . getprop)]
|
|
[putprop putprop-label (core-prim . putprop)]
|
|
[remprop remprop-label (core-prim . remprop)]
|
|
[property-list property-list-label (core-prim . property-list)]
|
|
[string->symbol string->symbol-label (core-prim . string->symbol)]
|
|
[symbol->string symbol->string-label (core-prim . symbol->string)]
|
|
[gensym->unique-string gensym->unique-string-label (core-prim . gensym->unique-string)]
|
|
[$make-symbol $make-symbol-label (core-prim . $make-symbol)]
|
|
[$symbol-unique-string $symbol-unique-string-label (core-prim . $symbol-unique-string)]
|
|
[$symbol-value $symbol-value-label (core-prim . $symbol-value)]
|
|
[$symbol-string $symbol-string-label (core-prim . $symbol-string)]
|
|
[$symbol-plist $symbol-plist-label (core-prim . $symbol-plist)]
|
|
[$set-symbol-value! $set-symbol-value!-label (core-prim . $set-symbol-value!)]
|
|
[$set-symbol-string! $set-symbol-string!-label (core-prim . $set-symbol-string!)]
|
|
[$set-symbol-unique-string! $set-symbol-unique-string!-label (core-prim . $set-symbol-unique-string!)]
|
|
[$set-symbol-plist! $set-symbol-plist!-label (core-prim . $set-symbol-plist!)]
|
|
;;; top-level
|
|
[top-level-bound? top-level-bound-label (core-prim . top-level-bound?)]
|
|
[top-level-value top-level-value-label (core-prim . top-level-value)]
|
|
[set-top-level-value! set-top-level-value!-label (core-prim . set-top-level-value!)]
|
|
;;; guardians
|
|
[make-guardian make-guardian-label (core-prim . make-guardian)]
|
|
;;; IO/low-level
|
|
[$make-port/input $make-port/input-label (core-prim . $make-port/input)]
|
|
[$make-port/output $make-port/output-label (core-prim . $make-port/output)]
|
|
[$make-port/both $make-port/both-label (core-prim . $make-port/both)]
|
|
[$port-handler $port-handler-label (core-prim . $port-handler)]
|
|
[$port-input-buffer $port-input-buffer-label (core-prim . $port-input-buffer)]
|
|
[$port-input-index $port-input-index-label (core-prim . $port-input-index)]
|
|
[$port-input-size $port-input-size-label (core-prim . $port-input-size)]
|
|
[$port-output-buffer $port-output-buffer-label (core-prim . $port-output-buffer)]
|
|
[$port-output-index $port-output-index-label (core-prim . $port-output-index)]
|
|
[$port-output-size $port-output-size-label (core-prim . $port-output-size)]
|
|
[$set-port-input-index! $set-port-input-index!-label (core-prim . $set-port-input-index!)]
|
|
[$set-port-input-size! $set-port-input-size!-label (core-prim . $set-port-input-size!)]
|
|
[$set-port-output-index! $set-port-output-index!-label (core-prim . $set-port-output-index!)]
|
|
[$set-port-output-size! $set-port-output-size!-label (core-prim . $set-port-output-size!)]
|
|
[make-input-port make-input-port-label (core-prim . make-input-port)]
|
|
[make-output-port make-output-port-label (core-prim . make-output-port)]
|
|
[make-input/output-port make-input/output-port-label (core-prim . make-input/output-port)]
|
|
[$make-input-port $make-input-port-label (core-prim . $make-input-port)]
|
|
[$make-output-port $make-output-port-label (core-prim . $make-output-port)]
|
|
[$make-input/output-port $make-input/output-port-label (core-prim . $make-input/output-port)]
|
|
[port-output-index port-output-index-label (core-prim . port-output-index)]
|
|
[port-output-size port-output-size-label (core-prim . port-output-size)]
|
|
[port-output-buffer port-output-buffer-label (core-prim . port-output-buffer)]
|
|
[set-port-output-index! set-port-output-index!-label (core-prim . set-port-output-index!)]
|
|
[set-port-output-size! set-port-output-size!-label (core-prim . set-port-output-size!)]
|
|
[port-input-buffer port-input-buffer-label (core-prim . port-input-buffer)]
|
|
[port-input-index port-input-index-label (core-prim . port-input-index)]
|
|
[port-input-size port-input-size-label (core-prim . port-input-size)]
|
|
[set-port-input-index! set-port-input-index!-label (core-prim . set-port-input-index!)]
|
|
[set-port-input-size! set-port-input-size!-label (core-prim . set-port-input-size!)]
|
|
[*standard-input-port* *standard-input-port*-label (core-prim . *standard-input-port*)]
|
|
[*standard-output-port* *standard-output-port*-label (core-prim . *standard-output-port*)]
|
|
[*standard-error-port* *standard-error-port*-label (core-prim . *standard-error-port*)]
|
|
[*current-input-port* *current-input-port*-label (core-prim . *current-input-port*)]
|
|
[*current-output-port* *current-output-port*-label (core-prim . *current-output-port*)]
|
|
;;; IO/ports
|
|
[output-port? output-port?-label (core-prim . output-port?)]
|
|
[input-port? input-port?-label (core-prim . input-port?)]
|
|
[port? port?-label (core-prim . port?)]
|
|
[port-name port-name-label (core-prim . port-name)]
|
|
[input-port-name input-port-name-label (core-prim . input-port-name)]
|
|
[output-port-name output-port-name-label (core-prim . output-port-name)]
|
|
[open-input-file open-input-file-label (core-prim . open-input-file)]
|
|
[with-input-from-file with-input-from-file-label (core-prim . with-input-from-file)]
|
|
[with-output-to-file with-output-to-file-label (core-prim . with-output-to-file)]
|
|
[open-output-file open-output-file-label (core-prim . open-output-file)]
|
|
[open-output-string open-output-string-label (core-prim . open-output-string)]
|
|
[get-output-string get-output-string-label (core-prim . get-output-string)]
|
|
[close-input-port close-input-port-label (core-prim . close-input-port)]
|
|
[close-output-port close-output-port-label (core-prim . close-output-port)]
|
|
[console-input-port console-input-port-label (core-prim . console-input-port)]
|
|
[console-output-port console-output-port-label (core-prim . console-output-port)]
|
|
[current-input-port current-input-port-label (core-prim . current-input-port)]
|
|
[current-output-port current-output-port-label (core-prim . current-output-port)]
|
|
[standard-input-port standard-input-port-label (core-prim . standard-input-port)]
|
|
[standard-output-port standard-output-port-label (core-prim . standard-output-port)]
|
|
[standard-error-port standard-error-port-label (core-prim . standard-error-port)]
|
|
[flush-output-port flush-output-port-label (core-prim . flush-output-port)]
|
|
[reset-input-port! reset-input-port!-label (core-prim . reset-input-port!)]
|
|
[$flush-output-port $flush-output-port-label (core-prim . $flush-output-port)]
|
|
[$reset-input-port! $reset-input-port!-label (core-prim . $reset-input-port!)]
|
|
[$close-input-port $close-input-port-label (core-prim . $close-input-port)]
|
|
[$close-output-port $close-output-port-label (core-prim . $close-output-port)]
|
|
;;; IO/high-level
|
|
[display display-label (core-prim . display)]
|
|
[write write-label (core-prim . write)]
|
|
[write-char write-char-label (core-prim . write-char)]
|
|
[read read-label (core-prim . read)]
|
|
[read-char read-char-label (core-prim . read-char)]
|
|
[read-token read-token-label (core-prim . read-token)]
|
|
[peek-char peek-char-label (core-prim . peek-char)]
|
|
[unread-char unread-char-label (core-prim . unread-char)]
|
|
[newline newline-label (core-prim . newline)]
|
|
[printf printf-label (core-prim . printf)]
|
|
[format format-label (core-prim . format)]
|
|
[pretty-print pretty-print-label (core-prim . pretty-print)]
|
|
[comment-handler comment-handler-label (core-prim . comment-handler)]
|
|
[print-gensym print-gensym-label (core-prim . print-gensym)]
|
|
[gensym-count gensym-count-label (core-prim . gensym-count)]
|
|
[gensym-prefix gensym-prefix-label (core-prim . gensym-prefix)]
|
|
[$write-char $write-char-label (core-prim . $write-char)]
|
|
[$read-char $read-char-label (core-prim . $read-char)]
|
|
[$peek-char $peek-char-label (core-prim . $peek-char)]
|
|
[$unread-char $unread-char-label (core-prim . $unread-char)]
|
|
;;; hash tables
|
|
[make-hash-table make-hash-table-label (core-prim . make-hash-table)]
|
|
[hash-table? hash-table?-label (core-prim . hash-table?)]
|
|
[get-hash-table get-hash-table-label (core-prim . get-hash-table)]
|
|
[put-hash-table! put-hash-table!-label (core-prim . put-hash-table!)]
|
|
;;; evaluation / control
|
|
[make-parameter make-parameter-label (core-prim . make-parameter)]
|
|
[apply apply-label (core-prim . apply)]
|
|
[values values-label (core-prim . values)]
|
|
[call-with-values cwv-label (core-prim . call-with-values)]
|
|
[call/cc call/cc-label (core-prim . call/cc)]
|
|
[call/cf call/cf-label (core-prim . call/cf)]
|
|
[dynamic-wind dynamic-wind-label (core-prim . dynamic-wind)]
|
|
[error error-label (core-prim . error)]
|
|
[print-error print-error-label (core-prim . print-error)]
|
|
[error-handler error-handler-label (core-prim . error-handler)]
|
|
[interrupt-handler interrupt-handler-label (core-prim . interrupt-handler)]
|
|
[exit exit-label (core-prim . exit)]
|
|
[compile-core-expr-to-port compile-core-expr-to-port-label (core-prim . compile-core-expr-to-port)]
|
|
[eval-core eval-core-label (core-prim . eval-core)]
|
|
[load load-label (core-prim . load)]
|
|
[assembler-output assembler-output-label (core-prim . assembler-output)]
|
|
;[fasl-write fasl-write-label (core-prim . fasl-write)]
|
|
[new-cafe new-cafe-label (core-prim . new-cafe)]
|
|
[command-line-arguments command-line-arguments-label (core-prim . command-line-arguments)]
|
|
[list*->code* list*->code*-label (core-prim . list*->code*)]
|
|
[install-library install-library-label (core-prim . install-library)]
|
|
[eval-top-level eval-top-level-label (core-prim . eval-top-level)]
|
|
[current-primitive-locations current-primitive-locations-label (core-prim . current-primitive-locations)]
|
|
;;; record/mid-level
|
|
[record? record?-label (core-prim . record?)]
|
|
[make-record-type make-record-type-label (core-prim . make-record-type)]
|
|
[record-type-descriptor record-type-descriptor-label (core-prim . record-type-descriptor)]
|
|
[record-type-field-names record-type-field-names-label (core-prim . record-type-field-names)]
|
|
[record-type-symbol record-type-symbol-label (core-prim . record-type-symbol)]
|
|
[record-type-name record-type-name-label (core-prim . record-type-name)]
|
|
[record-name record-name-label (core-prim . record-name)]
|
|
[record-constructor record-constructor-label (core-prim . record-constructor)]
|
|
[record-predicate record-predicate-labe (core-prim . record-predicate)]
|
|
[record-length record-length-label (core-prim . record-length)]
|
|
[record-printer record-printer-label (core-prim . record-printer)]
|
|
[record-ref record-ref-label (core-prim . record-ref)]
|
|
[record-field-accessor record-field-accessor-label (core-prim . record-field-accessor)]
|
|
[record-field-mutator record-field-mutator-label (core-prim . record-field-mutator)]
|
|
;;; records/low-level
|
|
[$record-set! $record-set!-label (core-prim . $record-set!)]
|
|
[$record-ref $record-ref-label (core-prim . $record-ref)]
|
|
[$record-rtd $record-rtd-label (core-prim . $record-rtd)]
|
|
[$record $record-label (core-prim . $record)]
|
|
[$make-record $make-record-label (core-prim . $make-record)]
|
|
[$record? $record?-label (core-prim . $record?)]
|
|
[$record/rtd? $record/rtd?-label (core-prim . $record/rtd?)]
|
|
;;; syntax-case
|
|
[identifier? identifier?-label (core-prim . identifier?)]
|
|
[syntax-error syntax-error-label (core-prim . syntax-error)]
|
|
[generate-temporaries generate-temporaries-label (core-prim . generate-temporaries)]
|
|
[free-identifier=? free-identifier=?-label (core-prim . free-identifier=?)]
|
|
[boot-library-expand boot-library-expand-label (core-prim . boot-library-expand)]
|
|
;;; codes
|
|
[$closure-code $closure-code-label (core-prim . $closure-code)]
|
|
[$code? $code?-label (core-prim . $code?)]
|
|
[$code->closure $code->closure-label (core-prim . $code->closure)]
|
|
[$code-reloc-vector $code-reloc-vector-label (core-prim . $code-reloc-vector)]
|
|
[$code-freevars $code-freevars-label (core-prim . $code-freevars)]
|
|
[$code-size $code-size-label (core-prim . $code-size)]
|
|
[$code-ref $code-ref-label (core-prim . $code-ref)]
|
|
[$code-set! $code-set!-label (core-prim . $code-set!)]
|
|
[code? code?-label (core-prim . code?)]
|
|
[make-code make-code-label (core-prim . make-code)]
|
|
[code-reloc-vector code-reloc-vector-label (core-prim . code-reloc-vector)]
|
|
[set-code-reloc-vector! set-code-reloc-vector!-label (core-prim . set-code-reloc-vector!)]
|
|
[code-size code-size-label (core-prim . code-size)]
|
|
[code-freevars code-freevars-label (core-prim . code-freevars)]
|
|
[code-ref code-ref-label (core-prim . code-ref)]
|
|
[code-set! code-set!-label (core-prim . code-set!)]
|
|
;;; tcbuckets
|
|
[$make-tcbucket $make-tcbucket-label (core-prim . $make-tcbucket)]
|
|
[$tcbucket-key $tcbucket-key-label (core-prim . $tcbucket-key)]
|
|
[$tcbucket-val $tcbucket-val-label (core-prim . $tcbucket-val)]
|
|
[$tcbucket-next $tcbucket-next-label (core-prim . $tcbucket-next)]
|
|
[$set-tcbucket-val! $set-tcbucket-val!-label (core-prim . $set-tcbucket-val!)]
|
|
[$set-tcbucket-next! $set-tcbucket-next!-label (core-prim . $set-tcbucket-next!)]
|
|
[$set-tcbucket-tconc! $set-tcbucket-tconc!-label (core-prim . $set-tcbucket-tconc!)]
|
|
;;; misc
|
|
[immediate? immediate?-label (core-prim . immediate?)]
|
|
[pointer-value pointer-value-label (core-prim . pointer-value)]
|
|
[$forward-ptr? $forward-ptr?-label (core-prim . $forward-ptr?)]
|
|
;;; junk that should go away
|
|
[$unbound-object? $unbound-object?-label (core-prim . $unbound-object?)]
|
|
[$make-call-with-values-procedure $make-cwv-procedure (core-prim . $make-call-with-values-procedure)]
|
|
[$make-values-procedure $make-values-procedure (core-prim . $make-values-procedure)]
|
|
[$$apply $$apply-label (core-prim . $$apply)]
|
|
[$arg-list $arg-list-label (core-prim . $arg-list)]
|
|
[$interrupted? $interrupted?-label (core-prim . $interrupted?)]
|
|
[$unset-interrupted! $unset-interrupted!-label (core-prim . $unset-interrupted!)]
|
|
[$fp-at-base $fp-at-base-label (core-prim . $fp-at-base)]
|
|
[$primitive-call/cc $primitive-call/cc-label (core-prim . $primitive-call/cc)]
|
|
[$frame->continuation $frame->continuation-label (core-prim . $frame->continuation)]
|
|
[$current-frame $current-frame-label (core-prim . $current-frame)]
|
|
[$seal-frame-and-call $seal-frame-and-call-label (core-prim . $seal-frame-and-call)]
|
|
[installed-libraries installed-libraries-label (core-prim . installed-libraries)]
|
|
[library-subst/env library-subst/env-label (core-prim . library-subst/env)]
|
|
[find-library-by-name find-library-by-name-label (core-prim . find-library-by-name)]
|
|
[imported-label->binding imported-label->binding-label (core-prim . imported-label->binding)]
|
|
[imported-loc->library imported-loc->library-label (core-prim . imported-loc->library)]
|
|
[library-spec library-spec-label (core-prim . library-spec)]
|
|
[current-library-collection current-library-collection-label (core-prim . current-library-collection)]
|
|
[invoke-library invoke-library-label (core-prim . invoke-library)]
|
|
))
|
|
|
|
|
|
(define (make-collection)
|
|
(let ([set '()])
|
|
(case-lambda
|
|
[() set]
|
|
[(x) (set! set (cons x set))])))
|
|
|
|
(define (make-system-data subst env)
|
|
(define who 'make-system-data)
|
|
(let ([export-subst (make-collection)]
|
|
[export-env (make-collection)]
|
|
[export-primlocs (make-collection)])
|
|
(for-each
|
|
(lambda (x)
|
|
(let ([name (car x)] [binding (cadr x)])
|
|
(let ([label (gensym)])
|
|
(export-subst (cons name label))
|
|
(export-env (cons label binding)))))
|
|
ikarus-system-macros)
|
|
(for-each
|
|
(lambda (x)
|
|
(cond
|
|
[(assq x (export-subst))
|
|
(error who "ambiguous export of ~s" x)]
|
|
[(assq x subst) =>
|
|
(lambda (p)
|
|
(let ([label (cdr p)])
|
|
(cond
|
|
[(assq label env) =>
|
|
(lambda (p)
|
|
(let ([binding (cdr p)])
|
|
(case (car binding)
|
|
[(global)
|
|
(export-subst (cons x label))
|
|
(export-env (cons label (cons 'core-prim x)))
|
|
(export-primlocs (cons x (cdr binding)))]
|
|
[else
|
|
(error #f "invalid binding ~s for ~s" p x)])))]
|
|
[else (error #f "cannot find binding for ~s" x)])))]
|
|
[(assq x scheme-env-junk) =>
|
|
(lambda (p)
|
|
(let ([name (car p)] [label (cadr p)] [binding (caddr p)])
|
|
(export-subst (cons name label))
|
|
(export-env (cons label binding))))]
|
|
[else (error 'make-system-data "cannot find export for ~s\n" x)]))
|
|
(map car ikarus-procedures-map))
|
|
(values (export-subst) (export-env) (export-primlocs))))
|
|
|
|
(define (get-export-subset key subst)
|
|
(let f ([ls subst])
|
|
(cond
|
|
[(null? ls) '()]
|
|
[else
|
|
(let ([x (car ls)])
|
|
(let ([name (car x)])
|
|
(cond
|
|
[(or (assq name ikarus-procedures-map)
|
|
(assq name ikarus-macros-map))
|
|
=>
|
|
(lambda (q)
|
|
(cond
|
|
[(memq key (cdr q))
|
|
(cons x (f (cdr ls)))]
|
|
[else (f (cdr ls))]))]
|
|
[else
|
|
;;; not going to any library?
|
|
(f (cdr ls))])))])))
|
|
|
|
(define (build-system-library export-subst export-env primlocs)
|
|
(define (build-library legend-entry)
|
|
(let ([key (car legend-entry)] [name (cadr legend-entry)])
|
|
(let ([id (gensym)]
|
|
[name name]
|
|
[version '()]
|
|
[import-libs '()]
|
|
[visit-libs '()]
|
|
[invoke-libs '()]
|
|
[subst (get-export-subset key export-subst)]
|
|
[env (if (equal? name '(ikarus system)) export-env '())])
|
|
`(install-library
|
|
',id ',name ',version ',import-libs ',visit-libs ',invoke-libs
|
|
',subst ',env void void))))
|
|
(let ([code `(library (ikarus primlocs)
|
|
(export) ;;; must be empty
|
|
(import (scheme))
|
|
(current-primitive-locations
|
|
(lambda (x)
|
|
(cond
|
|
[(assq x ',primlocs) => cdr]
|
|
[else #f])))
|
|
,@(map build-library library-legend))])
|
|
;(parameterize ([print-gensym #f])
|
|
; (pretty-print code))
|
|
(let-values ([(code empty-subst empty-env)
|
|
(boot-library-expand code)])
|
|
code)))
|
|
|
|
(define (expand-all files)
|
|
(let ([code* '()]
|
|
[subst '()]
|
|
[env '()])
|
|
(for-each
|
|
(lambda (file)
|
|
(printf "expanding ~s\n" file)
|
|
(load file
|
|
(lambda (x)
|
|
; (pretty-print x)
|
|
(let-values ([(code export-subst export-env)
|
|
(boot-library-expand x)])
|
|
(set! code* (cons code code*))
|
|
(set! subst (append export-subst subst))
|
|
(set! env (append export-env env))))))
|
|
files)
|
|
(printf "building system ...\n")
|
|
(let-values ([(export-subst export-env export-locs)
|
|
(make-system-data subst env)])
|
|
;(printf "export-subst=~s\n" export-locs)
|
|
(let ([code (build-system-library export-subst export-env export-locs)])
|
|
(values
|
|
(reverse (list* (car code*) code (cdr code*)))
|
|
export-locs)))))
|
|
|
|
(verify-procedures-map)
|
|
|
|
(printf "expanding ...\n")
|
|
|
|
(let-values ([(core* locs) (expand-all scheme-library-files)])
|
|
(printf "compiling ...\n")
|
|
(parameterize ([current-primitive-locations
|
|
(lambda (x)
|
|
(cond
|
|
[(assq x locs) => cdr]
|
|
[else #f]))])
|
|
(let ([p (open-output-file "ikarus.boot" 'replace)])
|
|
(for-each
|
|
(lambda (x) (compile-core-expr-to-port x p))
|
|
core*)
|
|
(close-output-port p))))
|
|
|
|
(printf "Happy Happy Joy Joy\n"))
|
|
|
|
(invoke (ikarus makefile))
|
|
|
|
;;; vim:syntax=scheme
|