From 97767df52a141debc956573c371664dfdbc25c95 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 16 May 2023 21:03:00 -0700 Subject: 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. --- stdlib/compiler.tl | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) (limited to 'stdlib') 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))))))) -- cgit v1.2.3