mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 22:59:16 +02:00
adding new repl commands for manipulating modules.
also repl doesn't use vt100 editing for dumb terminals.
This commit is contained in:
parent
f15885a1b6
commit
32d5e78d9e
2 changed files with 109 additions and 36 deletions
|
@ -3,8 +3,10 @@
|
|||
(export repl)
|
||||
(import-immutable (scheme))
|
||||
(import (chibi ast)
|
||||
(chibi io)
|
||||
(chibi process)
|
||||
(chibi term edit-line)
|
||||
(srfi 18)
|
||||
(srfi 38))
|
||||
(srfi 38)
|
||||
(srfi 98))
|
||||
(include "repl.scm"))
|
||||
|
|
|
@ -10,46 +10,117 @@
|
|||
thunk
|
||||
(lambda () (set-signal-action! sig old-handler)))))
|
||||
|
||||
(define (warn msg . args)
|
||||
(let ((out (current-error-port)))
|
||||
(display msg out)
|
||||
(for-each (lambda (x) (write-char #\space out) (write x out)) args)
|
||||
(newline out)))
|
||||
|
||||
(define (write-to-string x)
|
||||
(call-with-output-string (lambda (out) (write x out))))
|
||||
|
||||
(define (buffer-complete-sexp? buf)
|
||||
(guard (exn (else #f))
|
||||
(call-with-input-string (buffer->string buf) read)
|
||||
(call-with-input-string (buffer->string buf)
|
||||
(lambda (in)
|
||||
(let lp () (if (not (eof-object? (read/ss in))) (lp)))))
|
||||
#t))
|
||||
|
||||
(define (run-repl module env . o)
|
||||
(let ((history (make-history)))
|
||||
(let lp ((module module) (env env))
|
||||
(let ((line
|
||||
(edit-line
|
||||
(string-append (if module (symbol->string module) "") "> ")
|
||||
'history: history
|
||||
'complete?: buffer-complete-sexp?)))
|
||||
(define module? vector?)
|
||||
(define (module-env mod) (vector-ref mod 1))
|
||||
|
||||
(define (repl . o)
|
||||
(let* ((module (cond ((memq 'module: o) => cadr) (else #f)))
|
||||
(env (if module
|
||||
(module-env (if (module? module)
|
||||
module
|
||||
(eval `(load-module ',module) *config-env*)))
|
||||
(interaction-environment)))
|
||||
(history (cond ((memq 'history: o) => cadr) (else (make-history))))
|
||||
(raw? (cond ((memq 'raw?: o) => cadr)
|
||||
(else (member (get-environment-variable "TERM")
|
||||
'("emacs" "dumb"))))))
|
||||
(let lp ((module module) (env env) (config-env *config-env*))
|
||||
(let* ((prompt
|
||||
(string-append (if module (write-to-string module) "") "> "))
|
||||
(line
|
||||
(cond
|
||||
(raw?
|
||||
(display prompt)
|
||||
(flush-output)
|
||||
(read-line))
|
||||
(else
|
||||
(edit-line
|
||||
'prompt: prompt
|
||||
'history: history
|
||||
'complete?: buffer-complete-sexp?)))))
|
||||
(cond
|
||||
((or (not line) (eof-object? line)))
|
||||
((equal? line "") (lp module env))
|
||||
((equal? line "") (lp module env config-env))
|
||||
(else
|
||||
(history-commit! history line)
|
||||
(guard
|
||||
(exn
|
||||
(else (print-exception exn (current-error-port))))
|
||||
(let* ((expr (call-with-input-string line read/ss))
|
||||
(thread
|
||||
(make-thread
|
||||
(lambda ()
|
||||
(guard
|
||||
(exn
|
||||
(else (print-exception exn (current-error-port))))
|
||||
(let ((res (eval expr env)))
|
||||
(cond
|
||||
((not (eq? res (if #f #f)))
|
||||
(write/ss res)
|
||||
(newline)))))))))
|
||||
(with-signal-handler
|
||||
signal/interrupt
|
||||
(lambda (n)
|
||||
(display "Interrupt\n" (current-error-port))
|
||||
(thread-terminate! thread))
|
||||
(lambda () (thread-join! (thread-start! thread))))))
|
||||
(lp module env)))))))
|
||||
|
||||
(define (repl)
|
||||
(run-repl #f (interaction-environment)))
|
||||
(cond
|
||||
((and (> (string-length line) 0) (eqv? #\@ (string-ref line 0)))
|
||||
(let meta ((env env)
|
||||
(line (substring line 1 (string-length line)))
|
||||
(continue lp))
|
||||
(define (fail msg . args)
|
||||
(apply warn msg args)
|
||||
(continue module env config-env))
|
||||
(call-with-input-string line
|
||||
(lambda (in)
|
||||
(let ((op (read/ss in)))
|
||||
(case op
|
||||
((in)
|
||||
(let ((name (read/ss in)))
|
||||
(cond
|
||||
((eof-object? name)
|
||||
(continue #f (interaction-environment) config-env))
|
||||
((eval `(load-module ',name) config-env)
|
||||
=> (lambda (m)
|
||||
(continue name (module-env m) config-env)))
|
||||
(else
|
||||
(fail "couldn't find module:" name)))))
|
||||
((config)
|
||||
(let ((expr (read/ss in)))
|
||||
(cond
|
||||
((and (symbol? expr)
|
||||
(eqv? #\@ (string-ref (symbol->string expr) 0)))
|
||||
(meta config-env
|
||||
(substring line 6 (string-length line))
|
||||
(lambda _ (continue module env config-env))))
|
||||
(else
|
||||
(eval expr config-env)
|
||||
(continue module env config-env)))))
|
||||
((config-module-is)
|
||||
(let ((name (read/ss in)))
|
||||
(cond
|
||||
((eval `(load-module ',name) config-env)
|
||||
=> (lambda (m) (lp module env (module-env m))))
|
||||
(else
|
||||
(fail "couldn't find module:" name)))))
|
||||
(else
|
||||
(fail "unknown repl command:" op))))))))
|
||||
(else
|
||||
(guard
|
||||
(exn
|
||||
(else (print-exception exn (current-error-port))))
|
||||
(let* ((expr (call-with-input-string line read/ss))
|
||||
(thread
|
||||
(make-thread
|
||||
(lambda ()
|
||||
(guard
|
||||
(exn
|
||||
(else (print-exception exn (current-error-port))))
|
||||
(let ((res (eval expr env)))
|
||||
(cond
|
||||
((not (eq? res (if #f #f)))
|
||||
(write/ss res)
|
||||
(newline)))))))))
|
||||
(with-signal-handler
|
||||
signal/interrupt
|
||||
(lambda (n)
|
||||
(display "Interrupt\n" (current-error-port))
|
||||
(thread-terminate! thread))
|
||||
(lambda () (thread-join! (thread-start! thread))))))
|
||||
(lp module env config-env)))))))))
|
||||
|
|
Loading…
Add table
Reference in a new issue