#!/usr/bin/env ikarus -b ikarus.boot --script (library (ikarus makefile) (export) (import (scheme)) (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.handlers.ss" "ikarus.multiple-values.ss" "ikarus.predicates.ss" "ikarus.fixnums.ss" "ikarus.control.ss" "ikarus.collect.ss" "ikarus.records.ss" "ikarus.cxr.ss" "ikarus.strings.ss" "ikarus.numerics.ss" "ikarus.guardians.ss" "ikarus.core.ss" "libchezio.ss" "libhash.ss" "libwriter.ss" "libtokenizer.ss" "libassembler.ss" "libintelasm.ss" "libfasl.ss" "libtrace.ss" "libcompile.ss" "libsyntax.ss" "libpp.ss" "libcafe.ss" "libposix.ss" "libtimers.ss" "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)] [i (ikarus)] [r (r6rs)])) (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] [$car s ] [$cdr s ] [$set-car! s ] [$set-cdr! s ] [$memq s ] [$memv s ] [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] [integer->char s i] [char->integer s i] [char-whitespace? s i] [$char? s ] [$char= s ] [$char< s ] [$char> s ] [$char<= s ] [$char>= s ] [$char->fixnum s ] [$fixnum->char s ] [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] [$make-string s i] [$string-ref s ] [$string-set! s ] [$string-length s ] [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] [$make-vector s ] [$vector-length s ] [$vector-ref s ] [$vector-set! s ] [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] [$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 ] [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] [$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 ] [top-level-bound? s ] [top-level-value s ] [set-top-level-value! s ] [make-guardian s i] [$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 i] [make-output-port s i] [make-input/output-port s i] [$make-input-port s ] [$make-output-port s ] [$make-input/output-port s ] [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] [$flush-output-port s ] [$reset-input-port! s ] [$close-input-port s ] [$close-output-port s ] [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] [$write-char s ] [$read-char s ] [$peek-char s ] [$unread-char s ] [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] [$base-rtd s ] [$record-set! s ] [$record-ref s ] [$record-rtd s ] [$record s ] [$make-record s ] [$record? s ] [$record/rtd? s ] [identifier? s i] [syntax-error s i] [generate-temporaries s i] [free-identifier=? s i] [boot-library-expand s i] [$closure-code s ] [$code? s ] [$code->closure s ] [$code-reloc-vector s ] [$code-freevars s ] [$code-size s ] [$code-ref s ] [$code-set! s ] [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] [$make-tcbucket s ] [$tcbucket-key s ] [$tcbucket-val s ] [$tcbucket-next s ] [$set-tcbucket-val! s ] [$set-tcbucket-next! s ] [$set-tcbucket-tconc! s ] [immediate? s i] [pointer-value s i] [$forward-ptr? s ] [$unbound-object? s ] [$make-call-with-values-procedure s ] [$make-values-procedure s ] [$$apply s ] [$arg-list s ] [$interrupted? s ] [$unset-interrupted! s ] [$fp-at-base s ] [$primitive-call/cc s ] [$frame->continuation s ] [$current-frame s ] [$seal-frame-and-call s ] [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] [$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] )) (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>=?)] [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 [$base-rtd $base-rtd-label (core-prim . $base-rtd)] [$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)] [primitive-set! primitive-set!-label (core-prim . primitive-set!)] [$$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) (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))))) (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))