~ chicken-core (chicken-5) e65a1b47c1a586b9a95f2540622ff7660f8b6761
commit e65a1b47c1a586b9a95f2540622ff7660f8b6761
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Jul 14 16:46:32 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Jul 14 16:46:32 2011 +0200
first attempt at introducing wrapper structs for transformers; documented er/ir-macro-transformer; make check seems to work but self-compile is not yet tested
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 67a919e2..76fb4e85 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -43,7 +43,10 @@
(alist-update! name (add1 a) compiler-syntax-statistics)))))
(define (r-c-s names transformer #!optional (se '()))
- (let ((t (cons (##sys#er-transformer transformer) se)))
+ (let ((t (cons (##sys#ensure-transformer
+ (##sys#er-transformer transformer)
+ 'define-compiler-syntax)
+ se)))
(for-each
(lambda (name)
(##sys#put! name '##compiler#compiler-syntax t) )
diff --git a/compiler.scm b/compiler.scm
index 1779d6f4..2217bc6d 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -666,8 +666,9 @@
(list
(car b)
se
- (##sys#er-transformer
- (##sys#eval/meta (cadr b)))))
+ (##sys#ensure-transformer
+ (##sys#eval/meta (cadr b))
+ 'let-syntax)))
(cadr x) )
se) ) )
(walk
@@ -680,8 +681,9 @@
(list
(car b)
#f
- (##sys#er-transformer
- (##sys#eval/meta (cadr b)))))
+ (##sys#ensure-transformer
+ (##sys#eval/meta (cadr b))
+ 'letrec-syntax)))
(cadr x) ) )
(se2 (append ms se)) )
(for-each
@@ -708,13 +710,12 @@
(##sys#extend-macro-environment
name
(##sys#current-environment)
- (##sys#er-transformer (##sys#eval/meta body)))
+ (##sys#eval/meta body))
(walk
(if ##sys#enable-runtime-macros
`(##sys#extend-macro-environment
',var
- (##sys#current-environment)
- (##sys#er-transformer ,body)) ;XXX possibly wrong se?
+ (##sys#current-environment) ,body) ;XXX possibly wrong se?
'(##core#undefined) )
e se dest ldest h)) )
@@ -731,7 +732,9 @@
name '##compiler#compiler-syntax
(and body
(##sys#cons
- (##sys#er-transformer (##sys#eval/meta body))
+ (##sys#ensure-transformer
+ (##sys#eval/meta body)
+ 'define-compiler-syntax)
(##sys#current-environment))))
(walk
(if ##sys#enable-runtime-macros
@@ -740,7 +743,9 @@
'##compiler#compiler-syntax
,(and body
`(##sys#cons
- (##sys#er-transformer ,body)
+ (##sys#ensure-transformer
+ ,body
+ 'define-compiler-syntax)
(##sys#current-environment))))
'(##core#undefined) )
e se dest ldest h)))
@@ -753,8 +758,10 @@
(list
name
(and (pair? (cdr b))
- (cons (##sys#er-transformer
- (##sys#eval/meta (cadr b))) se))
+ (cons (##sys#ensure-transformer
+ (##sys#eval/meta (cadr b))
+ 'let-compiler-syntax)
+ se))
(##sys#get name '##compiler#compiler-syntax) ) ) )
(cadr x))))
(dynamic-wind
diff --git a/eval.scm b/eval.scm
index c7580a5e..c2d942f8 100644
--- a/eval.scm
+++ b/eval.scm
@@ -555,8 +555,9 @@
(list
(car b)
se
- (##sys#er-transformer
- (##sys#eval/meta (cadr b)))))
+ (##sys#ensure-transformer
+ (##sys#eval/meta (cadr b))
+ 'let-syntax)))
(cadr x) )
se) ) )
(compile
@@ -568,8 +569,9 @@
(list
(car b)
#f
- (##sys#er-transformer
- (##sys#eval/meta (cadr b)))))
+ (##sys#ensure-transformer
+ (##sys#eval/meta (cadr b))
+ 'letrec-syntax)))
(cadr x) ) )
(se2 (append ms se)) )
(for-each
@@ -590,7 +592,7 @@
(##sys#extend-macro-environment
name
(##sys#current-environment)
- (##sys#er-transformer (##sys#eval/meta body)))
+ (##sys#eval/meta body))
(compile '(##core#undefined) e #f tf cntr se) ) )
((##core#define-compiler-syntax)
diff --git a/expand.scm b/expand.scm
index 13825f70..697e3205 100644
--- a/expand.scm
+++ b/expand.scm
@@ -135,8 +135,14 @@
(define ##sys#chicken-macro-environment '()) ; used later in chicken.import.scm
(define ##sys#chicken-ffi-macro-environment '()) ; used later in foreign.import.scm
-(define (##sys#extend-macro-environment name se handler)
- (let ((me (##sys#macro-environment)))
+(define (##sys#ensure-transformer t #!optional loc)
+ (cond ((procedure? t) (##sys#slot (##sys#er-transformer t) 1)) ; DEPRECATED
+ ((##sys#structure? t 'transformer) (##sys#slot t 1))
+ (else (##sys#error loc "expected syntax-transformer, but got" t))))
+
+(define (##sys#extend-macro-environment name se transformer)
+ (let ((me (##sys#macro-environment))
+ (handler (##sys#ensure-transformer transformer 'define-syntax)))
(cond ((lookup name me) =>
(lambda (a)
(set-car! a se)
@@ -741,128 +747,131 @@
(walk (cdr x) (cdr p)) ) ) ) ) )
-;;; explicit-renaming transformer
-
-(define ((make-er/ir-transformer handler explicit-renaming?) form se dse)
- (let ((renv '())) ; keep rename-environment for this expansion
- (assert (list? se) "not a list" se) ;XXX remove later
- (define (rename sym)
- (cond ((pair? sym)
- (cons (rename (car sym)) (rename (cdr sym))))
- ((vector? sym)
- (list->vector (rename (vector->list sym))))
- ((not (symbol? sym)) sym)
- ((assq sym renv) =>
- (lambda (a)
- (dd `(RENAME/RENV: ,sym --> ,(cdr a)))
- (cdr a)))
- ((lookup sym se) =>
- (lambda (a)
- (cond ((symbol? a)
- ;; Add an extra level of indirection for already aliased
- ;; symbols. This prevents aliased symbols from popping up
- ;; in syntax-stripped output.
- (cond ((or (getp a '##core#aliased)
- (getp a '##core#primitive))
- (let ((a2 (macro-alias sym se)))
- (dd `(RENAME/LOOKUP/ALIASED: ,sym --> ,a ==> ,a2))
- (set! renv (cons (cons sym a2) renv))
- a2))
- (else (dd `(RENAME/LOOKUP: ,sym --> ,a))
- (set! renv (cons (cons sym a) renv))
- a)))
- (else
- (let ((a2 (macro-alias sym se)))
- (dd `(RENAME/LOOKUP/MACRO: ,sym --> ,a2))
- (set! renv (cons (cons sym a2) renv))
- a2)))))
- (else
- (let ((a (macro-alias sym se)))
- (dd `(RENAME: ,sym --> ,a))
- (set! renv (cons (cons sym a) renv))
- a))))
- (define (compare s1 s2)
- (let ((result
- (cond ((pair? s1)
- (and (pair? s2)
- (compare (car s1) (car s2))
- (compare (cdr s1) (cdr s2))))
- ((vector? s1)
- (and (vector? s2)
- (let ((len (vector-length s1)))
- (and (fx= len (vector-length s2))
- (do ((i 0 (fx+ i 1))
- (f #t (compare (vector-ref s1 i) (vector-ref s2 i))))
- ((or (fx>= i len) (not f)) f))))))
- ((and (symbol? s1) (symbol? s2))
- (let ((ss1 (or (getp s1 '##core#macro-alias)
- (lookup2 1 s1 dse)
- s1) )
- (ss2 (or (getp s2 '##core#macro-alias)
- (lookup2 2 s2 dse)
- s2) ) )
- (cond ((symbol? ss1)
- (cond ((symbol? ss2)
- (eq? (or (getp ss1 '##core#primitive) ss1)
- (or (getp ss2 '##core#primitive) ss2)))
- ((assq ss1 (##sys#macro-environment)) =>
- (lambda (a) (eq? (cdr a) ss2)))
- (else #f) ) )
- ((symbol? ss2)
- (cond ((assq ss2 (##sys#macro-environment)) =>
- (lambda (a) (eq? ss1 (cdr a))))
- (else #f)))
- (else (eq? ss1 ss2)))))
- (else (eq? s1 s2))) ) )
- (dd `(COMPARE: ,s1 ,s2 --> ,result))
- result))
- (define (lookup2 n sym dse)
- (let ((r (lookup sym dse)))
- (dd " (lookup/DSE " (list n) ": " sym " --> "
- (if (and r (pair? r))
- '<macro>
- r)
- ")")
- r))
- (define (assq-reverse s l)
- (cond
- ((null? l) #f)
- ((eq? (cdar l) s) (car l))
- (else (assq-reverse s (cdr l)))))
- (define (mirror-rename sym)
- (cond ((pair? sym)
- (cons (mirror-rename (car sym)) (mirror-rename (cdr sym))))
- ((vector? sym)
- (list->vector (mirror-rename (vector->list sym))))
- ((not (symbol? sym)) sym)
- (else ; Code stolen from ##sys#strip-syntax
- (let ((renamed (lookup sym se) ) )
- (cond ((assq-reverse sym renv) =>
- (lambda (a)
- (dd "REVERSING RENAME: " sym " --> " (car a)) (car a)))
- ((not renamed)
- (dd "IMPLICITLY RENAMED: " sym) (rename sym))
- ((pair? renamed)
- (dd "MACRO: " sym) (rename sym))
- ((getp sym '##core#real-name) =>
- (lambda (name)
- (dd "STRIP SYNTAX ON " sym " ---> " name)
- name))
- (else (dd "BUILTIN ALIAS:" renamed) renamed))))))
- (if explicit-renaming?
- ;; Let the user handle renaming
- (handler form rename compare)
- ;; Implicit renaming:
- ;; Rename everything in the input first, feed it to the transformer
- ;; and then swap out all renamed identifiers by their non-renamed
- ;; versions, and vice versa. User can decide when to inject code
- ;; unhygienically this way.
- (mirror-rename (handler (rename form) rename compare)) ) ) )
+;;; explicit/implicit-renaming transformer
+
+(define (make-er/ir-transformer handler explicit-renaming?)
+ (##sys#make-structure
+ 'transformer
+ (lambda (form se dse)
+ (let ((renv '())) ; keep rename-environment for this expansion
+ (assert (list? se) "not a list" se) ;XXX remove later
+ (define (rename sym)
+ (cond ((pair? sym)
+ (cons (rename (car sym)) (rename (cdr sym))))
+ ((vector? sym)
+ (list->vector (rename (vector->list sym))))
+ ((not (symbol? sym)) sym)
+ ((assq sym renv) =>
+ (lambda (a)
+ (dd `(RENAME/RENV: ,sym --> ,(cdr a)))
+ (cdr a)))
+ ((lookup sym se) =>
+ (lambda (a)
+ (cond ((symbol? a)
+ ;; Add an extra level of indirection for already aliased
+ ;; symbols. This prevents aliased symbols from popping up
+ ;; in syntax-stripped output.
+ (cond ((or (getp a '##core#aliased)
+ (getp a '##core#primitive))
+ (let ((a2 (macro-alias sym se)))
+ (dd `(RENAME/LOOKUP/ALIASED: ,sym --> ,a ==> ,a2))
+ (set! renv (cons (cons sym a2) renv))
+ a2))
+ (else (dd `(RENAME/LOOKUP: ,sym --> ,a))
+ (set! renv (cons (cons sym a) renv))
+ a)))
+ (else
+ (let ((a2 (macro-alias sym se)))
+ (dd `(RENAME/LOOKUP/MACRO: ,sym --> ,a2))
+ (set! renv (cons (cons sym a2) renv))
+ a2)))))
+ (else
+ (let ((a (macro-alias sym se)))
+ (dd `(RENAME: ,sym --> ,a))
+ (set! renv (cons (cons sym a) renv))
+ a))))
+ (define (compare s1 s2)
+ (let ((result
+ (cond ((pair? s1)
+ (and (pair? s2)
+ (compare (car s1) (car s2))
+ (compare (cdr s1) (cdr s2))))
+ ((vector? s1)
+ (and (vector? s2)
+ (let ((len (vector-length s1)))
+ (and (fx= len (vector-length s2))
+ (do ((i 0 (fx+ i 1))
+ (f #t (compare (vector-ref s1 i) (vector-ref s2 i))))
+ ((or (fx>= i len) (not f)) f))))))
+ ((and (symbol? s1) (symbol? s2))
+ (let ((ss1 (or (getp s1 '##core#macro-alias)
+ (lookup2 1 s1 dse)
+ s1) )
+ (ss2 (or (getp s2 '##core#macro-alias)
+ (lookup2 2 s2 dse)
+ s2) ) )
+ (cond ((symbol? ss1)
+ (cond ((symbol? ss2)
+ (eq? (or (getp ss1 '##core#primitive) ss1)
+ (or (getp ss2 '##core#primitive) ss2)))
+ ((assq ss1 (##sys#macro-environment)) =>
+ (lambda (a) (eq? (cdr a) ss2)))
+ (else #f) ) )
+ ((symbol? ss2)
+ (cond ((assq ss2 (##sys#macro-environment)) =>
+ (lambda (a) (eq? ss1 (cdr a))))
+ (else #f)))
+ (else (eq? ss1 ss2)))))
+ (else (eq? s1 s2))) ) )
+ (dd `(COMPARE: ,s1 ,s2 --> ,result))
+ result))
+ (define (lookup2 n sym dse)
+ (let ((r (lookup sym dse)))
+ (dd " (lookup/DSE " (list n) ": " sym " --> "
+ (if (and r (pair? r))
+ '<macro>
+ r)
+ ")")
+ r))
+ (define (assq-reverse s l)
+ (cond
+ ((null? l) #f)
+ ((eq? (cdar l) s) (car l))
+ (else (assq-reverse s (cdr l)))))
+ (define (mirror-rename sym)
+ (cond ((pair? sym)
+ (cons (mirror-rename (car sym)) (mirror-rename (cdr sym))))
+ ((vector? sym)
+ (list->vector (mirror-rename (vector->list sym))))
+ ((not (symbol? sym)) sym)
+ (else ; Code stolen from ##sys#strip-syntax
+ (let ((renamed (lookup sym se) ) )
+ (cond ((assq-reverse sym renv) =>
+ (lambda (a)
+ (dd "REVERSING RENAME: " sym " --> " (car a)) (car a)))
+ ((not renamed)
+ (dd "IMPLICITLY RENAMED: " sym) (rename sym))
+ ((pair? renamed)
+ (dd "MACRO: " sym) (rename sym))
+ ((getp sym '##core#real-name) =>
+ (lambda (name)
+ (dd "STRIP SYNTAX ON " sym " ---> " name)
+ name))
+ (else (dd "BUILTIN ALIAS:" renamed) renamed))))))
+ (if explicit-renaming?
+ ;; Let the user handle renaming
+ (handler form rename compare)
+ ;; Implicit renaming:
+ ;; Rename everything in the input first, feed it to the transformer
+ ;; and then swap out all renamed identifiers by their non-renamed
+ ;; versions, and vice versa. User can decide when to inject code
+ ;; unhygienically this way.
+ (mirror-rename (handler (rename form) rename compare)) ) ) )))
(define (##sys#er-transformer handler) (make-er/ir-transformer handler #t))
(define (##sys#ir-transformer handler) (make-er/ir-transformer handler #f))
-(define (er-macro-transformer x) x)
+(define er-macro-transformer ##sys#er-transformer)
(define ir-macro-transformer ##sys#ir-transformer)
diff --git a/manual/Macros b/manual/Macros
index 321e5d3d..36be848b 100644
--- a/manual/Macros
+++ b/manual/Macros
@@ -17,14 +17,15 @@ macro system based on ''explicit renaming''.
Defines a macro named {{IDENTIFIER}} that will transform an expression
with {{IDENTIFIER}} in operator position according to {{TRANSFORMER}}.
-The transformer expression must be a procedure with three arguments or
+The transformer expression must the result of a call
+to{{er-macro-transformer}} or {{ir-macro-transformer}}, or it must be
a {{syntax-rules}} form. If {{syntax-rules}} is used, the usual R5RS
-semantics apply. If {{TRANSFORMER}} is a procedure, then it will
-be called on expansion with the complete s-expression of the macro
-invocation, a rename procedure that hygienically renames identifiers
-and a comparison procedure that compares (possibly renamed) identifiers
-(see the section "Explicit renaming macros" below for a detailed explanation
-on non-R5RS macros).
+semantics apply. If {{TRANSFORMER}} is a transformer, then its
+transformer procedure will be called on expansion with the complete
+s-expression of the macro invocation, a rename procedure that
+hygienically renames identifiers and a comparison procedure that
+compares (possibly renamed) identifiers (see the section "Explicit
+renaming macros" below for a detailed explanation on non-R5RS macros).
{{define-syntax}} may be used to define local macros that are visible
throughout the rest of the body in which the definition occurred, i.e.
@@ -56,12 +57,26 @@ The effect of destructively modifying the s-expression passed to a
transformer procedure is undefined.
-==== syntax
+==== er-macro-transformer
-<macro>(syntax EXPRESSION)</macro>
+<procedure>(er-macro-transformer PROCEDURE)</procedure>
-Similar to {{quote}} but retains syntactical context information for
-embedded identifiers.
+Returns an explicit-remnaming transformer object wrapping the
+syntax-transformer procedure {{PROCEDURE}}. The procedure will be
+called with the form to be expanded and rename and compare procedures
+and perform explicit renaming to maintain hygiene. See below for
+more information about explicit renaming macros.
+
+
+==== ir-macro-transformer
+
+<procedure>(ir-macro-transformer PROCEDURE)</procedure>
+
+Returns a implicit-renaming transformer object wrapping the
+syntax-transformer procedure {{PROCEDURE}}. The procedure will be
+called with the form to be expanded and an inject and compare
+procedure and perform implicit renaming to maintain hygiene. See
+below for more information about implicit renaming macros.
==== strip-syntax
diff --git a/modules.scm b/modules.scm
index c38323c0..f42972b1 100644
--- a/modules.scm
+++ b/modules.scm
@@ -335,17 +335,17 @@
(map (lambda (se)
(if (symbol? se)
(find-reexport se)
- (list (car se) #f (##sys#er-transformer (cdr se)))))
+ (list (car se) #f (##sys#ensure-transformer (cdr se)))))
sexports))
(iexps
(map (lambda (ie)
(if (pair? (cdr ie))
- (list (car ie) (cadr ie) (##sys#er-transformer (caddr ie)))
+ (list (car ie) (cadr ie) (##sys#ensure-transformer (caddr ie)))
ie))
iexports))
(nexps
(map (lambda (ne)
- (list (car ne) #f (##sys#er-transformer (cdr ne))))
+ (list (car ne) #f (##sys#ensure-transformer (cdr ne))))
sdefs))
(mod (make-module name '() vexports sexps))
(senv (merge-se
diff --git a/srfi-13.import.scm b/srfi-13.import.scm
index 799c0833..b2748d66 100644
--- a/srfi-13.import.scm
+++ b/srfi-13.import.scm
@@ -110,21 +110,22 @@
xsubstring)
`((let-string-start+end
()
- ,(##sys#er-transformer
- (lambda (form r c)
- (##sys#check-syntax 'let-string-start+end form '(_ _ _ _ _ . _))
- (let ((s-e-r (cadr form))
- (proc (caddr form))
- (s-exp (cadddr form))
- (args-exp (car (cddddr form)))
- (body (cdr (cddddr form)))
- (%receive (r 'receive))
- (%string-parse-start+end (r 'string-parse-start+end))
- (%string-parse-final-start+end (r 'string-parse-final-start+end)))
- (if (pair? (cddr s-e-r))
- `(,%receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
- (,%string-parse-start+end ,proc ,s-exp ,args-exp)
- ,@body)
- `(,%receive ,s-e-r
- (,%string-parse-final-start+end ,proc ,s-exp ,args-exp)
- ,@body) ) ))))))
+ ,(##sys#ensure-transformer
+ (##sys#er-transformer
+ (lambda (form r c)
+ (##sys#check-syntax 'let-string-start+end form '(_ _ _ _ _ . _))
+ (let ((s-e-r (cadr form))
+ (proc (caddr form))
+ (s-exp (cadddr form))
+ (args-exp (car (cddddr form)))
+ (body (cdr (cddddr form)))
+ (%receive (r 'receive))
+ (%string-parse-start+end (r 'string-parse-start+end))
+ (%string-parse-final-start+end (r 'string-parse-final-start+end)))
+ (if (pair? (cddr s-e-r))
+ `(,%receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
+ (,%string-parse-start+end ,proc ,s-exp ,args-exp)
+ ,@body)
+ `(,%receive ,s-e-r
+ (,%string-parse-final-start+end ,proc ,s-exp ,args-exp)
+ ,@body) ) )))))))
diff --git a/synrules.scm b/synrules.scm
index 37515c7d..cf8912ec 100644
--- a/synrules.scm
+++ b/synrules.scm
@@ -104,11 +104,12 @@
(c x %ellipsis))
(define (make-transformer rules)
- `(,%lambda (,%input ,%rename ,%compare)
- (,%let ((,%tail (,%cdr ,%input)))
- (,%cond ,@(map process-rule rules)
- (,%else
- (##sys#syntax-rules-mismatch ,%input))))))
+ `(##sys#er-transformer
+ (,%lambda (,%input ,%rename ,%compare)
+ (,%let ((,%tail (,%cdr ,%input)))
+ (,%cond ,@(map process-rule rules)
+ (,%else
+ (##sys#syntax-rules-mismatch ,%input)))))))
(define (process-rule rule)
(if (and (pair? rule)
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 969420cf..b20ca7b4 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -40,9 +40,11 @@
;; some basic contrived testing
(define (fac n)
- (let-syntax ((m1 (lambda (n r c)
- (pp `(M1: ,n))
- (list (r 'sub1) (cadr n)))))
+ (let-syntax ((m1
+ (er-macro-transformer
+ (lambda (n r c)
+ (pp `(M1: ,n))
+ (list (r 'sub1) (cadr n))))))
(define (sub1 . _) ; ref. transp.? (should not be used here)
(error "argh.") )
#;(print "fac: " n)
@@ -365,11 +367,12 @@
(define-syntax loop
- (lambda (x r c)
- (let ((body (cdr x)))
- `(,(r 'call/cc)
- (,(r 'lambda) (exit)
- (,(r 'let) ,(r 'f) () ,@body (,(r 'f))))))))
+ (er-macro-transformer
+ (lambda (x r c)
+ (let ((body (cdr x)))
+ `(,(r 'call/cc)
+ (,(r 'lambda) (exit)
+ (,(r 'let) ,(r 'f) () ,@body (,(r 'f)))))))))
(let ((n 10))
(loop
@@ -387,10 +390,11 @@
(f (while0 #f (print "no.")))
(define-syntax while
- (lambda (x r c)
- `(,(r 'loop)
- (,(r 'if) (,(r 'not) ,(cadr x)) (exit #f))
- ,@(cddr x))))
+ (er-macro-transformer
+ (lambda (x r c)
+ `(,(r 'loop)
+ (,(r 'if) (,(r 'not) ,(cadr x)) (exit #f))
+ ,@(cddr x)))))
(let ((n 10))
(while (not (zero? n))
@@ -409,8 +413,9 @@
(syntax-rules ()
((_ (name . llist) body ...)
(define-syntax name
- (lambda (x r c)
- (apply (lambda llist body ...) (strip-syntax (cdr x))))))))
+ (er-macro-transformer
+ (lambda (x r c)
+ (apply (lambda llist body ...) (strip-syntax (cdr x)))))))))
(define-macro (loop . body)
(let ((loop (gensym)))
@@ -549,8 +554,9 @@
(define-syntax s1 (syntax-rules () ((_ x) (list x))))
(define-syntax s2
- (lambda (x r c)
- (r `(vector (s1 ,(cadr x)))))) ) ; without renaming the local version of `s1'
+ (er-macro-transformer
+ (lambda (x r c)
+ (r `(vector (s1 ,(cadr x))))))) ) ; without renaming the local version of `s1'
; below will be captured
(import m1)
diff --git a/types.db b/types.db
index 8aca3a10..7363afb0 100644
--- a/types.db
+++ b/types.db
@@ -269,6 +269,7 @@
(delete-file (procedure delete-file (string) string))
(enable-warnings (procedure enable-warnings (#!optional *) *))
(equal=? (procedure equal=? (* *) boolean))
+(er-macro-transformer (procedure er-macro-transformer ((procedure (* * *) *)) (struct transformer)))
(errno (procedure errno () fixnum))
(error (procedure error (#!rest) noreturn))
(exit (procedure exit (#!optional fixnum) noreturn))
@@ -358,6 +359,7 @@
(getenv (deprecated get-environment-variable))
(getter-with-setter (procedure getter-with-setter (procedure procedure #!optional string) procedure))
(implicit-exit-handler (procedure implicit-exit-handler (#!optional procedure) procedure))
+(ir-macro-transformer (procedure ir-macro-transformer ((procedure (* * *) *)) (struct transformer)))
(keyword->string (procedure keyword->string (symbol) string))
(keyword-style (procedure keyword-style (#!optional *) *))
(keyword? (procedure keyword? (*) boolean))
Trap