adding new repl commands for manipulating modules.

also repl doesn't use vt100 editing for dumb terminals.

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"))

lib/chibi/repl.scm

@@ -10,24 +10,98 @@
       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)
+(define module? vector?)
-  (let ((history (make-history)))
+(define (module-env mod) (vector-ref mod 1))
-    (let lp ((module module) (env env))
+
-      (let ((line
+(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
-              (string-append (if module (symbol->string module) "") "> ")
+                 'prompt: prompt
                  'history: history
-              'complete?: buffer-complete-sexp?)))
+                 '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)
+          (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))))
@@ -49,7 +123,4 @@
                   (display "Interrupt\n" (current-error-port))
                   (thread-terminate! thread))
                 (lambda () (thread-join! (thread-start! thread))))))
-          (lp module env)))))))
+            (lp module env config-env)))))))))
-
-(define (repl)
-  (run-repl #f (interaction-environment)))