35 lines
1.3 KiB
Racket
35 lines
1.3 KiB
Racket
#lang racket/base
|
|
|
|
(require "macro2.rkt"
|
|
(for-syntax racket/base
|
|
"parse2.rkt"
|
|
"literals.rkt"
|
|
syntax/parse
|
|
unstable/syntax))
|
|
|
|
(provide honu-struct honu-struct? honu-struct-get)
|
|
(define-values (honu-struct honu-struct? honu-struct-get)
|
|
(make-struct-type-property 'honu-struct))
|
|
|
|
(define-for-syntax (make-accessors name fields)
|
|
(for/list ([field fields])
|
|
(format-unique-id name "~a-~a" name field)))
|
|
|
|
(provide honu-structure)
|
|
(define-honu-syntax honu-structure
|
|
(lambda (code context)
|
|
(syntax-parse code #:literal-sets (cruft)
|
|
[(_ name:id (#%braces fields:identifier-comma-list) . rest)
|
|
(define out
|
|
(with-syntax ([(fields.name/accessor ...)
|
|
(make-accessors #'name (syntax->list #'(fields.name ...)))])
|
|
#'(struct name (fields.name ...)
|
|
#:transparent
|
|
#:property honu-struct (lambda (instance name)
|
|
(case name
|
|
[(fields.name) (fields.name/accessor instance)]
|
|
...
|
|
[else (error 'dot "no such field name ~a" name)])))))
|
|
(values out #'rest #t)])))
|
|
|