Remove unnecessary argument from make-field-map.

This commit is contained in:
Stevie Strickland 2010-11-15 13:14:07 -05:00
parent de0103129b
commit a1095d2fc1
2 changed files with 6 additions and 11 deletions

View File

@ -1194,8 +1194,7 @@
(quote-syntax inherit-field-name) (quote-syntax inherit-field-name)
(quote-syntax inherit-field-name-localized) (quote-syntax inherit-field-name-localized)
(quote-syntax inherit-field-accessor) (quote-syntax inherit-field-accessor)
(quote-syntax inherit-field-mutator) (quote-syntax inherit-field-mutator))
'())
... ...
(make-field-map trace-flag (make-field-map trace-flag
(quote-syntax the-finder) (quote-syntax the-finder)
@ -1204,8 +1203,7 @@
(quote-syntax local-field) (quote-syntax local-field)
(quote-syntax local-field-localized) (quote-syntax local-field-localized)
(quote-syntax local-field-accessor) (quote-syntax local-field-accessor)
(quote-syntax local-field-mutator) (quote-syntax local-field-mutator))
'())
... ...
(make-rename-super-map (quote-syntax the-finder) (make-rename-super-map (quote-syntax the-finder)
(quote the-obj) (quote the-obj)

View File

@ -61,7 +61,7 @@
(quasisyntax/loc stx (#,replace-stx . args))]))))) (quasisyntax/loc stx (#,replace-stx . args))])))))
(define (make-field-map trace-flag the-finder the-obj the-unwrapper the-binder the-binder-localized (define (make-field-map trace-flag the-finder the-obj the-unwrapper the-binder the-binder-localized
field-accessor field-mutator field-pos/null) field-accessor field-mutator)
(let ([set!-stx (datum->syntax the-finder 'set!)]) (let ([set!-stx (datum->syntax the-finder 'set!)])
(mk-set!-trans (mk-set!-trans
the-binder-localized the-binder-localized
@ -74,8 +74,7 @@
[trace (syntax/loc stx (set-event obj (quote id) id))] [trace (syntax/loc stx (set-event obj (quote id) id))]
[set (quasisyntax/loc stx [set (quasisyntax/loc stx
((unsyntax field-mutator) ((unsyntax field-mutator)
((unsyntax the-unwrapper) obj) ((unsyntax the-unwrapper) obj) id))])
(unsyntax-splicing field-pos/null) id))])
(if trace-flag (if trace-flag
(syntax/loc stx (let* bindings trace set)) (syntax/loc stx (let* bindings trace set))
(syntax/loc stx (let* bindings set))))] (syntax/loc stx (let* bindings set))))]
@ -84,8 +83,7 @@
[trace (syntax/loc stx (get-event obj (quote id)))] [trace (syntax/loc stx (get-event obj (quote id)))]
[call (quasisyntax/loc stx [call (quasisyntax/loc stx
(((unsyntax field-accessor) (((unsyntax field-accessor)
((unsyntax the-unwrapper) obj) ((unsyntax the-unwrapper) obj)) . args))])
(unsyntax-splicing field-pos/null)) . args))])
(if trace-flag (if trace-flag
(syntax/loc stx (let* bindings trace call)) (syntax/loc stx (let* bindings trace call))
(syntax/loc stx (let* bindings call))))] (syntax/loc stx (let* bindings call))))]
@ -94,8 +92,7 @@
[trace (syntax/loc stx (get-event obj (quote id)))] [trace (syntax/loc stx (get-event obj (quote id)))]
[get (quasisyntax/loc stx [get (quasisyntax/loc stx
((unsyntax field-accessor) ((unsyntax field-accessor)
((unsyntax the-unwrapper) obj) ((unsyntax the-unwrapper) obj)))])
(unsyntax-splicing field-pos/null)))])
(if trace-flag (if trace-flag
(syntax/loc stx (let* bindings trace get)) (syntax/loc stx (let* bindings trace get))
(syntax/loc stx (let* bindings get))))])))))) (syntax/loc stx (let* bindings get))))]))))))