ikarus/scheme/makefile.ss

1461 lines
73 KiB
Scheme
Executable File

#!/usr/bin/env ikarus -b ikarus.boot --r6rs-script
(import (except (ikarus) assembler-output)
(ikarus compiler)
(except (psyntax system $bootstrap)
eval-core
current-primitive-locations
compile-core-expr-to-port))
(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.apply.ss"
"ikarus.predicates.ss"
"ikarus.pairs.ss"
"ikarus.lists.ss"
"ikarus.fixnums.ss"
"ikarus.chars.ss"
"ikarus.structs.ss"
"ikarus.records.procedural.ss"
"ikarus.strings.ss"
"ikarus.transcoders.ss"
"ikarus.date-string.ss"
"ikarus.symbols.ss"
"ikarus.vectors.ss"
"ikarus.numerics.ss"
"ikarus.guardians.ss"
"ikarus.command-line.ss"
"ikarus.codecs.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.input-strings.ss"
"ikarus.io.output-strings.ss"
"ikarus.hash-tables.ss"
"ikarus.unicode-data.ss"
"ikarus.writer.ss"
"ikarus.reader.ss"
"ikarus.code-objects.ss"
"ikarus.intel-assembler.ss"
"ikarus.trace.ss"
"ikarus.fasl.write.ss"
"ikarus.fasl.ss"
"ikarus.compiler.ss"
"psyntax.compat.ss"
"psyntax.library-manager.ss"
"psyntax.internal.ss"
"psyntax.config.ss"
"psyntax.builders.ss"
"psyntax.expander.ss"
"ikarus.load.ss"
"ikarus.pretty-print.ss"
"ikarus.cafe.ss"
"ikarus.posix.ss"
"ikarus.timer.ss"
"ikarus.bytevectors.ss"
"ikarus.sort.ss"
"ikarus.promises.ss"
"ikarus.main.ss"))
(define ikarus-system-macros
'([define (define)]
[define-syntax (define-syntax)]
[module (module)]
[begin (begin)]
[import (import)]
[set! (set!)]
[let-syntax (let-syntax)]
[letrec-syntax (letrec-syntax)]
[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)]
[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)]
[record-type-descriptor (core-macro . record-type-descriptor)]
[record-constructor-descriptor (core-macro . record-constructor-descriptor)]
[define-struct (macro . define-struct)]
[include (macro . include)]
[syntax-rules (macro . syntax-rules)]
[quasiquote (macro . quasiquote)]
[quasisyntax (macro . quasisyntax)]
[with-syntax (macro . with-syntax)]
[identifier-syntax (macro . identifier-syntax)]
[let (macro . let)]
[let* (macro . let*)]
[cond (macro . cond)]
[do (macro . do)]
[and (macro . and)]
[or (macro . or)]
[time (macro . time)]
[delay (macro . delay)]
[endianness (macro . endianness)]
[assert (macro . assert)]
[... (macro . ...)]
[=> (macro . =>)]
[else (macro . else)]
[_ (macro . _)]
[unquote (macro . unquote)]
[unquote-splicing (macro . unquote-splicing)]
[unsyntax (macro . unsyntax)]
[unsyntax-splicing (macro . unsyntax-splicing)]
[trace-lambda (macro . trace-lambda)]
[trace-define (macro . trace-define)]
[eol-style (macro . eol-style)]
[buffer-mode (macro . buffer-mode)]
[file-options (macro . file-options)]
[error-handling-mode (macro . error-handling-mode)]
[fields (macro . fields)]
[mutable (macro . mutable)]
[immutable (macro . immutable)]
[parent (macro . parent)]
[protocol (macro . protocol)]
[sealed (macro . sealed)]
[opaque (macro . opaque )]
[nongenerative (macro . nongenerative)]
[parent-rtd (macro . parent-rtd)]
[define-record-type (macro . define-record-type)]
))
(define library-legend
;; abbr. name visible? required?
'([i (ikarus) #t #t]
[cm (chez modules) #t #t]
[symbols (ikarus symbols) #t #t]
[parameters (ikarus parameters) #t #t]
[interaction (ikarus interaction) #t #t]
[ne (ikarus null-environment-5) #t #t]
[se (ikarus scheme-report-environment-5) #t #t]
[r (rnrs) #t #t]
[r5 (rnrs r5rs) #t #t]
[ct (rnrs control) #t #t]
[ev (rnrs eval) #t #t]
[mp (rnrs mutable-pairs) #t #t]
[ms (rnrs mutable-strings) #t #t]
[pr (rnrs programs) #t #t]
[sc (rnrs syntax-case) #t #t]
[fi (rnrs files) #t #t]
[sr (rnrs sorting) #t #t]
[ba (rnrs base) #t #t]
[ls (rnrs lists) #t #t]
[is (rnrs io simple) #t #t]
[bv (rnrs bytevectors) #t #t]
[uc (rnrs unicode) #t #t]
[ex (rnrs exceptions) #t #t]
[bw (rnrs arithmetic bitwise) #t #t]
[fx (rnrs arithmetic fixnums) #t #t]
[fl (rnrs arithmetic flonums) #t #t]
[ht (rnrs hashtables) #t #t]
[ip (rnrs io ports) #t #t]
[en (rnrs enums) #t #t]
[co (rnrs conditions) #t #t]
[ri (rnrs records inspection) #t #t]
[rp (rnrs records procedural) #t #t]
[rs (rnrs records syntactic) #t #t]
[$pairs (ikarus system $pairs) #f #t]
[$lists (ikarus system $lists) #f #t]
[$chars (ikarus system $chars) #f #t]
[$strings (ikarus system $strings) #f #t]
[$vectors (ikarus system $vectors) #f #t]
[$flonums (ikarus system $flonums) #f #t]
[$bignums (ikarus system $bignums) #f #t]
[$bytes (ikarus system $bytevectors) #f #t]
[$transc (ikarus system $transcoders) #f #t]
[$fx (ikarus system $fx) #f #t]
[$rat (ikarus system $ratnums) #f #t]
[$symbols (ikarus system $symbols) #f #t]
[$structs (ikarus system $structs) #f #t]
[$ports (ikarus system $ports) #f #t]
[$codes (ikarus system $codes) #f #t]
[$tcbuckets (ikarus system $tcbuckets) #f #t]
[$io (ikarus system $io) #f #t]
[$arg-list (ikarus system $arg-list) #f #t]
[$stack (ikarus system $stack) #f #t]
[$interrupts (ikarus system $interrupts) #f #t]
[$all (psyntax system $all) #f #t]
[$boot (psyntax system $bootstrap) #f #t]
))
(define identifier->library-map
'(
[import i]
[foreign-call i]
[type-descriptor i]
[parameterize i parameters]
[define-struct i]
[include i r]
[time i]
[trace-lambda i]
[trace-define i]
[make-list i r]
[last-pair i r]
[bwp-object? i]
[weak-cons i]
[weak-pair? i]
[uuid i]
[date-string i]
[andmap i]
[ormap i]
[fx< i]
[fx<= i]
[fx> i]
[fx>= i]
[fx= i]
[fxadd1 i]
[fxsub1 i]
[fxquotient i]
[fxremainder i]
[fxmodulo i]
[fxsll i]
[fxsra i]
[sra i]
[sll i]
[fxlogand i]
[logand i]
[fxlogxor i]
[fxlogor i]
[fxlognot i]
[fixnum->string i]
[string->flonum i]
[add1 i]
[sub1 i]
[bignum? i]
[ratnum? i]
[flonum-parts i]
[flonum-bytes i]
[quotient+remainder i r]
[flonum->string i]
[random i]
[gensym? i symbols]
[getprop i symbols]
[putprop i symbols]
[remprop i symbols]
[property-list i symbols]
[gensym->unique-string i symbols]
[symbol-bound? i symbols]
[top-level-value i symbols]
[reset-symbol-proc! i symbols]
[make-guardian i]
[make-input-port i]
[make-output-port i]
[port-output-index i]
[port-output-size i]
[port-output-buffer i]
[set-port-output-index! i]
[set-port-output-size! i]
[port-input-buffer i]
[port-input-index i]
[port-input-size i]
[set-port-input-index! i]
[set-port-input-size! i]
[port-name i]
[input-port-name i]
[output-port-name i]
[with-input-from-string i]
[open-output-string i]
[open-input-string i r]
[get-output-string i]
[with-output-to-string i]
[console-input-port i]
[console-output-port i]
[reset-input-port! i]
[write-byte i]
[read-token i]
[unread-char i]
[printf i]
[format i]
[comment-handler i]
[print-gensym i symbols]
[print-graph i]
[print-unicode i]
[gensym-count i symbols]
[gensym-prefix i symbols]
[make-parameter i parameters]
[call/cf i]
[print-error i]
[error-handler i]
[interrupt-handler i]
[assembler-output i]
[new-cafe i]
[expand i]
[environment? i]
[time-it i]
[command-line-arguments i]
[set-rtd-printer! i]
[make-record-type i]
[struct? i]
[make-struct-type i]
[struct-type-name i]
[struct-type-symbol i]
[struct-type-field-names i]
[struct-field-accessor i]
[struct-length i]
[struct-ref i]
[struct-printer i]
[struct-name i]
[struct-type-descriptor i]
[code? i]
[immediate? i]
[pointer-value i]
[system i]
[installed-libraries i]
[current-primitive-locations $boot]
[boot-library-expand $boot]
[current-library-collection $boot]
[library-name $boot]
[find-library-by-name $boot]
[$car $pairs]
[$cdr $pairs]
[$set-car! $pairs]
[$set-cdr! $pairs]
[$memq $lists]
[$memv $lists]
[$char? $chars]
[$char= $chars]
[$char< $chars]
[$char> $chars]
[$char<= $chars]
[$char>= $chars]
[$char->fixnum $chars]
[$fixnum->char $chars]
[$make-string $strings]
[$string-ref $strings]
[$string-set! $strings]
[$string-length $strings]
[$make-bytevector $bytes]
[$bytevector-length $bytes]
[$bytevector-s8-ref $bytes]
[$bytevector-u8-ref $bytes]
[$bytevector-set! $bytes]
[$flonum-u8-ref $flonums]
[$make-flonum $flonums]
[$flonum-set! $flonums]
[$flonum-signed-biased-exponent $flonums]
[$flonum-rational? $flonums]
[$flonum-integer? $flonums]
[$fl+ $flonums]
[$fl- $flonums]
[$fl* $flonums]
[$fl/ $flonums]
[$fl= $flonums]
[$fl< $flonums]
[$fl<= $flonums]
[$fl> $flonums]
[$fl>= $flonums]
[$fixnum->flonum $flonums]
[$make-bignum $bignums]
[$bignum-positive? $bignums]
[$bignum-size $bignums]
[$bignum-byte-ref $bignums]
[$bignum-byte-set! $bignums]
[$make-ratnum $rat]
[$ratnum-n $rat]
[$ratnum-d $rat]
[$make-vector $vectors]
[$vector-length $vectors]
[$vector-ref $vectors]
[$vector-set! $vectors]
[$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]
[$fxinthash $fx]
[$make-symbol $symbols]
[$symbol-unique-string $symbols]
[$symbol-value $symbols]
[$symbol-string $symbols]
[$symbol-plist $symbols]
[$set-symbol-value! $symbols]
[$set-symbol-proc! $symbols]
[$set-symbol-string! $symbols]
[$set-symbol-unique-string! $symbols]
[$set-symbol-plist! $symbols]
[$init-symbol-value! ]
[$unbound-object? $symbols]
[base-rtd $structs]
[$struct-set! $structs]
[$struct-ref $structs]
[$struct-rtd $structs]
[$struct $structs]
[$make-struct $structs]
[$struct? $structs]
[$struct/rtd? $structs]
[$make-port/input $ports]
[$make-port/output $ports]
[$port-handler $ports]
[$port-buffer $ports]
[$port-index $ports]
[$port-size $ports]
[$set-port-index! $ports]
[$set-port-size! $ports]
[$closure-code $codes]
[$code->closure $codes]
[$code-reloc-vector $codes]
[$code-freevars $codes]
[$code-size $codes]
[$code-annotation $codes]
[$code-ref $codes]
[$code-set! $codes]
[$set-code-annotation! $codes]
[procedure-annotation i]
[$make-tcbucket $tcbuckets]
[$tcbucket-key $tcbuckets]
[$tcbucket-val $tcbuckets]
[$tcbucket-next $tcbuckets]
[$set-tcbucket-val! $tcbuckets]
[$set-tcbucket-next! $tcbuckets]
[$set-tcbucket-tconc! $tcbuckets]
[$flush-output-port $io]
[$reset-input-port! $io]
[$close-input-port $io]
[$close-output-port $io]
[$write-char $io]
[$write-byte $io]
[$read-char $io]
[$peek-char $io]
[$unread-char $io]
[$arg-list $arg-list]
[$collect-key $arg-list]
[$$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]
[$interrupted? $interrupts]
[$unset-interrupted! $interrupts]
[$apply-nonprocedure-error-handler ]
[$incorrect-args-error-handler ]
[$multiple-values-error ]
[$debug ]
[$underflow-misaligned-error ]
[top-level-value-error ]
[car-error ]
[cdr-error ]
[fxadd1-error ]
[fxsub1-error ]
[cadr-error ]
[fx+-type-error ]
[fx+-types-error ]
[fx+-overflow-error ]
[$do-event ]
[do-overflow ]
[do-overflow-words ]
[do-vararg-overflow ]
[collect i]
[collect-key i]
[do-stack-overflow ]
[make-promise ]
[make-traced-procedure i]
[error@fx+ ]
[fasl-write i]
[lambda i r ba se ne]
[and i r ba se ne]
[begin i r ba se ne]
[case i r ba se ne]
[cond i r ba se ne]
[define i r ba se ne]
[define-syntax i r ba se ne]
[identifier-syntax i r ba]
[if i r ba se ne]
[let i r ba se ne]
[let* i r ba se ne]
[let*-values r ba]
[let-syntax i r ba se ne]
[let-values i r ba]
[letrec i r ba se ne]
[letrec* i r ba]
[letrec-syntax i r ba se ne]
[or i r ba se ne]
[quasiquote i r ba se ne]
[quote i r ba se ne]
[set! i r ba se ne]
[syntax-rules i r ba se ne]
[unquote i r ba se ne]
[unquote-splicing i r ba se ne]
[< i r ba se]
[<= i r ba se]
[= i r ba se]
[> i r ba se]
[>= i r ba se]
[+ i r ba se]
[- i r ba se]
[* i r ba se]
[/ i r ba se]
[abs i r ba se]
[acos i r ba se]
[angle r ba se]
[append i r ba se]
[apply i r ba se]
[asin i r ba se]
[assert i r ba]
[assertion-violation r ba]
[atan i r ba se]
[boolean=? i r ba]
[boolean? i r ba se]
[car i r ba se]
[cdr i r ba se]
[caar i r ba se]
[cadr i r ba se]
[cdar i r ba se]
[cddr i r ba se]
[caaar i r ba se]
[caadr i r ba se]
[cadar i r ba se]
[caddr i r ba se]
[cdaar i r ba se]
[cdadr i r ba se]
[cddar i r ba se]
[cdddr i r ba se]
[caaaar i r ba se]
[caaadr i r ba se]
[caadar i r ba se]
[caaddr i r ba se]
[cadaar i r ba se]
[cadadr i r ba se]
[caddar i r ba se]
[cadddr i r ba se]
[cdaaar i r ba se]
[cdaadr i r ba se]
[cdadar i r ba se]
[cdaddr i r ba se]
[cddaar i r ba se]
[cddadr i r ba se]
[cdddar i r ba se]
[cddddr i r ba se]
[call-with-current-continuation i r ba se]
[call/cc i r ba]
[call-with-values i r ba se]
[ceiling i r ba se]
[char->integer i r ba se]
[char<=? i r ba se]
[char<? i r ba se]
[char=? i r ba se]
[char>=? i r ba se]
[char>? i r ba se]
[char? i r ba se]
[complex? r ba se]
[cons i r ba se]
[cos i r ba se]
[denominator i r ba se]
[div i r ba]
[mod i r ba]
[div-and-mod i r ba]
[div0 i r ba]
[mod0 i r ba]
[div0-and-mod0 i r ba]
[dynamic-wind i r ba se]
[eq? i r ba se]
[equal? i r ba se]
[eqv? i r ba se]
[error i r ba]
[even? i r ba se]
[exact i r ba]
[exact-integer-sqrt i r ba]
[exact? i r ba se]
[exp i r ba se]
[expt i r ba se]
[finite? i r ba]
[floor i r ba se]
[for-each i r ba se]
[gcd i r ba se]
[imag-part r ba se]
[inexact i r ba]
[inexact? i r ba se]
[infinite? i r ba]
[integer->char i r ba se]
[integer-valued? i r ba]
[integer? i r ba se]
[lcm i r ba se]
[length i r ba se]
[list i r ba se]
[list->string i r ba se]
[list->vector i r ba se]
[list-ref i r ba se]
[list-tail i r ba se]
[list? i r ba se]
[log i r ba se]
[magnitude r ba se]
[make-polar r ba se]
[make-rectangular r ba se]
[make-string i r ba se]
[make-vector i r ba se]
[map i r ba se]
[max i r ba se]
[min i r ba se]
[nan? i r ba]
[negative? i r ba se]
[not i r ba se]
[null? i r ba]
[number->string i r ba se]
[number? i r ba se]
[numerator i r ba se]
[odd? i r ba se]
[pair? i r ba se]
[positive? i r ba se]
[procedure? i r ba se]
[rational-valued? i r ba]
[rational? i r ba se]
[rationalize i r ba se]
[real-part r ba se]
[real-valued? i r ba]
[real? i r ba se]
[reverse i r ba se]
[round i r ba se]
[sin i r ba se]
[sqrt i r ba se]
[string i r ba se]
[string->list i r ba se]
[string->number i r ba se]
[string->symbol i symbols r ba se]
[string-append i r ba se]
[string-copy i r ba se]
[string-for-each i r ba]
[string-length i r ba se]
[string-ref i r ba se]
[string<=? i r ba se]
[string<? i r ba se]
[string=? i r ba se]
[string>=? i r ba se]
[string>? i r ba se]
[string? i r ba se]
[substring i r ba se]
[symbol->string i symbols r ba se]
[symbol=? i symbols r ba]
[symbol? i symbols r ba se]
[tan i r ba se]
[truncate i r ba se]
[values i r ba se]
[vector i r ba se]
[vector->list i r ba se]
[vector-fill! i r ba se]
[vector-for-each i r ba]
[vector-length i r ba se]
[vector-map i r ba]
[vector-ref i r ba se]
[vector-set! i r ba se]
[vector? i r ba se]
[zero? i r ba se]
[... i ne r ba sc]
[=> i ne r ba ex]
[_ i ne r ba sc]
[else i ne r ba ex]
[bitwise-arithmetic-shift i r bw]
[bitwise-arithmetic-shift-left i r bw]
[bitwise-arithmetic-shift-right i r bw]
[bitwise-not r bw]
[bitwise-and r bw]
[bitwise-ior r bw]
[bitwise-xor r bw]
[bitwise-bit-count r bw]
[bitwise-bit-field r bw]
[bitwise-bit-set? r bw]
[bitwise-copy-bit r bw]
[bitwise-copy-bit-field r bw]
[bitwise-first-bit-set r bw]
[bitwise-if r bw]
[bitwise-length r bw]
[bitwise-reverse-bit-field r bw]
[bitwise-rotate-bit-field r bw]
[fixnum? i r fx]
[fixnum-width i r fx]
[least-fixnum i r fx]
[greatest-fixnum i r fx]
[fx* i r fx]
[fx*/carry i r fx]
[fx+ i r fx]
[fx+/carry i r fx]
[fx- i r fx]
[fx-/carry i r fx]
[fx<=? i r fx]
[fx<? i r fx]
[fx=? i r fx]
[fx>=? i r fx]
[fx>? i r fx]
[fxand i r fx]
[fxarithmetic-shift i r fx]
[fxarithmetic-shift-left i r fx]
[fxarithmetic-shift-right i r fx]
[fxbit-count r fx]
[fxbit-field r fx]
[fxbit-set? r fx]
[fxcopy-bit r fx]
[fxcopy-bit-field r fx]
[fxdiv r fx]
[fxdiv-and-mod r fx]
[fxdiv0 r fx]
[fxdiv0-and-mod0 r fx]
[fxeven? i r fx]
[fxfirst-bit-set r fx]
[fxif i r fx]
[fxior i r fx]
[fxlength r fx]
[fxmax i r fx]
[fxmin i r fx]
[fxmod r fx]
[fxmod0 r fx]
[fxnegative? i r fx]
[fxnot i r fx]
[fxodd? i r fx]
[fxpositive? i r fx]
[fxreverse-bit-field r fx]
[fxrotate-bit-field r fx]
[fxxor i r fx]
[fxzero? i r fx]
[fixnum->flonum i r fl]
[fl* i r fl]
[fl+ i r fl]
[fl- i r fl]
[fl/ i r fl]
[fl<=? i r fl]
[fl<? i r fl]
[fl=? i r fl]
[fl>=? i r fl]
[fl>? i r fl]
[flabs i r fl]
[flacos i r fl]
[flasin i r fl]
[flatan i r fl]
[flceiling i r fl]
[flcos i r fl]
[fldenominator i r fl]
[fldiv r fl]
[fldiv-and-mod r fl]
[fldiv0 r fl]
[fldiv0-and-mod0 r fl]
[fleven? i r fl]
[flexp i r fl]
[flexpt i r fl]
[flfinite? i r fl]
[flfloor i r fl]
[flinfinite? i r fl]
[flinteger? i r fl]
[fllog i r fl]
[flmax i r fl]
[flmin i r fl]
[flmod r fl]
[flmod0 r fl]
[flnan? i r fl]
[flnegative? i r fl]
[flnumerator i r fl]
[flodd? i r fl]
[flonum? i r fl]
[flpositive? i r fl]
[flround i r fl]
[flsin i r fl]
[flsqrt i r fl]
[fltan i r fl]
[fltruncate i r fl]
[flzero? i r fl]
[real->flonum r fl]
[make-no-infinities-violation r fl]
[make-no-nans-violation r fl]
[&no-infinities r fl]
[no-infinities-violation? r fl]
[&no-nans r fl]
[no-nans-violation? r fl]
[bytevector->sint-list i r bv]
[bytevector->u8-list i r bv]
[bytevector->uint-list i r bv]
[bytevector-copy i r bv]
[bytevector-copy! i r bv]
[bytevector-fill! i r bv]
[bytevector-ieee-double-native-ref r bv]
[bytevector-ieee-double-native-set! r bv]
[bytevector-ieee-double-ref r bv]
[bytevector-ieee-single-native-ref r bv]
[bytevector-ieee-single-native-set! r bv]
[bytevector-ieee-single-ref r bv]
[bytevector-length i r bv]
[bytevector-s16-native-ref i r bv]
[bytevector-s16-native-set! i r bv]
[bytevector-s16-ref i r bv]
[bytevector-s16-set! i r bv]
[bytevector-s32-native-ref i r bv]
[bytevector-s32-native-set! i r bv]
[bytevector-s32-ref i r bv]
[bytevector-s32-set! i r bv]
[bytevector-s64-native-ref r bv]
[bytevector-s64-native-set! r bv]
[bytevector-s64-ref r bv]
[bytevector-s64-set! r bv]
[bytevector-s8-ref i r bv]
[bytevector-s8-set! i r bv]
[bytevector-sint-ref i r bv]
[bytevector-sint-set! i r bv]
[bytevector-u16-native-ref i r bv]
[bytevector-u16-native-set! i r bv]
[bytevector-u16-ref i r bv]
[bytevector-u16-set! i r bv]
[bytevector-u32-native-ref i r bv]
[bytevector-u32-native-set! i r bv]
[bytevector-u32-ref i r bv]
[bytevector-u32-set! i r bv]
[bytevector-u64-native-ref r bv]
[bytevector-u64-native-set! r bv]
[bytevector-u64-ref r bv]
[bytevector-u64-set! r bv]
[bytevector-u8-ref i r bv]
[bytevector-u8-set! i r bv]
[bytevector-uint-ref i r bv]
[bytevector-uint-set! i r bv]
[bytevector=? i r bv]
[bytevector? i r bv]
[endianness i r bv]
[native-endianness i r bv]
[sint-list->bytevector i r bv]
[string->utf16 r bv]
[string->utf32 r bv]
[string->utf8 i r bv]
[u8-list->bytevector i r bv]
[uint-list->bytevector i r bv]
[utf8->string i r bv]
[utf16->string r bv]
[utf32->string r bv]
[condition? r co]
[&assertion r co]
[assertion-violation? r co]
[&condition r co]
[condition r co]
[condition-accessor r co]
[condition-irritants r co]
[condition-message r co]
[condition-predicate r co]
[condition-who r co]
[define-condition-type r co]
[&error r co]
[error? r co]
[&implementation-restriction r co]
[implementation-restriction-violation? r co]
[&irritants r co]
[irritants-condition? r co]
[&lexical r co]
[lexical-violation? r co]
[make-assertion-violation r co]
[make-error r co]
[make-implementation-restriction-violation r co]
[make-irritants-condition r co]
[make-lexical-violation r co]
[make-message-condition r co]
[make-non-continuable-violation r co]
[make-serious-condition r co]
[make-syntax-violation r co]
[make-undefined-violation r co]
[make-violation r co]
[make-warning r co]
[make-who-condition r co]
[&message r co]
[message-condition? r co]
[&non-continuable r co]
[non-continuable-violation? r co]
[&serious r co]
[serious-condition? r co]
[simple-conditions r co]
[&syntax r co]
[syntax-violation r co sc]
[syntax-violation-form r co]
[syntax-violation-subform r co]
[syntax-violation? r co]
[&undefined r co]
[undefined-violation? r co]
[&violation r co]
[violation? r co]
[&warning r co]
[warning? r co]
[&who r co]
[who-condition? r co]
[case-lambda i r ct]
[do i r ct se ne]
[unless i r ct]
[when i r ct]
[define-enumeration r en]
[enum-set->list r en]
[enum-set-complement r en]
[enum-set-constructor r en]
[enum-set-difference r en]
[enum-set-indexer r en]
[enum-set-intersection r en]
[enum-set-member? r en]
[enum-set-projection r en]
[enum-set-subset? r en]
[enum-set-union r en]
[enum-set-universe r en]
[enum-set=? r en]
[make-enumeration r en]
[environment i ev]
[eval i ev se]
[raise r ex]
[raise-continuable r ex]
[with-exception-handler r ex]
[guard r ex]
[binary-port? r ip]
[buffer-mode i r ip]
[buffer-mode? i r ip]
[bytevector->string r ip]
[call-with-bytevector-output-port r ip]
[call-with-port r ip]
[call-with-string-output-port r ip]
[assoc i r ls se]
[assp i r ls]
[assq i r ls se]
[assv i r ls se]
[cons* i r ls]
[filter i r ls]
[find i r ls]
[fold-left i r ls]
[fold-right i r ls]
[for-all i r ls]
[exists i r ls]
[member i r ls se]
[memp i r ls]
[memq i r ls se]
[memv i r ls se]
[partition i r ls]
[remq i r ls]
[remp i r ls]
[remv i r ls]
[remove i r ls]
[set-car! i mp se]
[set-cdr! i mp se]
[string-set! i r ms se]
[string-fill! i r ms se]
[command-line i r pr]
[exit i r pr]
[delay i r5 se ne]
[exact->inexact i r r5 se]
[force i r5 se]
[inexact->exact i r r5 se]
[modulo i r r5 se]
[remainder i r r5 se]
[null-environment i r5 se]
[quotient i r r5 se]
[scheme-report-environment r5 se]
[close-port r ip]
[eol-style i r ip]
[error-handling-mode i r ip]
[file-options i r ip]
[flush-output-port i r ip]
[get-bytevector-all r ip]
[get-bytevector-n r ip]
[get-bytevector-n! r ip]
[get-bytevector-some r ip]
[get-char r ip]
[get-datum r ip]
[get-line r ip]
[get-string-all r ip]
[get-string-n r ip]
[get-string-n! r ip]
[get-u8 r ip]
[&i/o r ip is fi]
[&i/o-decoding r ip]
[i/o-decoding-error? r ip]
[&i/o-encoding r ip]
[i/o-encoding-error-char r ip]
[i/o-encoding-error? r ip]
[i/o-error-filename r ip is fi]
[i/o-error-port r ip is fi]
[i/o-error? r ip is fi]
[&i/o-file-already-exists r ip is fi]
[i/o-file-already-exists-error? r ip is fi]
[&i/o-file-does-not-exist r ip is fi]
[i/o-file-does-not-exist-error? r ip is fi]
[&i/o-file-is-read-only r ip is fi]
[i/o-file-is-read-only-error? r ip is fi]
[&i/o-file-protection r ip is fi]
[i/o-file-protection-error? r ip is fi]
[&i/o-filename r ip is fi]
[i/o-filename-error? r ip is fi]
[&i/o-invalid-position r ip is fi]
[i/o-invalid-position-error? r ip is fi]
[&i/o-port r ip is fi]
[i/o-port-error? r ip is fi]
[&i/o-read r ip is fi]
[i/o-read-error? r ip is fi]
[&i/o-write r ip is fi]
[i/o-write-error? r ip is fi]
[lookahead-char r ip]
[lookahead-u8 r ip]
[make-bytevector i r bv]
[make-custom-binary-input-port r ip]
[make-custom-binary-input/output-port r ip]
[make-custom-binary-output-port r ip]
[make-custom-textual-input-port r ip]
[make-custom-textual-input/output-port r ip]
[make-custom-textual-output-port r ip]
[make-i/o-decoding-error r ip]
[make-i/o-encoding-error r ip]
[make-i/o-error r ip is fi]
[make-i/o-file-already-exists-error r ip is fi]
[make-i/o-file-does-not-exist-error r ip is fi]
[make-i/o-file-is-read-only-error r ip is fi]
[make-i/o-file-protection-error r ip is fi]
[make-i/o-filename-error r ip is fi]
[make-i/o-invalid-position-error r ip is fi]
[make-i/o-port-error r ip is fi]
[make-i/o-read-error r ip is fi]
[make-i/o-write-error r ip is fi]
[latin-1-codec i r ip]
[make-transcoder i r ip]
[native-eol-style i r ip]
[native-transcoder i r ip]
[open-bytevector-input-port r ip]
[open-bytevector-output-port r ip]
[open-file-input-port r ip]
[open-file-input/output-port r ip]
[open-file-output-port r ip]
[open-string-input-port r ip]
[open-string-output-port r ip]
[output-port-buffer-mode r ip]
[port-eof? r ip]
[port-has-port-position? r ip]
[port-has-set-port-position!? r ip]
[port-position r ip]
[port-transcoder r ip]
[port? i r ip]
[put-bytevector r ip]
[put-char r ip]
[put-datum r ip]
[put-string r ip]
[put-u8 r ip]
[set-port-position! r ip]
[standard-error-port i r ip]
[standard-input-port i r ip]
[standard-output-port i r ip]
[string->bytevector r ip]
[textual-port? r ip]
[transcoded-port r ip]
[transcoder-codec i r ip]
[transcoder-eol-style i r ip]
[transcoder-error-handling-mode i r ip]
[utf-16-codec i r ip]
[utf-8-codec i r ip]
[input-port? i r is ip se]
[output-port? i r is ip se]
[current-input-port i r ip is se]
[current-output-port i r ip is se]
[current-error-port r ip is]
[eof-object i r ip is se]
[eof-object? i r ip is]
[close-input-port i r is se]
[close-output-port i r is se]
[display i r is se]
[newline i r is se]
[open-input-file i r is se]
[open-output-file i r is se]
[peek-char i r is se]
[read i r is se]
[read-char i r is se]
[with-input-from-file i r is se]
[with-output-to-file i r is se]
[write i r is se]
[write-char i r is se]
[call-with-input-file i r is se]
[call-with-output-file i r is se]
[hashtable-clear! r ht]
[hashtable-contains? r ht]
[hashtable-copy r ht]
[hashtable-delete! r ht]
[hashtable-entries r ht]
[hashtable-keys r ht]
[hashtable-mutable? r ht]
[hashtable-ref r ht]
[hashtable-set! r ht]
[hashtable-size r ht]
[hashtable-update! r ht]
[hashtable? r ht]
[make-eq-hashtable r ht]
[make-eqv-hashtable r ht]
[hashtable-hash-function r ht]
[make-hashtable r ht]
[hashtable-equivalence-function r ht]
[equal-hash r ht]
[string-hash r ht]
[string-ci-hash r ht]
[symbol-hash r ht]
[list-sort i r sr]
[vector-sort i r sr]
[vector-sort! i r sr]
[file-exists? i r fi]
[delete-file i r fi]
[define-record-type r rs]
[fields i r rs]
[immutable i r rs]
[mutable i r rs]
[opaque i r rs]
[parent i r rs]
[parent-rtd i r rs]
[protocol i r rs]
[record-constructor-descriptor r rs]
[record-type-descriptor r rs]
[sealed i r rs]
[nongenerative i r rs]
[record-field-mutable? r ri]
[record-rtd r ri]
[record-type-field-names r ri]
[record-type-generative? r ri]
[record-type-name r ri]
[record-type-opaque? r ri]
[record-type-parent r ri]
[record-type-sealed? r ri]
[record-type-uid r ri]
[record? r ri]
[make-record-constructor-descriptor r rp]
[make-record-type-descriptor r rp]
[record-accessor r rp]
[record-constructor r rp]
[record-mutator r rp]
[record-predicate r rp]
[record-type-descriptor? r rp]
[bound-identifier=? i r sc]
[datum->syntax i r sc]
[syntax i r sc]
[syntax->datum i r sc]
[syntax-case i r sc]
[unsyntax i r sc]
[unsyntax-splicing i r sc]
[quasisyntax i r sc]
[with-syntax i r sc]
[free-identifier=? i r sc]
[generate-temporaries i r sc]
[identifier? i r sc]
[make-variable-transformer i r sc]
[char-alphabetic? i r uc se]
[char-ci<=? i r uc se]
[char-ci<? i r uc se]
[char-ci=? i r uc se]
[char-ci>=? i r uc se]
[char-ci>? i r uc se]
[char-downcase i r uc se]
[char-foldcase i r uc]
[char-titlecase i r uc]
[char-upcase i r uc se]
[char-general-category i r uc]
[char-lower-case? i r uc se]
[char-numeric? i r uc se]
[char-title-case? i r uc]
[char-upper-case? i r uc se]
[char-whitespace? i r uc se]
[string-ci<=? i r uc se]
[string-ci<? i r uc se]
[string-ci=? i r uc se]
[string-ci>=? i r uc se]
[string-ci>? i r uc se]
[string-downcase r uc]
[string-foldcase i r uc]
[string-normalize-nfc r uc]
[string-normalize-nfd r uc]
[string-normalize-nfkc r uc]
[string-normalize-nfkd r uc]
[string-titlecase r uc]
[string-upcase r uc]
[char-ready? ]
[interaction-environment ]
[load i]
[void i $boot]
[gensym i symbols $boot]
[symbol-value i symbols $boot]
[set-symbol-value! i symbols $boot]
[eval-core $boot]
[pretty-print i $boot]
[module i cm]
[syntax-dispatch ]
[syntax-error i sc]
[$transcoder? $transc]
[$transcoder->data $transc]
[$data->transcoder $transc]
[file-options-spec i]
))
(define (macro-identifier? x)
(and (assq x ikarus-system-macros) #t))
(define (procedure-identifier? x)
(not (macro-identifier? x)))
(define bootstrap-collection
(let ([ls
(let f ([ls library-legend])
(define required? cadddr)
(define library-name cadr)
(cond
[(null? ls) '()]
[(required? (car ls))
(cons (find-library-by-name (library-name (car ls)))
(f (cdr ls)))]
[else (f (cdr ls))]))])
(case-lambda
[() ls]
[(x) (unless (memq x ls)
(set! ls (cons x ls)))])))
(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)))
(for-each f identifier->library-map))
(define (make-collection)
(let ([set '()])
(case-lambda
[() set]
[(x) (set! set (cons x set))])))
(define (assq1 x ls)
(let f ([x x] [ls ls] [p #f])
(cond
[(null? ls) p]
[(eq? x (caar ls))
(if p
(if (pair? p)
(if (eq? (cdr p) (cdar ls))
(f x (cdr ls) p)
(f x (cdr ls) 2))
(f x (cdr ls) (+ p 1)))
(f x (cdr ls) (car ls)))]
[else (f x (cdr ls) p)])))
(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)
(when (procedure-identifier? x)
(cond
[(assq x (export-subst))
(error who "ambiguous export of ~s" x)]
[(assq1 x subst) =>
;;; primitive defined (exported) within the compiled libraries
(lambda (p)
(unless (pair? p)
(error who "~s exports of ~s" p x))
(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 ~s" x
label)])))]
[else
;;; core primitive with no backing definition, assumed to
;;; be defined in other strata of the system
(let ([label (gensym)])
(export-subst (cons x label))
(export-env (cons label (cons 'core-prim x))))])))
(map car identifier->library-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
[(assq name identifier->library-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)]
[visible? (caddr legend-entry)])
(let ([id (gensym)]
[name name]
[version '()]
[import-libs '()]
[visit-libs '()]
[invoke-libs '()])
(let-values ([(subst env)
(if (equal? name '(psyntax system $all))
(values export-subst export-env)
(values
(get-export-subset key export-subst)
'()))])
`(install-library
',id ',name ',version ',import-libs ',visit-libs ',invoke-libs
',subst ',env void void ',visible?)))))
(let ([code `(library (ikarus primlocs)
(export) ;;; must be empty
(import
(only (psyntax library-manager)
install-library)
(only (ikarus compiler)
current-primitive-locations)
(ikarus))
(current-primitive-locations
(lambda (x)
(cond
[(assq x ',primlocs) => cdr]
[else #f])))
,@(map build-library library-legend))])
(let-values ([(code empty-subst empty-env)
(boot-library-expand code)])
code)))
;;; the first code to run on the system is one that initializes
;;; the value and proc fields of the location of $init-symbol-value!
;;; Otherwise, all subsequent inits to any global variable will
;;; segfault.
(define (make-init-code)
(define proc (gensym))
(define loc (gensym))
(define label (gensym))
(define sym (gensym))
(define val (gensym))
(define args (gensym))
(values
(list
`((case-lambda
[(,proc) (,proc ',loc ,proc)])
(case-lambda
[(,sym ,val)
(begin
((primitive $set-symbol-value!) ,sym ,val)
(if ((primitive procedure?) ,val)
((primitive $set-symbol-proc!) ,sym ,val)
((primitive $set-symbol-proc!) ,sym
(case-lambda
[,args
((primitive error)
'apply
'"~s is not a procedure"
((primitive $symbol-value) ,sym))]))))])))
`([$init-symbol-value! . ,label])
`([,label . (global . ,loc)])))
(define (expand-all files)
;;; remove all re-exported identifiers (those with labels in
;;; subst but not binding in env).
(define (prune-subst subst env)
(cond
((null? subst) '())
((not (assq (cdar subst) env)) (prune-subst (cdr subst) env))
(else (cons (car subst) (prune-subst (cdr subst) env)))))
(let-values (((code* subst env) (make-init-code)))
(for-each
(lambda (file)
(printf "expanding ~s\n" file)
(load file
(lambda (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)
(let-values ([(export-subst export-env export-locs)
(make-system-data (prune-subst subst env) env)])
(let ([code (build-system-library export-subst export-env export-locs)])
(values
(reverse (cons* (car code*) code (cdr code*)))
export-locs)))))
(verify-map)
(time-it "the entire bootstrap process"
(lambda ()
(let-values ([(core* locs)
(time-it "macro expansion"
(lambda ()
(parameterize ([current-library-collection
bootstrap-collection])
(expand-all scheme-library-files))))])
(current-primitive-locations
(lambda (x)
(cond
[(assq x locs) => cdr]
[else
(error 'bootstrap "no location for ~s" x)])))
(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")
;;; vim:syntax=scheme