diff --git a/src/ikarus.boot b/src/ikarus.boot index 13584af..0d635b4 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/makefile.ss b/src/makefile.ss index 0345d3a..bd93f3a 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -1,218 +1,58 @@ #!/usr/bin/env ikarus -b ikarus.boot --script -;;; 9.1: * starting with libnumerics -;;; 9.0: * graph marks for both reader and writer -;;; * circularity detection during read -;;; 8.1: * using chez-style io ports -;;; 6.9: * creating a *system* environment -;;; 6.8: * creating a core-primitive form in the expander -;;; 6.2: * side-effects now modify the dirty-vector -;;; * added bwp-object? -;;; * added pointer-value -;;; * added tcbuckets -;;; 6.1: * added case-lambda, dropped lambda -;;; 6.0: * basic compiler - (library (ikarus makefile) - (export) - (import (scheme)) + (export) + (import (scheme)) + + (define scheme-library-files + '("libhandlers.ss" + "libcontrol.ss" + "libcollect.ss" + "librecord.ss" + "libcxr.ss" + "libnumerics.ss" + "libguardians.ss" + "libcore.ss" + "libchezio.ss" + "libhash.ss" + "libwriter.ss" + "libtokenizer.ss" + "libassembler.ss" + "libintelasm.ss" + "libfasl.ss" + "libtrace.ss" + "libcompile.ss" + "libsyntax.ss" + "libpp.ss" + "libcafe.ss" + "libposix.ss" + "libtimers.ss" + "libtoplevel.ss")) + + (define (read-file file) + (with-input-from-file file + (lambda () + (let f () + (let ([x (read)]) + (if (eof-object? x) + '() + (cons x (f)))))))) + + (define (expand-library-file ifile) + (map chi-top-library (read-file ifile))) -(define macros - '(|#primitive| lambda case-lambda set! quote begin define if letrec - foreign-call ;$apply - quasiquote unquote unquote-splicing - define-syntax identifier-syntax let-syntax letrec-syntax - fluid-let-syntax alias meta eval-when with-implicit with-syntax - type-descriptor - syntax-case syntax-rules module $module import $import import-only - syntax quasisyntax unsyntax unsyntax-splicing datum - let let* let-values cond case define-record or and when unless do - include parameterize trace untrace trace-lambda trace-define - rec library - time)) - - - -(define public-primitives - '( - - null? pair? char? fixnum? bignum? symbol? gensym? string? vector? list? - boolean? procedure? not eof-object eof-object? bwp-object? - void fx= fx< fx<= fx> fx>= fxzero? fx+ fx- fx* fxadd1 fxsub1 - fxquotient fxremainder fxmodulo fxsll fxsra fxlognot fxlogor - fxlogand fxlogxor integer->char char->integer char=? char? char>=? cons car cdr set-car! set-cdr! caar - cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr - caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar - cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr list list* - make-list length list-ref append make-vector vector-ref - vector-set! vector-length vector vector->list list->vector - make-string string-ref string-set! string-length string - string->list list->string uuid string-append substring string=? - string? string>=? remprop putprop getprop - property-list $$apply apply map for-each andmap ormap memq memv assq - assv assoc eq? eqv? equal? reverse string->symbol symbol->string - top-level-value set-top-level-value! top-level-bound? - gensym gensym-count gensym-prefix print-gensym - gensym->unique-string call-with-values values make-parameter - dynamic-wind display write print-graph fasl-write printf fprintf format - print-error read-token read comment-handler error warning exit call/cc - error-handler eval current-eval compile alt-compile compile-file - alt-compile-file - new-cafe load system expand sc-expand current-expand expand-mode - environment? interaction-environment identifier? - free-identifier=? bound-identifier=? literal-identifier=? - datum->syntax-object syntax-object->datum syntax-error - syntax->list generate-temporaries record? record-set! record-ref - record-length record-type-descriptor make-record-type - record-printer record-name record-field-accessor - record-field-mutator record-predicate record-constructor - record-type-name record-type-symbol record-type-field-names - hash-table? make-hash-table get-hash-table put-hash-table! - assembler-output $make-environment - command-line-arguments port? input-port? output-port? - make-input-port make-output-port make-input/output-port - port-handler port-input-buffer port-input-index port-input-size - port-output-buffer port-output-index port-output-size - set-port-input-index! set-port-input-size! - set-port-output-index! set-port-output-size! port-name - input-port-name output-port-name write-char read-char - unread-char peek-char newline reset-input-port! - flush-output-port close-input-port close-output-port - console-input-port current-input-port standard-output-port - standard-error-port console-output-port current-output-port - open-output-file open-input-file open-output-string - with-output-to-string - get-output-string with-output-to-file call-with-output-file - open-input-string - with-input-from-file call-with-input-file date-string - file-exists? delete-file + - add1 sub1 * / expt - quotient+remainder quotient remainder modulo number? positive? - negative? zero? number->string logand = < > <= >= - last-pair - make-guardian weak-cons collect - interrupt-handler - time-it - posix-fork fork waitpid env environ - pretty-print - even? odd? member char-whitespace? char-alphabetic? - char-downcase max min complex? real? rational? - exact? inexact? integer? - string->number exact->inexact - - flonum? flonum->string string->flonum - sin cos atan sqrt - - chi-top-library compile-time-core-eval - )) - -(define system-primitives - '( - - $primitive-call/cc - $closure-code immediate? $unbound-object? $forward-ptr? - pointer-value primitive-ref primitive-set! $fx= $fx< $fx<= $fx> - $fx>= $fxzero? $fx+ $fx- $fx* $fxadd1 $fxsub1 $fxquotient - $fxremainder $fxmodulo $fxsll $fxsra $fxlognot $fxlogor - $fxlogand $fxlogxor $fixnum->char $char->fixnum $char= $char< - $char<= $char> $char>= $car $cdr $set-car! $set-cdr! - $make-vector $vector-ref $vector-set! $vector-length - $make-string $string-ref $string-set! $string-length $string - $symbol-string $symbol-unique-string $symbol-value - $set-symbol-string! $set-symbol-unique-string! - $set-symbol-value! $set-symbol-function! $make-symbol $set-symbol-plist! - $symbol-plist $sc-put-cte $record? $record/rtd? $record-set! - $record-ref $record-rtd $make-record $record $base-rtd $code? - $code-reloc-vector $code-freevars $code-size $code-ref - $code-set! $code->closure list*->code* make-code code? - set-code-reloc-vector! code-reloc-vector code-freevars - code-size code-ref code-set! $frame->continuation $fp-at-base - $current-frame $arg-list $seal-frame-and-call - $make-call-with-values-procedure $make-values-procedure - do-overflow $make-tcbucket $tcbucket-next $tcbucket-key - $tcbucket-val $set-tcbucket-next! $set-tcbucket-val! - $set-tcbucket-tconc! - call/cf - trace-symbol! untrace-symbol! make-traced-procedure - fixnum->string - $interrupted? $unset-interrupted! $do-event - $fasl-read - ;;; TODO: must open-code - - $make-port/input $make-port/output $make-port/both - $make-input-port $make-output-port $make-input/output-port - $port-handler $port-input-buffer $port-input-index - $port-input-size $port-output-buffer $port-output-index - $port-output-size $set-port-input-index! $set-port-input-size! - $set-port-output-index! $set-port-output-size! - - ;;; better open-code - - $write-char $read-char $peek-char $unread-char - - ;;; never open-code - - $reset-input-port! $close-input-port $close-output-port - $flush-output-port *standard-output-port* *standard-error-port* - *current-output-port* *standard-input-port* *current-input-port* - - ;;; - compile-core-expr-to-port - compiler-giveup-tally - )) - - -(define scheme-library-files - '(["libhandlers.ss" "libhandlers.fasl" p0 onepass] - ["libcontrol.ss" "libcontrol.fasl" p0 onepass] - ["libcollect.ss" "libcollect.fasl" p0 onepass] - ["librecord.ss" "librecord.fasl" p0 onepass] - ["libcxr.ss" "libcxr.fasl" p0 onepass] - ["libnumerics.ss" "libnumerics.fasl" p0 onepass] - ["libguardians.ss" "libguardians.fasl" p0 onepass] - ["libcore.ss" "libcore.fasl" p0 onepass] - ["libchezio.ss" "libchezio.fasl" p0 onepass] - ["libhash.ss" "libhash.fasl" p0 onepass] - ["libwriter.ss" "libwriter.fasl" p0 onepass] - ["libtokenizer.ss" "libtokenizer.fasl" p0 onepass] - ["libassembler.ss" "libassembler.fasl" p0 onepass] - ["libintelasm.ss" "libintelasm.fasl" p0 onepass] - ["libfasl.ss" "libfasl.fasl" p0 onepass] - ["libtrace.ss" "libtrace.fasl" p0 onepass] - ["libcompile.ss" "libcompile.fasl" p1 onepass] - ["libsyntax.ss" "libsyntax.fasl" p0 onepass] - ["libpp.ss" "libpp.fasl" p0 onepass] - ["libcafe.ss" "libcafe.fasl" p0 onepass] - ["libposix.ss" "libposix.fasl" p0 onepass] - ["libtimers.ss" "libtimers.fasl" p0 onepass] - ["libtoplevel.ss" "libtoplevel.fasl" p0 onepass] - )) - -(define (read-file ifile) - (with-input-from-file ifile - (lambda () - (let f () - (let ([x (read)]) - (if (eof-object? x) - '() - (cons x (f)))))))) - - -(define (join s ls) - (cond - [(null? ls) ""] - [else - (let ([str (open-output-string)]) - (let f ([a (car ls)] [d (cdr ls)]) - (cond - [(null? d) - (display a str) - (get-output-string str)] - [else - (display a str) - (display s str) - (f (car d) (cdr d))])))])) + (define (expand-all ls) + (apply append (map expand-library-file ls))) + (printf "expanding ...\n") + (let ([core* (expand-all scheme-library-files)]) + (printf "compiling ...\n") + (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")) ;;; ;;; NEW ARCHITECTURE @@ -232,40 +72,3 @@ ;;; (define compile-input-env ;;; '(;[prim-name export-loc] ;;; [car #{ikarus-car |174V9RJ/FjzvmJVu|}])) - - - - - -(define (new-compile-all) - (define (slurp-file file) - (with-input-from-file file - (lambda () - (let f () - (let ([x (read)]) - (if (eof-object? x) - '() - (cons x (f)))))))) - (define (expand-library ifile) - (map chi-top-library (slurp-file ifile))) - (define (expand-all ls) - (apply append (map (lambda (x) (expand-library (car x))) ls))) - (printf "expanding ...\n") - (let ([core* (expand-all scheme-library-files)]) - ;(with-output-to-file "ikarus.pp" - ; (lambda () - ; (for-each pretty-print core*)) - ; 'replace) - (printf "compiling ...\n") - (let ([p (open-output-file "ikarus.boot" 'replace)]) - (for-each - (lambda (x) (compile-core-expr-to-port x p)) - core*) - (close-output-port p)))) - -(new-compile-all) - -(printf "Happy Happy Joy Joy\n") -(exit) -) -; vim:syntax=scheme