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

define-inline: better handling of misapplication

Browse Source 
When a function from `define-inline` is applied to the wrong number of
arguments or the wrong keyword arguments, then leave it as a runtime
error (with a compile-time warning) instead of a badly reported
compile-time error.

Closes #3402
This commit is contained in:
Matthew Flatt 2021-05-05 20:00:41 -06:00
parent 808ea5f303
commit 9410a90a8b
3 changed files with 58 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-doc/scribblings/reference/syntax.scrbl
View File

@ -3047,12 +3047,15 @@ which has fewer dependencies than @racketmodname[racket/performance-hint].
(code:line keyword [arg-id default-expr])])]{ (code:line keyword [arg-id default-expr])])]{
Like @racket[define], but ensures that the definition will be inlined at its Like @racket[define], but ensures that the definition will be inlined at its
call sites. Recursive calls are not inlined, to avoid infinite inlining. call sites. Recursive calls are not inlined, to avoid infinite inlining.
Higher-order uses are supported, but also not inlined. Higher-order uses are supported, but also not inlined. Misapplication (by
supplying the wrong number of arguments or incorrect keyword arguments) is
also not inlined and left as a run-time error.
@racket[define-inline] may interfere with the Racket compiler's own inlining The @racket[define-inline] form may interfere with the Racket compiler's own inlining
heuristics, and should only be used when other inlining attempts (such as heuristics, and should only be used when other inlining attempts (such as
@racket[begin-encourage-inline]) fail. @racket[begin-encourage-inline]) fail.
}
@history[#:changed "8.1.0.5" @elem{Changed to treat misapplication as a run-time error.}]}
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------

5
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -5896,6 +5896,11 @@
1 "") 1 "")
(test/output (sub #:b 1 #:a 2) (test/output (sub #:b 1 #:a 2)
1 "") 1 "")
;; a bad call is a runtime error, not a compile-time error
(test #t procedure? (lambda () (sub 'oops)))
(test #t procedure? (lambda () (sub #:oops 77)))
(test #t procedure? sub)
) )

73
racket/collects/racket/performance-hint.rkt
View File

@ -61,9 +61,9 @@
(define-syntax (define-inline-helper stx) (define-syntax (define-inline-helper stx)
(syntax-parse stx (syntax-parse stx
[(_ (name:id . args:formals) . body) [(_ (name:id . args:formals) . body)
(with-syntax* ([internal-name (format-id #'name "~a-internal" #'name)] (with-syntax* ([internal-name (format-id #'here "~a-internal" #'name)]
[inline-name (format-id #'name "~a-inline" #'name)] [inline-name (format-id #'here "~a-inline" #'name)]
[function-aux (format-id #'name "~a-aux" #'name)] [function-aux (format-id #'here "~a-aux" #'name)]
[(arg-id ...) #'args.ids] [(arg-id ...) #'args.ids]
[(rest-arg-id ...) #'args.rest-arg] [(rest-arg-id ...) #'args.rest-arg]
[(tmp-arg-id ...) (generate-temporaries #'(arg-id ...))] [(tmp-arg-id ...) (generate-temporaries #'(arg-id ...))]
@ -76,7 +76,9 @@
#`(begin #`(begin
;; define a function version that recursive calls fall back to, to ;; define a function version that recursive calls fall back to, to
;; avoid infinite expansion ;; avoid infinite expansion
(define (internal-name . args) body*) (define internal-name
(let ([name (lambda args body*)])
name))
(define-syntax-parameter name (define-syntax-parameter name
(syntax-id-rules () (syntax-id-rules ()
[(_ . rest) (inline-name . rest)] [(_ . rest) (inline-name . rest)]
@ -97,25 +99,44 @@
(... (...
(syntax-parse stx* (syntax-parse stx*
[(_ arg*:actual ...) [(_ arg*:actual ...)
;; let*-bind the actuals, to ensure that they're evaluated ;; BEWARE! Catching all contract failures here, on the
;; only once, and in order ;; grounds that the only possible error *should* be
#`(let* ([arg*.tmp arg*.arg] ...) ;; an application of the inlined function to bad arguments:
(syntax-parameterize (with-handlers ([exn:fail:contract?
([name (make-rename-transformer #'internal-name)]) ;; If the arity or keywords are wrong, turn that
#,(let* ([arg-entries (attribute arg*.for-aux)] ;; into a run-time error
[keyword-entries (filter car arg-entries)] (lambda (exn)
[positional-entries (let ([loc (srcloc->string (srcloc (syntax-source stx*)
(filter (lambda (x) (not (car x))) (syntax-line stx*)
arg-entries)] (syntax-column stx*)
[sorted-keyword-entries (syntax-position stx*)
(sort keyword-entries (syntax-span stx*)))])
string<? (log-warning "~aincorrect call to would-be-inlined function: ~s"
#:key (lambda (kw) (if loc (format "~a: " loc) "")
(keyword->string (syntax-e #'name)))
(syntax-e (car kw)))))]) (syntax-parse stx*
(keyword-apply [(_ arg ...)
function-aux (syntax/loc stx*
(map (lambda (x) (syntax-e (car x))) (internal-name arg ...))]))])
sorted-keyword-entries) ;; let*-bind the actuals, to ensure that they're evaluated
(map cadr sorted-keyword-entries) ;; only once, and in order
(map cadr positional-entries)))))])))))])) #`(let* ([arg*.tmp arg*.arg] ...)
(syntax-parameterize
([name (make-rename-transformer #'internal-name)])
#,(let* ([arg-entries (attribute arg*.for-aux)]
[keyword-entries (filter car arg-entries)]
[positional-entries
(filter (lambda (x) (not (car x)))
arg-entries)]
[sorted-keyword-entries
(sort keyword-entries
string<?
#:key (lambda (kw)
(keyword->string
(syntax-e (car kw)))))])
(keyword-apply
function-aux
(map (lambda (x) (syntax-e (car x)))
sorted-keyword-entries)
(map cadr sorted-keyword-entries)
(map cadr positional-entries))))))])))))]))