summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/language/elisp/README6
-rw-r--r--module/language/elisp/compile-tree-il.scm52
-rw-r--r--test-suite/tests/elisp-compiler.test11
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*"