You are looking at historical revision 1613 of this page. It may differ significantly from its current revision.
A generic macro-expansion and code-walking and code-transformation facility.
[procedure] (expand EXPRESSION [HOOK [ARGUMENT ...]])
Recursively expands macros in EXPRESSION, calling the procedure HOOK (if provided). The hook is called with 5 arguments:
(HOOK EXPR CLASS WALK ENV MARK ARGUMENT ...)
EXPR is the currently traversed subexpression, CLASS is a symbol identifying the expression class, WALK is a procedure of one or more arguments that should be called to walk sub-expressions of EXPR recursively. The additional arguments ARGUMENT ... will be passed to the hook as additional parameters, which in turn should pass the same number of extra arguments to recursive invocations of WALK (plus the sub-expression to walk). ENV is a list of lists containing the lexical environment, where each list is a list of lexically bound identifiers (symbols). The frontmost list holds the current environment. MARK is a procedure of one argument that can be used to mark subexpressions which should not be traversed by HOOK.
Invoking WALK with the same (eq?) EXPR that has been given as the first argument to HOOK performs default processing and walking of subexpressions of EXPR.
Note that the default processing returns S-expressions. If you want to use expand to create some other type (for example an abstract syntax tree of dedicated node records), you have to provide treatment and translation for all expression classes.
[procedure] (expand/context EXPRESSION CONTEXT [HOOK [ARGUMENT ...]])
Similar to expand, but allows passing additional expansion-parameters, which should be created by calling expansion-context.
[procedure] (expansion-context #!key evaluate compilation unsafe cooked classes)
Creates an expansion-context that is used to pass additional expansion parameters to expand/context. The keyword arguments have the following meaning:
- should macro-expansion time evaluation be performed (for example, in an eval-when clause) (boolean, default: #f)
- does the expansion happen during compilation (as opposed to interpretation) (boolean, default: #t when called during compilation or #f otherwise)
- does the expansion happen in an unsafe compilation context (boolean, default: #f)
- list of symbols identifying the classes of expressions for which the hook should be called during expansion (list or #t, default: #t)
- whether internal forms that perform expansion-time evaluation or other special processing (usually compiler-specific) be processed as they appear (#t) or whether they should be passed through to the hook function - passing #t for evaluate implies cooked mode
The following expression classes exist:
- variable reference
- literal constant
- quoted literal constant
- an undefined value - note that this means really undefined, not (void)
- if conditional
- begin sequence
- let binding form
- lambda expression
- procedure application
- compiler special form
- require-extension or require-for-syntax form (or internal equivalent)
- special internal form - should normally be treated as a call to an identity function
[procedure] (expansion-context? X)
Returns #t if X is an expansion context, or #f otherwise.
[procedure] (install-toplevel-expander EXPANDER [OVERRIDE-MACROEXPAND])
Installs EXPANDER as the toplevel macro expander for subsequent interpretation or compilation. If OVERRIDE-MACROEXPAND is given and true, then macroexpand will also invoke the given expander and no further internal macroexpansion takes place. Use this when you want to install a custom macroexpansion package that does complete processing of syntax transformation. If you merely want to do some custom pre-processing, pass #f for this argument (or omit it completely).
(define exp '(begin (define (count-bits2 n result) (if (zero? n) result (count-bits2 (bitwise-and n (sub1 n)) (add1 result)))) (time (do ((i 0 (add1 i))) ((>= i 10)) (print (count-bits2 i 0))))) )
(pp (expand exp)) ; expand all macros
(define exp2 ; trace global variable references (expand exp (lambda (x c w e m) (if (and (symbol? x) (not (ormap (cut memq x <>) e))) (w (m `(let ((x ,x)) (print "ref: " ',x " = " x) x) ) ) (w x) ) ) ) )
(pp exp2) (pp (eval exp2)) ; the code can be evaluated as usual
(define exp3 ; trace all calls (expand/context exp (expansion-context classes: '(app)) (lambda (x c w e m) (let ((fn (gensym))) (w (m `((let ((,fn ,(car x))) (print "calling: " ,fn) ,fn) ,@(map w (cdr x) ) ) ) ) ) ) ) )
(pp exp3) (pp (eval exp3))
(define (instrument-calls exp pred? mod) ;; instrument calls that satisfy a given predicate (expand/context exp (expansion-context classes: '(app)) (lambda (x c w e m) (if (pred? x) (w (m (mod (map w x)))) (w x) ) ) ) )
(define exp4 ; trace calls (instrument-calls exp (constantly #t) (lambda (call) (let ((v (gensym))) `(begin (print "calling: " ',call) ,call) ) ) ) )
(pp exp4) (eval exp4)
;;;; count direct calls to "car"
(define n 0)
(define (count exp) (expand/context exp (expansion-context classes: '(app)) (lambda (x c w e m) (match x (('car arg) (inc! n) `(car ,(w arg)) ) (_ (w x)) ) ) ) )
(for-each count (read-file "codewalk.scm")) (pp n) ; should be "7"
Copyright (c) 2006, Felix L. Winkelmann All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- initial release