Missing argument in syntax-rules Hygienic macro call from Scheme R5RS example - macros

I have one more questions about Hygienic macros in Scheme, consider example from R5RS
(let-syntax ((when (syntax-rules ()
((when test stmt1 stmt2 ...)
(if test
(begin stmt1
stmt2 ...))))))
(let ((if #t))
(when if (set! if 'now))
if))
Why it match if the pattern have 3 arguments and ellipsis that can match empty list?
It's called with 2 arguments if and (set! if 'now). What should be ... bind to, if stmt2 can be bind to empty list? This is kind of non Lispy if ... is just nothing. Is that true?
What should be the expansion of when in this context? What is the value of stmt2?
Why this don't work but the first code does?
(let-syntax ((when (syntax-rules ()
((when test stmt1 stmt2 ...)
(if test
(begin stmt1
stmt2 ...))))))
(when if 10))
it work in Kawa but not in Guile, is that the bug in Guile and it should in fact work like in Kawa?
And one more question why it don't evaluate to nil? If next element in list after 10, is nil so stmt2 should be nil? R5RS is not very helpful in that regard.
I'm asking this because I've just finsihed renaming scheme for my macro system in LIPS Scheme and when I'm pattern matching I've got comparison of stmt2 and nil and there is also ... left. Should in this case ... just be ignored and stmt2 should be nil? And it should match even that there is one less symbol in pattern? This is really confusing.
What should be the expansion of last snippet of code?
EDIT:
One more thought
(let-syntax ((when (syntax-rules ()
((when test stmt1 . stmt2)
(if test
(begin stmt1
stmt2))))))
(when if 10))
This works in Kawa and return nil as expected but in Guile it throw exception, I consider Kawa Scheme to be better in following spec.
But why it even match the pattern if there are not enough arguments?

Yes. It is very non lispy that we have a modifier ... that changes the meaning of element in front. eg. something ... is basically similar to . something except it works with structures like this:
(define-syntax my-let
(syntax-rules ()
((_ ((a b) ...)
body1 bodyn ...)
((lambda (a ...)
body1 bodyn ...)
b ...))))
Notice I use body1 ro require at least one expression in the body since bodyn ... can be zero or more elements. This will turn:
(my-let ()
test)
==>
((lambda () test))
As well as
(my-let ((a b) (c d))
test1 test2)
==>
((lambda (a c)
test1 test2)
b
d)
My example cannot be rewritten with cons syntax, but basically using . works the same way as rest arguments in the pattern and . in a quote:
'(a b . (c d))
; ==> (a b c d)
Your when would not work with more than one expression.
eg.
(let-syntax ((when (syntax-rules ()
((when test stmt1 . stmt2)
(if test
(begin stmt1
stmt2))))))
(define if #t)
(when if (display 'true) #t))
Imagine that all report bindings also exist under r5rs: prefix. The expansion will become:
(r5rs:if if
(begin (display 'true)
(#t)))
; ERROR: Application not a procedure: #t
This is correct:
(let-syntax ((when (syntax-rules ()
((when test stmt1 . stmt2)
(if test
(begin stmt1
. stmt2))))))
(define if #t)
(when if (display 'true) #t))
; ==> #t (prints true)

Related

a question about memorized lazy eval macro in scheme language

Currently, i have been reading the book the scheme programming language written by Kent Dybvig.
In section 5.7, it implements memorized lazy eval in scheme using the scheme macro system.
The source code as
(define-syntax delay
(syntax-rules ()
[(_ expr) (make-promise (lambda () expr))]))
(define make-promise
(lambda (p)
(let ([val #f] [set? #f])
(lambda ()
(unless set?
(let ([x (p)])
(unless set?
(set! val x)
(set! set? #t))))
val))))
(define force
(lambda (promise)
(promise)))
But i can not understand why the variable set? need to be tested twice in the procedure make-promise.
This is the reason from the book
The second test of the variable set? in make-promise is necessary in the event that, as a result of
applying p, the promise is recursively forced. Since a promise must always return the same value, the result of
the first application of p to complete is returned.
which i can not understand
Could anyone explain it to me? Thanks!
The key is that force may reenter itself. Maybe an example can help you understand this:
(define x 5)
(letrec ([f (delay
(if (zero? x)
0
(begin
(set! x (- x 1))
(+ (force f) 1))))])
(force f))
The result will be 0, because the inner force call returns 0.
If without the second test, the result will be 5. In this situation, every (force f) returns different values.

Racket - implementing the let* function using macro

I need to implement my_let* using defmacro which works similarly to let*, but while let* is expanded to a series of nested let calls (behind the scenes), my_let* needs to be expanded to a single let call, and use the define statement to define the arguments i get.
an example of using my_let*:
(my_let* ((a 2)
(b 3)
(c (+ a b)))
(+ a b c))
and the return value of this code should be 10. just as if it was use let*.
the code above will be expanded in my_let* to the following:
(let ()
(define a 2)
(define b 3)
(define c (+ a b))
(+ a b c))
I'm new to using macro, though i successfully written some macros, this one got me lost.
Thank you in advance.
Use syntax-parse. At the least don't even consider using defmacro in Racket.
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (my-let* stx)
(syntax-parse stx
[(_my-let* ([name:id e:expr] ...) body ...)
#'(let ()
(define name e) ...
body ...)]))
The name:id means that name must be an identifier and e:expr means
that e must an expression. These simple annotations help syntax-parse
to give you better error messages.
Example:
(my-let* ((4 2)
(b 3)
(c (+ a b)))
(+ a b c))
Here the DrRacket will color the 4 read and give the message:
my-let*: expected identifier in: 4
The Scheme way is using syntax-rules
(define-syntax my-let*
(syntax-rules ()
((_ ((binding expression) ...) body ...)
(let ()
(define binding expression) ...
body ...))))
Using defmacro is more like making a procedure.
(define (my-let-fun* bindings . body)
...)
How it should work is like this:
(my-let-fun* '((a 1) (b 2) (c (+ a b))) "test" '(list a b c))
; ==> (let () (define a 1) (define b 2) (define c (+ a b)) "test" (list a b c))
If you have not called my-let-fun* in your implementation it's just changing it to a defmacro and you're done.
(defmacro my-let* (bindings . body)
...)
It's quite simple to do either with a helper to do recursion or foldr to do the bindings. Good luck!
Your my-let* will only work in #lang racket and perhaps #!r6rs and later. In R5RS you will get an error in this case:
(my-let* ((a 1) (b 2) (c (+ a b)))
(list a b c))
; signals an error that a is undefined.
The reason is that it expands to something like this:
(let ((a 'undefined) (b 'undefined) (c 'undefined))
(let ((tmp1 1) (tmp2 2) (tmp3 (+ a b)))
(set! a tmp1)
(set! b tmp2)
(set! c tmp3))
(list a b c))
Between the error messages and some judicious use of the macro stepper I think it's hard to go too wrong here. The trouble is just making sure you've put things together right using either conses or unquote-splicing. I believe the standard practice in such macros is heavy use of quasiquote and unquote-splicing in order for the output to as closely match the intended statement as possible, otherwise the macro can become quite inscrutable. But I am not a defmacro expert.
#lang racket/base
(require (for-syntax racket/base)
compatibility/defmacro)
(defmacro my-let* (binding-pairs . body)
(define defines (map (lambda (bp) (cons 'define bp)) binding-pairs))
`(let ()
,#defines
,#body))
(my-let* ((a 2)
(b (expt a 3)))
(printf "a:~a\nb:~a\n" a b)
(+ a b))

Is it possible to match repeated patterns in R5RS macroes define-syntax/syntax-rules?

This R5RS macro is what I have tried and is pretty much what I want to do. Racket or other implementations don't like this macro exactly where I wanted the magic to happen.
(define-syntax quote-unique
(syntax-rules (magic end)
;; end case
((quote-unique magic processed end)
'processed)
;; finished iteration
((quote-unique magic (processed ...) sym1 end rest ... )
(quote-unique magic (processed ... sym1) rest ... end))
;; match (doesn't work since racket doesn't like sym1 twice in template)
;; but I'm looking for the same expression twice
((quote-unique magic processed sym1 sym1 . rest )
(quote-unique magic processed sym1 . rest))
;; rotate
((quote-unique magic processed sym1 sym2 rest ... )
(quote-unique magic processed sym1 rest ... sym2))
;; start iteration
((quote-unique rest ...)
(quote-unique magic () rest ... end))))
This would have been easy in Common Lisp:
(defmacro quote-unique ( &rest xs )
(labels ((remove-duplicates (lis)
(if lis
(if (member (car lis) (cdr lis))
(remove-duplicates (cdr lis))
(cons (car lis) (remove-duplicates (cdr lis)))))))
(list 'quote (remove-duplicates xs))))
I also have been reading Define syntax primer and think the implementation of is-eqv? would have pointed me in the right directions, but it seems it's not a macro that is defined there.
If it's not possible in R5RS compile time, how could this be done with R6RS?
The remove-id example of Chris Jester-Young's answer is expressible in R5RS:
(define-syntax remove-id
(syntax-rules ()
((remove-id s (t ...))
(letrec-syntax ((aux (syntax-rules (s)
((aux p* ())
'p*)
((aux p* (s . rest))
(aux p* rest))
((aux (p (... ...)) (u . rest))
(aux (p (... ...) u) rest)))))
(aux () (t ...))))))
(Note that quoting the ellipsis by (... ...) is not strictly R5RS (only R7RS), but is only used to have the resulting sequence in the given order and not reversed. Thus by adding another macro, you can even ditch the ellipsis.)
I hope this example makes it clear how to solve your original problem. If something can be solved with hygienic macros, one should think twice before using a procedural macro or a macro facility that probably won't be standardized after R6RS.
You can't do this using syntax-rules, but you can do it using syntax-case, by using a guard that uses free-identifier=?. Here's an example:
(define-syntax (remove-id stx)
(syntax-case stx ()
((_ head ())
#''())
((_ head (next tail ...)) (free-identifier=? #'head #'next)
#'(remove-id head (tail ...)))
((_ head (next tail ...))
#'(cons 'next (remove-id head (tail ...))))))
> (remove-id foo (foo bar baz qux foo bar))
; => (bar baz qux bar)
But of course, if you're going to use syntax-case, there's a much simpler way to implement your quote-unique (this implementation uses Racket's custom hashtables):
(require (for-syntax racket/dict))
(define-syntax (quote-unique stx)
(define (id-dict ids)
(foldl (lambda (id d)
(dict-set d id #t))
(make-immutable-custom-hash free-identifier=? (compose eq-hash-code syntax-e))
(syntax-e ids)))
(syntax-case stx ()
((_ ids ...)
(with-syntax ((unique (dict-keys (id-dict #'(ids ...)))))
#''unique))))

set! global from Scheme macro?

I am trying to write a wrapper for define, that stores the values passed to it. I've been approaching it in baby steps (being new to Lisp in general, and even newer to Scheme) but have run into a wall.
In Racket, I'm starting with:
> (require (lib "defmacro.ss"))
> (define-macro (mydefine thing definition)
`(define ,thing ,definition))
> (mydefine a 9)
> a
9
Okay, that works. Time to do something in the macro, prior to returning the s-exprs:
> (define-macro (mydefine thing definition)
(display "This works")
`(define ,thing ,definition))
> (mydefine a "bob")
This works
> a
"bob"
Nice. But I can't for the life of me get it to set a global variable instead of displaying something:
> (define *myglobal* null)
> (define-macro (mydefine thing definition)
(set! *myglobal* "This does not")
`(define ,thing ,definition))
> (mydefine a ":-(")
set!: cannot set identifier before its definition: *myglobal*
Any suggestions on how to accomplish this would be greatly appreciated.
I suspect that I'm trying to swim against the current here, either by fiddling with globals from a macro in Scheme, or by using define-macro instead of learning the Scheme-specific syntax for macro creation.
You're running against Racket's phase separation -- which means that each phase (the runtime and the compile-time) operate in different worlds. As Vijay notes, one way to solve this is to do what you want at runtime, but that will probably not be what you need in the long run. The thing is that trying these things usually means that you will want to store some syntactic information at the compile-time level. For example, say that you want to store the names of all of your defined names, to be used in a second macro that will print them all out. You would do this as follows (I'm using sane macros here, define-macro is a legacy hack that shouldn't be used for real work, you can look these things up in the guide, and then in the reference):
#lang racket
(define-for-syntax defined-names '())
(define-syntax (mydefine stx)
(syntax-case stx ()
[(_ name value)
(identifier? #'name)
(begin (set! defined-names (cons #'name defined-names))
#'(define name value))]
;; provide the same syntactic sugar that `define' does
[(_ (name . args) . body)
#'(mydefine name (lambda args . body))]))
Note that defined-names is defined at the syntax level, which means that normal runtime code cannot refer to it. In fact, you can have it bound to a different value at the runtime level, since the two bindings are distinct. Now that that's done, you can write the macro that uses it -- even though defined-names is inaccessible at the runtime, it is a plain binding at the syntax level, so:
(define-syntax (show-definitions stx)
(syntax-case stx ()
[(_) (with-syntax ([(name ...) (reverse defined-names)])
#'(begin (printf "The global values are:\n")
(for ([sym (in-list '(name ...))]
[val (in-list (list name ...))])
(printf " ~s = ~s\n" sym val))))]))
The statement (set! *myglobal* "This does not") is executed in the transformer environment, not the normal environment. So it's not able to find *myglobal. We need to get both the expressions executed in the environment where *myglobal* is defined.
Here is one solution:
(define *defined-values* null)
(define-macro (mydefine thing definition)
`(begin
(set! *defined-values* (cons ,definition *defined-values*))
(define ,thing ,`(car *defined-values*))))
> (mydefine a 10)
> (mydefine b (+ 20 30))
> a
10
> b
50
> *defined-values*
(50 10)
> (define i 10)
> (mydefine a (begin (set! i (add1 i)) i)) ;; makes sure that `definition`
;; is not evaluated twice.
> a
11
If the Scheme implementation does not provide define-macro but has define-syntax, mydefine could be defined as:
(define-syntax mydefine
(syntax-rules ()
((_ thing definition)
(begin
(set! *defined-values* (cons definition *defined-values*))
(define thing (car *defined-values*))))))

How do I define functions using Racket macros?

I am trying to write a macro that defines a special class of data structure with associated functions.
I know this is possible; it is done multiple times in the core language itself.
As a specific example, how would I define the define-struct macro in Scheme itself. It needs to create make-struct, struct-<<field>>, etc functions.
I tried doing this using define, however, this only defines the function in the macro's lexical scope.
How can I actually define a function in a macro?
The key for an answer is datum->syntax. The basic idea is that you want to take some random data and turn it into a syntax -- in this case, turn a symbol into an identifier. An identifier is basically a symbol with some lexical information that (very roughly) indicates how it is bound. Using datum->syntax you can do exactly that: it expects an existing piece of syntax which is where it copies the binding from, and a datum (a symbol here) which is the value that is contained in the syntax wrapper.
Here's an example that demonstrates a define-struct-like tool using this:
#lang scheme
;; implements a defstruct-like macro that uses association lists
(define-syntax (defstruct-lite stx)
(syntax-case stx ()
[(defstruct-lite name field ...)
(let ([make-id
(lambda (template . ids)
(let ([str (apply format template (map syntax->datum ids))])
(datum->syntax stx (string->symbol str))))])
(with-syntax ([make-name (make-id "make-~a" #'name)]
[name? (make-id "~a?" #'name)]
[(arg ...) (generate-temporaries #'(field ...))]
[(name-field ...)
(map (lambda (f) (make-id "~a-~a" #'name f))
(syntax->list #'(field ...)))])
#'(begin
(define (make-name arg ...) (list 'name (cons 'field arg) ...))
(define (name? x) (and (pair? x) (eq? 'name (car x))))
(define (name-field x)
(and (name? x) (cdr (assq 'field (cdr x)))))
...)))]))
And here's an example of using it:
(defstruct-lite point x y)
(point-y (make-point 1 2))