TL;DR
I'm trying to expand an optional ellipsis (~optional datum:my-class ...) into a form that uses attributes from my-class like so: #'(list datum.attr ...).
But as the form is optional, when it's not present, it resolves to #f, which the ellipsis pattern doesn't like:
;; ?: attribute contains non-list value
;; value: #f
I tried using the #:defaults argument of ~optional, like so:
(~optional datum:my-class ... #:defaults ([(datum 1) null]))
;; which works for usage:
#'(list datum ...)
;; but not for:
#'(list datum.attr ...)
I got it to work by using this trick:
(~optional datum:my-class ...)
#'(list #,#(if (attribute datum) #'(datum.attr ...) #'()))
I'm trying to find if there's a better way.
Complete runnable example
I tried keeping it to the bare minimum. Check out the test submodule.
To see the issue, uncomment one of the four implementations of parse-bag, and run raco test file.rkt.
#lang racket/base
(provide parse-bag)
(require
(for-syntax racket/base syntax/parse)
syntax/parse)
(struct bag (label objects) #:transparent)
(struct object (name) #:transparent)
(begin-for-syntax
(define-syntax-class obj-exp
#:datum-literals (object name)
(pattern (object (name <name>:str))
#:with result #'(object <name>))))
;; IMPLEMENTATION ONE
;; DESC: The naive but failing approach
;; UNCOMMENT TO TEST
#;(define-syntax (parse-bag stx)
(syntax-parse stx
#:datum-literals (label objects)
[(_ (label <label>:str)
(~optional (objects <object>:obj-exp ...)))
#'(bag <label>
(list <object>.result ...))]))
;; ?: attribute contains non-list value
;; value: #f
;; IMPLEMENTATION TWO
;; DESC: adding defaults will fail too
;; UNCOMMENT TO TEST
#;(define-syntax (parse-bag stx)
(syntax-parse stx
#:datum-literals (label objects)
[(_ (label <label>:str)
(~optional (objects <object>:obj-exp ...)
#:defaults ([(<object> 1) null]))) ; (HERE)
#'(bag <label>
(list <object>.result ...))]))
;; ?: attribute contains non-list value
;; value: #f
;; IMPLEMENTATION THREE
;; DESC: it won't fail when not using syntax-class attributes
;; UNCOMMENT TO TEST
#;(define-syntax (parse-bag stx)
(syntax-parse stx
#:datum-literals (label objects)
[(_ (label <label>:str)
(~optional (objects <object>:obj-exp ...)
#:defaults ([(<object> 1) null])))
#'(bag <label>
(list <object> ...))])) ; (HERE)
;; name: unbound identifier
;; IMPLEMENTATION FOUR
;; DESC: it works, but I find it ugly
;; UNCOMMENT TO TEST
#;(define-syntax (parse-bag stx)
(syntax-parse stx
#:datum-literals (label objects)
[(_ (label <label>:str)
(~optional (objects <object>:obj-exp ...)))
#`(bag <label>
(list #,#(if (attribute <object>)
#'(<object>.result ...)
#'())))]))
(module+ test (require rackunit)
(check-equal?
(parse-bag
(label "Biscuits")
(objects (object (name "Cookie"))
(object (name "Brownie"))))
(bag "Biscuits"
(list (object "Cookie")
(object "Brownie"))))
(check-equal?
(parse-bag (label "Sweets"))
(bag "Sweets" '()))
)
There are two classes of strategies to fix "attribute value is false" errors:
Put defaults or alternatives so that the attribute is never false.
(a) Using ~optional with #:defaults
(b) Using ~or, possibly with ~parse
(c) Using a syntax-class with multiple patterns
Deal with the attribute being false in the body.
(a) Using unsyntax and if
(b) Using ~?
1 (a)
Implementations 2 and 3 in the question, as well as the code in Zoé's answer, all use ~optional with #:defaults, so they all are attempts to fix it with 1 (a).
Zoé's answer shows a correct use of this. The main point is that if you use an attribute like <object>.result, you need to specify a default for <object>.result, not just <object>.
However, one downside to this comes if there are multiple attributes in the obj-exp class that you need to use. That would require you to specify a default for each one:
(~optional (objects <object>:obj-exp ...)
#:defaults ([(<object>.result 1) null]
[(<object>.x 1) null]))
1 (b)
If you use multiple attributes from a syntax class, such as <object>.result, <object>.x, <object>.y, <object>.z, etc, then 1 (a) would require you to specify a default for each one separately. To avoid that, instead of writing this:
(~optional (objects <object>:obj-exp ...)
#:defaults ([(<object>.result 1) null]
[(<object>.x 1) null]
[(<object>.y 1) null]
[(<object>.z 1) null]))
You can use ~or and ~parse like this:
(~or (objects <object>:obj-exp ...)
(~and (~seq) (~parse (<object>:obj-exp ...) null)))
1 (c)
(define-splicing-syntax-class maybe-objects
#:datum-literals (objects)
[pattern (objects <object>:obj-exp ...)]
[pattern (~seq) #:with (<object>:obj-exp ...) null])
2 (a) and (b)
Implementation 4 in the question uses unsyntax-splicing and if, so it's an example of 2 (a):
#,#(if (attribute <object>)
#'(<object>.result ...)
#'())
However, as you noted, this looks kind of ugly. And it also has another problem. If this itself were under an ellipsis, this breaks down because ellipses don't carry their effects inside a #, or #,#.
That's why ~? exists for 2 (b). Instead of using #,#(if ....), you can use:
(~? (<object>.result ...) ())
That doesn't quite work, but this variant of it does:
(~? (list <object>.result ...) (list))
Using that in a variation on implementation 4:
(define-syntax (parse-bag stx)
(syntax-parse stx
#:datum-literals (label objects)
[(_ (label <label>:str)
(~optional (objects <object>:obj-exp ...)))
#`(bag <label>
(~? (list <object>.result ...) (list)))]))
When using #:defaults, you need to specify the attribute:
(~optional <object>:obj-exp ... #:defaults ([(<object>.result 1) null]))
Complete code:
(define-syntax (parse-bag stx)
(syntax-parse stx
#:datum-literals (label objects)
[(_ (label <label>:str)
(~optional (objects <object>:obj-exp ...)
#:defaults ([(<object>.result 1) null]))) ; + attribute here
#'(bag <label>
(list <object>.result ...))])) ; now it works!
Another way would be to move the ellipsis usage to the syntax-class, as in this question: A splicing syntax class that matches an optional pattern and binds attributes
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] ...)]))]))
Consider the scenario where I would like to specify a very simplistic actor language using Racket macros. An actor is defined by a behaviour that defines some local state and message handlers that implement some logic. The body of a message handler can use both the formal parameters of the message, as well as the state variables. An example is implemented in the code below.
There is quite a lot of context in the code which is probably not even necessary. However, I have included it regardless in order to provide a running example, and the fact that I need to use syntax-parametrize may complicate the solution. The special point of interest is the with-syntax clause in the MESSAGE macro, where I require the (local-state-variable ...) pattern to match a list of identifiers, currently #'local-state-variables which is a list of symbols (bound by syntax-parameterize in the ACTOR macro), and thus does not match. So far I have not been able to find the solution, although it does not seem like it should be shockingly difficult. Am I missing something obvious?
#lang racket
(require (for-syntax syntax/parse))
(require racket/stxparam)
(define LOCAL_STATE
(lambda (stx)
(raise-syntax-error 'LOCAL_STATE "should only be used inside an actor" stx)))
; Define some syntax classes because abstractions are nice
(begin-for-syntax
(define-syntax-class actor-local-state
#:description "actor local state"
#:literals (LOCAL_STATE)
(pattern (LOCAL_STATE state-variable:id ...)))
(define-syntax-class message-pattern
#:description "actor message pattern"
(pattern (identifier:id argument:id ...))))
(define-syntax-parameter local-state-variables
(lambda (stx)
(raise-syntax-error 'local-state-variables "reserved keyword for actors" stx)))
(define-syntax (MESSAGE stx)
(syntax-parse stx
[(_ pattern:message-pattern body:expr ...+)
; Currently there is a "binding match failed" error on the following line, but replacing #'local-state-variables with #'(a b) (a list of identifiers) needless to say works.
(with-syntax ([(local-state-variable ...) #'local-state-variables])
; For simplicity just display the state variables - this is normally where some magic happens
#'(display '(local-state-variable ...)))]))
(define-syntax (ACTOR stx)
(syntax-parse stx
[(_ state:actor-local-state handler:expr ...+)
#'(syntax-parameterize
([local-state-variables '(state.state-variable ...)])
; For the sake of simplicity, an actor is currently a list of message handlers
(list handler ...))]))
; in this proof-of-concept code this should print (a b)
(define behaviour
(ACTOR (LOCAL_STATE a b)
(MESSAGE (add x y) (+ a b x y))))
Use syntax-parameter-value. Here's an example of using syntax parameters to manage lists of variables:
;; vars : syntax parameter of (Listof Identifier)
(define-syntax-parameter vars null)
;; with-vars: like let, but set vars
(define-syntax (with-vars stx)
(syntax-parse stx
[(_ ([var:id rhs:expr] ...) . body)
#'(let ([var rhs] ...)
(syntax-parameterize ([vars (list (quote-syntax var) ...)])
. body))]))
;; get-vars: get vars (symbolic name) and their values
(define-syntax (get-vars stx)
(syntax-parse stx
[(_)
(with-syntax ([(var ...) (syntax-parameter-value #'vars)])
#'(list (list (quote var) var) ...))]))
;; Examples:
(get-vars)
;; => '()
(with-vars ([x 1])
(get-vars))
;; => '((x 1))
(with-vars ([x 1])
(with-vars ([y 2] [z 3])
(set! z 17)
(get-vars)))
;; => '((y 2) (z 17))
The easiest way to turn any datum (including a list of symbol) into an identifier with datum->syntax. (You can also use format-id, but that works on only a single identifier.) With these functions, you pass in a syntax object for the scopes you want your new identifier to have, or #f if you want it to inherit the scopes that your current macro is generating.1 Getting your list of identifiers (as one single syntax object, would just be:
(syntax->datum stx '(a b c))
Where '(a b c) is your list of identifiers. Finally, you can then add this in your with-syntax:
(with-syntax ([(local-state-variables ...) (datum->syntax stx ...)])
...)
As a side note, the way to answer the title of your question, just iterate over your list with map producing a new list using format-id:
(map (curry format-id stx "~a") '(a b c)
1Unless I'm wrong, if so, please correct this.
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 created this:
(define-syntax (with-hash stx)
(syntax-parse stx
[(_ obj:id ((~or key:id [new-key:id hash-key:id]) ...) body:expr ...+)
#'(let ([key (hash-ref obj 'key)] ...
[new-key (hash-ref obj 'hash-key)] ...)
(begin body ...))]))
So that I can do this:
(require rackunit)
(define h (hash 'id 1 'name "scott"))
(with-hash h (id [new-name name])
(check-equal? id 1)
(check-equal? new-name "scott"))
How can I add an alternative pattern that automatically binds all the hash keys locally without the client specifying them in the call?
ie:
(define h (hash 'id 1 'name "scott"))
(with-hash h
(check-equal? id 1)
(check-equal? name "scott"))
I suspect it involves renaming transformers, but am I able to declare syntax parameters and rename them dynamically, based on the runtime hash?
Also, I thought something like this might be on the right track:
(define-syntax (with-hash stx)
(syntax-parse stx
[(_ obj:id (key:id ...) body:expr ...+)
#'(let ([key (hash-ref obj 'key)] ...)
(begin body ...))]
[(_ obj:id body:expr ...+)
#'(with-hash obj (id title) body ...)]))
where I recall the macro and parse out the datums to be bound, but in that case, the id and title variables are not bound, even though the macro works otherwise.
Clearly I'm missing something in my understanding.
Any insights are appreciated.
Thanks.
You can't, really. Variable scoping is a static property, and a hash's keys are a dynamic property, so any solution is going to be wrong. But since you asked, there are two wrong solutions that are vaguely similar to what you're asking for.
One thing you could do is use eval. But when you call eval you will have lost any local variables; see the docs. You can probably work the code out yourself.
Another thing you could do is change the meaning of unbound variable references by shadowing #%top, which is the syntax implicitly wrapped around variable references to unbound (or "bound by the top level environment, maybe") variables. But that means that with-hash will fail to shadow any keys that already have a local or module-level binding. Here's what the code looks like, anyway:
(define-syntax (with-hash stx)
(syntax-case stx ()
[(with-hash h . body)
(with-syntax ([#%top (datum->syntax stx '#%top)])
#'(let-syntax ([#%top
(syntax-rules ()
[(#%top . x)
(hash-ref h 'x)])])
(begin . body)))]))
Dang, Ryan responded while I was trying to come up with an answer :) Here is a solution with eval anyways, with the same caveat that others have already expressed.
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (with-hash stx)
(syntax-parse stx
[(_ h:expr body:expr ...+)
#'(begin
(define-namespace-anchor a)
(let ([keys (hash-keys h)])
(define (mk-bind k) `[,k (hash-ref h (quote ,k))])
(eval
`(let ,(map mk-bind keys)
,#(quote (body ...)))
(namespace-anchor->namespace a))))]))
(require rackunit)
(define h (hash 'id 1 'name "scott"))
(with-hash h
(check-equal? id 1)
(check-equal? name "scott"))
EDIT:
As an alternative, you can fake it with something like this if you know you are only going to use it in a specific way.
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (with-hash stx)
(syntax-parse stx #:datum-literals (check-equal?)
[(_ h:expr (check-equal? key:id val:expr) ...)
#'(let ([keys (hash-keys h)])
(check-true (hash-has-key? h (quote key))) ...
(check-equal? (hash-ref h (quote key)) val) ...)]))
(require rackunit)
(define h (hash 'id 1 'name "scott"))
(with-hash h
(check-equal? id 1)
(check-equal? name "scott"))
I'd suggest going the other direction and sticking with providing the identifiers. It is always a bit suspicious when identifiers are created/added into the evaluation environment in a Scheme program. Yes it is allowed and can be done safely, but it confuses ones understanding of what is bound, when and where.
So instead I'd suggest thinking of your with-hash as a binding construct which allows access to the fields in hash. Used like this:
(with-hash h ((the-id 'id) (the-name 'name)) ...)
or, using the default names,
(with-hash h (id name) ...)
It would be implemented like this:
(define-syntax with-hash
(syntax-rules ()
((_ "gen" hash ((fname fkey) ...) body ...)
(let ((obj hash))
(let ((fname (hash-ref obj 'fkey)) ...)
body ...))))
...
))
I have a macro that's working when one argument is passed, and I'd like to expand it to accept n number of arguments using ..., but I'm having trouble figuring out the syntax.
The macro accepts either custom syntax, ie, key:val key:val, or it accepts a procedure.
For example: (3 different usages)
(schema-properties [(name:first-name type:string)])
(schema-properties [(name:age type:number required:#t)])
(schema-properties [(my-custom-fn arg1 arg2 arg3)])
Definition:
(define-syntax (schema-properties stx)
(syntax-parse stx
[(_ [(prop:expr ...)])
(with-syntax ([prop0 (make-prop-hash #'(prop ...))])
#'(list prop0))]))
(define-for-syntax (make-prop-hash stx)
(with-syntax ([(props ...) stx])
(if (regexp-match #px":"
(symbol->string (car (syntax->datum #'(props ...)))))
#'(pairs->hash 'props ...)
#'(props ...))))
This works, in that it checks the prop:expr syntax for the presense of ":", and if it exists, passes it to the function (pairs->hash 'props ...), otherwise, it just invokes it (props ...).
Now, I'd like to be able to pass in:
(schema-properties [(name:first-name type:string)
(name:last-name type:string)
(my-fn arg1 arg2 arg3)])
and have it work the same way. But I'm currently in ellipsis hell and my brain is no longer working correctly.
Any insights are appreciated.
Recommendation: use helper functions to help deal with nesting. Your schema-properties macro knows how to deal with one level of nesting, and you want to apply that to multiple clauses. It's the same principle as when we deal with lists of things: have a helper to deal with the thing, and then apply that across your list. It helps cut down complexity.
For your code, we can do it like this:
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (schema-properties stx)
(syntax-parse stx
[(_ [clause ...])
(with-syntax ([(transformed-clauses ...)
(map handle-clause (syntax->list #'(clause ...)))])
#'(list transformed-clauses ...))]))
;; handle-clause: clause-stx -> stx
(define-for-syntax (handle-clause a-clause)
(syntax-parse a-clause
[(prop:expr ...)
(make-prop-hash #'(prop ...))]))
(define-for-syntax (make-prop-hash stx)
(with-syntax ([(props ...) stx])
(if (regexp-match #px":"
(symbol->string (car (syntax->datum #'(props ...)))))
#'(pairs->hash 'props ...)
#'(props ...))))
;;; Let's try it out. I don't know what your definition of pairs->hash is,
;;; but it probably looks something like this:
(define (pairs->hash . pairs)
(define ht (make-hash))
(for ([p pairs])
(match (symbol->string p)
[(regexp #px"([-\\w]+):([-\\w]+)"
(list _ key value))
(hash-set! ht key value)]))
ht)
(schema-properties [(name:first-name type:string)
(name:last-name type:string)
(list 1 2 3)])
Another recommendation: use syntax classes to help deal with nesting:
First, define a syntax class that recognizes key:value identifiers (and makes their component strings available as key and value attributes):
(begin-for-syntax
(define-syntax-class key-value-id
#:attributes (key value)
(pattern x:id
#:do [(define m (regexp-match "^([^:]*):([^:]*)$"
(symbol->string (syntax-e #'x))))]
#:fail-unless m #f
#:with (_ key value) m)))
Now define a clause as either a sequence of those (to be handled one way) or anything else (to be treated as an expression, which must produce a procedure). The code attribute contains the interpretation of each kind of clause.
(begin-for-syntax
(define-syntax-class clause
#:attributes (code)
(pattern (x:key-value-id ...)
#:with code #'(make-immutable-hash '((x.key . x.value) ...)))
(pattern proc
#:declare proc (expr/c #'(-> any))
#:with code #'(proc.c))))
Now the macro just puts the pieces together:
(define-syntax (schema-properties stx)
(syntax-parse stx
[(_ [c:clause ...])
#'(list c.code ...)]))