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" '()))
)
~?
and~parse
, which I didn't knew about before. Thanks :) – Informed