2006-12-24 04:08:18 -05:00
|
|
|
#!/usr/bin/env ikarus -b ikarus.boot --script
|
2006-11-23 19:44:29 -05:00
|
|
|
|
2007-05-01 05:49:33 -04:00
|
|
|
(library (ikarus makefile)
|
2007-05-01 17:39:17 -04:00
|
|
|
(export)
|
2007-05-06 20:54:30 -04:00
|
|
|
(import
|
|
|
|
|
(ikarus system $bootstrap)
|
|
|
|
|
(ikarus))
|
2007-05-01 17:39:17 -04:00
|
|
|
|
|
|
|
|
(define scheme-library-files
|
2007-05-02 00:06:44 -04:00
|
|
|
;;; 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: ...).
|
|
|
|
|
;;;
|
2007-05-05 22:54:53 -04:00
|
|
|
'("ikarus.singular-objects.ss"
|
|
|
|
|
"ikarus.handlers.ss"
|
2007-05-05 03:16:26 -04:00
|
|
|
"ikarus.multiple-values.ss"
|
2007-05-05 01:56:44 -04:00
|
|
|
"ikarus.control.ss"
|
2007-05-05 02:07:50 -04:00
|
|
|
"ikarus.collect.ss"
|
2007-05-05 17:39:18 -04:00
|
|
|
"ikarus.apply.ss"
|
2007-05-05 04:45:13 -04:00
|
|
|
"ikarus.predicates.ss"
|
2007-05-05 05:06:32 -04:00
|
|
|
"ikarus.pairs.ss"
|
2007-05-05 05:22:15 -04:00
|
|
|
"ikarus.lists.ss"
|
2007-05-05 04:45:13 -04:00
|
|
|
"ikarus.fixnums.ss"
|
|
|
|
|
"ikarus.chars.ss"
|
2007-05-05 02:17:55 -04:00
|
|
|
"ikarus.records.ss"
|
2007-05-05 03:46:26 -04:00
|
|
|
"ikarus.strings.ss"
|
2007-05-05 23:03:29 -04:00
|
|
|
"ikarus.date-string.ss"
|
2007-05-05 06:47:21 -04:00
|
|
|
"ikarus.symbols.ss"
|
2007-05-05 04:25:15 -04:00
|
|
|
"ikarus.vectors.ss"
|
2007-05-05 02:34:37 -04:00
|
|
|
"ikarus.numerics.ss"
|
2007-05-05 03:03:50 -04:00
|
|
|
"ikarus.guardians.ss"
|
2007-05-05 06:58:41 -04:00
|
|
|
"ikarus.command-line.ss"
|
2007-05-05 18:04:38 -04:00
|
|
|
"ikarus.io-ports.ss"
|
2007-05-05 18:32:56 -04:00
|
|
|
"ikarus.io-primitives.unsafe.ss"
|
2007-05-05 18:42:57 -04:00
|
|
|
"ikarus.io-primitives.ss"
|
2007-05-05 19:39:02 -04:00
|
|
|
"ikarus.io.input-files.ss"
|
2007-05-05 19:53:16 -04:00
|
|
|
"ikarus.io.output-files.ss"
|
2007-05-05 20:05:33 -04:00
|
|
|
"ikarus.io.output-strings.ss"
|
2007-05-05 20:24:14 -04:00
|
|
|
"ikarus.hash-tables.ss"
|
2007-05-05 20:40:23 -04:00
|
|
|
"ikarus.writer.ss"
|
2007-05-05 20:47:31 -04:00
|
|
|
"ikarus.reader.ss"
|
2007-05-05 20:54:57 -04:00
|
|
|
"ikarus.code-objects.ss"
|
2007-05-05 21:18:41 -04:00
|
|
|
"ikarus.intel-assembler.ss"
|
2007-05-06 22:48:10 -04:00
|
|
|
"ikarus.trace.ss"
|
2007-05-05 21:24:43 -04:00
|
|
|
"ikarus.fasl.ss"
|
2007-05-05 21:18:41 -04:00
|
|
|
"ikarus.compiler.ss"
|
2007-05-06 18:58:54 -04:00
|
|
|
"ikarus.library-manager.ss"
|
2007-05-05 22:05:34 -04:00
|
|
|
"ikarus.syntax.ss"
|
2007-05-06 20:39:42 -04:00
|
|
|
"ikarus.load.ss"
|
2007-05-05 22:07:50 -04:00
|
|
|
"ikarus.pretty-print.ss"
|
2007-05-05 22:09:41 -04:00
|
|
|
"ikarus.cafe.ss"
|
2007-05-05 22:14:06 -04:00
|
|
|
"ikarus.posix.ss"
|
2007-05-05 22:15:40 -04:00
|
|
|
"ikarus.timer.ss"
|
2007-05-06 20:20:13 -04:00
|
|
|
"ikarus.main.ss"))
|
2007-05-02 00:06:44 -04:00
|
|
|
|
2007-05-04 07:46:33 -04:00
|
|
|
(define ikarus-system-macros
|
2007-05-03 03:58:43 -04:00
|
|
|
'([define (define)]
|
|
|
|
|
[define-syntax (define-syntax)]
|
|
|
|
|
[module (module)]
|
|
|
|
|
[begin (begin)]
|
|
|
|
|
[set! (set!)]
|
|
|
|
|
[foreign-call (core-macro . foreign-call)]
|
|
|
|
|
[quote (core-macro . quote)]
|
|
|
|
|
[syntax-case (core-macro . syntax-case)]
|
|
|
|
|
[syntax (core-macro . syntax)]
|
|
|
|
|
[lambda (core-macro . lambda)]
|
|
|
|
|
[case-lambda (core-macro . case-lambda)]
|
|
|
|
|
[type-descriptor (core-macro . type-descriptor)]
|
|
|
|
|
[letrec (core-macro . letrec)]
|
|
|
|
|
[if (core-macro . if)]
|
|
|
|
|
[when (core-macro . when)]
|
|
|
|
|
[unless (core-macro . unless)]
|
|
|
|
|
[parameterize (core-macro . parameterize)]
|
|
|
|
|
[case (core-macro . case)]
|
|
|
|
|
[let-values (core-macro . let-values)]
|
|
|
|
|
[define-record (macro . define-record)]
|
|
|
|
|
[include (macro . include)]
|
|
|
|
|
[syntax-rules (macro . syntax-rules)]
|
|
|
|
|
[quasiquote (macro . quasiquote)]
|
|
|
|
|
[with-syntax (macro . with-syntax)]
|
|
|
|
|
[let (macro . let)]
|
|
|
|
|
[let* (macro . let*)]
|
|
|
|
|
[cond (macro . cond)]
|
|
|
|
|
[and (macro . and)]
|
|
|
|
|
[or (macro . or)]))
|
2007-05-02 02:16:56 -04:00
|
|
|
|
2007-05-04 09:13:14 -04:00
|
|
|
(define library-legend
|
2007-05-06 20:54:30 -04:00
|
|
|
'([i (ikarus)]
|
|
|
|
|
[r (r6rs)]
|
|
|
|
|
[$all (ikarus system $all)]
|
|
|
|
|
[$pairs (ikarus system $pairs)]
|
|
|
|
|
[$lists (ikarus system $lists)]
|
|
|
|
|
[$chars (ikarus system $chars)]
|
|
|
|
|
[$strings (ikarus system $strings)]
|
|
|
|
|
[$vectors (ikarus system $vectors)]
|
|
|
|
|
[$fx (ikarus system $fx)]
|
|
|
|
|
[$symbols (ikarus system $symbols)]
|
|
|
|
|
[$records (ikarus system $records)]
|
|
|
|
|
[$ports (ikarus system $ports)]
|
|
|
|
|
[$codes (ikarus system $codes)]
|
|
|
|
|
[$tcbuckets (ikarus system $tcbuckets)]
|
|
|
|
|
[$io (ikarus system $io)]
|
|
|
|
|
[$arg-list (ikarus system $arg-list)]
|
|
|
|
|
[$stack (ikarus system $stack)]
|
2007-05-06 20:15:49 -04:00
|
|
|
[$interrupts (ikarus system $interrupts)]
|
2007-05-06 20:54:30 -04:00
|
|
|
[$boot (ikarus system $bootstrap)]
|
2007-05-06 17:41:59 -04:00
|
|
|
))
|
2007-05-04 09:13:14 -04:00
|
|
|
|
2007-05-04 11:16:42 -04:00
|
|
|
(define ikarus-macros-map
|
2007-05-06 20:07:00 -04:00
|
|
|
'([define i r]
|
|
|
|
|
[define-syntax i r]
|
|
|
|
|
[module i ]
|
|
|
|
|
[begin i r]
|
|
|
|
|
[set! i r]
|
|
|
|
|
[foreign-call i r]
|
|
|
|
|
[quote i r]
|
|
|
|
|
[syntax-case i r]
|
|
|
|
|
[syntax i r]
|
|
|
|
|
[lambda i r]
|
|
|
|
|
[case-lambda i r]
|
|
|
|
|
[type-descriptor i ]
|
|
|
|
|
[letrec i r]
|
|
|
|
|
[if i r]
|
|
|
|
|
[when i r]
|
|
|
|
|
[unless i r]
|
|
|
|
|
[parameterize i ]
|
|
|
|
|
[case i r]
|
|
|
|
|
[let-values i r]
|
|
|
|
|
[define-record i r]
|
|
|
|
|
[include i r]
|
|
|
|
|
[syntax-rules i r]
|
|
|
|
|
[quasiquote i r]
|
|
|
|
|
[with-syntax i r]
|
|
|
|
|
[let i r]
|
|
|
|
|
[let* i r]
|
|
|
|
|
[cond i r]
|
|
|
|
|
[and i r]
|
|
|
|
|
[or i r]))
|
2007-05-04 11:16:42 -04:00
|
|
|
|
|
|
|
|
(define ikarus-procedures-map
|
2007-05-06 20:07:00 -04:00
|
|
|
'([void i]
|
|
|
|
|
[not i]
|
|
|
|
|
[boolean? i]
|
|
|
|
|
[null? i]
|
|
|
|
|
[procedure? i]
|
|
|
|
|
[eof-object? i]
|
|
|
|
|
[eof-object i]
|
|
|
|
|
[eq? i]
|
|
|
|
|
[eqv? i]
|
|
|
|
|
[equal? i]
|
|
|
|
|
[cons i]
|
|
|
|
|
[pair? i]
|
|
|
|
|
[car i]
|
|
|
|
|
[cdr i]
|
|
|
|
|
[set-car! i]
|
|
|
|
|
[set-cdr! i]
|
|
|
|
|
[caar i]
|
|
|
|
|
[cdar i]
|
|
|
|
|
[cadr i]
|
|
|
|
|
[cddr i]
|
|
|
|
|
[caaar i]
|
|
|
|
|
[cdaar i]
|
|
|
|
|
[cadar i]
|
|
|
|
|
[cddar i]
|
|
|
|
|
[caadr i]
|
|
|
|
|
[cdadr i]
|
|
|
|
|
[caddr i]
|
|
|
|
|
[cdddr i]
|
|
|
|
|
[caaaar i]
|
|
|
|
|
[cdaaar i]
|
|
|
|
|
[cadaar i]
|
|
|
|
|
[cddaar i]
|
|
|
|
|
[caadar i]
|
|
|
|
|
[cdadar i]
|
|
|
|
|
[caddar i]
|
|
|
|
|
[cdddar i]
|
|
|
|
|
[caaadr i]
|
|
|
|
|
[cdaadr i]
|
|
|
|
|
[cadadr i]
|
|
|
|
|
[cddadr i]
|
|
|
|
|
[caaddr i]
|
|
|
|
|
[cdaddr i]
|
|
|
|
|
[cadddr i]
|
|
|
|
|
[cddddr i]
|
|
|
|
|
[list i]
|
|
|
|
|
[list-ref i]
|
|
|
|
|
[make-list i]
|
|
|
|
|
[list* i]
|
|
|
|
|
[list? i]
|
|
|
|
|
[append i]
|
|
|
|
|
[last-pair i]
|
|
|
|
|
[reverse i]
|
|
|
|
|
[length i]
|
|
|
|
|
[assq i]
|
|
|
|
|
[assv i]
|
|
|
|
|
[assoc i]
|
|
|
|
|
[memq i]
|
|
|
|
|
[memv i]
|
|
|
|
|
[member i]
|
|
|
|
|
[bwp-object? i]
|
|
|
|
|
[weak-cons i]
|
|
|
|
|
[weak-pair? i]
|
|
|
|
|
[char? i]
|
|
|
|
|
[char=? i]
|
|
|
|
|
[char<? i]
|
|
|
|
|
[char>? i]
|
|
|
|
|
[char<=? i]
|
|
|
|
|
[char>=? i]
|
|
|
|
|
[integer->char i]
|
|
|
|
|
[char->integer i]
|
|
|
|
|
[char-whitespace? i]
|
|
|
|
|
[string? i]
|
|
|
|
|
[string i]
|
|
|
|
|
[make-string i]
|
|
|
|
|
[string-ref i]
|
|
|
|
|
[string-set! i]
|
|
|
|
|
[string-length i]
|
|
|
|
|
[string=? i]
|
|
|
|
|
[substring i]
|
|
|
|
|
[string-append i]
|
|
|
|
|
[string->list i]
|
|
|
|
|
[list->string i]
|
|
|
|
|
[uuid i]
|
|
|
|
|
[date-string i]
|
|
|
|
|
[vector i]
|
|
|
|
|
[make-vector i]
|
|
|
|
|
[vector-ref i]
|
|
|
|
|
[vector-set! i]
|
|
|
|
|
[vector? i]
|
|
|
|
|
[vector-length i]
|
|
|
|
|
[list->vector i]
|
|
|
|
|
[vector->list i]
|
|
|
|
|
[for-each i]
|
|
|
|
|
[map i]
|
|
|
|
|
[andmap i]
|
|
|
|
|
[ormap i]
|
|
|
|
|
[fixnum? i]
|
|
|
|
|
[fx< i]
|
|
|
|
|
[fx<= i]
|
|
|
|
|
[fx> i]
|
|
|
|
|
[fx>= i]
|
|
|
|
|
[fx= i]
|
|
|
|
|
[fx- i]
|
|
|
|
|
[fx+ i]
|
|
|
|
|
[fx* i]
|
|
|
|
|
[fxzero? i]
|
|
|
|
|
[fxadd1 i]
|
|
|
|
|
[fxsub1 i]
|
|
|
|
|
[fxquotient i]
|
|
|
|
|
[fxremainder i]
|
|
|
|
|
[fxmodulo i]
|
|
|
|
|
[fxsll i]
|
|
|
|
|
[fxsra i]
|
|
|
|
|
[fxlogand i]
|
|
|
|
|
[fxlogxor i]
|
|
|
|
|
[fxlogor i]
|
|
|
|
|
[fxlognot i]
|
|
|
|
|
[fixnum->string i]
|
|
|
|
|
[string->flonum i]
|
|
|
|
|
[- i]
|
|
|
|
|
[= i]
|
|
|
|
|
[< i]
|
|
|
|
|
[> i]
|
|
|
|
|
[<= i]
|
|
|
|
|
[>= i]
|
|
|
|
|
[* i]
|
|
|
|
|
[+ i]
|
|
|
|
|
[add1 i]
|
|
|
|
|
[sub1 i]
|
|
|
|
|
[number? i]
|
|
|
|
|
[bignum? i]
|
|
|
|
|
[integer? i]
|
|
|
|
|
[flonum? i]
|
|
|
|
|
[quotient i]
|
|
|
|
|
[remainder i]
|
|
|
|
|
[quotient+remainder i]
|
|
|
|
|
[number->string i]
|
|
|
|
|
[string->number i]
|
|
|
|
|
[flonum->string i]
|
|
|
|
|
[symbol? i]
|
|
|
|
|
[gensym? i]
|
|
|
|
|
[gensym i]
|
|
|
|
|
[getprop i]
|
|
|
|
|
[putprop i]
|
|
|
|
|
[remprop i]
|
|
|
|
|
[property-list i]
|
|
|
|
|
[string->symbol i]
|
|
|
|
|
[symbol->string i]
|
|
|
|
|
[gensym->unique-string i]
|
|
|
|
|
[symbol-bound? i]
|
|
|
|
|
[symbol-value i]
|
|
|
|
|
[set-symbol-value! i]
|
|
|
|
|
[make-guardian i]
|
|
|
|
|
[make-input-port i]
|
|
|
|
|
[make-output-port i]
|
|
|
|
|
[make-input/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]
|
|
|
|
|
[output-port? i]
|
|
|
|
|
[input-port? i]
|
|
|
|
|
[port? i]
|
|
|
|
|
[port-name i]
|
|
|
|
|
[input-port-name i]
|
|
|
|
|
[output-port-name i]
|
|
|
|
|
[open-input-file i]
|
|
|
|
|
[with-input-from-file i]
|
|
|
|
|
[with-output-to-file i]
|
|
|
|
|
[open-output-file i]
|
|
|
|
|
[open-output-string i]
|
|
|
|
|
[get-output-string i]
|
|
|
|
|
[close-input-port i]
|
|
|
|
|
[close-output-port i]
|
|
|
|
|
[console-input-port i]
|
|
|
|
|
[console-output-port i]
|
|
|
|
|
[current-input-port i]
|
|
|
|
|
[current-output-port i]
|
|
|
|
|
[standard-input-port i]
|
|
|
|
|
[standard-output-port i]
|
|
|
|
|
[standard-error-port i]
|
|
|
|
|
[flush-output-port i]
|
|
|
|
|
[reset-input-port! i]
|
|
|
|
|
[display i]
|
|
|
|
|
[write i]
|
|
|
|
|
[write-char i]
|
|
|
|
|
[read i]
|
|
|
|
|
[read-char i]
|
|
|
|
|
[read-token i]
|
|
|
|
|
[peek-char i]
|
|
|
|
|
[unread-char i]
|
|
|
|
|
[newline i]
|
|
|
|
|
[printf i]
|
|
|
|
|
[format i]
|
|
|
|
|
[pretty-print i]
|
|
|
|
|
[comment-handler i]
|
|
|
|
|
[print-gensym i]
|
|
|
|
|
[gensym-count i]
|
|
|
|
|
[gensym-prefix i]
|
|
|
|
|
[make-hash-table i]
|
|
|
|
|
[hash-table? i]
|
|
|
|
|
[get-hash-table i]
|
|
|
|
|
[put-hash-table! i]
|
|
|
|
|
[make-parameter i]
|
|
|
|
|
[apply i]
|
|
|
|
|
[values i]
|
|
|
|
|
[call-with-values i]
|
|
|
|
|
[call/cc i]
|
|
|
|
|
[call/cf i]
|
|
|
|
|
[dynamic-wind i]
|
|
|
|
|
[error i]
|
|
|
|
|
[print-error i]
|
|
|
|
|
[error-handler i]
|
|
|
|
|
[interrupt-handler i]
|
|
|
|
|
[exit i]
|
|
|
|
|
[load i]
|
|
|
|
|
[assembler-output i]
|
|
|
|
|
[new-cafe i]
|
|
|
|
|
[command-line-arguments i]
|
|
|
|
|
[record? i]
|
|
|
|
|
[make-record-type i]
|
|
|
|
|
[record-type-descriptor i]
|
|
|
|
|
[record-type-field-names i]
|
|
|
|
|
[record-type-symbol i]
|
|
|
|
|
[record-type-name i]
|
|
|
|
|
[record-name i]
|
|
|
|
|
[record-constructor i]
|
|
|
|
|
[record-predicate i]
|
|
|
|
|
[record-length i]
|
|
|
|
|
[record-printer i]
|
|
|
|
|
[record-ref i]
|
|
|
|
|
[record-field-accessor i]
|
|
|
|
|
[record-field-mutator i]
|
|
|
|
|
[identifier? i]
|
|
|
|
|
[syntax-error i]
|
|
|
|
|
[generate-temporaries i]
|
|
|
|
|
[free-identifier=? i]
|
|
|
|
|
[code? i]
|
|
|
|
|
[immediate? i]
|
|
|
|
|
[pointer-value i]
|
2007-05-06 20:54:30 -04:00
|
|
|
|
|
|
|
|
[current-library-collection $boot]
|
|
|
|
|
[compile-core-expr-to-port $boot]
|
|
|
|
|
[current-primitive-locations $boot]
|
|
|
|
|
[boot-library-expand $boot]
|
2007-05-06 17:41:59 -04:00
|
|
|
; (ikarus system $pairs)
|
|
|
|
|
[$car $pairs]
|
|
|
|
|
[$cdr $pairs]
|
|
|
|
|
[$set-car! $pairs]
|
|
|
|
|
[$set-cdr! $pairs]
|
|
|
|
|
; (ikarus system $lists)
|
|
|
|
|
[$memq $lists]
|
|
|
|
|
[$memv $lists]
|
|
|
|
|
; (ikarus system $chars)
|
|
|
|
|
[$char? $chars]
|
|
|
|
|
[$char= $chars]
|
|
|
|
|
[$char< $chars]
|
|
|
|
|
[$char> $chars]
|
|
|
|
|
[$char<= $chars]
|
|
|
|
|
[$char>= $chars]
|
|
|
|
|
[$char->fixnum $chars]
|
|
|
|
|
[$fixnum->char $chars]
|
|
|
|
|
; (ikarus system $strings)
|
|
|
|
|
[$make-string $strings]
|
|
|
|
|
[$string-ref $strings]
|
|
|
|
|
[$string-set! $strings]
|
|
|
|
|
[$string-length $strings]
|
|
|
|
|
; (ikarus system $vectors)
|
|
|
|
|
[$make-vector $vectors]
|
|
|
|
|
[$vector-length $vectors]
|
|
|
|
|
[$vector-ref $vectors]
|
|
|
|
|
[$vector-set! $vectors]
|
|
|
|
|
; (ikarus system $fx)
|
|
|
|
|
[$fxzero? $fx]
|
|
|
|
|
[$fxadd1 $fx]
|
|
|
|
|
[$fxsub1 $fx]
|
|
|
|
|
[$fx>= $fx]
|
|
|
|
|
[$fx<= $fx]
|
|
|
|
|
[$fx> $fx]
|
|
|
|
|
[$fx< $fx]
|
|
|
|
|
[$fx= $fx]
|
|
|
|
|
[$fxsll $fx]
|
|
|
|
|
[$fxsra $fx]
|
|
|
|
|
[$fxquotient $fx]
|
|
|
|
|
[$fxmodulo $fx]
|
|
|
|
|
[$fxlogxor $fx]
|
|
|
|
|
[$fxlogor $fx]
|
|
|
|
|
[$fxlognot $fx]
|
|
|
|
|
[$fxlogand $fx]
|
|
|
|
|
[$fx+ $fx]
|
|
|
|
|
[$fx* $fx]
|
|
|
|
|
[$fx- $fx]
|
|
|
|
|
; (ikarus system $symbols)
|
|
|
|
|
[$make-symbol $symbols]
|
|
|
|
|
[$symbol-unique-string $symbols]
|
|
|
|
|
[$symbol-value $symbols]
|
|
|
|
|
[$symbol-string $symbols]
|
|
|
|
|
[$symbol-plist $symbols]
|
|
|
|
|
[$set-symbol-value! $symbols]
|
|
|
|
|
[$set-symbol-string! $symbols]
|
|
|
|
|
[$set-symbol-unique-string! $symbols]
|
|
|
|
|
[$set-symbol-plist! $symbols]
|
2007-05-06 18:43:04 -04:00
|
|
|
[$unbound-object? $symbols]
|
2007-05-06 17:41:59 -04:00
|
|
|
; (ikarus system $records)
|
|
|
|
|
[base-rtd $records]
|
|
|
|
|
[$record-set! $records]
|
|
|
|
|
[$record-ref $records]
|
|
|
|
|
[$record-rtd $records]
|
|
|
|
|
[$record $records]
|
|
|
|
|
[$make-record $records]
|
|
|
|
|
[$record? $records]
|
|
|
|
|
[$record/rtd? $records]
|
|
|
|
|
; (ikarus system $ports)
|
|
|
|
|
[$make-port/input $ports]
|
|
|
|
|
[$make-port/output $ports]
|
|
|
|
|
[$make-port/both $ports]
|
|
|
|
|
[$port-handler $ports]
|
|
|
|
|
[$port-input-buffer $ports]
|
|
|
|
|
[$port-input-index $ports]
|
|
|
|
|
[$port-input-size $ports]
|
|
|
|
|
[$port-output-buffer $ports]
|
|
|
|
|
[$port-output-index $ports]
|
|
|
|
|
[$port-output-size $ports]
|
|
|
|
|
[$set-port-input-index! $ports]
|
|
|
|
|
[$set-port-input-size! $ports]
|
|
|
|
|
[$set-port-output-index! $ports]
|
|
|
|
|
[$set-port-output-size! $ports]
|
|
|
|
|
; (ikarus system $codes)
|
|
|
|
|
[$closure-code $codes]
|
|
|
|
|
[$code->closure $codes]
|
|
|
|
|
[$code-reloc-vector $codes]
|
|
|
|
|
[$code-freevars $codes]
|
|
|
|
|
[$code-size $codes]
|
|
|
|
|
[$code-ref $codes]
|
|
|
|
|
[$code-set! $codes]
|
|
|
|
|
; (ikarus system $tcbuckets)
|
|
|
|
|
[$make-tcbucket $tcbuckets]
|
|
|
|
|
[$tcbucket-key $tcbuckets]
|
|
|
|
|
[$tcbucket-val $tcbuckets]
|
|
|
|
|
[$tcbucket-next $tcbuckets]
|
|
|
|
|
[$set-tcbucket-val! $tcbuckets]
|
|
|
|
|
[$set-tcbucket-next! $tcbuckets]
|
|
|
|
|
[$set-tcbucket-tconc! $tcbuckets]
|
|
|
|
|
; (ikarus system $io)
|
|
|
|
|
[$flush-output-port $io]
|
|
|
|
|
[$reset-input-port! $io]
|
|
|
|
|
[$close-input-port $io]
|
|
|
|
|
[$close-output-port $io]
|
|
|
|
|
[$write-char $io]
|
|
|
|
|
[$read-char $io]
|
|
|
|
|
[$peek-char $io]
|
|
|
|
|
[$unread-char $io]
|
2007-05-06 18:10:51 -04:00
|
|
|
; (ikarus system $arg-list)
|
2007-05-06 18:04:15 -04:00
|
|
|
[$arg-list $arg-list]
|
2007-05-06 18:10:51 -04:00
|
|
|
; (ikarus system $stack)
|
|
|
|
|
[$$apply $stack]
|
|
|
|
|
[$fp-at-base $stack]
|
|
|
|
|
[$primitive-call/cc $stack]
|
|
|
|
|
[$frame->continuation $stack]
|
|
|
|
|
[$current-frame $stack]
|
|
|
|
|
[$seal-frame-and-call $stack]
|
|
|
|
|
[$make-call-with-values-procedure $stack]
|
|
|
|
|
[$make-values-procedure $stack]
|
2007-05-06 20:15:49 -04:00
|
|
|
; (ikarus system $interrupts)
|
|
|
|
|
[$interrupted? $interrupts]
|
|
|
|
|
[$unset-interrupted! $interrupts]
|
2007-05-06 20:18:36 -04:00
|
|
|
;;; the following must be defined but they don't have
|
|
|
|
|
;;; to reside in any library since they're here so that
|
|
|
|
|
;;; the compiler can target them. They're not usable
|
|
|
|
|
;;; by the end user.
|
|
|
|
|
[$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 ]
|
|
|
|
|
[do-stack-overflow ]
|
|
|
|
|
[syntax-dispatch ]
|
2007-05-06 17:41:59 -04:00
|
|
|
))
|
2007-05-06 17:02:49 -04:00
|
|
|
|
2007-05-06 17:41:59 -04:00
|
|
|
(define (verify-procedures-map)
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(unless (assq x library-legend)
|
|
|
|
|
(error 'verify "~s is not in the libraries list" x)))
|
|
|
|
|
(cdr x)))
|
|
|
|
|
ikarus-procedures-map))
|
2007-05-06 17:02:49 -04:00
|
|
|
|
2007-05-04 07:46:33 -04:00
|
|
|
(define (make-collection)
|
|
|
|
|
(let ([set '()])
|
|
|
|
|
(case-lambda
|
|
|
|
|
[() set]
|
2007-05-04 07:50:42 -04:00
|
|
|
[(x) (set! set (cons x set))])))
|
2007-05-04 07:46:33 -04:00
|
|
|
|
2007-05-04 07:16:32 -04:00
|
|
|
(define (make-system-data subst env)
|
2007-05-04 09:13:14 -04:00
|
|
|
(define who 'make-system-data)
|
2007-05-04 07:46:33 -04:00
|
|
|
(let ([export-subst (make-collection)]
|
|
|
|
|
[export-env (make-collection)]
|
|
|
|
|
[export-primlocs (make-collection)])
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(let ([name (car x)] [binding (cadr x)])
|
|
|
|
|
(let ([label (gensym)])
|
|
|
|
|
(export-subst (cons name label))
|
|
|
|
|
(export-env (cons label binding)))))
|
|
|
|
|
ikarus-system-macros)
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(cond
|
2007-05-04 09:13:14 -04:00
|
|
|
[(assq x (export-subst))
|
|
|
|
|
(error who "ambiguous export of ~s" x)]
|
2007-05-04 07:46:33 -04:00
|
|
|
[(assq x subst) =>
|
|
|
|
|
(lambda (p)
|
|
|
|
|
(let ([label (cdr p)])
|
|
|
|
|
(cond
|
|
|
|
|
[(assq label env) =>
|
|
|
|
|
(lambda (p)
|
|
|
|
|
(let ([binding (cdr p)])
|
|
|
|
|
(case (car binding)
|
|
|
|
|
[(global)
|
|
|
|
|
(export-subst (cons x label))
|
|
|
|
|
(export-env (cons label (cons 'core-prim x)))
|
|
|
|
|
(export-primlocs (cons x (cdr binding)))]
|
|
|
|
|
[else
|
|
|
|
|
(error #f "invalid binding ~s for ~s" p x)])))]
|
|
|
|
|
[else (error #f "cannot find binding for ~s" x)])))]
|
2007-05-06 20:01:18 -04:00
|
|
|
[else
|
|
|
|
|
;;; core primitive with no backing definition
|
|
|
|
|
(let ([label (gensym)])
|
|
|
|
|
(export-subst (cons x label))
|
|
|
|
|
(export-env (cons label (cons 'core-prim x))))]))
|
2007-05-04 11:16:42 -04:00
|
|
|
(map car ikarus-procedures-map))
|
2007-05-04 07:46:33 -04:00
|
|
|
(values (export-subst) (export-env) (export-primlocs))))
|
|
|
|
|
|
2007-05-04 09:13:14 -04:00
|
|
|
(define (get-export-subset key subst)
|
|
|
|
|
(let f ([ls subst])
|
|
|
|
|
(cond
|
|
|
|
|
[(null? ls) '()]
|
|
|
|
|
[else
|
|
|
|
|
(let ([x (car ls)])
|
|
|
|
|
(let ([name (car x)])
|
|
|
|
|
(cond
|
2007-05-04 11:16:42 -04:00
|
|
|
[(or (assq name ikarus-procedures-map)
|
|
|
|
|
(assq name ikarus-macros-map))
|
|
|
|
|
=>
|
2007-05-04 09:13:14 -04:00
|
|
|
(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))])))])))
|
2007-05-03 03:58:43 -04:00
|
|
|
|
2007-05-04 06:14:20 -04:00
|
|
|
(define (build-system-library export-subst export-env primlocs)
|
2007-05-04 09:13:14 -04:00
|
|
|
(define (build-library legend-entry)
|
|
|
|
|
(let ([key (car legend-entry)] [name (cadr legend-entry)])
|
|
|
|
|
(let ([id (gensym)]
|
|
|
|
|
[name name]
|
|
|
|
|
[version '()]
|
|
|
|
|
[import-libs '()]
|
|
|
|
|
[visit-libs '()]
|
2007-05-06 19:20:52 -04:00
|
|
|
[invoke-libs '()])
|
|
|
|
|
(let-values ([(subst env)
|
|
|
|
|
(if (equal? name '(ikarus 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)))))
|
2007-05-04 09:13:14 -04:00
|
|
|
(let ([code `(library (ikarus primlocs)
|
|
|
|
|
(export) ;;; must be empty
|
2007-05-06 18:58:54 -04:00
|
|
|
(import
|
|
|
|
|
(only (ikarus library-manager)
|
|
|
|
|
install-library)
|
2007-05-06 20:54:30 -04:00
|
|
|
(only (ikarus compiler)
|
|
|
|
|
current-primitive-locations)
|
2007-05-06 19:14:51 -04:00
|
|
|
(ikarus))
|
2007-05-04 09:13:14 -04:00
|
|
|
(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)))
|
2006-11-23 19:44:29 -05:00
|
|
|
|
2007-05-03 04:38:48 -04:00
|
|
|
(define (expand-all files)
|
|
|
|
|
(let ([code* '()]
|
|
|
|
|
[subst '()]
|
|
|
|
|
[env '()])
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (file)
|
2007-05-06 17:41:59 -04:00
|
|
|
(printf "expanding ~s\n" file)
|
2007-05-03 04:38:48 -04:00
|
|
|
(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)
|
2007-05-04 09:13:14 -04:00
|
|
|
(printf "building system ...\n")
|
2007-05-04 07:16:32 -04:00
|
|
|
(let-values ([(export-subst export-env export-locs)
|
|
|
|
|
(make-system-data subst env)])
|
|
|
|
|
(let ([code (build-system-library export-subst export-env export-locs)])
|
2007-05-03 04:38:48 -04:00
|
|
|
(values
|
|
|
|
|
(reverse (list* (car code*) code (cdr code*)))
|
2007-05-04 07:16:32 -04:00
|
|
|
export-locs)))))
|
2006-11-23 19:44:29 -05:00
|
|
|
|
2007-05-06 17:41:59 -04:00
|
|
|
(verify-procedures-map)
|
|
|
|
|
|
2007-05-01 17:39:17 -04:00
|
|
|
(printf "expanding ...\n")
|
2007-05-02 00:06:44 -04:00
|
|
|
|
2007-05-04 07:16:32 -04:00
|
|
|
(let-values ([(core* locs) (expand-all scheme-library-files)])
|
2007-05-01 17:39:17 -04:00
|
|
|
(printf "compiling ...\n")
|
2007-05-04 07:16:32 -04:00
|
|
|
(parameterize ([current-primitive-locations
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(cond
|
|
|
|
|
[(assq x locs) => cdr]
|
2007-05-06 20:12:25 -04:00
|
|
|
[else
|
|
|
|
|
(error 'bootstrap "no location for ~s" x)]))])
|
2007-05-04 07:16:32 -04:00
|
|
|
(let ([p (open-output-file "ikarus.boot" 'replace)])
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (x) (compile-core-expr-to-port x p))
|
|
|
|
|
core*)
|
|
|
|
|
(close-output-port p))))
|
2007-05-02 00:06:44 -04:00
|
|
|
|
2007-05-01 17:39:17 -04:00
|
|
|
(printf "Happy Happy Joy Joy\n"))
|
2007-04-28 20:54:02 -04:00
|
|
|
|
2007-05-03 01:49:16 -04:00
|
|
|
(invoke (ikarus makefile))
|
2007-05-04 11:16:42 -04:00
|
|
|
|
2007-05-05 23:10:47 -04:00
|
|
|
;;; vim:syntax=scheme
|
