diff options
Diffstat (limited to 'scheme/guile')
| -rw-r--r-- | scheme/guile/geiser/evaluation.scm | 23 | 
1 files changed, 13 insertions, 10 deletions
| diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index 6b8df8f..1cc21a7 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/geiser/evaluation.scm @@ -40,8 +40,8 @@    (write (list (cons 'result result) (cons 'output output)))    (newline)) -(define compile-opts (make-fluid)) -(define compile-file-opts (make-fluid)) +(define compile-opts '()) +(define compile-file-opts '())  (define default-warnings '(arity-mismatch unbound-variable))  (define verbose-warnings `(unused-variable ,@default-warnings)) @@ -51,13 +51,14 @@                        ((symbol? wl) (case wl                                        ((none nil null) '())                                        ((medium default) default-warnings) -                                      ((high verbose) verbose-warnings))) +                                      ((high verbose) verbose-warnings) +                                      (else '())))                        (else '())))           (fwarns (if (memq 'unused-variable warns)                       (cons 'unused-toplevel warns)                       warns))) -    (fluid-set! compile-opts (list #:warnings warns)) -    (fluid-set! compile-file-opts (list #:warnings fwarns)))) +    (set! compile-opts (list #:warnings warns)) +    (set! compile-file-opts (list #:warnings fwarns))))  (ge:set-warnings 'none) @@ -71,10 +72,12 @@      (write-result result output)))  (define (compile/no-warns form module) -  (with-fluids ((compile-opts '())) -    (compile/warns form module))) +  (compile* form module '())) -(define (compile/warns form module-name) +(define (compile/warns form module) +  (compile* form module compile-opts)) + +(define (compile* form module-name opts)    (let* ((module (or (find-module module-name) (current-module)))           (ev (lambda ()                 (call-with-values @@ -82,7 +85,7 @@                       (let* ((o (compile form                                          #:to 'objcode                                          #:env module -                                        #:opts (fluid-ref compile-opts))) +                                        #:opts opts))                              (thunk (make-program o)))                         (start-stack 'geiser-evaluation-stack                                      (eval `(,thunk) module)))) @@ -94,7 +97,7 @@     (lambda ()       (let ((cr (compile-file path                               #:canonicalization 'absolute -                             #:opts (fluid-ref compile-file-opts)))) +                             #:opts compile-file-opts)))         (and cr              (list (object->string (save-module-excursion                                     (lambda () (load-compiled cr)))))))))) | 
