I'm trying to write a define-let macro in racket, which "saves" the header of a (let ((var value) ...) ...) , namely just the (var value) ... part, and allows re-using it later on.
The code below works as expected:
#lang racket
;; define-let allows saving the header part of a let, and re-use it later
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var value] ...)
#`(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
#`(let ([#,(datum->syntax stx2 'var) value] ...)
. body)]))]))
;; Save the header (let ([x "works]) ...) in the macro foo
(define-let foo [x "works"])
;; Use the header, should have the same semantics as:
;; (let ([x "BAD"])
;; (let ([x "works])
;; (displayln x))
(let ([x "BAD"])
(foo (displayln x))) ;; Displays "works".
The problem is that the macro breaks hygiene: as shown in the example below, the variable y, declared in a define-let which is produced by a macro, should be a new, uninterned symbol, due to hygiene, but it manages to leak out of the macro, and it is erroneously accessible in (displayln y).
;; In the following macro, hygiene should make y unavailable
(define-syntax (hygiene-test stx)
(syntax-case stx ()
[(_ name val)
#'(define-let name [y val])]))
;; Therefore, the y in the above macro shouldn't bind the y in (displayln y).
(hygiene-test bar "wrong")
(let ((y "okay"))
(bar (displayln y))) ;; But it displays "wrong".
How can I write the define-let macro so that it behaves like in the first example, but also preserves hygiene when the identifier is generated by a macro, giving "okay" in the second example?
Following the cue "syntax-parameter" from Chris, here is an one solution:
#lang racket
(require racket/stxparam
(for-syntax syntax/strip-context))
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var expr] ...)
(with-syntax ([(value ...) (generate-temporaries #'(expr ...))])
#`(begin
(define-syntax-parameter var (syntax-rules ()))
...
(define value expr)
...
(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
(with-syntax ([body (replace-context #'stx1 #'body)])
#'(syntax-parameterize ([var (syntax-id-rules () [_ value])] ...)
. body))]))))]))
(define-let foo [x "works"])
(let ([x "BAD"])
(foo (displayln x))) ; => works
(let ([x "BAD"])
(foo
(let ([x "still works"])
(displayln x)))) ; => still works
UPDATE
This solution passes the additional test in the comments.
The new solution transfers the context of the body to
the variables to be bound.
#lang racket
(require (for-syntax syntax/strip-context))
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var expr] ...)
#`(begin
(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
(with-syntax ([(var ...) (map (λ (v) (replace-context #'body v))
(syntax->list #'(var ...)))])
#'(let ([var expr] ...)
. body))])))]))
(define-let foo [x "works"])
(let ([x "BAD"])
(foo (displayln x))) ; => works
(let ([x "BAD"])
(foo
(let ([x "still works"])
(displayln x)))) ; => still works
(let ([z "cool"])
(foo (displayln z))) ; => cool
Related
I'm trying to build a macro-defining macro
Background
I have some structs that I'm using to represent an AST. I will be defining lots of transformations on these struct, but some of these transformations will be pass-through ops: i.e. I'll match on the AST and just return it unmodified. I'd like to have a macro automate all the default cases, and I'd like to have a macro automate making that macro. :)
Example
Here are the struct definitions that I'm using:
(struct ast (meta) #:transparent)
(struct ast/literal ast (val) #:transparent)
(struct ast/var-ref ast (name) #:transparent)
(struct ast/prim-op ast (op args) #:transparent)
(struct ast/if ast (c tc fc) #:transparent)
(struct ast/fun-def ast (name params body) #:transparent)
(struct ast/λ ast (params body) #:transparent)
(struct ast/fun-call ast (fun-ref args) #:transparent)
I want a macro called ast-matcher-maker that gives me a new macro, in this case if-not-removal, which would e.g. transform patterns like (if (not #<AST_1>) #<AST_2> #<AST_3>) into (if #<AST_1> #<AST_3> #<AST_2>):
(ast-matcher-maker match/ast
(ast/literal meta val)
(ast/var-ref meta name)
(ast/prim-op meta op args)
(ast/if meta test true-case false-case)
(ast/fun-def meta name params body)
(ast/λ meta params body)
(ast/fun-call meta fun-ref args))
(define (not-conversion some-ast)
(match/ast some-ast
[(ast/if meta `(not ,the-condition) tc fc) ; forgive me if my match syntax is a little off here
(ast/if meta the-condition fc tc)]))
Ideally, the call to ast-matcher-maker would expand to this or the like:
(define-syntax (match/ast stx)
(syntax-case stx ()
[(match/ast in clauses ...)
;; somehow input the default clauses
#'(match in
clauses ...
default-clauses ...)]))
And the call to match/ast inside the body of not-conversion would expand to:
(match some-ast
[(ast/if meta `(not ,the-condition) tc fc)
(ast/if meta the-condition fc tc)]
[(ast/literal meta val) (ast/literal meta val)]
[(ast/var-ref meta name) (ast/var-ref meta name)]
[(ast/prim-op meta op args) (ast/prim-op meta op args)]
[(ast/fun-def meta name params body) (ast/fun-def meta name params body)]
[(ast/λ meta params body) (ast/λ meta params body)]
[(ast/fun-call meta fun-ref args) (ast/fun-call meta fun-ref args)])
What I have so far
This is what I've got:
#lang racket
(require macro-debugger/expand)
(define-syntax (ast-matcher-maker stx)
(syntax-case stx ()
[(_ id struct-descriptors ...)
(with-syntax ([(all-heads ...) (map (λ (e) (datum->syntax stx (car e)))
(syntax->datum #'(struct-descriptors ...)))])
(define (default-matcher branch-head)
(datum->syntax stx (assoc branch-head (syntax->datum #'(struct-descriptors ...)))))
(define (default-handler branch-head)
(with-syntax ([s (default-matcher branch-head)])
#'(s s)))
(define (make-handlers-add-defaults clauses)
(let* ([ah (syntax->datum #'(all-heads ...))]
[missing (remove* (map car clauses) ah)])
(with-syntax ([(given ...) clauses]
[(defaults ...) (map default-handler missing)])
#'(given ... defaults ...))))
(println (syntax->datum #'(all-heads ...)))
(println (syntax->datum (default-matcher 'h-ast/literal)))
#`(define-syntax (id stx2)
(syntax-case stx2 ()
;;;
;;; This is where things get dicy
;;;
[(_ in-var handlers (... ...))
(with-syntax ([(all-handlers (... ...))
(make-handlers-add-defaults (syntax->datum #'(handlers (... ...))))])
#'(match in-var
all-handlers (... ...)))]))
)]))
;; I've been using this a little bit for debugging
(syntax->datum
(expand-only #'(ast-matcher-maker
match/h-ast
(h-ast/literal meta val)
(h-ast/var-ref meta name)
(h-ast/prim-op meta op args))
(list #'ast-matcher-maker)))
;; You can see the errors by running this:
;; (ast-matcher-maker
;; match/h-ast
;; (h-ast/literal meta val)
;; (h-ast/var-ref meta name)
;; (h-ast/prim-op meta op args))
Any ideas?
I have a solution. I am open to improvements or suggestions.
I am not sure if the syntax macros return can close over/reference functions defined inside the scope of that macro expander. (That's what I'm doing with the make-handlers-add-defaults function.) I think the technical terminology involved is that the function definition and the function invocation happens in different phases.
Someone please correct me if I am wrong.
My solution was to embed the data I need directly in the macro—this would make the intermediate AST bigger perhaps, but that may or may not be a bad thing. Here's what I ended up with:
(define-syntax (ast-matcher-maker stx)
(syntax-case stx ()
[(_ id struct-descriptors ...)
#`(define-syntax (id stx2)
(syntax-case stx2 ()
[(_ in-var handlers (... ...))
;; Embed the data I need directly into the macro
(let ([all-defaults '#,(syntax->datum #'(struct-descriptors ...))])
(define (gen-handlers clauses)
(let* ([missing (remove* (map car clauses) (map car all-defaults))]
[default-handler (λ (a) (with-syntax ([s (datum->syntax stx2 (assoc a all-defaults))])
#'(s s)))]
[override-handler (λ (a) (with-syntax ([s (datum->syntax stx2 (assoc (car a) all-defaults))]
[a (datum->syntax stx2 (cadr a))])
#'(s a)))])
(with-syntax ([(given (... ...)) (map override-handler clauses)]
[(defaults (... ...)) (map default-handler missing)])
#'(given (... ...) defaults (... ...)))))
(with-syntax ([(handlers (... ...)) (gen-handlers (syntax->datum #'(handlers (... ...))))])
#'(match in-var
handlers (... ...))))]))]))
And using:
(ast-matcher-maker
match/h-ast
(h-ast/literal meta val)
(h-ast/var-ref meta name)
(h-ast/prim-op meta op args))
(define (foo-name some-ast)
(match/h-ast some-ast
[h-ast/var-ref (h-ast/var-ref meta (cons 'foo name))]))
Invoking foo-name gives me what I want:
(foo-name (h-ast/literal null 42)) ;=> (h-ast/literal null 42))
(foo-name (h-ast/var-ref null 'hi)) ;=> (h-ast/var-ref null '(foo . hi))
I think this is what you are going for.
(define-syntax (ast-matcher-maker stx)
(syntax-case stx ()
[(_ name default-clauses ...)
#'(define-syntax name
(syntax-rules ()
[(_ e override-clauses (... ...))
(match e
override-clauses (... ...)
[(and v default-clauses) v] ...)]))]))
I would like to wrap a getter and setter function around an identifier, so that
(define x 1)
(set! x v) ; should expand to (custom-set! x v)
x ; should expand to (custom-get x)
where custom-put! and custom-get are defined somewhere else and add additional behavior such as logging.
In the racket guide (Section 16.1.6), there is an example for a Set!-Transformer which works for a setter and a getter with zero arguments. However, I need a macro which expands an identifier occurence to a getter function with the matched identifier as its argument.
I tried to adopt the macro in the linked section as follows:
(define-syntax-rule (generate-accessors id get put!)
(define-syntax id
(make-set!-transformer
(lambda (stx)
(syntax-case stx (set! get)
[id (identifier? (syntax id)) (syntax (get id))]
[(set! id e) (syntax (put! id e))])))))
The problem is that (syntax (get id)) leads to infinite expansion.
Is there a straightforward way to cut off recursion for a template expression? I also thought about generating a fresh identifier bound to id and including it in the literal list, but I do not know how to accomplish this.
The example you link to works with the code from the previous section
that defines get-val and put-val!:
(define-values (get-val put-val!)
(let ([private-val 0])
(values (lambda () private-val)
(lambda (v) (set! private-val v)))))
(define-syntax val
(make-set!-transformer
(lambda (stx)
(syntax-case stx (set!)
[val (identifier? (syntax val)) (syntax (get-val))]
[(set! val e) (syntax (put-val! e))]))))
val ;; 0
(set! val 42)
val ;; 42
Let's write the macro-writing macro, generate-accessors, that
parameterizes the identifier and accessors, and see that it works:
(define-syntax (generate-accessors stx)
(syntax-case stx ()
[(_ val get-val put-val!)
(syntax
(define-syntax val
(make-set!-transformer
(lambda (stx)
(syntax-case stx (set!)
[val (identifier? (syntax val)) (syntax (get-val))]
[(set! val e) (syntax (put-val! e))])))))]))
(generate-accessors foo get-val put-val!)
foo ;; 0
(set! foo 42)
foo ;; 42
Also, let's exercise it with another pair of accessors, that shows a
side-effect like "logging":
(define-values (custom-get custom-set!)
(let ([private-val 0])
(values (lambda () (println "get") private-val)
(lambda (v) (println "set") (set! private-val v)))))
(generate-accessors bar custom-get custom-set!)
bar ;; 0
(set! bar 42)
bar ;; 42
EDIT: In response to your comment, here's a variation where it generates a fresh pair of accessors (and value) for each invocation. It lets you supply a pair of runtime functions to be called, to do extra work (here just println). (You could simplify this to hardcode the println or log-debug or whatever, if you find it's always the same thing.)
(require (for-syntax racket/base
racket/syntax
syntax/parse))
(define-syntax (define/logged stx)
(syntax-parse stx
[(_ id:id init:expr on-get:expr on-set:expr)
#:with get (format-id stx "get-~a" #'id)
#:with set (format-id stx "set!-~a" #'id)
#'(begin
(define-values (get set)
(let ([v init])
(values (λ () (on-get 'id v) v)
(λ (e) (on-set 'id e) (set! v e)))))
(define-syntax id
(make-set!-transformer
(λ (stx)
(syntax-parse stx
[id:id #'(get)]
[(set! id e) #'(set e)])))))]))
(define (on-get id v)
(println `(get ,id ,v)))
(define (on-set! id v)
(println `(set! ,id ,v)))
(define/logged foo 0 on-get on-set!)
foo
(set! foo 42)
foo
;; prints:
;; '(get foo 0)
;; 0
;; '(set! foo 42)
;; '(get foo 42)
;; 42
I'm not 100% clear on the context of what you're trying to do. Maybe this is closer, or at least gives you some ideas.
Note here I'm switching to syntax-parse instead of trying to follow the original example from the Guide. Just because.
I'm trying to write a macro behaving just like racket define, but processing fully expanded racket procedures in some way (just expanding for simplicity in the example below):
(define-syntax (define/expand stx)
(syntax-case stx ()
[(_ (head args ...) body body-rest ...)
(let* ([define/racket (syntax/loc stx (define (head args ...) body body-rest ...))]
[fully-expanded (local-expand define/racket 'top-level (list))])
fully-expanded)]
[(_ id expr) (syntax/loc stx (define id expr))]))
Everything is fine unless recursive definition is met:
(define/expand (sum n)
(if (<= n 0)
0
(+ n (sum (- n 1)))))
Running it raises an error
sum: unbound identifier in module in: sum
pointing the call of the sum (not the definition). Obviously the definition of sum is not captured by local expander. I've tried a straightforward way of fixing it: creating new local definition context and binding head into it:
(define-syntax (define/expand stx)
(syntax-case stx ()
[(_ (head args ...) body body-rest ...)
(let* ([ctx (syntax-local-make-definition-context)] ; <- These two lines added
[_ (syntax-local-bind-syntaxes (list #'head) #f ctx)] ; <--/
[define/racket (syntax/loc stx (define (head args ...) body body-rest ...))]
[fully-expanded (local-expand define/racket 'top-level (list) ctx)])
fully-expanded)]
[(_ id expr) (syntax/loc stx (define id expr))]))
It solves the problem (local expanded successfully expands the procedure into define-values), but creates the other one:
module: out-of-context identifier for definition in: sum
pointing the definition of sum. The reason is probably that expander binds identifiers to one in ctx instead of head in current context.
Intuitively it does not seem to be a rare problem, but I could not find the solution over the network. I thought that I should somehow use local-expand/capture-lifts and syntax-local-lift-expression, but I don't get how to use it properly. Could someone clarify what's going on and/or give a hint how to fix it?
Let's try your first program in a top-level (repl):
#lang racket
(define-syntax (define/expand stx)
(syntax-case stx ()
[(_ (head args ...) body body-rest ...)
(let*
([define/racket (syntax/loc stx (define (head args ...) body body-rest ...))]
[fully-expanded (local-expand define/racket 'top-level (list))])
fully-expanded)]
[(_ id expr)
(syntax/loc stx (define id expr))]))
and then in the repl:
Welcome to DrRacket, version 6.6.0.3--2016-07-28(-/f) [3m].
Language: racket, with debugging [custom]; memory limit: 1024 MB.
> (define/expand (sum n)
(if (<= n 0)
0
(+ n (sum (- n 1)))))
.#<syntax:3:2 (define-values (sum) (lambda ...>
> (sum 5)
15
This shows that your program works at the top-level.
The reason the same approach doesn't work in a module context
is that the #%module-begin uses partial expansion of forms
to detect definitions before expanding expressions.
In other words define/expand must tell #%module-begin that
it expands into a definition of sum but must delay the use
of local-expand until #%module-begin has detected all
bound identifiers at the module level.
This suggests a two step approach:
#lang racket
(define-syntax (delay-expansion stx)
(syntax-case stx ()
[(_delay-expansion more ...)
(let ([fully-expanded (local-expand #'(lambda () more ...) 'module (list))])
(display fully-expanded)
fully-expanded)]))
(define-syntax (define/expand stx)
(syntax-case stx ()
[(_ (head args ...) body body-rest ...)
(syntax/loc stx
(define (head args ...)
((delay-expansion
body body-rest ...))))]
[(_ id expr)
(syntax/loc stx
(define id expr))]))
(define/expand (sum n)
(if (<= n 0)
0
(+ n (sum (- n 1)))))
(sum 5)
See more here: https://groups.google.com/d/msg/racket-users/RB3inP62SVA/54r6pJL0wMYJ
What I want to be able to do is transform e.g.
(define count-suits (symbol-map-function hearts diamonds clubs spades))
into
(define count-suits (λ (#:hearts hearts
#:diamonds diamonds
#:clubs clubs
#:spades spades)
(make-hash (cons 'hearts hearts)
(cons 'diamonds diamonds)
(cons 'clubs clubs)
(cons 'spades spades))))
I have the body of the lambda working with
(define-syntax (generate-symbol-map stx)
(syntax-case stx ()
((gen...map enumerations ...)
#'(make-hash (cons (quote enumerations) enumerations) ...))))
but I'm having a devil of a time generating
(λ (#:hearts hearts
#:diamonds diamonds
#:clubs clubs
#:spades spades)
This is what I have so far
;; e.g. (weave '(1 3 5 7) '(2 4 6 8)) = '(1 2 3 4 5 6 7 8)
;; tested, works.
(define-for-syntax (weave list1 list2)
(cond ((empty? list1) list2)
((empty? list2) list1)
(else (list* (car list1)
(car list2)
(weave (cdr list1)
(cdr list2))))))
(define-syntax (symbol-map-function stx)
(syntax-case stx ()
((sym...ion symbols ...)
; What I'm trying to do here is splice the result of weaving the keywords,
; generated by format-id, with the symbols themselves, e.g. in the case of
; (symbol-map-function foo bar baz):
; #`(λ (#,#(weave '(#:foo #:bar #:baz) '(foo bar baz)))
; --> #`(λ (#,#'(#:foo foo #:bar bar #:baz baz))
; --> #`(λ (#:foo foo #:bar bar #:baz baz)
; I am using syntax-unquote-splicing because I am in syntax-quasiquote and the
; result of the expression is a list that I want to be spliced into the arguments.
#`(λ (#,#(weave (list (syntax-e (format-id #'symbols
"#:~a"
(syntax-e #'symbols))) ...)
(list #'(symbols ...))))
(generate-symbol-map symbols ...)))))
(list (syntax-e (format-id #'symbols "#:~a" (syntax-e #'symbols))) ...) is meant to result in
(list (syntax-e (format-id #'foo "#:~a" (syntax-e #'foo)))
(syntax-e (format-id #'bar "#:~a" (syntax-e #'bar)))
(syntax-e (format-id #'baz "#:~a" (syntax-e #'baz))))
but I'm told I'm missing ellipses after #'symbols. I've tried playing around with the code in different ways, but not with any real purpose or insight, and I haven't stumbled into anything that works.
The ... cannot appear outside of a template, which means they must appear inside the #' part that precedes symbols. You can write #'(symbols ...) but not #'symbols ....
After this, you will probably want to use syntax->list, which turns your syntax object into a list of syntax objects.
Also, you cannot use format-id to generate keywords, because format-id will enforce the result to be a symbol, and will this enclose the generated id within pipes:
> (require racket/syntax)
> (format-id #'here "#:~a" 'auie)
#<syntax |#:auie|>
So you need to use syntax->datum, symbol->string, and then string->keyword to do what you want here.
Here is a working example:
#lang racket
(require (for-syntax racket/syntax racket/list))
(define-syntax (foo stx)
(syntax-case stx ()
[(_ (sym ...) body ...)
(with-syntax ([kws (flatten
(map (λ(k)
(list
(string->keyword
(symbol->string
(syntax->datum k)))
k))
(syntax->list #'(sym ...))))]
)
#'(λ kws body ...))]))
; Test:
((foo (aa bb)
(list aa bb))
#:bb 'bbb
#:aa 'aaa)
; -> '(aaa bbb)
Here's a working implementation of symbol-map-function:
(require (for-syntax racket/list))
(define-syntax (symbol-map-function stx)
(define (id->keyword id)
(datum->syntax id (string->keyword (symbol->string (syntax-e id)))))
(syntax-case stx ()
((_ id ...)
(andmap identifier? (syntax->list #'(id ...)))
(with-syntax ((lambda-list (append-map (lambda (id)
(list (id->keyword id) id))
(syntax->list #'(id ...)))))
#'(lambda lambda-list
(make-hash `((id . ,id) ...)))))))
I wish I know a better way to assemble the lambda list than using append-map; improvements welcome. :-)
I'm trying to define a macro that generates an anonymous function taking one argument named it, for succinctness, so that instead of
(λ (it) body)
I can write
(λλ body)
(In other words, (λλ body) transforms to (λ (it) body))
(define-syntax-parameter it #f)
(define-syntax λλ
(syntax-rules ()
((_ body)
(λ (x) (syntax-parameterize ((it x)) body)))))
(λλ (< it 0)) ; For testing
I get operators.rkt:13:28: ?: literal data is not allowed; no #%datum syntax transformer is bound in the transformer environment in: #f at (define-syntax-parameter if #f), but as far as I can tell, this is exactly like the example given in racket's doc for how to use define-syntax-parameter. I can suppress the error by replacing #f with a function (I used member, but not for any real reason), but after doing that, I get operators.rkt:17:38: x: identifier used out of context in: x. What am I doing wrong?
You left out the syntax-id-rules part in the example. It's the part that specifies that it should expand to x. Alternatively, you can use make-rename-transformer:
#lang racket
(require racket/stxparam)
(define-syntax-parameter it #f)
(define-syntax λλ
(syntax-rules ()
((_ body)
(λ (x) (syntax-parameterize ([it (make-rename-transformer #'x)]) body)))))
((λλ (< it 0)) 5)
((λλ (< it 0)) -5)
=>
#f
#t
Syntax parameters are not the only way to implement the macro you have in mind. A simpler (IMO) way is to just use datum->syntax to inject the identifier it:
(define-syntax (λλ stx)
(syntax-case stx ()
((_ body ...)
(with-syntax ((it (datum->syntax stx 'it)))
#'(λ (it) body ...)))))
To use your example:
(define my-negative? (λλ (< it 0)))
(my-negative? -1) ;; => #t