#!/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.unicode-data.ss"
    "ikarus.numerics.ss"
    "ikarus.conditions.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.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                          i 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                      i 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