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

fix some error-message reporting for mzscheme define-struct

Browse Source 
svn: r8953

original commit: 9ecf9dfe4aedc729a71fc525399e89caae066e2f
This commit is contained in:
Matthew Flatt 2008-03-11 21:14:40 +00:00
parent 8dc8589a9a
commit db1a358d81
1 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/scheme/private/old-ds.ss
View File

@ -1,16 +1,25 @@
(module old-ds '#%kernel (module old-ds '#%kernel
(#%require "define-struct.ss" (#%require "define-struct.ss"
(for-syntax "stxcase-scheme.ss")) (for-syntax '#%kernel
"stxcase-scheme.ss"))
(#%provide define-struct let-struct datum) (#%provide define-struct let-struct datum)
(define-syntaxes (define-struct) (define-syntaxes (define-struct)
(syntax-rules () (lambda (stx)
[(_ base (field ...)) (with-syntax ([orig stx])
(define-struct* base (field ...) #:mutable)] (syntax-case stx ()
[(_ base (field ...) insp) [(_ base (field ...))
(define-struct* base (field ...) #:mutable #:inspector insp)])) #'(define-struct/derived orig base (field ...) #:mutable)]
[(_ base (field ...) insp)
(with-syntax ([insp
(if (keyword? (syntax-e #'insp))
(datum->syntax #'insp
(cons '#%datum #'insp)
#'insp)
#'insp)])
#'(define-struct/derived orig base (field ...) #:mutable #:inspector insp))]))))
(define-syntaxes (let-struct) (define-syntaxes (let-struct)
(syntax-rules () (syntax-rules ()