summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-07-10 11:19:19 +0200
committerAndy Wingo <wingo@pobox.com>2010-07-10 11:19:19 +0200
commitc27d140ab4a5e5f6aad5a6e3912d06fb074358aa (patch)
tree3f4681f724ac3ac2caae8e3ff9eadb1d5a7805c5
parent8c8a13ecf5ee7c2d8342259cb9d187b8b16f1327 (diff)
downloadguile-c27d140ab4a5e5f6aad5a6e3912d06fb074358aa.tar.gz
validating repl options; value-history on by default
* module/system/repl/common.scm: Use (ice-9 history). Turns on value history by default. (repl-default-options): Expand the format of options to include an optional value transformer, run when setting a value. Add prompt and value-history options. (repl-prepare-eval-thunk): Use repl-option-ref. (repl-option-ref): Error if the option is unknown. (repl-option-set!, repl-default-option-set!): Error if the option is unknown. Pass the val through the transformer procedure. (repl-default-prompt-set!): Just use repl-default-option-set!. * module/system/repl/command.scm (option): Update for the new options format.
-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))
;;;