misc-deps
/
raart
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

simpl

This commit is contained in:
Jay McCarthy 2018-01-03 18:25:40 -05:00
parent f5bdaed63f
commit d7216e29d7
1 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
struct-define.rkt
View File

@ -3,6 +3,20 @@
racket/struct-info racket/struct-info
syntax/parse)) syntax/parse))
(begin-for-syntax
(define (make-field-name-transformer instace-id-stx field-ref-stx field-set!-stx)
(make-set!-transformer
(lambda (stx)
(syntax-case stx (set!)
[(set! id v)
(if (syntax->datum field-set!-stx)
(quasisyntax/loc stx
(#,field-set!-stx #,instace-id-stx v))
(raise-syntax-error 'set! "field not mutable" stx #'id))]
[id (identifier? #'id)
(quasisyntax/loc stx
(#,field-ref-stx #,instace-id-stx))])))))
(define-syntax (struct-define stx) (define-syntax (struct-define stx)
(syntax-parse stx (syntax-parse stx
[(_ the-struct the-instance:expr) [(_ the-struct the-instance:expr)
@ -27,17 +41,8 @@
(syntax/loc stx (syntax/loc stx
(begin (define the-instance-id the-instance) (begin (define the-instance-id the-instance)
(define-syntax field-name (define-syntax field-name
(make-set!-transformer (make-field-name-transformer #'the-instance-id
(lambda (stx) #'field-ref #'field-set!))
(syntax-case stx (set!)
[(set! id v)
(if (syntax->datum #'field-set!)
(quasisyntax/loc stx
(field-set! the-instance-id v))
(raise-syntax-error 'set! "field not mutable" stx #'id))]
[id (identifier? #'id)
(syntax/loc stx
(field-ref the-instance-id))]))))
...))])) ...))]))
(define-syntax-rule (define-struct-define the-struct the-struct-define) (define-syntax-rule (define-struct-define the-struct the-struct-define)