I was impressed with Lexi's struct-update module and wanted to extend it a
bit, so I've been working on a version of my own that exports a macro
called 'struct++'. I'm having some issues with phase level when applying
contracts to fields.
Here are some examples:
#lang racket
(require struct++)
; equivalent to normal struct, but generates keyword constructor
(struct++ feature (name))
(feature 'nose) ; okay
(feature++ #:name 'nose) ;okay
; put contracts on all the fields
(define rgb-color/c (integer-in 0 255))
(struct++ rgb ([red rgb-color/c] [green rgb-color/c] [blue rgb-color/c])
#:transparent)
(rgb -11 8 256) ; okay -- no special features when using the raw
constructor, so invalid values are accepted
(rgb++ #:red -11 #:green 8 #:blue 200) ; keyword ctor throws exception
because -11 is invalid
; contracts, default values, and wrapper functions that process the data
before struct creation
(struct++ location (
[name (or/c symbol? string?) ~a] ;
[(labels "hello") any/c (compose flatten list)]
[(x 0) integer?]
[y integer? abs]
[(z 10) (integer-in -10 10) add1])
#:transparent)
(location++ #:name 8 #:y 11)
; throws exception because 8 isn't a symbol/string
(location++ #:name 'home #:y 'invalid)
; throws because 'invalid isn't an integer
(location++ #:name 'home #:y -99)
; same as (location "home" '("hello") 0 99 11) ; note the 11, resulting
from the add1 wrapper
(location++ #:name 'home #:y -99 #:labels "personal")
; same as (location "home" '("personal") 0 99 11) ; -99 became 99 from abs
(location++ #:name 'home #:y -99 #:labels (list (vector "personal")
'("dwelling" ("location"))))
; same as (location "home" '(#("personal") "dwelling" "location") 0 99 11)
All great. The problem comes when I try to use a predicate that isn't
defined in #lang racket. So:
#lang racket
(require struct++) ; the struct++ module exports the struct++ module
;
(struct feature (name) #:transparent)
(struct++ face ([type feature?]))
(face++ #:type (feature 'foo)) ; causes a compile time error:
"feature?: unbound identifier in module"
I think what's happening is:
1) (struct feature ...) runs at phase 0 and defines, among other things,
the feature? predicate
2) (struct++ face ...) is a macro that runs at phase 1
3) Therefore, feature? has not been created yet when the struct++ macro
expands.
I've played around with a variety of 'for-template', 'for-syntax', and
'for-meta' on the provide spec but had no success making this work out. I
think it has to be simpler than I'm making it out to be; could someone give
me a pointer to what I'm doing wrong?
I've cut the code down as much as possible for purposes of demonstration,
but it's still ~50 lines. Apologies for taking your time, but can anyone
tell me how to fix this?
Full code is here: https://github.com/dstorrs/struct-plus-plus
Example code, cut as much as possible so no defaults or etc:
#lang racket
(require (for-syntax syntax/parse/experimental/template
syntax/parse
racket/syntax
(only-in racket/list partition flatten)))
(provide struct++)
;; syntax->keyword was lifted from:
;; http://www.greghendershott.com/2015/07/keyword-structs-revisited.html
(begin-for-syntax
(define syntax->keyword (compose1 string->keyword symbol->string
syntax->datum)))
(define-syntax (struct++ stx)
(define-template-metafunction (make-ctor-contract stx)
(define-syntax-class contract-spec
(pattern (required?:boolean (kw:keyword contr:expr))))
;;
(syntax-parse stx
[(make-ctor-contract (item:contract-spec ...+ predicate))
(let-values
([(mandatory optional)
(partition car
(syntax->datum #'(item ...)))])
(define flat-mand (if (null? mandatory) '() (foldl append '() (map
cadr mandatory))))
(define flat-opt (if (null? optional) '() (foldl append '() (map
cadr optional ))))
#`(->* (#,@flat-mand) (#,@flat-opt) predicate))]))
;;
(define-syntax-class field
(pattern [id:id field-contract:expr]
#:with kw (syntax->keyword #'id)
#:with ctor-arg #`(#,(syntax->keyword #'id) id)
#:with required? #'#t
#:with wrapper-func #'identity))
;;
(syntax-parse stx
((struct++ struct-id:id (~optional super-type:id) (field:field ...) opt
...)
; A double ... (used below) flattens one level
(with-syntax* ([ctor-id (format-id #'struct-id "~a++" #'struct-id)]
[((ctor-arg ...) ...) #'(field.ctor-arg ...)]
[predicate (format-id #'struct-id "~a?" #'struct-id)]
)
(template
(begin
(struct struct-id (field.id ...) opt ...)
(define/contract (ctor-id ctor-arg ... ...)
(make-ctor-contract
((field.required? (field.kw field.field-contract)) ...
predicate))
(struct-id (field.wrapper-func field.id) ...))))))))
--
You received this message because you are subscribed to the Google Groups
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.
