summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/system/repl/command.scm4
-rw-r--r--module/system/repl/common.scm46
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))
;;;