Scheme macro expansion: Nesting let-syntax inside define-syntax - macros

I wish to expand
(foo x (f n) (f n) (arbitrary) (f n) ...)
into
(begin (x 'f n) (x 'f n) (arbitrary) (x 'f n) ...)
my attempt is:
(define-syntax foo
(syntax-rules ()
((_ l a ...)
(let-syntax ((f (syntax-rules ()
((_ n) (l (quote f) n)))))
(begin a ...)))))
(define (x t1 t2) (cons t1 t2)) ;; for example only
(define (arbitrary) (cons 'a 'b)) ;; for example only
(foo x (f 1) (f 2) (arbitrary) (f 3))
Using a macro stepper I can see that the first stage of the macro expands to
(let-syntax ((f (syntax-rules () ((_ n) (x 'f n)))))
(begin (f 1) (f 2) (arbitrary) (f 3)))
Which, when evaluated in isolation works perfectly, but when executed as a whole I get an error about f being an undefined identifier. I assume this is an issue in scoping, is this type of macro expansion possible?

Yeah, you need to get f from somewhere -- your macro just makes it up, and therefore it is not visible to users of foo. When you do consider that you need to get it from somewhere, the question is where would you get it from? Here's a fixed version of your code that assumes that it is the first thing in the second subform of foo:
(define-syntax foo
(syntax-rules ()
[(_ l (f a) more ...)
(let-syntax ([f (syntax-rules ()
[(_ n) (l 'f n)])])
(list (f a) more ...))]))
(define (x t1 t2) (cons t1 t2))
(define (arbitrary) (cons 'a 'b))
(foo x (f 1) (f 2) (arbitrary) (f 3))
(I also made it expand into a list to see that all forms are transformed.)
However, if you want a global kind of f to be used inside foo, then you really have to do just that: define a global f. Here's a limited way to do that:
;; no body => using `f' is always an error
(define-syntax f (syntax-rules ()))
(define-syntax foo
(syntax-rules ()
[(_ l a ...) (list (foo-helper l a) ...)]))
(define-syntax foo-helper
(syntax-rules (f) ; match on f and transform it
[(_ l (f n)) (l 'f n)]
[(_ l a) a]))
(define (x t1 t2) (cons t1 t2))
(define (arbitrary) (cons 'a 'b))
(foo x (f 1) (f 2) (arbitrary) (f 3))
The main limitation in this is that it will only work if one of the a forms is using f -- but it won't work if it is nested in an expression. For example, this will throw a syntax error:
(foo x (f 1) (f 2) (arbitrary)
(let ([n 3]) (f n)))
You can imagine complicating foo-helper and make it scan its input recursively, but that's a slippery slope you don't want to get into. (You'll need to make special cases for places like inside a quote, in a binding, etc.)
The way to solve that in Racket (and recently in Guile too) is to use a syntax parameter. Think about this as binding f to the same useless macro using define-syntax-parameter, and then use syntax-parameterize to "adjust" its meaning inside a foo to a macro that does the transformation that you want. Here's how this looks like:
;; needed to get syntax parameters
(require racket/stxparam)
;; same useless definition, but as a syntax parameter
(define-syntax-parameter f (syntax-rules ()))
(define-syntax foo
(syntax-rules ()
[(_ l a ...)
;; adjust it inside these forms
(syntax-parameterize ([f (syntax-rules ()
[(_ n) (l 'f n)])])
(list a ...))]))
(define (x t1 t2) (cons t1 t2))
(define (arbitrary) (cons 'a 'b))
(foo x (f 1) (f 2) (arbitrary)
(let ([n 3]) (f n)))

Related

Flatten syntax tree using hygenic macros

Is it possible to write an R5RS macro that would "flatten" arbitrarily deep syntax tree?
Example:
(flatten-syntax (a (b (c d)) e)) => (a b c d e)
My endgoal is to have another macro that would work like this:
(declare-tree (a (b (c d)) e))
=>
(begin (define a #f) (define b #f) (define c #f) (define d #f) (define e #f))
but it should be easy to define if flatten-syntax is available.
The most challenging part for me here is the syntax-rules-only restriction, but if you have syntax-case solution, please also post it.
My progress on this problem stalled at this point:
(define-syntax flatten-syntax-helper
(syntax-rules ()
((_ buf (x . xs))
(flatten-syntax-helper
(flatten-syntax-helper buf x) xs))
((_ buf ())
buf)
((_ buf x)
(x . buf))))
(define-syntax-rule (my-flatten-syntax T)
(flatten-syntax-helper () T))
In guile, ,expand (my-flatten-syntax (a (b (c d)) e)) results in syntax error "failed to match any pattern in form my-flatten-syntax".
Here's my quick attempt:
#lang racket
(define-syntax reverse-macro
(syntax-rules ()
[(_ () (result ...)) '(result ...)]
[(_ (x xs ...) (result ...)) (reverse-macro (xs ...) (x result ...))]))
(define-syntax flatten-syntax-aux
(syntax-rules ()
[(_ ((xs ...) ys ...) (result ...))
(flatten-syntax-aux (xs ... ys ...) (result ...))]
[(_ (x xs ...) (result ...))
(flatten-syntax-aux (xs ...) (x result ...))]
[(_ () (result ...))
(reverse-macro (result ...) ())]))
(define-syntax-rule (flatten-syntax xs)
(flatten-syntax-aux xs ()))
(flatten-syntax (a (b (c d)) e)) ;=> '(a b c d e)
Indeed, you can create declare-tree by adjusting flatten-syntax a little bit, but it might be surprising to you that defining declare-tree directly is in fact much easier:
#lang racket
(define-syntax declare-tree
(syntax-rules ()
[(_ ((xs ...) ys ...))
(begin (declare-tree (xs ...))
(declare-tree (ys ...)))]
[(_ (x xs ...))
(begin (define x #f)
(declare-tree (xs ...)))]
[(_ ())
(begin)]))
(declare-tree (a (b (c d)) e))
(list a b c d e) ;=> '(#f #f #f #f #f)
This is because declare-tree actually doesn't need to flatten the structure. It can generate nested begin, like:
(begin
(begin (define a #f)
(define b #f))
(begin (define c #f)
(define d #f)))

recursive expansion of macros in racket?

I'm wondering if there is a way to do recursive expansion of macros?
(define-syntax my-define
(syntax-rules ()
[(my-define (fn v ...) body) #'(define (fn v ...) body)]))
(define-syntax my-let
(syntax-rules ()
[(my-let ([v e] ...) body) #'(let ([v e] ...) body)]))
;(my-define (f1 a) a)
; this returns (define (f1 a) a)
;(my-let ([x 10]) x)
; this returns (let ([x 10]) x)
(my-define (f1 a) (my-let ([x 10]) x))
; but this returns (define (f1 a) (my-let [x 10] x)))
The nested case is somehow not expanded. Am I doing something wrong?
Seems to work fine, when you remove the #' (which you probably put it in to debug):
#lang racket
(define-syntax my-define
(syntax-rules ()
[(my-define (fn v ...) body)
(define (fn v ...) body)]))
(define-syntax my-let
(syntax-rules ()
[(my-let ([v e] ...) body)
(let ([v e] ...) body)]))
(my-define (fact n)
(my-let ([k (- n 1)])
(if (zero? n) 1 (* n (fact k)))))
(fact 5)

Function composition in Scheme

I'm trying to modify the function below to compose two functions in Scheme.
(define (compose F1 F2)
(eval F1 (interaction-environment))
)
rather than
(define (compose f g)
(λ (x) (f (g x))))
But I'm not sure about how to use eval.
From your suggestion, I guess you want to use Scheme's macros / preprocessing capabilities. eval isn't meant for code transformation. Composition ∘ can be defined in Scheme as
(define (∘ f g)
(lambda (x) (f (g x))) )
or
(define-syntax ∘
(syntax-rules ()
((∘ f g)
(lambda (x) (f (g x))) )))
where the arity of expressions f and g is 1.
(define (plus-10 n) (+ n 10))
(define (minus-3 n) (- n 3))
(display
(map (∘ plus-10 minus-3)
(list 1 2 3 4) ))
The map expression at compile-time becomes
(map (lambda (x) (plus-10 (minus-3 x)))
(list 1 2 3 4) )
equal?s
(list 8 9 10 11)

Two questions about Racket macro

About hygienic macro
I don't fully understand how hygienic macro work. Here is two example.
first one is:
#lang racket
(define-syntax (g stx)
(syntax-case stx ()
([_ arg]
#'(display arg))))
(let ([display 1])
(g 3))
this works fine but this one:
#lang racket
(define-syntax (g stx)
(syntax-case stx ()
([_ arg]
#'(display arg))))
(define display 1)
(g 3)
will raise an exception. How to explain the difference between the two case?
How to define a macro like this
I want to define a macro to allow anonymous recursive function in racket.
This one won't work because recur is not defined in the module:
#lang racket
(define Z
(λ(recur)
((λ(x) (recur (λ(y) (x x) y)))
(λ(x) (recur (λ(y) (x x) y))))))
(define-syntax-rule (R proc)
(Z (λ(recur) proc)))
((R (λ(n)
(if [= n 1]
1
(* n (recur (- n 1)))))) 3)
How to achieve this?
To answer your first question, the thing your forgetting here is that when you do a module level define like that, that definition is bound for the whole module. So, you could, theoretically write your second code block like this:
#lang racket
(let ([display 1])
(define-syntax (g stx)
(syntax-case stx ()
([_ arg]
#'(display arg))))
(g 3))
And now it makes sense why you get an error, because the display in your macro is bound to 1, which is not a function.
Long story short, think of hygiene just as lexical scope. Whatever display is bound to when you define your macro is what it will be. (This is opposed to macros in other languages, where whatever display is bound to when you call (or really expand) the macro, is what it will be.
Now, to answer your second question, I apologize, but am unclear what you are trying to ask here. If you could clean it up a bit then I can fill in this part of the answer.
So you want to break hygene? You need to get recur to have the lexical context of the original form such that recur will be seen as the same identifier. You can do this with datum->syntax and the result might look something like this:
(define-syntax (recur-λ stx)
(syntax-case stx ()
[(_ args body ...)
(with-syntax ([recur-stx (datum->syntax stx 'recur)])
#'(Z (λ (recur-stx)
(λ args body ...))))]))
Now as long as your args or the nesting in body introduces recur it will work:
; multiple argument recursion
(define Z
(λ (f)
((λ (g) (g g))
(λ (g)
(f (λ args (apply (g g) args)))))))
; ackerman
((recur-λ (m n)
(cond
((= m 0) (+ n 1))
((= n 0) (recur (- m 1) 1))
(else (recur (- m 1) (recur m (- n 1))))))
3
6)
; ==> 509
It won't work if you make recur an argument:
((recur-λ (recur) (recur 1)) 1)
; ==> error: recur not a procedure
And of course if you make a nested binding:
((recur-λ (a)
(define recur a)
(recur 1))
1)
; ==> error: recur not a procedure
And of course you can step through the macroexpander and it will show you that it does something like this:
(expand-once
#'(recur-λ (m n)
(cond
((= m 0) (+ n 1))
((= n 0) (recur (- m 1) 1))
(else (recur (- m 1) (recur m (- n 1)))))))
; ==>
; #'(Z
; (λ (recur)
; (λ (m n)
; (cond
; ((= m 0) (+ n 1))
; ((= n 0) (recur (- m 1) 1))
; (else (recur (- m 1) (recur m (- n 1))))))))

Programatically filling in a letrec in Scheme. Macros or eval?

I'm just playing with an NFA for string recognition. I have a macro that creates a function which consumes input and passes on the rest to some other functions. Because there might be loops in my NFA graph, I'm using letrec to put the whole thing together. Here is some code (been testing in PLT-Scheme):
(define-syntax-rule (match chars next accepting)
; a function that consumes a list of chars from a list l.
; on success (if there's more to do) invokes each of next on the remainder of l.
(lambda (l)
(let loop ((c chars) (s l))
(cond
((empty? c)
(cond
((and (empty? s) accepting) #t)
(else
(ormap (lambda (x) (x s)) next))))
((empty? s) #f)
((eq? (car c) (car s))
(loop (cdr c) (cdr s)))
(else #f)))))
; matches (a|b)*ac. e .g. '(a a b b a c)
(define (matches? l)
(letrec
([s4 (match '( ) '() #t)]
[s3 (match '(c) `(,s4) #f)]
[s2 (match '(a) `(,s3) #f)]
[s1 (match '( ) `(,s2 ,s5) #f)]
[s5 (match '( ) `(,s6 ,s7) #f)]
[s6 (match '(a) `(,s8) #f)]
[s7 (match '(b) `(,s8) #f)]
[s8 (match '( ) `(,s1) #f)])
(s1 l)))
(matches? '(a c))
(matches? '(a b b b a c))
(matches? '(z a b b b a c))
Now, what if I had a simple data-structure to represent my NFA, like a list of lists. e.g.
'((s4 () () #t)
(s3 (c) (s4) #f)
...)
My question is: How would I turn that list into the former letrec statement? I'm not too good with Macros and my understanding is that I probably shouldn't be using eval.
If the list is known at compile time (what I mean is, before your program starts running) then you can use a macro. Otherwise you must use eval.
It's ok. This is one of the good uses for eval. :)
I came up with this macro which seems to do the job
(I'm not an expert either):
(define-syntax nfa
(syntax-rules (let-bindings)
; All the let bindings have been expanded
[(nfa start (let-bindings . bindings))
(lambda (l) (letrec bindings (start l)))]
; Otherwise, expand the next binding
[(nfa start (let-bindings . bindings) (s c n a) . rest)
(nfa start (let-bindings (s (match 'c (list . n) a)) . bindings) . rest)]
; Insert the expanded bindings list
[(nfa start states)
(nfa start (let-bindings) . states)]))
; matches (a|b)*ac. e .g. '(a a b b a c)
(define matches?
(nfa s1 ([s4 ( ) () #t]
[s3 (c) (s4) #f]
[s2 (a) (s3) #f]
[s1 ( ) (s2 s5) #f]
[s5 ( ) (s6 s7) #f]
[s6 (a) (s8) #f]
[s7 (b) (s8) #f]
[s8 ( ) (s1) #f])))
The trick is to use intermediate forms to create "subtitution loops",
and reserve identifiers (cf. let-bindings) to distinguish these intermediate forms
from direct usage of the macro.
I think your problem can be seprate into 2 subproblem:
write a macro that consumes a NFA description and generate a NFA automatically,I call this macro make-NFA
apply make-NFA to a list generated programatically,I call this macro apply-macro
the second subproblem is easy:
(define-syntax apply-macro
(syntax-rules ()
((_ macro ls)
(eval
`(macro ,#ls)
(interaction-environment)))))
;(define ls '(1 2 3))
;(apply-macro if ls)=>2
the first question,I have a DFA sample,you can write a NFA by youself:
(define-syntax make-DFA
(syntax-rules (: ->)
((_ init-state (state : result (symbol -> next) ...) ...)
(letrec
((state
(lambda(sigma)
(cond
((null? sigma) result)
(else
(case (car sigma)
((symbol)
(next (cdr sigma)))...
(else false))))))... )
init-state))))
(define DFA1
(make-DFA q1
(q1 : true (#\a -> q2)
(#\b -> q3))
(q2 : false (#\a -> q1)
(#\b -> q4))
(q3 : false (#\a -> q4)
(#\b -> q1))
(q4 : true (#\a -> q3)
(#\b -> q2))))
(DFA1 (string->list "ababa"));=>#f
well,may be define-macro is a better way to implement apply-macro.