(module repl mzscheme
(require "reader.ss"
(lib "util.ss" "planet"))
(define prim-eval (current-eval))
(define prim-namespace
(let ((src (current-namespace)))
(parameterize ((current-namespace (make-namespace 'empty)))
(namespace-attach-module src 'mzscheme)
(namespace-require
'mzscheme '(only mzscheme #%app #%top #%datum
quote lambda begin define let if set!
values
null? pair? list? cons car cdr
map list apply append
and > vector? = >= ))
(namespace-require
'(planet "expander.ss" ("dvanhorn" "r6rs-expander-vantonder.plt" 3 1)))
(eval '(define (nan? x)
(and (real? x)
(not (= x x)))))
(eval '(define (infinite? x)
(and (real? x)
(not (nan? x))
(nan? (- x x)))))
(current-namespace))))
(define library-path
(let-values (((base name must-be-dir?)
(split-path
(resolve-planet-path
'(planet "expander.ss" ("dvanhorn" "r6rs-expander-vantonder.plt" 3 1))))))
(build-path base "lib/")))
(parameterize ((read-curly-brace-as-paren #f) (read-accept-box #f)
(read-accept-compiled #f)
(read-accept-graph #f)
(read-accept-dot #t)
(read-accept-infix-dot #f)
(read-accept-quasiquote #t)
(read-accept-reader #f)
(current-readtable readtable) (current-prompt-read
(λ () (printf "R6RS> ")
(let ((x (read)))
(if (mzprim? x)
(namespace-require (mzprim-quoted-require x))
x))))
(current-eval
(λ (x)
(parameterize ((current-eval prim-eval)
(current-namespace prim-namespace))
(eval `(ex:repl '(,(if (and (pair? x)
(eq? '#%top-interaction (car x)))
(cdr x)
x))))))))
(parameterize ((current-directory library-path)
(current-load
(λ (path expected-module-name)
(let ((p (open-input-file path)))
(let loop ((x (read p)))
(cond
((eof-object? x) (close-input-port p) (values))
(else (eval x) (loop (read p)))))))))
(for-each load (list
"core.ss"
"core/define-values.ss"
"core/vector-types.ss"
"rnrs/eval.ss"
"rnrs/io/simple.ss"
"rnrs/unicode.ss"
"rnrs/eval.ss"
"rnrs/control.ss"
"rnrs/base.ss"
"rnrs/mutable-strings.ss"
"rnrs/mutable-pairs.ss"
"rnrs/syntax-case.ss"
"rnrs/files.ss"
"rnrs/programs.ss"
"rnrs/eval/reflection.ss"
"rnrs/lists.ss" "rnrs/r5rs.ss"
"rnrs/arithmetic/bitwise.ss"
"rnrs/bytevectors/private/core.ss" "rnrs/bytevectors/private/proto.ss" "rnrs/bytevectors/private/ieee.ss" "rnrs/bytevectors/private/string.ss" "rnrs/bytevectors.ss"
"rnrs/records/private/core.ss" "rnrs/records/procedural.ss" "rnrs/records/inspection.ss" "rnrs/records/private/explicit.ss" "rnrs/records/syntactic.ss"
"rnrs.ss"
"ubik/define-values.ss" "slib/record.ss"
"srfi/n5.ss" "srfi/n6.ss" "srfi/n8.ss" "srfi/n9.ss" "srfi/n11.ss"
"srfi/n16.ss"
"srfi/n17.ss"
"srfi/n26.ss" "srfi/n28.ss" "srfi/n31.ss"
"srfi/n39.ss"
"srfi/streams/primitive.ss" "srfi/n42.ss" "srfi/n54.ss"
"srfi/n60.ss" "srfi/n63.ss" "srfi/n66.ss" "srfi/n69.ss" "srfi/n74.ss" "srfi/n78.ss" "srfi/n95.ss"
"srfi/n5/tests.ss" "srfi/n6/tests.ss" "srfi/n9/tests.ss" "srfi/n42/tests.ss" "srfi/tests.ss"
"ubik/explicit-renaming.ss" "ubik/include.ss"
))
(read-eval-print-loop)))
(newline)
(exit)
)