diff options
-rw-r--r-- | module/system/repl/command.scm | 4 | ||||
-rw-r--r-- | module/system/repl/common.scm | 46 |
2 files changed, 34 insertions, 16 deletions
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 54a9ef512..1beaf31d9 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -305,8 +305,8 @@ Show description/documentation." List/show/set options." (pmatch args (() - (for-each (lambda (key+val) - (format #t "~A\t~A\n" (car key+val) (cdr key+val))) + (for-each (lambda (spec) + (format #t " ~A~24t~A\n" (car spec) (cadr spec))) (repl-options repl))) ((,key) (display (repl-option-ref repl key)) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index 0c42ea7dd..4fc8697d5 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -24,6 +24,7 @@ #:use-module (system base language) #:use-module (system vm program) #:use-module (ice-9 control) + #:use-module (ice-9 history) #:export (<repl> make-repl repl-language repl-options repl-tm-stats repl-gc-stats repl-inport repl-outport repl-debug repl-welcome repl-prompt @@ -105,9 +106,21 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.") (define repl-default-options (copy-tree - '((compile-options . (#:warnings (unbound-variable arity-mismatch))) - (trace . #f) - (interp . #f)))) + `((compile-options (#:warnings (unbound-variable arity-mismatch)) #f) + (trace #f #f) + (interp #f #f) + (prompt #f ,(lambda (prompt) + (cond + ((not prompt) #f) + ((string? prompt) (lambda (repl) prompt)) + ((thunk? prompt) (lambda (repl) (prompt))) + ((procedure? prompt) prompt) + (else (error "Invalid prompt" prompt))))) + (value-history + ,(value-history-enabled?) + ,(lambda (x) + (if x (enable-value-history!) (disable-value-history!)) + (->bool x)))))) (define %make-repl make-repl) (define* (make-repl lang #:optional debug) @@ -158,7 +171,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.") (let* ((eval (language-evaluator (repl-language repl)))) (if (and eval (or (null? (language-compilers (repl-language repl))) - (assq-ref (repl-options repl) 'interp))) + (repl-option-ref repl 'interp))) (lambda () (eval form (current-module))) (make-program (repl-compile repl form))))) @@ -178,22 +191,27 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.") (newline (repl-outport repl))))) (define (repl-option-ref repl key) - (assq-ref (repl-options repl) key)) + (cadr (or (assq key (repl-options repl)) + (error "unknown repl option" key)))) (define (repl-option-set! repl key val) - (set! (repl-options repl) (assq-set! (repl-options repl) key val))) + (let ((spec (or (assq key (repl-options repl)) + (error "unknown repl option" key)))) + (set-car! (cdr spec) + (if (procedure? (caddr spec)) + ((caddr spec) val) + val)))) (define (repl-default-option-set! key val) - (set! repl-default-options (assq-set! repl-default-options key val))) + (let ((spec (or (assq key repl-default-options) + (error "unknown repl option" key)))) + (set-car! (cdr spec) + (if (procedure? (caddr spec)) + ((caddr spec) val) + val)))) (define (repl-default-prompt-set! prompt) - (repl-default-option-set! - 'prompt - (cond - ((string? prompt) (lambda (repl) prompt)) - ((thunk? prompt) (lambda (repl) (prompt))) - ((procedure? prompt) prompt) - (else (error "Invalid prompt" prompt))))) + (repl-default-option-set! 'prompt prompt)) ;;; |