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

Make use of stepper-define-struct-hint' in define-record-procedures'.

Browse Source
This commit is contained in:
Mike Sperber 2010-06-09 14:33:21 +02:00
parent 78832fe332
commit fc879f1894
1 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/deinprogramm/define-record-procedures.scm
View File

@ -26,7 +26,8 @@
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((_ ?type-name ((_ ?stx
?type-name
?mutable? ?mutable?
?contract-constructor-name ?contract-constructor-name
?constructor ?constructor
@ -190,7 +191,7 @@
;; again, with properties ;; again, with properties
(with-syntax ((struct-type-defs (with-syntax ((struct-type-defs
(stepper-syntax-property (stepper-syntax-property
(syntax/loc x struct-type-defs) 'stepper-skip-completely #t)) (syntax/loc x struct-type-defs) 'stepper-define-struct-hint #'?stx))
(constructor-def (constructor-def
(stepper-syntax-property #'constructor-def 'stepper-skip-completely #t)) (stepper-syntax-property #'constructor-def 'stepper-skip-completely #t))
(predicate-def (predicate-def
@ -347,10 +348,11 @@ prints as:
(syntax->list (syntax (accessor ...))) (syntax->list (syntax (accessor ...)))
"Selektor ist kein Bezeichner") "Selektor ist kein Bezeichner")
(with-syntax (((dummy-mutator ...) (with-syntax ((?stx x)
((dummy-mutator ...)
(generate-temporaries (syntax (accessor ...))))) (generate-temporaries (syntax (accessor ...)))))
(syntax (syntax
(define-record-procedures* ?type-name #f (define-record-procedures* ?stx ?type-name #f
dummy-contract-constructor-name dummy-contract-constructor-name
?constructor ?constructor
?predicate ?predicate
@ -414,10 +416,11 @@ prints as:
(syntax->list (syntax (accessor ...))) (syntax->list (syntax (accessor ...)))
"Selektor ist kein Bezeichner") "Selektor ist kein Bezeichner")
(with-syntax (((dummy-mutator ...) (with-syntax ((?stx x)
((dummy-mutator ...)
(generate-temporaries (syntax (accessor ...))))) (generate-temporaries (syntax (accessor ...)))))
(syntax (syntax
(define-record-procedures* ?type-name #f ?contract-constructor-name (define-record-procedures* ?stx ?type-name #f ?contract-constructor-name
?constructor ?constructor
?predicate ?predicate
((accessor dummy-mutator) ...)))))) ((accessor dummy-mutator) ...))))))
@ -479,11 +482,12 @@ prints as:
"Selektor ist kein Bezeichner")))) "Selektor ist kein Bezeichner"))))
(syntax->list (syntax (?field-spec ...)))) (syntax->list (syntax (?field-spec ...))))
#'(define-record-procedures* ?type-name #t (with-syntax ((?stx x))
dummy-contract-constructor-name #'(define-record-procedures* ?stx ?type-name #t
?constructor dummy-contract-constructor-name
?predicate ?constructor
(?field-spec ...)))) ?predicate
(?field-spec ...)))))
((_ ?type-name ((_ ?type-name
?constructor ?constructor
?predicate ?predicate
@ -541,10 +545,11 @@ prints as:
"Selektor ist kein Bezeichner")))) "Selektor ist kein Bezeichner"))))
(syntax->list (syntax (?field-spec ...)))) (syntax->list (syntax (?field-spec ...))))
#'(define-record-procedures* ?type-name #t ?contract-constructor-name (with-syntax ((?stx x))
?constructor #'(define-record-procedures* ?stx ?type-name #t ?contract-constructor-name
?predicate ?constructor
(?field-spec ...)))) ?predicate
(?field-spec ...)))))
((_ ?type-name ((_ ?type-name
?contract-constructor-name ?contract-constructor-name
?constructor ?constructor