diff options
-rw-r--r-- | module/language/elisp/README | 6 | ||||
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 52 | ||||
-rw-r--r-- | test-suite/tests/elisp-compiler.test | 11 |
3 files changed, 57 insertions, 12 deletions
diff --git a/module/language/elisp/README b/module/language/elisp/README index f4278fdd5..7fc51be92 100644 --- a/module/language/elisp/README +++ b/module/language/elisp/README @@ -32,7 +32,11 @@ Especially still missing: Other ideas and things to think about: * %nil vs. #f/'() handling in Guile * lexical-let and/or optional lexical binding as extensions - * compiler options for all lexical binding, no void checks + * compiler options for all lexical binding + +Compiler options implemented: + * #:disable-void-check ['all / '(sym1 sym2 sym3)] to disable the check + for void value on access either completely or for some symbols Extensions over original elisp: * (guile-ref module symbol) construct to build a (@ module symbol) from elisp diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index d3d627bf8..a7374c626 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -34,7 +34,7 @@ (define bindings-data (make-fluid)) ; Store for which symbols (or all/none) void checks are disabled. -(define disabled-void-check (make-fluid)) +(define disable-void-check (make-fluid)) ; Find the source properties of some parsed expression if there are any @@ -109,6 +109,15 @@ (make-const loc sym)))) +; See if we should do a void-check for a given variable. That means, check +; that this check is not disabled via the compiler options for this symbol. + +(define (want-void-check? sym) + (let ((disabled (fluid-ref disable-void-check))) + (and (not (eq? disabled 'all)) + (not (memq sym disabled))))) + + ; Generate code to reference a fluid saved variable. (define (reference-variable loc sym module) @@ -120,14 +129,16 @@ ; Reference a variable and error if the value is void. (define (reference-with-check loc sym module) - (let ((var (gensym))) - (make-let loc '(value) `(,var) `(,(reference-variable loc sym module)) - (make-conditional loc - (call-primitive loc 'eq? - (make-module-ref loc runtime 'void #t) - (make-lexical-ref loc 'value var)) - (runtime-error loc "variable is void:" (make-const loc sym)) - (make-lexical-ref loc 'value var))))) + (if (want-void-check? sym) + (let ((var (gensym))) + (make-let loc '(value) `(,var) `(,(reference-variable loc sym module)) + (make-conditional loc + (call-primitive loc 'eq? + (make-module-ref loc runtime 'void #t) + (make-lexical-ref loc 'value var)) + (runtime-error loc "variable is void:" (make-const loc sym)) + (make-lexical-ref loc 'value var)))) + (reference-variable loc sym module))) ; Generate code to set a fluid saved variable. @@ -734,6 +745,25 @@ (else (make-const loc expr))))) +; Process the compiler options. +; FIXME: Why is '(()) passed as options by the REPL? + +(define (process-options! opt) + (if (and (not (null? opt)) + (not (equal? opt '(())))) + (if (null? (cdr opt)) + (error "Invalid compiler options" opt) + (let ((key (car opt)) + (value (cadr opt))) + (case key + ((#:disable-void-check) + (if (and (not (eq? value 'all)) + (not (and (list? value) (and-map symbol? value)))) + (error "Invalid value for #:disable-void-check" value) + (fluid-set! disable-void-check value))) + (else (error "Invalid compiler option" key))))))) + + ; Entry point for compilation to TreeIL. ; This creates the bindings data structure, and after compiling the main ; expression we need to make sure all fluids for symbols used during the @@ -741,8 +771,10 @@ (define (compile-tree-il expr env opts) (values - (with-fluid* bindings-data (make-bindings) + (with-fluids* (list bindings-data disable-void-check) + (list (make-bindings) '()) (lambda () + (process-options! opts) (let ((loc (location expr)) (compiled (compile-expr expr))) (make-sequence loc diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index b76d4fad7..584cfd4bf 100644 --- a/test-suite/tests/elisp-compiler.test +++ b/test-suite/tests/elisp-compiler.test @@ -29,6 +29,8 @@ (syntax-rules (pass-if pass-if-exception) ((_ (pass-if test-name exp)) (pass-if test-name (compile 'exp #:from 'elisp #:to 'value))) + ((_ (pass-if test-name exp #:opts opts)) + (pass-if test-name (compile 'exp #:from 'elisp #:to 'value #:opts opts))) ((_ (pass-if-equal test-name result exp)) (pass-if test-name (equal? result (compile 'exp #:from 'elisp #:to 'value)))) @@ -203,7 +205,14 @@ (progn (setq a 1 b 2) (and (eq (makunbound 'b) 'b) (boundp 'a) - (not (boundp 'b)))))) + (not (boundp 'b))))) + + (pass-if "disabled void check (all)" + (progn (makunbound 'a) a t) + #:opts '(#:disable-void-check all)) + (pass-if "disabled void check (symbol list)" + (progn (makunbound 'a) a t) + #:opts '(#:disable-void-check (x y a b)))) (with-test-prefix/compile "Let and Let*" |