suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

define-struct for the whalesong language uses mutable, transparent structures by default

Browse Source
This commit is contained in:
Danny Yoo 2011-09-02 13:36:41 -04:00
parent 97681d43ec
commit 086a5dc61f
1 changed files with 26 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lang/whalesong.rkt
View File

@ -6,6 +6,8 @@
;; * Automatically running tests
;; * Annotating all applications so they produce stack traces on error
;; * Adding the "shared" form by default.
;; * define-struct automatically has #:transparent and #:mutable
(require "base.rkt"
"private/traced-app.rkt"
@ -19,9 +21,11 @@
(provide (except-out (all-from-out "base.rkt")
#%app
#%module-begin)
#%module-begin
define-struct)
(rename-out [traced-app #%app]
[my-module-begin #%module-begin])
[my-module-begin #%module-begin]
[my-define-struct define-struct])
shared
(all-from-out "bool.rkt")
(except-out (all-from-out "check-expect/check-expect.rkt")
@ -34,4 +38,23 @@
[(_ body ...)
(syntax/loc stx
(#%module-begin body ...
(run-tests)))]))
(run-tests)))]))
(define-syntax (my-define-struct stx)
(syntax-case stx ()
[(_ id (fields ...) options ...)
(let* ([new-options (syntax->list #'(options ...))]
[new-options (cond [(memq '#:transparent (map syntax-e new-options))
new-options]
[else
(cons (syntax #:transparent) new-options)])]
[new-options (cond [(memq '#:mutable (map syntax-e new-options))
new-options]
[else
(cons (syntax #:mutable) new-options)])])
(with-syntax [((new-options ...) new-options)]
(syntax/loc stx
(define-struct id (fields ...) new-options ...))))]))