* Added a "boot-library-expand" to separate the top-library

expander from the experimental expander.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-02 00:06:44 -04:00
parent 718b20767f
commit 671e2f475c
3 changed files with 45 additions and 30 deletions

Binary file not shown.

View File

@ -979,6 +979,7 @@
[generate-temporaries generate-temporaries-label (core-prim . generate-temporaries)]
[free-identifier=? free-identifier=?-label (core-prim . free-identifier=?)]
[chi-top-library chi-top-library-label (core-prim . chi-top-library)]
[boot-library-expand boot-library-expand-label (core-prim . boot-library-expand)]
;;; codes
[$closure-code $closure-code-label (core-prim . $closure-code)]
[$code? $code?-label (core-prim . $code?)]
@ -2387,7 +2388,7 @@
r mr lhs* lex* rhs* kwd*)]
[else
(return e* module-init** r mr lhs* lex* rhs*)]))))]))))
(define library-expander^
(define library-expander
(lambda (e)
(let-values ([(name exp* b*) (parse-library e)])
(let ([rib (make-scheme-rib)]
@ -2404,11 +2405,6 @@
(build-void)
(build-sequence no-source
(chi-expr* init* r mr))))))))))
(define library-expander
(lambda (x)
(let ([v (library-expander^ x)])
;(pretty-print v)
v)))
(primitive-set! 'identifier? id?)
(primitive-set! 'generate-temporaries
(lambda (ls)
@ -2430,6 +2426,7 @@
(apply string-append args)
(strip x '()))))
(primitive-set! 'syntax-dispatch syntax-dispatch)
(primitive-set! 'boot-library-expand library-expander)
(primitive-set! 'chi-top-library library-expander))

View File

@ -5,30 +5,46 @@
(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"
;;; 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: ...).
;;;
'("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 ()
@ -39,12 +55,13 @@
(cons x (f))))))))
(define (expand-library-file ifile)
(map chi-top-library (read-file ifile)))
(map boot-library-expand (read-file ifile)))
(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)])
@ -52,6 +69,7 @@
(lambda (x) (compile-core-expr-to-port x p))
core*)
(close-output-port p)))
(printf "Happy Happy Joy Joy\n"))