diff --git a/collects/racket/contract/private/arrow.rkt b/collects/racket/contract/private/arrow.rkt index abffd8c719..dd9d244641 100644 --- a/collects/racket/contract/private/arrow.rkt +++ b/collects/racket/contract/private/arrow.rkt @@ -24,7 +24,8 @@ v4 todo: "prop.rkt" "misc.rkt" "generate.rkt" - racket/stxparam) + racket/stxparam + racket/performance-hint) (require (for-syntax racket/base) (for-syntax "helpers.rkt") (for-syntax syntax/stx) @@ -74,14 +75,7 @@ v4 todo: #,(call-gen #'())] [else #,(call-gen rng-checkers)])))) -(define-syntax (cross-module-inline stx) - (syntax-case stx () - [(_ defn) - (syntax-property #'defn - 'compiler-hint:cross-module-inline - #t)])) - -(cross-module-inline +(begin-encourage-inline (define tail-marks-match? (case-lambda [(m) (and m (null? m))] diff --git a/collects/racket/performance-hint.rkt b/collects/racket/performance-hint.rkt new file mode 100644 index 0000000000..2753b35140 --- /dev/null +++ b/collects/racket/performance-hint.rkt @@ -0,0 +1,24 @@ + +(module inline '#%kernel + (#%require (for-syntax '#%kernel)) + (#%provide begin-encourage-inline) + + ;; Attach a property to encourage the bytecode compiler to inline + ;; functions: + (define-syntaxes (begin-encourage-inline) + (lambda (stx) + (let-values ([(l) (syntax->list stx)]) + (if l + (datum->syntax + stx + (cons + (quote-syntax begin) + (map + (lambda (form) + (syntax-property form + 'compiler-hint:cross-module-inline + #t)) + (cdr l))) + stx + stx) + (raise-syntax-error #f "bad syntax" stx)))))) diff --git a/collects/racket/private/map.rkt b/collects/racket/private/map.rkt index 7e1bef220b..3aadf114d6 100644 --- a/collects/racket/private/map.rkt +++ b/collects/racket/private/map.rkt @@ -5,7 +5,7 @@ (module map '#%kernel (#%require '#%utils ; built into mzscheme "small-scheme.rkt" "define.rkt" - (for-syntax '#%kernel)) + "../performance-hint.rkt") (#%provide (rename map2 map) (rename for-each2 for-each) @@ -14,17 +14,8 @@ ;; ------------------------------------------------------------------------- - ;; Attach a property to encourage the bytecode compiler to inline - ;; `map', etc.: - (define-syntax hint-inline - (lambda (stx) - (syntax-property (cadr (syntax->list stx)) - 'compiler-hint:cross-module-inline - #t))) + (begin-encourage-inline - ;; ------------------------------------------------------------------------- - - (hint-inline (define map2 (let ([map (case-lambda @@ -50,9 +41,8 @@ (loop (cdr l1) (cdr l2)))])) (map f l1 l2))] [(f . args) (apply map f args)])]) - map))) + map)) - (hint-inline (define for-each2 (let ([for-each (case-lambda @@ -78,9 +68,8 @@ (loop (cdr l1) (cdr l2)))])) (for-each f l1 l2))] [(f . args) (apply for-each f args)])]) - for-each))) + for-each)) - (hint-inline (define andmap2 (let ([andmap (case-lambda @@ -110,9 +99,8 @@ (loop (cdr l1) (cdr l2)))]))) (andmap f l1 l2))] [(f . args) (apply andmap f args)])]) - andmap))) + andmap)) - (hint-inline (define ormap2 (let ([ormap (case-lambda diff --git a/collects/scribblings/guide/performance.scrbl b/collects/scribblings/guide/performance.scrbl index ec71674402..964035d4da 100644 --- a/collects/scribblings/guide/performance.scrbl +++ b/collects/scribblings/guide/performance.scrbl @@ -1,6 +1,8 @@ #lang scribble/doc @(require scribble/manual "guide-utils.rkt" - (for-label racket/flonum racket/unsafe/ops)) + (for-label racket/flonum + racket/unsafe/ops + racket/performance-hint)) @title[#:tag "performance"]{Performance} @@ -169,10 +171,8 @@ itself calls functions other than simple primitive operations. When a module is compiled, some functions defined at the module level are determined to be candidates for inlining into other modules; normally, only trivial functions are considered candidates for cross-module -inlining, but a programmer can attach a -@indexed-racket['compiler-hint:cross-module-inline] @tech[#:doc '(lib -"scribblings/reference/reference.scrbl")]{syntax property} (with a -true value) to a function's definition form to encourage inlining +inlining, but a programmer can wrap a function definition with +@racket[begin-encourage-inline] to encourage inlining of the function. Primitive operations like @racket[pair?], @racket[car], and diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index f68413923e..eea6317fb8 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -10,7 +10,8 @@ racket/provide racket/package racket/splicing - racket/runtime-path)) + racket/runtime-path + racket/performance-hint)) @(define require-eval (make-base-eval)) @(define syntax-eval @@ -2084,9 +2085,9 @@ z If a @racket[define-values] form for a function definition in a module body has a @indexed-racket['compiler-hint:cross-module-inline] @tech{syntax property} with a true value, then the Racket treats the -property as a performance hint. See +property as a performance hint. See @guidesecref["func-call-performance"] in @|Guide| for more -information.} +information, and see also @racket[begin-encourage-inline].} @defform*[[(define-syntax id expr) @@ -2591,3 +2592,14 @@ syntactic forms or languages that supply a more limited kind of @close-eval[require-eval] @close-eval[meta-in-eval] + +@;------------------------------------------------------------------------ +@section[#:tag "performance-hint"]{Performance Hints: @racket[begin-encourage-inline]} + +@note-lib-only[racket/performance-hint] + +@defform[(begin-encourage-inline form ...)]{ + +Attaches a @racket['compiler-hint:cross-module-inline] +@tech{syntax property} to each @racket[form], which is useful when a +@racket[form] is a function definition. See @racket[define-values].} diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index f5cdb749e1..e53aa60afe 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -1382,16 +1382,16 @@ (null? 10))) (module check-inline-request racket/base + (require racket/performance-hint) (provide loop) - (define loop - (begin - 'compiler-hint:cross-module-inline - ;; large enough that the compiler wouldn't infer inlining: - (lambda (f n) - (let loop ([i n]) - (if (zero? i) - 10 - (cons (f i) (loop (sub1 n))))))))) + (begin-encourage-inline + (define loop + ;; large enough that the compiler wouldn't infer inlining: + (lambda (f n) + (let loop ([i n]) + (if (zero? i) + 10 + (cons (f i) (loop (sub1 n))))))))) (test-comp `(module m racket/base (require 'check-inline-request)