A splicing syntax class that matches an optional pattern and binds attributes - racket

A splicing syntax class that I have is defined as follows. The syntax class matches a sequence of two statements (first pattern), one of the statements (third and second patterns) and perhaps even none of those statements at all (last pattern).
As you can see there is quite a lot of "duplicate" code, because every pattern returns either the attributes of something captured in the pattern, or an empty thing otherwise. The problem I have is that currently the statement is never truly optional, since the last pattern must match something. In this case an empty set of brackets ().
The question is: how can I make the statement truly optional? As a side question - can the code be condensed by making better use of head patterns?
(define-splicing-syntax-class signal-subscriptions-and-declarations
#:description "subscriptions to signals and signal declarations"
; Match the case where both a subscription and declaration statement is present
(pattern (~seq subscribed:signal-subscriptions declared:signal-declarations)
#:with (subscription-collection ...) #'(subscribed.signal-collection ...)
#:with (subscription-signal-id ...) #'(subscribed.signal-identifier ...)
#:with (declaration-signal-id ...) #'(declared.signal-identifier ...))
; Match the case where no declaration statement is present
(pattern subscribed:signal-subscriptions
#:with (subscription-collection ...) #'(subscribed.signal-collection ...)
#:with (subscription-signal-id ...) #'(subscribed.signal-identifier ...)
#:with (declaration-signal-id ...) #'())
; Match the case where no subscription statement is present
(pattern declared:signal-declarations
#:with (subscription-collection ...) #'()
#:with (subscription-signal-id ...) #'()
#:with (declaration-signal-id ...) #'(declared.signal-identifier ...))
(pattern ()
#:with (subscription-collection ...) #'()
#:with (subscription-signal-id ...) #'()
#:with (declaration-signal-id ...) #'()))

It sounds like you have two separate things, both of which are optional. So it makes sense to have two separate syntax-classes, like this:
(define-splicing-syntax-class opt-signal-subscriptions
;; Match the case where a subscription is present
[pattern (~seq subscribed:signal-subscriptions)
#:with (subscription-collection ...) #'(subscribed.signal-collection ...)
#:with (subscription-signal-id ...) #'(subscribed.signal-identifier ...)]
;; Match the case where no subscription is present
[pattern (~seq)
#:with (subscription-collection ...) #'()
#:with (subscription-signal-id ...) #'()])
(define-splicing-syntax-class opt-signal-declarations
;; Match the case where a declaration statement is present
[pattern (~seq declared:signal-declarations)
#:with (declaration-signal-id ...) #'(declared.signal-identifier ...)]
;; Match the case where no declaration statement is present
[pattern (~seq)
#:with (declaration-signal-id ...) #'()])
Both of these use an empty (~seq) case (matches 0 terms) to make it optional, instead of (), which matches 1 term. Then a syntax-class similar to your original one can be defined like this:
(define-splicing-syntax-class signal-subscriptions-and-declarations
#:description "subscriptions to signals and signal declarations"
#:auto-nested-attributes
[pattern (~seq :opt-signal-subscriptions :opt-signal-declarations)])
This is different from your original one because this can match 0, 1, or 2 terms, while yours will require at least 1 term, which will have to be () when neither option is present.

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

how can I capture the expanded forms?

I'm trying to capture the expanded forms by defining my own module-begin:
(define-syntax-rule (my-module-begin e ...)
(#%module-begin
e ...
(foo e ...)))
Am I correct that foo here gets the original forms? If so is there a way for foo to get the expanded forms instead?
To get the expanded forms you'll need to use local-expand in some way.
Part 1, an incomplete solution
You might think to call local-expand separately on every expression like this:
#lang racket
(require syntax/parse/define
(for-syntax syntax/stx))
(define-simple-macro (my-module-begin e ...)
; define a function that expands it
#:do [(define (expand/mod-ctx e)
(local-expand e 'module '()))]
; get the expanded versions by calling that function on the e's
#:with (e-expanded ...) (stx-map expand/mod-ctx #'(e ...))
; use the expanded versions inside foo
(#%module-begin
e-expanded ...
(foo e-expanded ...)))
This works when the e forms are expressions like (+ 1 2) or (let ([x 3] [y 4]) (make-list x y)). However, it doesn't work when the e forms can be definitions.
Part 2, getting the expanded versions from Racket's #%module-begin
One way to support using local-expand with these module-level definitions is to wrap it in racket's #%module-begin form before expanding. This allows it to process all the es together in one call to local-expand.
(define-simple-macro (my-module-begin e ...)
; get the expanded versions by calling that function on a
; *constructed* module-begin form
#:with (_ e-expanded ...) (local-expand #'(#%module-begin e ...) 'module-begin '())
; use the expanded versions inside foo
(#%module-begin
e-expanded ...
(foo e-expanded ...)))
This gets Racket's #%module-begin to handle the definitions, and when it's done, you can pattern match on it with (_ e-expanded ...).

Nested macros in Racket

I want to be able to write a nested expression like this:
(AND/OR expr1 op1 expr2 AND/OR expr3 op2 expr4 and so on)
Where AND/OR is essentially AND or OR. But I want to be able to write an infinite amount of them. I'm using the define-syntax to try to make this happen but I'm not sure how to accept infinite amounts of nested expressions.
Don't mind the expr's and op's in my example, that part I can handle myself. I only want to know how to accept infinite nesting.
Example:
(SELECT somecolumns
FROM sometable
WHERE something
AND/OR something
AND/OR (something AND/OR something)
AND/OR ...)
As Asumu says, in general it's simpler to deal with s-expressions, at least in order to ensure correct operator priority, but for some simple cases pattern matching of syntax-rules (and syntax-parse and co) makes this easy, using rest arguments and recursive matching:
#lang racket
(define-syntax parse-args
(syntax-rules (AND) ; treat AND as a literal
[(_)
; no more argument, return value:
'()]
[(_ (arg1 AND in-rst ...))
; Composed argument found, call parse-args recursively:
(parse-args arg1 AND in-rst ...)]
[(_ arg1 AND rst ...)
; AND operator found, parse left side and rest
(list 'and
; parse the argument (may be composed or not):
(parse-args arg1)
; then parse the rest of the arguments:
(parse-args rst ...))]
[(_ arg)
; in case the argument is not composed or does not contain AND, don't parse it
arg]))
;; TESTS:
(parse-args 'a AND ('b AND 'bb) AND 'c AND 'f)
; -> '(and a (and (and b bb) (and c f)))
(parse-args 'a AND ('b AND 'bb))
; -> '(and a (and b bb))
However, note that the above code can become impractical when adding other operators.
Edit:
Together with the select macro:
(define-syntax SELECT
(syntax-rules (FROM WHERE)
[(_ select FROM from WHERE where ...)
(list 'Select select 'From from 'Where (parse-args where ...))]))
; TEST:
(SELECT 'somecolumns
FROM 'sometable
WHERE 'something1
AND 'something2
AND ('something3 AND 'something4)
AND 'blop)
; ->
#;'(Select
somecolumns
From
sometable
Where
(and something1
(and something2
(and (and something3 something4) blop))))
Again, pattern-matching allows for cutting the list at the right point to get the rest arguments

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

Racket macros - making pairs

I've just started diving into Racket macros, and am trying to make a terse simple-macro-defining macro. I would like to expand an expression like this:
(macro id
(param) replacement1
(params ...) replacement2)
Into something like this:
(define-syntax id
(syntax-rules ()
((id param) replacement1)
((id params ...) replacement2)))
So the cddr of the original expression is turned into pairs of expressions (for use in the syntax-rules body), and the id is inserted into the car of each of these pairs.
I'm having trouble thinking recursively when using only the pattern-matching provided by syntax-rules (I keep wanting to manipulate the expression as though it were a normal list). What kind of pattern should I use? Or, can I somehow manipulate it as a normal list, and then unquote the result for use in the expansion?
Many thanks
Edit - tentative solution, informed by Taymon's answer
Part of my curiosity here was about getting rid of those pairing parentheses. I looked into syntax-case, but got a bit confused, so tried to do it purely with the pattern-matching sub-language. I ended up using Taymon's macro combined with another macro to 'pairize' the given templates (it acts kind of like an accumulator function):
(define-syntax-rule (macro-aux id ((param ...) expr) ...)
(define-syntax id
(syntax-rules ()
((id param ...) expr)
...)))
(define-syntax pairize
(syntax-rules ()
((pairize id (pairs ...) p b) (macro-aux id pairs ... (p b)))
((pairize id (pairs ...) p b rest ...) (pairize id (pairs ... (p b)) rest ...))))
(define-syntax macro
(syntax-rules ()
((macro id tpl-expr ...) (pairize id () tpl-expr ...))))
It is possible to build a macro expander that manipulates the syntax expression as regular Racket data. However, that's not really necessary in this case.
One thing I would recommend is changing your syntax slightly, so that each pattern-replacement pair is enclosed in brackets. Like this:
(macro id
[(param) replacement1]
[(params ...) replacement2])
Once that's done, you can just use a regular pattern-matching macro. Here's my take on it:
(define-syntax-rule (macro id [(param ...) replacement] ...)
(define-syntax id
(syntax-rules ()
[(id param ...) replacement] ...)))
Taymon is right, but it is also possible to do it with ellipses without wrapping the pattern-replacement pairs in brackets, using ~seq from syntax/parse:
(require syntax/parse/define)
(define-simple-macro (macro id (~seq (param ...) replacement) ...)
(define-syntax id
(syntax-rules ()
[(id param ...) replacement] ...)))
Which can be used like you originally wanted:
(macro id
(param) replacement1
(params ...) replacement2)