Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 14:49:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding @import and @import-only to the repl.

Browse source
This commit is contained in:
Alex Shinn 2011-11-06 15:52:29 +09:00
parent 370d990df5
commit 731a6f6347
1 changed files with 82 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

149
lib/chibi/repl.scm
View file

@ -87,8 +87,8 @@
(cond ((memq 'history: o) => cadr) (cond ((memq 'history: o) => cadr)
(else (else
(or (guard (exn (else #f)) (or (guard (exn (else #f))
(list->history (list->history
(call-with-input-file history-file read))) (call-with-input-file history-file read)))
(make-history))))) (make-history)))))
(raw? (cond ((memq 'raw?: o) => cadr) (raw? (cond ((memq 'raw?: o) => cadr)
(else (member (get-environment-variable "TERM") (else (member (get-environment-variable "TERM")
@ -104,9 +104,9 @@
(read-line in)) (read-line in))
(else (else
(edit-line in out (edit-line in out
'prompt: prompt 'prompt: prompt
'history: history 'history: history
'complete?: buffer-complete-sexp?))))) 'complete?: buffer-complete-sexp?)))))
(cond (cond
((or (not line) (eof-object? line))) ((or (not line) (eof-object? line)))
((equal? line "") (lp module env meta-env)) ((equal? line "") (lp module env meta-env))
@ -121,70 +121,85 @@
(apply warn msg args) (apply warn msg args)
(continue module env meta-env)) (continue module env meta-env))
(call-with-input-string line (call-with-input-string line
(lambda (in) (lambda (in)
(let ((op (read/ss in))) (let ((op (read/ss in)))
(case op (case op
((in) ((import import-only)
(let ((name (read/ss in))) (let* ((mod-name (read in))
(cond (mod+imps (eval `(resolve-import ',mod-name)
((eof-object? name) meta-env)))
(continue #f (interaction-environment) meta-env)) (if (pair? mod+imps)
((eval `(load-module ',name) meta-env) (let ((env (if (eq? op 'import-only)
=> (lambda (m) (make-environment)
(continue name (module-env m) meta-env))) env))
(else (imp-env
(fail "couldn't find module:" name))))) (vector-ref
((meta config) (eval `(load-module ',mod-name) meta-env)
(if (eq? op 'config) 1)))
(display "Note: @config has been renamed @meta\n" out)) (%import env imp-env (cdr mod+imps) #f)
(let ((expr (read/ss in))) (continue module env meta-env))
(cond (fail "couldn't find module:" mod-name))))
((and ((in)
(symbol? expr) (let ((name (read/ss in)))
(eqv? escape (string-ref (symbol->string expr) 0))) (cond
(meta meta-env ((eof-object? name)
(substring line 6 (string-length line)) (continue #f (interaction-environment) meta-env))
(lambda _ (continue module env meta-env)))) ((eval `(load-module ',name) meta-env)
(else => (lambda (m)
(eval expr meta-env) (continue name (module-env m) meta-env)))
(continue module env meta-env))))) (else
((meta-module-is) (fail "couldn't find module:" name)))))
(let ((name (read/ss in))) ((meta config)
(cond (if (eq? op 'config)
((eval `(load-module ',name) meta-env) (display "Note: @config has been renamed @meta\n" out))
=> (lambda (m) (lp module env (module-env m)))) (let ((expr (read/ss in)))
(else (cond
(fail "couldn't find module:" name))))) ((and
((exit)) (symbol? expr)
(else (eqv? escape (string-ref (symbol->string expr) 0)))
(fail "unknown repl command:" op)))))))) (meta meta-env
(substring line 6 (string-length line))
(lambda _ (continue module env meta-env))))
(else
(eval expr meta-env)
(continue module env meta-env)))))
((meta-module-is)
(let ((name (read/ss in)))
(cond
((eval `(load-module ',name) meta-env)
=> (lambda (m) (lp module env (module-env m))))
(else
(fail "couldn't find module:" name)))))
((exit))
(else
(fail "unknown repl command:" op))))))))
(else (else
(guard (guard
(exn (exn
(else (print-exception exn (current-error-port)))) (else (print-exception exn (current-error-port))))
(let* ((expr (call-with-input-string line (let* ((expr (call-with-input-string line
(lambda (in2) (lambda (in2)
(set-port-fold-case! in2 (port-fold-case? in)) (set-port-fold-case! in2 (port-fold-case? in))
(let ((expr (read/ss in2))) (let ((expr (read/ss in2)))
(set-port-fold-case! in (port-fold-case? in2)) (set-port-fold-case! in (port-fold-case? in2))
expr)))) expr))))
(thread (thread
(make-thread (make-thread
(lambda () (lambda ()
(guard (guard
(exn (exn
(else (print-exception exn (current-error-port)))) (else (print-exception exn (current-error-port))))
(let ((res (eval expr env))) (let ((res (eval expr env)))
(cond (cond
((not (eq? res (if #f #f))) ((not (eq? res (if #f #f)))
(write/ss res) (write/ss res)
(newline))))))))) (newline)))))))))
(with-signal-handler (with-signal-handler
signal/interrupt signal/interrupt
(lambda (n) (lambda (n)
(display "Interrupt\n" (current-error-port)) (display "Interrupt\n" (current-error-port))
(thread-terminate! thread)) (thread-terminate! thread))
(lambda () (thread-join! (thread-start! thread)))))) (lambda () (thread-join! (thread-start! thread))))))
(lp module env meta-env))))))) (lp module env meta-env)))))))
(if history-file (if history-file
(call-with-output-file history-file (call-with-output-file history-file