From 32d5e78d9e19e2bb85e8c57deecb9c560d114716 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 22 May 2011 13:59:36 -0700 Subject: [PATCH] adding new repl commands for manipulating modules. also repl doesn't use vt100 editing for dumb terminals. --- lib/chibi/repl.module | 4 +- lib/chibi/repl.scm | 141 +++++++++++++++++++++++++++++++----------- 2 files changed, 109 insertions(+), 36 deletions(-) diff --git a/lib/chibi/repl.module b/lib/chibi/repl.module index 445983bf..d5dca322 100644 --- a/lib/chibi/repl.module +++ b/lib/chibi/repl.module @@ -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")) diff --git a/lib/chibi/repl.scm b/lib/chibi/repl.scm index 5c297ee2..36e1adaf 100644 --- a/lib/chibi/repl.scm +++ b/lib/chibi/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)))))))))