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

make some arity error messages for ->i contracted functions

Browse Source 
slightly less terrible

... but ->i still doesn't do as good a job as -> and ->* do for arity
errors (specifically, ->i is still letting the blame-less errors that
application constructs thru when it could be assigning blame)
This commit is contained in:
Robby Findler 2014-09-10 16:55:38 -05:00
parent c7e23b867e
commit dcfe7ede67
1 changed files with 23 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
racket/collects/racket/contract/private/arr-i.rkt
View File

@ -11,6 +11,7 @@
racket/private/performance-hint racket/private/performance-hint
(for-syntax racket/base (for-syntax racket/base
racket/stxparam-exptime racket/stxparam-exptime
syntax/name
"arr-i-parse.rkt" "arr-i-parse.rkt"
(rename-in (rename-in
@ -787,7 +788,7 @@ evaluted left-to-right.)
body))] body))]
[else stx])) [else stx]))
(define-for-syntax (mk-wrapper-func/blame-id-info an-istx used-indy-vars) (define-for-syntax (mk-wrapper-func/blame-id-info stx an-istx used-indy-vars)
(define-values (wrapper-proc-arglist (define-values (wrapper-proc-arglist
blame-ids args+rst blame-ids args+rst
@ -838,28 +839,28 @@ evaluted left-to-right.)
arg-proj-vars indy-arg-proj-vars arg-proj-vars indy-arg-proj-vars
wrapper-args indy-arg-vars wrapper-args indy-arg-vars
indy-arg-vars ordered-args indy-res-vars ordered-ress)) indy-arg-vars ordered-args indy-res-vars ordered-ress))
(values (values
(map cdr blame-ids) (map cdr blame-ids)
#`(λ #,wrapper-proc-arglist (with-syntax ([arg-checker (or (syntax-local-infer-name stx) 'arg-checker)])
(λ (val) #`(λ #,wrapper-proc-arglist
(chk val #,(and (syntax-parameter-value #'making-a-method) #t)) (λ (val)
(let ([arg-checker (chk val #,(and (syntax-parameter-value #'making-a-method) #t))
(λ #,(args/vars->arglist an-istx wrapper-args this-param) (let ([arg-checker
#,wrapper-body)]) (λ #,(args/vars->arglist an-istx wrapper-args this-param)
(impersonate-procedure #,wrapper-body)])
val (impersonate-procedure
(make-keyword-procedure val
(λ (kwds kwd-args . args) (make-keyword-procedure
(with-continuation-mark (λ (kwds kwd-args . args)
contract-continuation-mark-key blame (with-continuation-mark
(keyword-apply arg-checker kwds kwd-args args))) contract-continuation-mark-key blame
(λ args (keyword-apply arg-checker kwds kwd-args args)))
(with-continuation-mark (λ args
contract-continuation-mark-key blame (with-continuation-mark
(apply arg-checker args)))) contract-continuation-mark-key blame
impersonator-prop:contracted ctc (apply arg-checker args))))
impersonator-prop:blame blame)))))) impersonator-prop:contracted ctc
impersonator-prop:blame blame)))))))
(define-for-syntax (arg/res-to-indy-var indy-arg-vars ordered-args indy-res-vars ordered-ress var) (define-for-syntax (arg/res-to-indy-var indy-arg-vars ordered-args indy-res-vars ordered-ress var)
(define (try vars ordered) (define (try vars ordered)
@ -1068,7 +1069,7 @@ evaluted left-to-right.)
(define-syntax (->i/m stx) (define-syntax (->i/m stx)
(define an-istx (parse-->i stx)) (define an-istx (parse-->i stx))
(define used-indy-vars (mk-used-indy-vars an-istx)) (define used-indy-vars (mk-used-indy-vars an-istx))
(define-values (blame-ids wrapper-func) (mk-wrapper-func/blame-id-info an-istx used-indy-vars)) (define-values (blame-ids wrapper-func) (mk-wrapper-func/blame-id-info stx an-istx used-indy-vars))
(define val-first-wrapper-func (mk-val-first-wrapper-func/blame-id-info an-istx used-indy-vars)) (define val-first-wrapper-func (mk-val-first-wrapper-func/blame-id-info an-istx used-indy-vars))
(define args+rst (append (istx-args an-istx) (define args+rst (append (istx-args an-istx)
(if (istx-rst an-istx) (if (istx-rst an-istx)