[racket] Macros baffle me

"Eduardo Costa" wrote:
> In general,  I don't have  problems with macros  in Common Lisp  or in
> Scheme. However, macros in Racket baffle me.

I assume you  mean that you are fine with  DEFINE-MACRO; hygienic macros
are significantly different.  You appear to grasp basic pattern matching
and output form composition by SYNTAX-RULES, good.

> I  simply  cannot  figure  out  how  syntax->datum,  syntax->list  and
> datum->syntax work.

For now, that's all right for SYNTAX->DATUM and DATUM->SYNTAX; getting a
basic understanding of SYNTAX->LIST was very important for me when I was
struggling   to  understand   hygienic  macros.    Here  some   function
implementations to look at:

   (define (syntax-car stx)
     (syntax-case stx ()
       ((?car . ?cdr)
        (syntax ?car))
       ))

   (define (syntax-cdr stx)
     (syntax-case stx ()
       ((?car . ?cdr)
        (syntax ?cdr))
       ))

   (define (syntax->list stx)
     (syntax-case stx ()
       (()
        '())
       ((?car . ?cdr)
        (cons (syntax ?car)
              (syntax->list (syntax ?cdr))))
       ))

   (syntax-car (syntax (a . b))) => #<syntax expr=a>
   (syntax-cdr (syntax (a . b))) => #<syntax expr=b>
   (syntax->list (syntax (a b c)))
   => (#<syntax expr=a> #<syntax expr=b> #<syntax expr=c>)

  I will  leave to other  people to suggest tutorials  and documentation
that are considered  good these days; rather I include  working code for
you to  study; I  think it  does what I  understand you  want to  do.  I
assume in good faith that this is not homework.

  A couple of notes first:

* Understand that the notation:

     #'?thing

  is equivalent to:

     (syntax ?thing)

* Take note that:

     (syntax-case stx ()
       ((?car . ?cdr)
        (free-identifier=? #'?car #'and)
        (do-something)))

  is equivalent to the shorter:

     (syntax-case stx (and)
       ((and . ?cdr)
        (do-something)))

  because  the code  SYNTAX-CASE  expands to  contains an  automatically
  built:

     (free-identifier=? #'?car #'and)

  Now the code.  I am no Racket user (sorry), this is standard R6RS code
without Racket specific bindings[1].  Most likely, Racket has better and
built-in functions you can use in place of DELETE-DUPLICATE-IDENTIFIERS,
and maybe also FREE-VARS.

[1] <http://docs.racket-lang.org/r6rs/Using_R6RS_with_DrRacket.html?q=r6rs>

;; demo.sps --

#!r6rs
(import (rnrs (6)))

(define-syntax with-vars
  (syntax-rules ()
    ((_ (?id0) ?body0 ?body ...)
     (for-all (lambda (?id0) ?body0 ?body ...)
       '(#t #f)))
    ((_ (?id0 ?id ...) ?body0 ?body ...)
     (for-all (lambda (?id0)
                (with-vars (?id ...) ?body0 ?body ...))
       '(#t #f)))
    ))

(define-syntax tauta
  (lambda (stx)
    (define free-vars
      (case-lambda
       ((stx)
        (free-vars stx '()))
       ((stx id*)
        ;;Collect the free variables appearing  in the syntax object STX
        ;;and  accumulate them  in  the list  of  identifiers ID*;  this
        ;;function is a recursive code walker inside STX.  For instance:
        ;;
        ;;   (free-vars #'(or Q (or (not P) P)))
        ;;   => (#'P #'Q)
        ;;
        ;;In  the context  of this  function: a  "free variable"  is any
        ;;identifier not FREE-IDENTIFIER=? to one among:
        ;;
        ;;  and or then -> <-> not equiv display displayln
        ;;
        ;;We assume STX represents a valid code form.
        ;;
        ;;NOTE We do honor QUOTE but not QUASIQUOTE, SYNTAX, QUASISYNTAX
        ;;etc.
        (syntax-case stx (and or then -> <-> not equiv display displayln
                              quote)
          ((and . ?form)
           (free-vars #'?form id*))
          ((or . ?form)
           (free-vars #'?form id*))
          ((then . ?form)
           (free-vars #'?form id*))
          ((-> . ?form)
           (free-vars #'?form id*))
          ((<-> . ?form)
           (free-vars #'?form id*))
          ((not . ?form)
           (free-vars #'?form id*))
          ((equiv . ?form)
           (free-vars #'?form id*))
          ((display . ?form)
           (free-vars #'?form id*))
          ((displayln . ?form)
           (free-vars #'?form id*))

          ((quote . ?datum)
           ;;Do not visit the datum.
           id*)

          ((?id . ?form)
           (identifier? #'?id)
           (free-vars #'?form (cons #'?id id*)))
          ((?car . ?cdr)
           (append (free-vars #'?car)
                   (free-vars #'?cdr)
                   id*))
          (?atom
           id*)
          ))
       ))

    (define delete-duplicate-identifiers
      (case-lambda
       ((id*)
        (delete-duplicate-identifiers id* free-identifier=?))
       ((id* identifier=)
        ;;Given  the  list  of  identifiers  ID*  remove  the  duplicate
        ;;identifiers and return a proper list of unique identifiers.
        ;;
        (assert (and (list? id*) (for-all identifier? id*)))
        (let clean-tail ((id* id*))
          (if (null? id*)
              '()
            (let ((head (car id*)))
              (cons head (clean-tail (remp (lambda (id)
                                             (identifier= id head))
                                       (cdr id*))))))))))

    (syntax-case stx ()
      ((_ ?expr)
       (let* ((var* (free-vars #'?expr))
              (var* (delete-duplicate-identifiers var*)))
         #`(with-vars #,var* ?expr)))
      )))

(define-syntax print-tauta
  (syntax-rules ()
    ((_ ?expr)
     (let ((input-expr (quote ?expr))
           (result     (tauta ?expr))
           (port       (current-output-port)))
       (display input-expr port)
       (display " => "     port)
       (display result     port)
       (newline port)
       (flush-output-port port)))
    ))

(define (then x y)
  (or y (not x)))

(define (equiv x y)
  (and (then x y) (then y x)))

(print-tauta (or (then P Q) (then Q (not P))))
(print-tauta (or P (not P))) ; excluded middle
(print-tauta (or (and P Q) (or (not P) (not Q))))
(print-tauta (equiv (then P Q) (then (not Q) (not P)))) ;equiv
(print-tauta (then (and (then (not A) B) (then (not A) (not B))) A)) ;reductio ad absurdum
(print-tauta (equiv (not (and A B)) (or (not A) (not B)))) ; De Morgan's law

;;; end of file
-- 
"Now feel the funk blast!"
Rage Against the Machine - "Calm like a bomb"