low-level-macros

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.

THIS MODULE IS NOW OBSOLETE. USE BINDINGS INSTEAD!

Low-level macros made easy

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.

Programming interface

The module macro-helpers

macro-helpers

macro-helpers #!optional symprocedure: shows which symbols are exported, if called with no argument, or sym's documentation.

symbol-dispatcher

symbol-dispatcher alistprocedure: creates a documentation procedure as used by macro-helpers and low-level-macros.

bind-exception

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

add-prefix pref idprocedure: adds a prefix to a symbol.

prefixed-with?

prefixed-with? preprocedure: returns a predicate, which checks, if pre is a prefix of its argument.

strip-prefix

strip-prefix pre idprocedure: strips the prefix pre from the identifier id.

strip-suffix

strip-suffix suf idprocedure: strips the suffix suf from the identifier id.

extract

extract ok? treeprocedure: returns a flat list of all the symbols in a tree which pass the ok? test.

remove-duplicates

remove-duplicates lstprocedure: returns a sublist of lst with dups removed.

adjoin

adjoin obj lstprocedure: conses obj to lst provided it isn't already there.

memp

memp ok? lstprocedure: returns the tail of lst, whose car passes ok?, or #f otherwise.

assp

assp ok? tblprocedure: returns the table item whose car passes ok?

replace*

replace* what? by treeprocedure: substitutes each old with (what? old) by (by old) in a tree.

map*

map* fn #!rest treesprocedure: tree-version of map. Returns a tree.

flatten

flatten treeprocedure: returns a flat list with all the items of tree.

flatten-map*

flatten-map* fn #!rest treesprocedure: combination of flatten and map*. Returns a list.

filter

filter ok? lstprocedure: returns two sublists of lst where each item passes ok? or not ok? respectively.

mappend

mappend fn listsprocedure: combination of map and append, i.e. mapcan in CL.

plist?

plist? xprprocedure: is xpr a pseudolist? Allways #t.

pnull?

pnull? xprprocedure: is xpr a null? pseudolist? For example (pnull? 1) is true.

plength

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

plist-ref pl kprocedure: returns the kth item of a pseudolist. Imported for-syntax and reexported by low-level-macros.

plist-tail

plist-tail pl kprocedure: returns the tail, starting from k, of a pseudolist. Imported for-syntax and reexported by low-level-macros.

seq-length

seq-length seqprocedure: returns the length of the generic sequence seq, presently a string, vector or (pseudo-)list.

seq-ref

seq-ref seq nprocedure: returns the nth item of the generic sequence seq, presently a string, vector or (pseudo-)list.

seq-tail

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!

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

vector-tail vec kprocedure: returns the subvector of vec starting with index k.

list-of?

list-of ok?procedure: returns a predicate which checks, if its list argument passes ok?

atom?

atom? xprprocedure: same as (not (pair? xpr)).

list-destruc

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

seq-destruc pat seqprocedure: same as list-destruc, but destructures generic sequences. Used in the bindings module.

dbind-ex

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

dbind-lit literalsprocedure: where literals is the second returned value of list- or seq-destruc. Generates code which checks if literals match.

dbind-len

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

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.

The module low-level-macros

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

(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

(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

(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

(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

(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.

letrec-macro

(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

(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

(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

(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

(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.

Requires

nothing

Usage

(require-library low-level-macros)
(import low-level-macros macro-helpers)
(import-for-syntax
  (only low-level-macros macro-rules once-only with-gensyms))

Examples

(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)

Author

Juergen Lorenz

License

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.

Last update

Apr 24, 2017

Version History

3.4.3: patch supplied by Peter Bex applied
3.4.2: bug in test etc? fixed
3.4.1: module now obsolete, use bindings instead
3.4: define-er-macro added
3.3: syntax change in define-macro, bind and bind-case renamed
3.2.2: destruc fixed
3.2.1: seq-tail fixed
3.2: internal documenatation added, generic updater renamed
3.1: generic sequences added in macro-helpers, destruc enhanced accordingly
3.0: complete rewrite, accepting now non-symbolic literals
2.1.1: exception-handler introduced
2.1: dependency on bindings removed, simplified versions of bind and bind-case added
2.0: complete rewrite
1.2: renamed macro-define to define-macro
1.1: fixed low-level-macros.meta and low-level-macros.setup
1.0: initial import, merging er-macros and ir-macros

chickadee » low-level-macros

Identifier search

TOC »

Contents »