path: root/artima/scheme/scarti.txt

for instance,
you could develop your program by using an interpreted implementation,
with the advantage of rapid development and debugging, and later on
deploy your program by using a compiled implementation, with the
advantage of speed and deployment. 

 ; draws a cake with n candles

  (define (print-cake n)
    (printf "   ~a  \n" (make-string n #\.))
    (printf " .-~a-.\n" (make-string n #\|))
    (printf " | ~a |\n" (make-string n #\space))
    (printf "---~a---\n" (make-string n #\-)))


For instance an alternative version of ``multi-define``
could be the following::

 (def-syntax multi-def
   (syntax-match (=)
     (=> (ctx (name = value) ...)
         #'(begin (define name value) ...))))

Here the identifier ``=`` is recognized as a keyword inside the
scope of the macro.

 > (multi-def (a = 1) (b = 2) (c = (+ a b)))
 > (list a b c)
 (1 2 3)

Breaking hygiene
------------------------------------------ 

Sometimes you want to break hygiene. ``def-syntax`` allows you to
do it just as easily as ``define-macro``. Here is an example,
a Python-like ``while`` loop which recognizes the "keywords"
``break`` and ``continue``.

A simple
macro to define the three components of a three-dimensional vector
``v`` as three variables ``v.x, v.y, v.z``:

.. code-block:: scheme

 (define (make-syntax-symbol syntax-sym . strings)
   )

 (def-syntax (define-3d-vector v vec)
   #`(begin
      (define #,(make-syntax-symbol #'v  ".x") (vector-ref v 0))
      (define #,(make-syntax-symbol #'v  ".y") (vector-ref v 1))
      (define #,(make-syntax-symbol #'v  ".z") (vector-ref v 2))))

This macro should be compared with:

.. code-block:: scheme

  (define (make-symbol sym . strings)
  )

  (define-macro (define-3d-vector v vec)
    `(begin
        (define ,(make-symbol v  ".x") (vector-ref v 0))
        (define ,(make-symbol v  ".y") (vector-ref v 1))
        (define ,(make-symbol v  ".z") (vector-ref v 2))))

The definition using ``def-syntax`` is a bit uglier than the one of
``define-macro``, but this is a feature, not a bug, since breaking
hygiene is a dirty thing and it is a good thing to have a dirty syntax
for it. That should prompt people to use better solutions. For
instance in this case a better solution would be to define a second
order hygienic macro like the following one:

.. code-block:: scheme

 (def-syntax (define-3d-vector v vec)
   #'(begin
      (define _v v)
      (def-syntax v
        ((v) #'_v)
        ((v x) #'(vector-ref _v 0))
        ((v y) #'(vector-ref _v 1))
        ((v z) #'(vector-ref _v 2)))))

so you would use the syntax ``(v x), (v y), (v z)`` instead of ``v.x, v.y, v.z``
(more parenthesis the better ;) Notice that the auxiliary variabile ``_v``
is introduced hygienically so that it cannot be accessed directly; still,
you can get the value of the vector with the syntax ``(v)``.

Guarded patterns
--------------------------------------------------------------------------

There is another major advantage of ``def-syntax``
versus ``define-macro``: better error messages via the usage of
guarded patterns. The general version of a clause in ``def-syntax``
is of kind ``(skeleton condition otherwise  ...)`` and if a condition
is present, the pattern is matched only if the condition is satified;
if not, if there is an ``otherwise``, specification, that is executed,
else, the matcher look at the clause. For instance the macro
``define-3d-vector v vec`` could be made more robust against
errors in this way:

.. code-block:: scheme

 (def-syntax (define-3d-vector v vec)
   #'(begin
        (define _v v)
        (def-syntax v
           ((v) _v)
           ((v x) #'(vector-ref _v 0))
           ((v y) #'(vector-ref _v 1))
           ((v z) #'(vector-ref _v 2)))) 
   (identifier? #'v)
   (syntax-violation #'v "not a valid identifier!" #'v))

Now you get a meaningful error message if you try something like the following:


.. code-block:: scheme

 > (define-3d-vector "v" (vector 1 2 3)) 


Last but not least, ``def-syntax`` macros, being based on syntax
objects and not just S-expressions, have information about source code
location and they are able to provide more informative error messages.



Macros with helper functions
----------------------------------------------------

``define-macro``-style macros often use helper functions as building blocks.
``syntax-rules`` is unable to do that, but ``def-syntax``, being based on 
``syntax-case`` has no trouble at all.  For instance, suppose you want
to define a version of ``let`` with fewer parenthesis (as done in Arc),
such that

.. code-block:: scheme

  (my-let (x 1 y 2) (+ x y))

expands to

.. code-block:: scheme

  (let ((x 1)(y 2)) (+ x y))

and that you already have a list-processing ``chop`` function such that

.. code-block:: scheme

 > (chop '(x 1 y 2))
 ((x 1) (y 2))

You can use the ``chop`` function inside your ``def-syntax`` macro
as simply as that:

.. code-block:: scheme

  (def-syntax (my-let (x ...) body1 body2 ...)
    #`(let #,(chop #'(x ...)) body1 body2 ...))

Often one wants to perform general computations at compile time, in terms
of helper functions invoked by a macro. To make this task easier, 
``umacros`` provides an helper function
``syntax-apply`` that takes a function and a list of syntax objects 
and return a syntax-object.

Here an example computing the factorial of ``n`` at compile time, if ``n``
is a literal number:

;FACT-MACRO

In particular, ``define-style`` macros themselves are an example of
this class of macros, since they are performing list processing at
compile time in terms of an expander function. That means that
``define-macro`` can be defined in terms of ``def-syntax`` in
a few lines of code::

.. code-block:: scheme

 (def-syntax define-macro
   (syntax-match ()
      (=> (define-macro (name . params) body1 body2 ...)
          #'(define-macro name (lambda params body1 body2 ...)))
      (=> (define-macro name expander)
          #'(def-syntax (name . args)
              (datum->syntax #'name (apply expander (syntax->datum #'args)))))
      ))

``syntax-match`` and second order macros
------------------------------------------------

Whereas *umacros* are intended to make life easy for beginner macro
programmers, they also have the ambition to make life easier for
*expert* macro programmers.  To this aim, the library alots exports
some utility which is helpful when writing complex macros. The most
important of such utilities is the macro ``syntax-match``, which is
useful when you need to access directly the transformer underlying the
macro, for instance writing second order macros, i.e. macro defining
macros.  Actually ``def-syntax`` is just a thing layer of sugar over
``syntax-match``, being ``(def-syntax (name . args) body ...)``
a shortcut for
``(define-syntax name (syntax-match (literal ...) (=> (name . args) body ...)
))``.

Here is an example of usage of ``syntax-match``.
We define a ``named-vector`` second order macro, which allows
to define macros providing a record-like syntax to vectors. 

.. code-block:: scheme

    (def-syntax (named-vector field ...)
       #'(let ((i (enum-set-indexer (make-enumeration '(field ...)))))
             (syntax-match (make set! fields field ...)
               (=> (_ make (field-name field-value) (... ...))
                #'(vector field-value (... ...)))
               (=> (_ v set! field value)
                   #`(vector-set! v #,(i 'field) value)) ...
               (=> (_ v field)
                   #`(vector-ref v #,(i 'field))) ...
               (=> (_ fields)
                   #''(field ...))
               (=> (_ v)
                   #'v)
               )))

``named-vector`` expands to a macro transformer and can be used as follows:

.. code-block:: scheme

 > (define-syntax book (named-vector title author))
 > (book fields)
 (title author)

The macro ``book`` allows to define vectors  as follows:

 > (define b (book make (title "Bible") (author "God")))
 > (book b title)
 "Bible"
 (book b author)
 "God"
 > (book b set! title "The Bible")
 > (book b)
 #("The Bible" "God")

``syntax-fold``
------------------------------------------

Another powerful utility provided by *umacros* is ``syntax-fold``,
which is useful in the definition of complex macros, whenever you need
to convert a list of *N* expressione into a list of *N'* expressions,
with *N'* different from *N*.  Consider for instance the following
problem: convert the list of *N* elements ``(a1 a2 a3 a4 ...)`` into
the list of *2N* elements ``(a1 a1 a2 a2 a3 a3 ...)``.

With regular fold can be done as follows:

 > (define ls '(a1 a2 a3 a4 a5 a6))
 > (fold-right (lambda (x acc) (cons* x x acc)) '() ls)
 (a1 a1 a2 a2 a3 a3 a4 a4 a5 a5 a6 a6)

This is easily done with ``syntax-fold``:

 > (define-syntax double 
      (syntax-fold (right acc ()) 
       (((_ x) #'(x x)))))
 > (double 1 2 3)

   

For instance, the previous macro can be generalized to an N-dimensional
vector as follows:

.. code-block:: scheme

 (def-syntax (define-vector v vec)
   (if (identifier? v)
   #'(begin
        (define _v v)
        (def-syntax v
           (=> (v) _v)
           #,(list-comp #`(=> (v i) (vector-ref _v i)) (i) (in (range N)))))
    "not a valid identifier!" #'v))

|#

(import (rnrs) (ikarus) (umacros3))

(pretty-print (def-syntax <patterns>))

(def-syntax (for i i1 i2 body ...)
 #'(let ((start i1) (stop i2))
     (assert (<= start stop))
     (let loop ((i start))
       (unless (>= i stop) body ... (loop (+ 1 i))))))
; (identifier? #'i))

(pretty-print (for <patterns>))
(for i 0 5 (display i))
(newline)

(pretty-print (syntax-expand (for i 0 5 (display i))))
;(newline))

;LET/CC
(def-syntax (let/cc cont body ...)
  #'(call/cc (lambda (cont) body ...)))
;END

;WHILE
(def-syntax (while condition body ...)
  (with-syntax
    ((break (datum->syntax #'while 'break))
     (continue (datum->syntax #'while 'continue)))
    #'(let/cc break
        (let loop ()
          (let/cc continue
             (if condition
                 (begin body ... (loop))
                 (break)))
          (loop)))))
;END

;WHILE-EXAMPLE
(define i 0)
(while (< i 10)
  (set! i (+ 1 i))
  (if (= i 2) (continue))
  (display i)
  (if (= i 5) (break)))
;END

(newline)

;FACT-MACRO
(def-syntax fact
  (letrec
      ((fac (lambda (n) (if (or (= n 1) (= n 0)) 1 (* n  (fac (- n 1)))))))
    (syntax-match ()
     (=> (fact n) (datum->syntax #'fact (fac (syntax->datum #'n)))))))
;END

(define (syntax-apply ctxt func . args)
  (datum->syntax ctxt (apply func (syntax->datum args))))

;(def-syntax (fact n) (apply-in-ctx #'fact fac #'n))

(display (fact 6))

;(define chop (syntax-match => (a b rest ...) #'((a b) (chop rest))))

;(define (list-head lst n)
;  (if (= 0 n)
;(define (chop-helper lst n acc)
;  (if (<= (length lst) n) (reverse (cons lst acc))
;      (chop-helper (list-tail lst n) (cons acc)))) 


Implementing literals with guards
---------------------------------------------------------

Literal identifiers defined via ``syntax-match`` have many advantages,
including the fact that they can be introspected. However, sometimes
you may want to implement them using guards instead. This is
advantageous if you have a single pattern and you don't need
to use the full power of ``syntax-match``, or if you want to
give customized error messages in case of wrong syntaxes.

Here is an example::

> (def-syntax (for3 el in lst do something ...)
    #'(apply for-each (lambda el do something ...)
        (transpose lst))
    (eq? (syntax->datum #'in) 'in)
    (syntax-violation 'for3 "invalid literal: required 'in'" #'in))

The guard strips the syntax object ``#'in`` by converting it down to a
simple datum, i.e. to a quoted Scheme expression via ``syntax->datum``,
and then checks if the datum is identical to the quoted identifier
``'in``. If not, a suitable syntax error is raised::

 > (for3 (x y) on '((a b) (x y) (1 2)) (display x) (display y))
 Unhandled exception
  Condition components:
    1. &who: for3
    2. &message: "invalid literal: required 'in'"
    3. &syntax:
        form: on
        subform: #f

You may want to hide the low-level details in your guards, i.e. the
call to ``syntax->datum``; moreover, you may want to remove
the duplication in the name of the literal identifier, which is
repeated twice; finally, you may want to extend the syntax to
check for many identifiers at once. All that can be done with a
suitable macro, as the following one::

> (def-syntax literal? ; a macro to be used in guards
   (syntax-match (syntax) ; remember: (syntax x) means #'x
     (=> (literal? (syntax name) ...)
         #'(and (eq? (syntax->datum #'name) 'name) ...)
         (for-all identifier? #'(name ...)))))

``literal?`` accepts patterns of the form ``(literal? #'name ...)``
where name is a valid identifier: this is checked early on
by the guard ``(for-all identifier? #'(name ...))`` which
is true if all the objects in the syntax list
``#'(name ...)`` are valid identifiers.

Using this macro, ``for3`` can be rewritten as

> (def-syntax (for4 el in lst do something ...)
    #'(apply for-each (lambda el do something ...)
        (transpose lst))
    (literal? #'in)
    (syntax-violation 'for3 "invalid literal: required 'in'" #'in))

 
In order to give a concrete example, here is a ``for``
loop defined via ``def-syntax``::

 (def-syntax (for i i1 i2 body ...)
  #'(let ((start i1) (stop i2)) 
      (assert (<= start stop))
      (let loop ((i start))
        (unless (>= i stop) body ... (loop (+ 1 i))))))

It is not an accident that the syntax resembles the ``define-macro`` syntax:

.. code-block:: scheme

 (define-macro (for i i1 i2 . body)
  (let ((start (gensym)) (stop (gensym)))
   `(let ((,start ,i1) (,stop ,i2))
      (let loop ((,i ,start))
        (unless (>= ,i ,stop) ,@body (loop (+ 1 ,i)))))))

On the aestetic side, ``def-syntax`` looks more elegant than ``define-macro``
because you can avoid all the funny commas and @-signs, as well as the gensyms
(in this example introducing the names ``start`` and ``stop`` is necessary in 
order to prevent multiple evaluation, and using ``gensym`` is necessary
in order to prevent unwanted variable capture). Moreover, ``def-syntax``
is more powerful, since it can accepts guarded patterns. For instance,
suppose we want to extend the previous ``for`` macro, by checking that
``i`` is a valid identifier.
That is easily done by using the extended form
of ``def-syntax``:


.. code-block:: scheme

 (def-syntax (for i i1 i2 body ...)
  #'(let ((start i1) (stop i2)) 
      (let loop ((i start))
        (unless (>= i stop) body ... (loop (+ 1 i)))))
  (identifier? #'i)
  )

It is possible to improve the error message by adding a clause
to the guard:

.. code-block:: scheme

 (def-syntax (for i i1 i2 body ...)
  #'(let ((start i1) (stop i2)) 
      (let loop ((i start))
        (unless (>= i stop) body ... (loop (+ 1 i)))))
  (identifier? #'i)
  (syntax-violation 'def-syntax "Not a valid identifier" #'i)
  )

The extended for ``def-syntax`` is
``(def-syntax (name . args) body fender else ...)``
where the fender and/or the else clause are optional.


---------------------

The Scheme module system is extremely complex, because of the
complications caused by macros and because of the want of
separate compilation. However, fortunately, the complication
is hidden, and the module system works well enough for many
simple cases. The proof is that we introduced the R6RS module
system in episode 5_, and for 20 episode we could go on safely
by just using the basic import/export syntax. However, once
nontrivial macros enters in the game, things start to become
complicated.

identifier-append
------------------------------------------

Suppose you want
to define an utility to generate identifiers to be inserted
unhygienically inside macros. A typical use case is the definition of
a bunch of identifiers with different suffixes. We can perform the
task with the following helper function:

$$lang:IDENTIFIER-APPEND

All the functions used here (``string->symbol``, ``string-append``,
``symbol->string`` work in the obvious way.
Here is a trivial example of usage of ``identifier-append`` in a
``def-book`` macro which introduces two identifiers for the fields
``title`` and ``author``:

$$DEF-BOOK

Here is a test, showing that hygiene is effectively broken and that
the identifiers ``name-title`` and ``name-author`` are really introduced
in the namespace after expansion:

$$TEST-DEF-BOOK

Are fexpr better than macros?
---------------------------------------------

http://en.wikipedia.org/wiki/Fexpr


#|
(define sentinel (gensym))

(def-syntax (hash-lambda h)
  (syntax-match ()
     (sub ())))

;; I would write the module system over alists
(define (alist->hash a)
  (define h (make-eq-hashtable))                                                
  (for-each (lambda (x) (hashtable-set! h (car x) (cadr x))) a)
  (case-lambda
    (() h)
    ((name) (hashtable-ref h name sentinel))))
 
(def-syntax (module-object def ...)
  (: with-syntax (name ...) (map get-name-from-define #'(def ...))
     #'(let ()
         def ...
         (alist->hash (list (list 'name name) ...)))))

(display (syntax-expand (module-object
                         (define a 1)
                         (define (f) a))))
                         
(define mod1
  (module-object
   (define a 1)
   (define (f) a)))

(display (mod1 'a))
(display ((mod1 'f)))

;(define mod1 (alist (a 1) (f (lambda () a))))

(define-ct example
  (define x 1)
  (define y (* x 2)))

(pretty-print (syntax-expand
(define-ct example
  (define x 1)
  (define y (* x 2)))))

(display (list (example x) (example y)))
         
|#



Suppose you wanted to define the macros
``define-ct`` and ``alist`` in the same module:

.. code-block:: scheme

 (import (rnrs) (sweet-macros))

 (def-syntax (alist arg ...)
    <code here> ...)

  (def-syntax (define-ct kw (define name value) ...)
    #'(def-syntax kw
        (let ((a (alist (name value) ...)))
             <more code here> ...)))