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.
- Outdated egg!
- Low-level macros made easy
- Programming interface
- The module macro-helpers
- The module low-level-macros
- The module macro-helpers
- Last update
- Version History
THIS MODULE IS NOW OBSOLETE. USE BINDINGS INSTEAD!
This module contains some macros to make the use of low-level macros easier. It replaces the now obsolete modules er-macros and ir-macros.
Recall that low-level macros are implemented as transformer routines, which are three-parameter procedures enclosed in er-macro-transformer or ir-macro-transformer respectively
(er-macro-transformer (lambda (form rename compare?) ...)) (ir-macro-transformer (lambda (form inject compare?) ...))
The programmer's job is to destructure the macro-code, form, and to do the renaming of all symbols which should appear in the macro-expansion by hand in the explicit-renaming case or to inject those symbols, which should not be renamed in the implicit-renaming case. In any case, symbols which are not renamed are unhygienic. The third parameter allows to handle additional keywords.
Each of these transformer arguments does a special job, each of which is tedious and error-prone. In this module, we'll automate each of these jobs.
Let's start with destructuring the macro-code. It can be done by a local macro, dbind, which in turn uses procedures destruc, dbind-ex, dbind-lit and dbind-len, which must be imported for-syntax and hence should appear in a helper module, macro-helpers. The implementation of dbind follows Graham's classic "On Lisp", p. 232. Here is a Chicken version for lists:
(define-syntax dbind (ir-macro-transformer (lambda (form inject compare?) (letrec ( (mappend (lambda (fn lists) (apply append (map fn lists)))) (destruc (lambda (pat seq) (let loop ((pat pat) (seq seq) (n 0)) (if (pair? pat) (let ((p (car pat)) (recu (loop (cdr pat) seq (+ n 1)))) (if (symbol? p) (cons `(,p (list-ref ,seq ,n)) recu) (let ((g (gensym))) (cons (cons `(,g (list-ref ,seq ,n)) (loop p g 0)) recu)))) (let ((tail `(list-tail ,seq ,n))) (if (null? pat) '() `((,pat ,tail)))))))) (dbind-ex (lambda (binds body) (if (null? binds) `(begin ,@body) `(let ,(map (lambda (b) (if (pair? (car b)) (car b) b)) binds) ,(dbind-ex (mappend (lambda (b) (if (pair? (car b)) (cdr b) '())) binds) body))))) ) (let ((pat (cadr form)) (seq (caddr form)) (body (cdddr form)) (gseq 'seq)) `(let ((,gseq ,seq)) ,(dbind-ex (destruc pat gseq) body)))))))
Its local procedures will be put in the helper module which must be imported for-syntax. The other destructuring procedures in the helper module are needed for checking the length of sequences and for coping with non-symbol literals.
Using dbind two exported macros, list-bind and list-bind-case, are exported and used in define-er-macro and macro-rules respectively, the latter being a low-level-version of syntax-rules, which accepts injected symbols.
Renaming in define-er-macro can be done by supplying a special rename-prefix, % in most cases. Symbols with this prefix are extracted from the macro-body and transformed into a let which defines the necessary renamed symbols. Last but not least, additional keywords can be extracted from the macro body as well and transformed into a where clause of the bind macro. This way, the transformer disappears completely on the surface, but ,of course, happens to do the job behind the scene.
- macro-helpers #!optional symprocedure
shows which symbols are exported, if called with no argument, or sym's documentation.
- symbol-dispatcher alistprocedure
creates a documentation procedure as used by macro-helpers and low-level-macros.
- bind-exception loc msg #!rest argsprocedure
generates a composite condition of type (exn bind) with location loc, message msg and arguments args. Imported and reexported by low-level-macros.
- add-prefix pref idprocedure
adds a prefix to a symbol.
- prefixed-with? preprocedure
returns a predicate, which checks, if pre is a prefix of its argument.
- strip-prefix pre idprocedure
strips the prefix pre from the identifier id.
- strip-suffix suf idprocedure
strips the suffix suf from the identifier id.
- extract ok? treeprocedure
returns a flat list of all the symbols in a tree which pass the ok? test.
- remove-duplicates lstprocedure
returns a sublist of lst with dups removed.
- adjoin obj lstprocedure
conses obj to lst provided it isn't already there.
- memp ok? lstprocedure
returns the tail of lst, whose car passes ok?, or #f otherwise.
- assp ok? tblprocedure
returns the table item whose car passes ok?
- replace* what? by treeprocedure
substitutes each old with (what? old) by (by old) in a tree.
- map* fn #!rest treesprocedure
tree-version of map. Returns a tree.
- flatten treeprocedure
returns a flat list with all the items of tree.
- flatten-map* fn #!rest treesprocedure
combination of flatten and map*. Returns a list.
- filter ok? lstprocedure
returns two sublists of lst where each item passes ok? or not ok? respectively.
- mappend fn listsprocedure
combination of map and append, i.e. mapcan in CL.
- plist? xprprocedure
is xpr a pseudolist? Allways #t.
- pnull? xprprocedure
is xpr a null? pseudolist? For example (pnull? 1) is true.
- plength plprocedure
returns the length of a pseudolist. For example (plength 1) is 0. Imported for-syntax and reexported by low-level-macros.
- plist-ref pl kprocedure
returns the kth item of a pseudolist. Imported for-syntax and reexported by low-level-macros.
- plist-tail pl kprocedure
returns the tail, starting from k, of a pseudolist. Imported for-syntax and reexported by low-level-macros.
- seq-length seqprocedure
returns the length of the generic sequence seq, presently a string, vector or (pseudo-)list.
- seq-ref seq nprocedure
returns the nth item of the generic sequence seq, presently a string, vector or (pseudo-)list.
- seq-tail seq nprocedure
returns the tail of the generic sequence seq, presently a string, vector or (pseudo-)list, starting at n.
- seq-length-ref-tail! type? type-length type-ref type-tailprocedure
updates the local tables of seq-length, seq-ref and seq-tail in one go by adding appropriate pairs to its front.
- vector-tail vec kprocedure
returns the subvector of vec starting with index k.
- list-of ok?procedure
returns a predicate which checks, if its list argument passes ok?
- atom? xprprocedure
same as (not (pair? xpr)).
- list-destruc pat seqprocedure
helper, which does most of the work to destructure seq according to the pattern pat, a nested pseudolist of symbols and non-symbol literals. Returns three lists, to be used by dbind-ex, dbind-lit and dbind-len respectively.
- seq-destruc pat seqprocedure
same as list-destruc, but destructures generic sequences. Used in the bindings module.
- dbind-ex symbols bodyprocedure
where body is a list starting with a fender expression and symbols is the first returned value of list- or seq-destruc. Generates a nested let expression.
- dbind-lit literalsprocedure
where literals is the second returned value of list- or seq-destruc. Generates code which checks if literals match.
- dbind-len length-checksprocedure
where length-checks is the third returned value of list- or seq-destruc. Generates code which checks if pat and seq are matchable at all.
- dbind-def op symbolsprocedure
where op is either 'set! or 'define and symbols is the first returned value of list- or seq-destruc. Returns code for bind-define or bind-set! in the bindings module.
- low-level-macros sym ..procedure
returns a list of all the exported symbols of the module, if called with no argument, or sym's documentation.
- (list-bind pat seq (where . fenders) .. xpr ....)syntax
binds pattern variables of pat to subexpressions of seq and executes xpr .... in this context, provided all fenders return #t, if supplied.
Note, that non-symbol literals are accepted in pat and seq and considered a match if they are equal.
- (list-bind-case seq clause ....)syntax
where seq is a nested pseudolist expression and each clause is of one of two forms
(pat (where . fenders) xpr ....) (pat xpr ....)
Matches seq against a series of patterns and executes the body of the first matching pattern satisfying fenders (if given).
Note, that non-symbol literals are accepted in seq and each pat and considered a match if they are equal.
- (define-er-macro (name . args) (rename-prefix pre) . body)syntax
where body can start with an optional (keywords key ...) clause.
Defines an explicit-renaming macro by renaming every symbol in the body which starts with prefix pre.
- (define-macro (name . args) xpr ....))syntax
- (define-macro (name . args) (inject sym ...) xpr ....))syntax
- (define-macro (name . args) (inject sym ...) (keywords key ...) xpr ....))syntax
- (define-macro (name . args) (keywords key ...) (inject sym ...) xpr ....))syntax
generates an implicit-renaming macro, name. Keywords and injected symbols are extracted from the macro body and transformed into appropriate subexpressions of the macro-transformer.
- (let-macro ((code . body) ....) xpr ....)syntax
where (code . body) .... are as in define-macro.
This is a local version of define-macro, allowing a list of (code . body) lists to be processed in xpr .... in parallel.
- (letre-macro ((code0 . body) ....) xpr ....)syntax
where (code0 . body) .... are as in define-macro.
This is a local version of define-macro, allowing a list of (code . body) lists to be processed in xpr .... recursively.
- (macro-rules sym ... (keyword ...) (pat (where . fenders) .. tpl) ....)syntax
like syntax-rules, but the templates are usually quasiquote-expressions. Moreover, the symbols sym ... are injected, if there are any.
Note, that non-symbol literals are accepted in each pat and considered a match if they are equal to a corresponding literal in the macro-code.
macro-rules must be imported for-syntax.
- (once-only (x ...) . body)syntax
to be used in a macro-body to avoid side-effects. The arguments x ... are only evaluated once. once-only must be imported for-syntax.
- (with-gensyms (x ...) . body)syntax
to be used in a macro body. Generates a list of gensyms x ... with-gensyms must be imported for-syntax.
- (define-syntax-rule (name . args) tpl)syntax
- (define-syntax-rule (name . args) (with-keywords (x ...) tpl))syntax
the only high-level macro. To be used instead of syntax-rules in case there is only one rule and no additional keywords.
(require-library low-level-macros) (import low-level-macros macro-helpers) (import-for-syntax (only low-level-macros macro-rules once-only with-gensyms))
(require-library low-level-macros) (import low-level-macros macro-helpers) (import-for-syntax (only low-level-macros macro-rules once-only with-gensyms)) ;; destructuring (list-bind a 1 a) ; -> 1 (list-bind (x y z w) '(1 2 3 4) (list x y z w) ; -> '(1 2 3 4) (list-bind (x (y (z))) '(1 (2 (3))) (where (odd? y)) (list x y z)) ; -> error (list-bind (x (y (z))) '(1 (2 (3))) (list x y z)) ; -> '(1 2 3) (letrec ( (my-map (lambda (fn lst) (list-bind-case lst (() '()) ((x . xs) (cons (fn x) (my-map fn xs)))))) ) (my-map add1 '(1 2 3))) ; -> '(2 3 4) (list-bind-case '(1 2 3 4 5) ((a (b . C) . d) (list a b C d)) ((e . f) (where (zero? e)) e) ((e . f) (list e f))) ; -> '(1 (2 3 4 5))) (list-bind-case '(1 (#f 3)) ((x y) (where (number? y)) (list x y)) ((x ("y" . z)) (list x z)) ((x (#f z)) (list x z))) ; -> '(1 3) ;; two anaphoric macros (define-syntax aif (macro-rules it () ((_ test consequent) `(let ((,it ,test)) (if ,it ,consequent))) ((_ test consequent alternative) `(let ((,it ,test)) (if ,it ,consequent ,alternative))))) (define-macro (alambda args xpr . xprs) (with-inject-prefix % `(letrec ((,%self (lambda ,args ,xpr ,@xprs))) ,%self))) ;; effective membership testing (define-macro (in? what equ? . choices) (let ((insym 'in)) `(let ((,insym ,what)) (or ,@(map (lambda (choice) `(,equ? ,insym ,choice)) choices))))) ;; two versions of a verbose if (define-macro (verbose-if test (then . xprs) (else . yprs)) (with-rename-prefix % (with-keywords (then else) `(,%if ,test (,%begin ,@xprs) (,%begin ,@yprs))))) (define-syntax vif (macro-rules (then else) ((_ test (then xpr . xprs)) `(if ,test (begin ,xpr ,@xprs))) ((_ test (else xpr . xprs)) `(if ,(not test) (begin ,xpr ,@xprs))) ((_ test (then xpr . xprs) (else ypr . yprs)) `(if ,test (begin ,xpr ,@xprs) (begin ,ypr ,@yprs))))) ;; low-level version of cond (define-syntax my-cond (macro-rules (else =>) ((_ (else xpr . xprs)) `(begin ,xpr ,@xprs)) ((_ (test => xpr)) (let ((temp test)) `(if ,temp (,xpr ,temp)))) ((_ (test => xpr) . clauses) (let ((temp test)) `(if ,temp (,xpr ,temp) (my-cond ,@clauses)))) ((_ (test)) test) ((_ (test) . clauses) (let ((temp test)) `(if ,temp ,temp (my-cond ,@clauses)))) ((_ (test xpr . xprs)) `(if ,test (begin ,xpr ,@xprs))) ((_ (test xpr . xprs) . clauses) `(if ,test (begin ,xpr ,@xprs) (my-cond ,@clauses))))) ;; non-symbolic literals (define-syntax foo (macro-rules () ((_ "foo" x) x) ((_ #f x) `(list 'false)) ((_ #f x) 'false) ((_ a b) (where (string? a)) `(list ,a ,b)) ((_ a b) (where (odd? a)) `(list ,a ,b)) ((_ a b) a))) (foo "foo" 1) ; -> 1 (foo "bar" 2) ; -> '("bar" 2) (foo #f 'blabla) ; -> '(false) (foo 1 2) ; -> '(1 2) (foo 2 3) ; -> 2 ;; generics (use tuples) (seq-tail '#(0 1 2) 3) ; -> '#() (seq-tail "foo" 1) ; -> "oo" (seq-ref "foo" 1) ; -> #\o (seq-tail '(0 1 2) 1) ; -> '(1 2) ;; add tuples to generic sequences (seq-length-ref-tail! tuple? tuple-length tuple-ref tuple-from-upto) (seq-ref (tuple 0 1 2) 1) ; -> 1 (seq-tail (tuple 0 1 2) 1) ; -> (tuple 1 2)
Copyright (c) 2011-2014, Juergen Lorenz 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.
Apr 24, 2017
- patch supplied by Peter Bex applied
- bug in test etc? fixed
- module now obsolete, use bindings instead
- define-er-macro added
- syntax change in define-macro, bind and bind-case renamed
- destruc fixed
- seq-tail fixed
- internal documenatation added, generic updater renamed
- generic sequences added in macro-helpers, destruc enhanced accordingly
- complete rewrite, accepting now non-symbolic literals
- exception-handler introduced
- dependency on bindings removed, simplified versions of bind and bind-case added
- complete rewrite
- renamed macro-define to define-macro
- fixed low-level-macros.meta and low-level-macros.setup
- initial import, merging er-macros and ir-macros