diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-05-16 21:03:00 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-05-16 21:03:00 -0700 |
| commit | 97767df52a141debc956573c371664dfdbc25c95 (patch) | |
| tree | aed7914652dc9fac09f117b2fc903b2306f0dbcb /stdlib | |
| parent | c990d37be74f452d1a8bcb2b0b1dc133704c0a93 (diff) | |
| download | txr-97767df52a141debc956573c371664dfdbc25c95.tar.gz txr-97767df52a141debc956573c371664dfdbc25c95.tar.bz2 txr-97767df52a141debc956573c371664dfdbc25c95.zip | |
with-compile-options: reimplement using compiler-let
The with-compile-opts macro is rewritten such that
it cad occur inside code that is being compiled, and
change compiler options for individual subexpressions.
It continues to work as before in scripted build steps
such as when calls to (compile-file ...) are wrapped
in it. However, for the time being, that now only works
in interpreted code, because with this change, when
a with-compile-opts form is compiled, it no longer
arranges for the binding of *compile-opts* to be visible
to the subforms; the binding affects the compiler's
own environment.
* stdlib/compiler.tl (with-compile-opts): Rewrite.
* txr.1: Documented.
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/compiler.tl | 26 |
1 files changed, 14 insertions, 12 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 504d3ea8..c5d00612 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -2609,15 +2609,17 @@ (@else (error "~s: cannot compile ~s" 'compile else)))) (defmacro usr:with-compile-opts (:form form . clauses) - (with-gensyms (co) - ^(let* ((,co (copy *compile-opts*)) - (*compile-opts* ,co)) - ,*(collect-each ((cl clauses)) - (match-case cl - ((@(as op @(or nil t :warn :error)) . @syms) - (each ((s syms)) - (unless (member s %warning-syms%) - (compile-error form "~s isn't a recognized warning option" s))) - ^(set ,*(mappend (ret ^((qref ,co ,@1) ,op)) syms))) - (@(or @(atom) (@(not @(keywordp)) . @nil)) cl) - (@nil (compile-error form "unrecognized clause syntax: ~s" cl))))))) + (match-case clauses + (() ()) + (((@(as op @(or nil t :warn :error)) . @syms) . @rest) + (each ((s syms)) + (unless (member s %warning-syms%) + (compile-error form + "~s isn't a recognized warning option" s))) + ^(compiler-let ((*compile-opts* (let ((co (copy *compile-opts*))) + (set ,*(mappend (ret ^(co.,@1 ,op)) + syms)) + co))) + ,*(if rest ^((with-compile-opts ,*rest))))) + ((@first . @rest) + ^(progn ,first ,*(if rest ^((with-compile-opts ,*rest))))))) |