How can I group optional attributes captured with syntax-parse? - macros

When writing a macro that uses syntax/parse, I have created a splicing syntax class that captures options that may be provided to the macro. These options are all optional, and they may be provided in any order. Using the ~optional ellipsis head pattern makes this easy enough:
(define-splicing-syntax-class opts
(pattern (~seq (~or (~optional (~seq #:a a))
(~optional (~seq #:b b))
(~optional (~seq #:x x))
(~optional (~seq #:y y)))
...))
However, there is a catch: I want to be able to group these options into two groups: the group containing a and b, and the group containing x and y. However, the user may still specify the options in any order, so for this example input:
(foobar #:b 3 #:y 7 #:a 2)
I want to be able to produce the following attributes:
first-opts: (#:a 2 #:b 3)
second-opts: (#:y 7)
So far, I’ve managed to do this manually using #:with, but it isn’t pretty:
(define-splicing-syntax-class opts
#:attributes ([first-opts 1] [second-opts 1])
(pattern (~seq (~or (~optional (~seq #:a a))
(~optional (~seq #:b b))
(~optional (~seq #:x x))
(~optional (~seq #:y y)))
...)
#:with (first-opts ...)
#`(#,#(if (attribute a) #'(#:a a) #'())
#,#(if (attribute b) #'(#:b b) #'()))
#:with (second-opts ...)
#`(#,#(if (attribute x) #'(#:x x) #'())
#,#(if (attribute y) #'(#:y y) #'()))))
This can be simplified a little bit using template from syntax/parse/experimental/template:
(define-splicing-syntax-class opts
#:attributes ([first-opts 1] [second-opts 1])
(pattern (~seq (~or (~optional (~seq #:a a))
(~optional (~seq #:b b))
(~optional (~seq #:x x))
(~optional (~seq #:y y)))
...)
#:with (first-opts ...)
(template ((?? (?# #:a a))
(?? (?# #:b b))))
#:with (second-opts ...)
(template ((?? (?# #:a x))
(?? (?# #:b y))))))
However, this is really just some sugar for the above, and it doesn’t actually address the problem of having to enumerate each option in each clause. If I, for example, added a #:c option, I would need to remember to add it to the first-opts group, otherwise it would be completely ignored.
What I really want is some declarative way to group these sets of optional values. For example, I’d like a syntax like this:
(define-splicing-syntax-class opts
#:attributes ([first-opts 1] [second-opts 1])
(pattern (~seq (~or (~group first-opts
(~optional (~seq #:a a))
(~optional (~seq #:b b)))
(~group second-opts
(~optional (~seq #:x x))
(~optional (~seq #:y y))))
...)))
Or, even better, it would be nice if I could use existing primitives, something like this:
(define-splicing-syntax-class opts
#:attributes ([first-opts 1] [second-opts 1])
(pattern (~seq (~or (~and first-opts
(~seq (~optional (~seq #:a a))
(~optional (~seq #:b b))))
(~and second-opts
(~seq (~optional (~seq #:x x))
(~optional (~seq #:y y)))))
...)))
However, neither of those work. Is there any way to do this using the builtins provided by syntax/parse? If not, is there any simple way to define something like ~group myself?

There is a way to do that with a ~groups-no-order pattern expander like this:
(define-splicing-syntax-class opts
#:attributes ([first-opts 1] [second-opts 1])
[pattern (~groups-no-order
[first-opts
(~optional (~seq #:a a))
(~optional (~seq #:b b))]
[second-opts
(~optional (~seq #:x x))
(~optional (~seq #:y y))])])
(syntax-parse #'(foobar #:b 3 #:y 7 #:a 2)
[(foobar opts:opts)
(values #'(opts.first-opts ...)
#'(opts.second-opts ...))])
; #<syntax (#:a 2 #:b 3)>
; #<syntax (#:y 7)>
Where ~groups-no-order can be defined like this:
#lang racket
(provide ~groups-no-order)
(require syntax/parse
seq-no-order
(for-syntax racket/syntax
syntax/stx))
(define-syntax ~groups-no-order
(pattern-expander
(lambda (stx)
(syntax-case stx ()
[(groups [group-name member-pat ...] ...)
(with-syntax ([ooo (quote-syntax ...)])
(define/with-syntax [[member-tmp ...] ...]
(stx-map generate-temporaries #'[[member-pat ...] ...]))
(define/with-syntax [group-tmp ...]
(generate-temporaries #'[group-name ...]))
#'(~and (~seq-no-order (~and (~seq (~var member-tmp) ooo)
member-pat)
... ...)
(~parse [[(~var group-tmp) ooo] ooo] #'[[member-tmp ooo] ...])
...
(~parse [group-name ooo] #'[group-tmp ooo ooo])
...))]))))
This does the same thing as your first solution using #:with, but it abstracts that stuff out into a reusable pattern expander.

I'm not (yet) sure of a way you can do this with something like ~group, but there is a way you can make your existing (working) solution that uses #:with look a lot nicer. Maybe it will work for your case, maybe not.
~optional takes in a default argument #:defaults, which you can set to be the empty syntax list, #'#f, or some other sentinel value, removing your requirement to have an if statement in your #:with clause. It would look something like this:
(define-splicing-syntax-class opts
#:attributes ([first-opts 1] [second-opts 1])
(pattern (~seq (~or (~optional (~seq #:a a) #:defaults ([a #'#f]))
(~optional (~seq #:b b) #:defaults ([b #'#f]))
(~optional (~seq #:x x) #:defaults ([x #'#f]))
(~optional (~seq #:y y) #:defaults ([y #'#f])))
...)
#:with (first-opts ...) #'(#:a a #:b b)
#:with (second-opts ...) #'(#:x x #:y y)
Hope that helps.

I think using ~and leads to the most straightforward macro, but the head pattern version of ~and is more restrictive and doesn't quite work so I would separate the head-pattern part out.
Does the code below accomplish what you want?
Without head patterns you lose ~optional so I manually check for duplicates.
Also, first-opts and second-opts are not flattened, but I suspect that is ok?
#lang racket
(require (for-syntax syntax/parse racket/list))
(define-for-syntax (check-duplicate-kws kws-stx)
(check-duplicates (syntax->list kws-stx) #:key syntax->datum))
(define-syntax test
(syntax-parser
[(_ (~seq k:keyword v) ...)
#:fail-when (check-duplicate-kws #'(k ...)) "duplicate keyword"
#:with ((~or (~and first-opts (~or (#:a _) (#:b _)))
(~and second-opts (~or (#:c _) (#:d _)))) ...)
#'((k v) ...)
#'(void)]))

Related

How to access syntax-class attributes in `~optional` that contains ellipsis?

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

Keyword and default argument macro interfering with variable arguments in Racket

I am using the macro mentioned on this page (Macro for keyword and default values of function arguments in Racket) which permits me to use {arg_name arg_value} for default and named arguments (without the need for #:key_name). It is otherwise working all right but it is interfering with declaration of functions with variable arguments (fnname . vars). The error is simply "bad syntax". How can this be corrected? Thanks for your comments / answers.
Edit: My current code is:
(require syntax/parse/define ; for define-simple-macro
(only-in racket [define old-define] [#%app old-#%app])
(for-syntax syntax/stx)) ; for stx-map
(begin-for-syntax
;; identifier->keyword : Identifer -> (Syntaxof Keyword)
(define (identifier->keyword id)
(datum->syntax id (string->keyword (symbol->string (syntax-e id))) id id))
;; for use in define
(define-syntax-class arg-spec
[pattern name:id
;; a sequence of one thing
#:with (norm ...) #'(name)]
[pattern {name:id default-val:expr} ; rn: ch if {} needed here; since works well with [] here;
#:when (equal? #\{ (syntax-property this-syntax 'paren-shape))
#:with name-kw (identifier->keyword #'name)
;; a sequence of two things
#:with (norm ...) #'(name-kw {name default-val})]))
(define-syntax-parser define ; instead of define-simple-macro;
[(define x:id val:expr)
#'(old-define x val)]
[(define (fn arg:arg-spec ...) body ...+)
#'(old-define (fn arg.norm ... ...) body ...)])
(begin-for-syntax
;; for use in #%app
(define-syntax-class arg
[pattern arg:expr
#:when (not (equal? #\{ (syntax-property this-syntax 'paren-shape)))
;; a sequence of one thing
#:with (norm ...) #'(arg)]
[pattern {name:id arg:expr}
#:when (equal? #\{ (syntax-property this-syntax 'paren-shape))
#:with name-kw (identifier->keyword #'name)
;; a sequence of two things
#:with (norm ...) #'(name-kw arg)]))
(require (for-syntax (only-in racket [#%app app])))
(define-simple-macro (#%app fn arg:arg ...)
#:fail-when (app equal? #\{ (app syntax-property this-syntax 'paren-shape))
"function applications can't use `{`"
(old-#%app fn arg.norm ... ...))
I am not sure which part to change. If I remove last part (define-simple-macro) the named/default arguments in {} do not work.
Further Edit: I have modified the code as follows:
(define-syntax-parser define ; instead of define-simple-macro;
[(define x:id val:expr)
#'(old-define x val)]
[(define (fn arg:arg-spec ...) body ...+)
#'(old-define (fn arg.norm ... ...) body ...)]
[(define (fn . vars) body ...+)
#'(old-define (fn . vars) body ...)] )
and it works:
(define (testvars . vars)
(println (list? vars))
(for ((item vars))(println item)) )
(testvars 1 2 3)
#t
1
2
3
But why do I still need "(define-simple-macro .." part? Also, why do I need 2 "(begin-for-syntax.." definitions?
Edit again: further modification:
(define-syntax-parser define
[(define x:id val:expr)
#'(old-define x val)]
[(define (fn arg:arg-spec ...) body ...+)
#'(old-define (fn arg.norm ... ...) body ...)]
[(define (fn arg:arg-spec ... . vars) body ...+)
#'(old-define (fn arg.norm ... ... . vars) body ...)]
)
Above finally works with both named and variable arguments, e.g. (fnname {x 0} {y 1} 10 20 30), thanks to all the help from #AlexKnauth in comments below.
As we figured out in the comments, all you have to do is add a third case to the define macro, similar to the second case, but with a . rst after the arg:arg-spec ... in the pattern and again after the arg.norm ... ... in the template.
The second case was
[(define (fn arg:arg-spec ...) body ...+)
#'(old-define (fn arg.norm ... ...) body ...)]
The new case is similar, but with the . rst added
[(define (fn arg:arg-spec ... . rst) body ...+)
#'(old-define (fn arg.norm ... ... . rst) body ...)]
In context it looks like this.
(define-syntax-parser define
[(define x:id val:expr)
#'(old-define x val)]
[(define (fn arg:arg-spec ...) body ...+)
#'(old-define (fn arg.norm ... ...) body ...)]
[(define (fn arg:arg-spec ... . rst) body ...+)
#'(old-define (fn arg.norm ... ... . rst) body ...)]
)

Implementing multi list comprehensions in Racket

Im implementing a macro to do list comprehensions
(define-syntax list-comp
(syntax-rules (for in if)
[(list-comp <expr> for <var> in <list>)
(map (lambda (<var>) <expr>) <list>)]
[(list-comp <expr> for <var> in <list> if <cond>)
(map (lambda (<var>) <expr>)
(filter (lambda (<var>) <cond>) <list>))]))
I wanna modify this macro so it can accept any number of lists.
so for example
(+ l1 l2) for in List1 List2 would return the sum of adding each element in each list
and should also work with (+ l1 l2 l3...) for in list1 list2 list3 and so on...
Since map can map over several lists at once, the multi variable case is a natural extension of the one variable case.
(define-syntax list-comp
(syntax-rules (for in if)
[(list-comp <expr> for (<var> ...) in <list> ...) ;
(map (lambda (<var> ...) <expr>) <list> ...)]
[(list-comp <expr> for <var> in <list>)
(map (lambda (<var>) <expr>) <list>)]
[(list-comp <expr> for <var> in <list> if <cond>)
(map (lambda (<var>) <expr>)
(filter (lambda (<var>) <cond>) <list>))]))
(define xs '( 1 2 3))
(define ys '(10 20 30))
(list-comp (+ x y) for (x y) in xs ys)
(list-comp x for x in xs)
If you want to read more on list comprehensions, I can recommend chapter 7 of the book "The Implementation of Functional languages". You can can read the chapter online here:
http://research.microsoft.com/en-us/um/people/simonpj/papers/slpj-book-1987/PAGES/127.HTM
The syntax is different from Scheme, but the rewrite rules can be translated directly into syntax-rules macros.

Stumbling over syntax-quote-unsplicing, template variables, and ellipses in syntax-case

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

Racket Macro Ellipsis Syntax

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