Outdated egg!
This is an egg for CHICKEN 4, the unsupported old release. You're almost certainly looking for the CHICKEN 5 version of this egg, if it exists.
If it does not exist, there may be equivalent functionality provided by another egg; have a look at the egg index. Otherwise, please consider porting this egg to the current version of CHICKEN.
TOC »
Basic procedural macros
This library provides two modules, one with helper routines to be imported for syntax into the other with macros, which facilitate the writing of procedural-macros.
Chicken provides two procedural macro-systems, implicit and explicit renaming macros. In both you have to destructure the use-form yourself and provide for the renaming or injecting of names which could or should be captured. Destructuring can be automated with the bind macro -- a simplified version of the equally named macro in the bindings library -- and renaming resp. injecting can be almost automated with the help of a prefix parameter, which replaces the rename resp. inject parameter in the macro transformer routine.
Usually an ambituous explicit renaming macro contains a long let defining the renamed symbols -- usually prefixed with some fixed symbol constant like % -- which is then executed in the macro's body by unquoting it. Our two macros create the let automatically. The only thing you have to do is providing a prefix and using it to prefix all symbols you want renamed resp injected.
Here is a simple example, the numeric if.
(define-er-macro (nif form % compare?)
(bind (_ xpr pos zer neg) form
`(,%let ((,%result ,xpr))
(,%cond
((,%positive? ,%result) ,pos)
((,%negative? ,%result) ,neg)
(,%else ,zer)))))Note, that one of the standard arguments of an er-macro-transformer, rename, is replaced by the rename-prefix %, which characterize the symbols in the body to be renamed.
The macro searches its body for symbols starting with this prefix, collects them in a list, removes duplicates and adds the necesary let with pairs of the form
(%name (rename 'name)
to the front of the body. In other words it does what you usually do by hand.
For implicit renaming macros the list of injected symbols is usually, but not allways, short, even empty for nif. Of course, the generated let replaces rename with inject in this case. For example, here is a version of alambda, an anaphoric version of lambda, which injects the name self:
(define-ir-macro (alambda form % compare?)
(bind (_ args xpr . xprs) form
`(letrec ((,%self (lambda ,args ,xpr ,@xprs)))
,%self)))The helper module basic-macro-helpers
Some of the following procedures are used in the macros of the basic-macros module. Others are here for completeness, for example the pseudo-list package.
basic-macro-helpers
- basic-macro-helpers sym ..procedure
documentation procedure
pseudo-list
- pseudo-list sentinel #!rest argsprocedure
constructs a new pseudo-list.
pseudo-list?
- pseudo-list? xprprocedure
predicate. Note, that except lists everything is a pseudo-list.
pseudo-list-of
- pseudo-list-of #!rest predsprocedure
returns a unary predicate, which tests, if its argument is passed by each predicate in preds.
pseudo-null?
- pseudo-null? xprprocedure
not a pair.
pseudo-length
- pseudo-length plprocedure
length of a pseudo-list. The sentinel is not counted.
pseudo-ref
- pseudo-ref pl kprocedure
returns the kth item of a pseudo-list. k must be less then pl's pseudo-length.
pseudo-tail
- pseudo-tail pl kprocedure
- pseudo-tail plprocedure
returns the kth tail of a pseudo-list. k must be less then or equal to pl's pseudo-length. In the latter case, or when no k is provided, the sentinel is returned.
pseudo-head
- pseudo-head pl kprocedure
- pseudo-head plprocedure
returns the kth tail of a pseudo-list. k must be less then or equal to pl's pseudo-length. In the latter case, or when no k is provided, a list with the sentinel stripped is returned.
pseudo-sentinel
- pseudo-sentinel plprocedure
returns the sentinel of a pseudo-list. If pl is not a pair, pl itself is returned.
pseudo-flatten
- pseudo-flatte treeprocedure
transforms a nested pseudo-list to a flat list.
adjoin
- adjoin obj lstprocedure
adds obj to lst, provided obj is not an item of lst.
remove-duplicates
- remove-duplicates lstprocedure
removes all duplicates of lst.
filter
- filter ok? lstprocedure
returns the sublist of lst consisting of all items passing the ok? predicate.
sym-prepends?
- sym-prepends? pre symprocedure
does the symbol sym start with the symbol pre?
sym-tail
- sym-tail pre symprocedure
returns the subsymbol of sym by stripping the prefix pre.
The module basic-macros
basic-macros
- basic-macros sym ..procedure
documentation procedure
define-syntax-rule
- (define-syntax-rule (name . args) xpr . xprs)syntax
- (define-syntax-rule (name . args) (keywords . keys) xpr . xprs)syntax
simplyfied version of syntax-rules if there is only one rule.
define-ir-macro-transformer
- (define-er-macro-transformer (name form inject compare?)syntax
wrapper around ir-macro-transformer.
define-er-macro-transformer
- (define-er-macro-transformer (name form rename compare?)syntax
wrapper around er-macro-transformer.
define-er-macro
- (define-er-macro (name form rename-symbol compare?) xpr . xprs)syntax
defines an explicit-renaming-macro name with macro-code form renaming each symbol in the body xpr . xprs starting with rename-symbol automatically.
define-ir-macro
- (define-ir-macro (name form inject-symbol compare?) xpr . xprs)syntax
defines an implicit-renaming-macro name with macro-code form injecting each symbol in the body xpr . xprs starting with inject-symbol automatically.
bind
- (bind pat seq (where (x x? ...) ...) xpr . xprs)syntax
- (bind pat seq xpr . xprs)syntax
binds pattern varibles of a nested pseudo-list pat to corresponding expressions of the nested pseudo-list seq and executes the body xpr . xprs in this context, provided all fenders (x? x) ... are passed, if there are any. Note, that the underscore symbol serves as wildcard, which binds nothing, and literals in pat and seq must match.
Must be used for-syntax if used to destucture macro-code in explicit- or implicit-renaming macros.
This is a restricted version of the equally named macro in the bindings library.
bind-case
- (bind-case seq (pat fenders ... xpr . xprs) ...)syntax
- (bind-case seq (pat xpr . xprs) ...)syntax
executes (bind pat seq xpr . xprs) or (bind pat seq fenders ... xpr . xprs) respectively of the first pattern pat matching seq and passing fenders.
Must be used for-syntax if used to destucture macro-code in explicit- or implicit-renaming macros.
once-only
- (once-only (x . xs) xpr . xprs)syntax
to be used in a macro-body to avoid side-effects. The arguments x . xs are only evaluated once. once-only must be used for-syntax in explicit or implicit renaming macros.
with-mapped-symbols
- (with-mapped-symbols mapper prefix- (prefix-x ...) xpr . xprs)syntax
binds a series of prefixed names, prefix-x ... to the images of the original names, x ..., under mapper and evaluates xpr . xprs in this context. To be used for-synax in ir- or er-macro-transformers, where mapper is either inject or rename.
with-gensyms
- (with-gensyms (x ...) xpr ....)syntax
to be used in a macro body and hence to be imported for-syntax. Generates a list of gensyms x ... which can be used in xpr .....
Requirements
None
Usage
(use basic-macros) (import basic-macro-helpers) (import-for-syntax (only basic-macros bind bind-case once-only)
Examples
(require-library basic-macros)
(import basic-macros basic-macro-helpers)
(import-for-syntax (only basic-macros bind once-only))
;; flatten
(pseudo-flatten '(0 1 . 2))
;-> '(0 1 2)
(pseudo-flatten '(0 (1 2)))
;-> '(0 1 2)
(pseudo-flatten '(0 (1 (2 . 3))))
;-> '(0 1 2 3)
(pseudo-flatten '(0 (1 (2 . 3) 4)))
;-> '(0 1 2 3 4)
;; bindings
(bind x 1 x)
;->1
(bind (x . y) (cons 1 2) (list x y))
;->'(1 2)
(bind (x (y (z . w))) '(1 (2 (3 . 4))) (list x y z w))
;-> '(1 2 3 4)
(bind (x (y (z . w))) '(1 (2 (3 4 5))) (list x y z w))
;-> '(1 2 3 (4 5))
(bind (x . #f) (cons 1 #f) x)
;->1
(bind (x "y" z) '(1 "y" 2) (list x z))
;-> '(1 2)
(not (condition-case
(bind (x . _) (list 1 2 3 4) _)
; wildcard not a variable
((exn) #f)))
(not (condition-case
(bind (x . #f) (cons 1 #t) x)
; literals don't match
((exn) #f)))
(not (condition-case
(bind (x "y" z) '(1 "q" 2) (list x z))
; literals don't match
((exn) #f)))
(define (my-map fn lst)
(let loop ((lst lst) (result '()))
(bind-case lst
(() (reverse result))
((x . xs)
(loop xs (cons (fn x) result))))))
(my-map add1 '(0 1 2 3 4))
;-> '(1 2 3 4 5)
(bind-case '(1 (2 3))
((x y) (list x y))
((x (y . z)) (list x y z))
((x (y z)) (list x y z)))
;-> '(1 (2 3))
(bind-case '(1 (2 . 3))
((x y) (list x y))
((x (y . z)) (list x y z))
((x (y z)) (list x y z)))
;-> '(1 (2 . 3))
(bind-case '(2 2)
((a b) (where (a even?) (b odd?)) (print 'even-odd a b))
((a b) (where (a odd?) (b even?)) (print 'odd-even a b))
((a b) (list a b)))
;-> '(2 2)
;; renaming-macros
(define counter
(let ((n 0))
(lambda ()
(set! n (add1 n))
n)))
;; once-only
(define-er-macro (square form % compare?)
(let ((x (cadr form)))
(once-only (x)
`(* ,x ,x))))
(= (square (counter)) 1)
(= (square (counter)) 4)
(= (square (counter)) 9)
;; swap!
(define-er-macro-transformer (swap! form rename compare?)
(let ((x (cadr form)) (y (caddr form)))
(with-mapped-symbols rename % (%tmp %let %set!)
`(,%let ((,%tmp ,x))
(,%set! ,x ,y)
(,%set! ,y ,%tmp)))))
(equal? (let ((x 'x) (y 'y))
(swap! x y)
(list x y))
'(y x))
;; numeric if
(define-er-macro (nif form % compare?)
(bind (_ xpr pos zer neg)
form
`(,%let ((,%result ,xpr))
(,%cond
((,%positive? ,%result) ,pos)
((,%negative? ,%result) ,neg)
(,%else ,zer)))))
(eq? (nif 5 'pos 'zer 'neg) 'pos)
;;; verbose if
(define-ir-macro (vif form % compare?)
(bind-case form
((_ test (key xpr . xprs))
(cond
((compare? key %then)
`(if ,test (begin ,xpr ,@xprs)))
((compare? key %else)
`(if ,(not test) (begin ,xpr ,@xprs)))
(else
`(error 'vif "syntax-error"))))
((_ test (key1 xpr . xprs) (key2 ypr . yprs))
(cond
((and (compare? key1 %then)
(compare? key2 %else))
`(if ,test
(begin ,xpr ,@xprs)
(begin ,ypr ,@yprs)))
((and (compare? key1 %else)
(compare? key2 %then))
`(if ,test
(begin ,ypr ,@yprs)
(begin ,xpr ,@xprs)))
(else
`(error 'vif "syntax-error"))))
))
(eq? (vif (positive? 5) (then 'true)) 'true)
(eq? (vif (negative? 5) (else 'false)) 'false)
(define-ir-macro (alambda form % compare?)
(bind (_ args xpr . xprs) form
`(letrec ((,%self (lambda ,args ,xpr ,@xprs)))
,%self)))
(equal?
(map (alambda (n)
(if (zero? n)
1
(* n (self (- n 1)))))
'(1 2 3 4 5))
'(1 2 6 24 120))
Last update
Jan 18, 2018
Author
License
Copyright (c) 2017-2018, Juergen Lorenz (ju (at) jugilo (dot) de) 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.
Version History
- 1.3
- pseudo-list-of added, pseudo-list? redefined as not list?
- 1.2
- bind-case now procedural to improve error message
- 1.1
- added some additional macros from the procedural-macros egg
- 1.0
- initial import