Top Level or Not Dependent Scheme Macro Expansion - macros

Is it possible to write a macro in Scheme that expands differently depending upon whether the macro was used at the top level or internally? I'm primarily interested in a solution that works in Guile Scheme.

If you mean "internal" in the sense of internal definitions, then it might work to have the macro redefine itself in the nested scope.
(define inner-transformer
(syntax-rules ()
[(_ (id a ...) e1 e2 ...)
(define (id a ...)
(format #t "inner func ~a\n" 'id)
(let () e1 e2 ...))]))
(define-syntax func
(lambda (x)
(syntax-case x ()
[(k (id a ...) e1 e2 ...)
#'(define (id a ...)
(let-syntax ([k inner-transformer])
(format #t "top func ~a\n" 'id)
(let () e1 e2 ...)))])))
(func (foo x)
(func (bar y)
(func (baz z)
(+ x y z))
(baz y))
(bar x))
(foo 1)
Guile result:
top func foo
inner func bar
inner func baz
$1 = 3

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)

In Racket, how do I create a syntax rule which can deal with multiple of one parameter?

Kind of difficult to word the question in the title.
(define-syntax func
(syntax-rules ()
((func a b c (d e) ...) (cond ((and (not (empty? d)) (not (empty? e))) (+ d e))
)
)
)
)
If someone calls (func a b c (1 1) (2 2)), I would like it to add all d's and e's together. First, my code above produces an error
syntax: missing ellipsis with pattern variable in template in: d
and if it didn't even give me that error, I'm not even sure if it would add all of them together. I would also like it to do other things in case d and e were not provided, so I put it in a cond.
Thank you.
Edit:
(define-syntax func
(syntax-rules ()
((func a b c (d e) ...)
(cond
((and
(not (empty? d))
(not (empty? e)))
(+ d e))))))
The pattern something ... will match zero or more elements. Thus in you pattern (func a b c) will match the rule.
If a pattern has elipses in the pattern it needs elipses in the expansion. Eg.
(define-syntax test
(syntax-rules ()
((_ a b ...)
(if a (begin #t b ...) #f))))
(test 1) ; ==> #t
(test 1 2) ; ==> 2
(test #f 2) ; ==> #f

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

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)))

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.