• Wiki
• Download
• Manual
• Eggs
• API
• Tests
• Bugs

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.

• egg

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

[procedure] (basic-macro-helpers sym ..)

documentation procedure

pseudo-list

[procedure] (pseudo-list sentinel . args)

constructs a new pseudo-list.

pseudo-list?

[procedure] (pseudo-list? xpr)

predicate. Note, that except lists everything is a pseudo-list.

pseudo-list-of

[procedure] (pseudo-list-of . preds)

returns a unary predicate, which tests, if its argument is passed by each predicate in preds.

pseudo-null?

[procedure] (pseudo-null? xpr)

not a pair.

pseudo-length

[procedure] (pseudo-length pl)

length of a pseudo-list. The sentinel is not counted.

pseudo-ref

[procedure] (pseudo-ref pl k)

returns the kth item of a pseudo-list. k must be less then pl's pseudo-length.

pseudo-tail

[procedure] (pseudo-tail pl k)
[procedure] (pseudo-tail pl)

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

[procedure] (pseudo-head pl k)
[procedure] (pseudo-head pl)

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

[procedure] (pseudo-sentinel pl)

returns the sentinel of a pseudo-list. If pl is not a pair, pl itself is returned.

pseudo-flatten

[procedure] (pseudo-flatte tree)

transforms a nested pseudo-list to a flat list.

adjoin

[procedure] (adjoin obj lst)

adds obj to lst, provided obj is not an item of lst.

remove-duplicates

[procedure] (remove-duplicates lst)

removes all duplicates of lst.

filter

[procedure] (filter ok? lst)

returns the sublist of lst consisting of all items passing the ok? predicate.

sym-prepends?

[procedure] (sym-prepends? pre sym)

does the symbol sym start with the symbol pre?

sym-tail

[procedure] (sym-tail pre sym)

returns the subsymbol of sym by stripping the prefix pre.

The module basic-macros

basic-macros

[procedure] (basic-macros sym ..)

documentation procedure

define-syntax-rule

[syntax] (define-syntax-rule (name . args) xpr . xprs)
[syntax] (define-syntax-rule (name . args) (keywords . keys) xpr . xprs)

simplyfied version of syntax-rules if there is only one rule.

define-ir-macro-transformer

[syntax] (define-er-macro-transformer (name form inject compare?)

wrapper around ir-macro-transformer.

define-er-macro-transformer

[syntax] (define-er-macro-transformer (name form rename compare?)

wrapper around er-macro-transformer.

define-er-macro

[syntax] (define-er-macro (name form rename-symbol compare?) xpr . xprs)

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

[syntax] (define-ir-macro (name form inject-symbol compare?) xpr . xprs)

defines an implicit-renaming-macro name with macro-code form injecting each symbol in the body xpr . xprs starting with inject-symbol automatically.

bind

[syntax] (bind pat seq (where (x x? ...) ...) xpr . xprs)
[syntax] (bind pat seq xpr . xprs)

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

[syntax] (bind-case seq (pat fenders ... xpr . xprs) ...)
[syntax] (bind-case seq (pat xpr . xprs) ...)

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

[syntax] (once-only (x . xs) xpr . xprs)

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

[syntax] (with-mapped-symbols mapper prefix- (prefix-x ...) xpr . xprs)

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

[syntax] (with-gensyms (x ...) xpr ....)

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

Juergen Lorenz

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