CombineFiles.scheme
Copyright Ó 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Michael Plass, December 27, 1990 10:31 am PST
Last changed by Pavel on January 31, 1990 5:15:46 pm PST
(define (make-scheme-lite) (make-scheme-config "Scheme"
"DynamicWind" "Lists" "Numbers" "Miscellaneous" "Iterate" "Records" "Tables" "Dynamics" "Debugger" "Syntax1" "Syntax2" "Quasiquote" "ExtendSyntax" "Expand" "Hobbit" "Trace"
))
(define (make-tidbit) (make-scheme-config "Tidbit"
"TidbitTop" "TidbitMisc" "TidbitIntCode" "TidbitCedar"
))
(define (make-scheme-config out . system-component-names)
(define (compile filename)
(format #t "(hobbit-file ~S) ..." filename)
(hobbit-file filename)
(display " done.")
(newline)
)
(define outname (string-append out ".$cheme"))
(for-each compile system-component-names)
(display "Combining files to make ")
(display outname)
(display ". . .")
(combine-compiled-files outname system-component-names)
(display "done.")
(newline)
)
(define (combine-compiled-files out in)
(define (read-file-list name)
(call-with-input-file (string-append name ".$cheme") (lambda (p)
(define head (list ""))
(let loop ((last head) (a (read p)))
(if (eof-object? a)
(cdr head)
(begin
(set-cdr! last (list a))
(loop (cdr last) (read p)))))
))
)
(call-with-output-file out (lambda (p)
(binary-write (cons '#!begin (apply append (map read-file-list in))) p)))
)