79 lines
2.4 KiB
Racket
79 lines
2.4 KiB
Racket
#lang planet dyoo/whalesong/base
|
|
(require (for-syntax racket/base
|
|
syntax/struct))
|
|
|
|
|
|
(define-syntax (my-define-struct stx)
|
|
(syntax-case stx ()
|
|
[(_ name (fields ...) kw ...)
|
|
(with-syntax ([(names ...)
|
|
(build-struct-names #'name
|
|
(syntax->list #'(fields ...))
|
|
#f
|
|
#f)])
|
|
(with-syntax ([cnstr (syntax-case #'(names ...) ()
|
|
[(struct:name-id constructor misc ...)
|
|
#'constructor])])
|
|
#'(begin
|
|
(define-values (names ...)
|
|
(let ()
|
|
(define-struct name (fields ...) kw ...)
|
|
(call-with-values (lambda ()
|
|
(let ([cnstr (lambda args
|
|
(apply cnstr args))])
|
|
(displayln names) ...
|
|
(values names ...)))
|
|
(lambda args
|
|
(displayln "in the result of call-with-values")
|
|
(displayln args)
|
|
(apply values args))))))))]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define-syntax (my-define-struct2 stx)
|
|
(syntax-case stx ()
|
|
[(_ name (fields ...) kw ...)
|
|
(with-syntax ([(names ...)
|
|
(build-struct-names #'name
|
|
(syntax->list #'(fields ...))
|
|
#f
|
|
#f)])
|
|
(with-syntax ([cnstr (syntax-case #'(names ...) ()
|
|
[(struct:name-id constructor misc ...)
|
|
#'constructor])])
|
|
#'(begin
|
|
(define-values (names ...)
|
|
(let ()
|
|
(begin
|
|
(define-struct name (fields ...) kw ...)
|
|
(let ([cnstr (lambda args
|
|
(apply cnstr args))])
|
|
(displayln names) ...
|
|
(values names ...))))))))]))
|
|
|
|
|
|
|
|
(my-define-struct swf (f) #:mutable)
|
|
(displayln "---")
|
|
struct:swf
|
|
make-swf
|
|
swf?
|
|
swf-f
|
|
set-swf-f!
|
|
|
|
|
|
(displayln "***")
|
|
|
|
|
|
(my-define-struct swf2 (f) #:mutable)
|
|
(displayln "---")
|
|
struct:swf2
|
|
make-swf2
|
|
swf2?
|
|
swf2-f
|
|
set-swf2-f!
|