"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"
____________________
Racket Users list:
http://lists.racket-lang.org/users
