mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 10:10:23 +02:00
Code Activity

validating repl options; value-history on by default

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-07-10 11:19:19 +02:00
parent 8c8a13ecf5
commit c27d140ab4
2 changed files with 34 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/system/repl/command.scm
View file

@ -305,8 +305,8 @@ Show description/documentation."
List/show/set options." List/show/set options."
(pmatch args (pmatch args
(() (()
(for-each (lambda (key+val) (for-each (lambda (spec)
(format #t "~A\t~A\n" (car key+val) (cdr key+val))) (format #t " ~A~24t~A\n" (car spec) (cadr spec)))
(repl-options repl))) (repl-options repl)))
((,key) ((,key)
(display (repl-option-ref repl key)) (display (repl-option-ref repl key))

46
module/system/repl/common.scm
View file

@ -24,6 +24,7 @@
#:use-module (system base language) #:use-module (system base language)
#:use-module (system vm program) #:use-module (system vm program)
#:use-module (ice-9 control) #:use-module (ice-9 control)
#:use-module (ice-9 history)
#:export (<repl> make-repl repl-language repl-options #:export (<repl> make-repl repl-language repl-options
repl-tm-stats repl-gc-stats repl-inport repl-outport repl-debug repl-tm-stats repl-gc-stats repl-inport repl-outport repl-debug
repl-welcome repl-prompt repl-welcome repl-prompt
@ -105,9 +106,21 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(define repl-default-options (define repl-default-options
(copy-tree (copy-tree
'((compile-options . (#:warnings (unbound-variable arity-mismatch))) `((compile-options (#:warnings (unbound-variable arity-mismatch)) #f)
(trace . #f) (trace #f #f)
(interp . #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 make-repl)
(define* (make-repl lang #:optional debug) (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)))) (let* ((eval (language-evaluator (repl-language repl))))
(if (and eval (if (and eval
(or (null? (language-compilers (repl-language repl))) (or (null? (language-compilers (repl-language repl)))
(assq-ref (repl-options repl) 'interp))) (repl-option-ref repl 'interp)))
(lambda () (eval form (current-module))) (lambda () (eval form (current-module)))
(make-program (repl-compile repl form))))) (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))))) (newline (repl-outport repl)))))
(define (repl-option-ref repl key) (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) (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) (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) (define (repl-default-prompt-set! prompt)
(repl-default-option-set! (repl-default-option-set! 'prompt prompt))
'prompt
(cond
((string? prompt) (lambda (repl) prompt))
((thunk? prompt) (lambda (repl) (prompt)))
((procedure? prompt) prompt)
(else (error "Invalid prompt" prompt)))))
;;; ;;;