Move define-inline to racket/performance-hint.
Move begin-encourage-inline to racket/private for dependencies.
This commit is contained in:
Vincent St-Amour
parent
715b0a7be7
commit
18389532e7
|
|
@ -884,6 +884,7 @@ path/s is either such a string or a list of them.
|
|||
"collects/racket/generic.rkt" responsible (asumu stamourv)
|
||||
"collects/racket/match" responsible (samth)
|
||||
"collects/racket/match.rkt" responsible (samth)
|
||||
"collects/racket/performance-hint.rkt" responsible (stamourv) drdr:command-line (raco "test" *)
|
||||
"collects/racket/place" responsible (tewk)
|
||||
"collects/racket/place/distributed/examples/hello-world.rkt" drdr:command-line #f
|
||||
"collects/racket/private/generic.rkt" responsible (asumu stamourv)
|
||||
|
|
@ -1513,12 +1514,10 @@ path/s is either such a string or a list of them.
|
|||
"collects/unstable/automata" responsible (jay)
|
||||
"collects/unstable/debug.rkt" responsible (samth)
|
||||
"collects/unstable/hash.rkt" responsible (samth)
|
||||
"collects/unstable/inline.rkt" responsible (stamourv) drdr:command-line (raco "test" *)
|
||||
"collects/unstable/logging.rkt" responsible (stamourv)
|
||||
"collects/unstable/match.rkt" responsible (samth)
|
||||
"collects/unstable/scribblings/debug.scrbl" responsible (samth)
|
||||
"collects/unstable/scribblings/hash.scrbl" responsible (samth)
|
||||
"collects/unstable/scribblings/inline.scrbl" responsible (stamourv)
|
||||
"collects/unstable/scribblings/logging.scrbl" responsible (stamourv)
|
||||
"collects/unstable/scribblings/match.scrbl" responsible (samth)
|
||||
"collects/unstable/scribblings/sequence.scrbl" responsible (samth)
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
"misc.rkt"
|
||||
"blame.rkt"
|
||||
syntax/location
|
||||
racket/performance-hint
|
||||
racket/private/performance-hint
|
||||
(for-syntax racket/base
|
||||
racket/stxparam-exptime
|
||||
"arr-i-parse.rkt"
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ v4 todo:
|
|||
"misc.rkt"
|
||||
"generate.rkt"
|
||||
racket/stxparam
|
||||
racket/performance-hint)
|
||||
racket/private/performance-hint)
|
||||
(require (for-syntax racket/base)
|
||||
(for-syntax "helpers.rkt")
|
||||
(for-syntax syntax/stx)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require "blame.rkt"
|
||||
"generate-base.rkt"
|
||||
racket/performance-hint)
|
||||
racket/private/performance-hint)
|
||||
|
||||
(provide prop:contract
|
||||
contract-struct?
|
||||
|
|
|
|||
|
|
@ -1,24 +1,227 @@
|
|||
#lang racket/base
|
||||
|
||||
(module inline '#%kernel
|
||||
(#%require (for-syntax '#%kernel))
|
||||
(#%provide begin-encourage-inline)
|
||||
(require "private/performance-hint.rkt")
|
||||
|
||||
;; 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))))))
|
||||
;; Note: because of `define-inline''s dependencies, this module is pretty
|
||||
;; heavyweight. If this becomes a problem, we can export a
|
||||
;; `begin-encourage-inline' submodule (that only re-exports
|
||||
;; `begin-encourage-inline'), to make it available without the overhead.
|
||||
|
||||
(provide begin-encourage-inline
|
||||
define-inline)
|
||||
|
||||
(require (for-syntax syntax/parse syntax/define
|
||||
racket/syntax racket/base)
|
||||
racket/stxparam)
|
||||
|
||||
(begin-for-syntax
|
||||
|
||||
(define-splicing-syntax-class actual
|
||||
(pattern (~seq (~optional kw:keyword) arg:expr)
|
||||
#:with tmp (generate-temporary #'arg)
|
||||
#:attr for-aux (list (attribute kw) (attribute tmp))))
|
||||
|
||||
(define-syntax-class formals
|
||||
(pattern () ; done
|
||||
#:with aux-args #'()
|
||||
#:with ids #'()
|
||||
#:with rest-arg #'()) ; rest-arg is () for no rest arg or (id)
|
||||
(pattern rest:id
|
||||
#:with aux-args #'rest
|
||||
#:with ids #'()
|
||||
#:with rest-arg #'(rest))
|
||||
(pattern (x:id . rest:formals)
|
||||
#:with aux-args #'(x . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)
|
||||
(pattern ([x:id default:expr] . rest:formals)
|
||||
;; for aux-args, wrap defaults in syntax
|
||||
#:with aux-args #'([x #'default] . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)
|
||||
(pattern (kw:keyword x:id . rest:formals)
|
||||
#:with aux-args #'(kw x . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)
|
||||
(pattern (kw:keyword [x:id default:expr] . rest:formals)
|
||||
#:with aux-args #'(kw [x #'default] . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)))
|
||||
|
||||
(define-syntax (define-inline stx)
|
||||
(syntax-parse stx
|
||||
[(_ (name . formals) . body)
|
||||
(define-values (name lam) (normalize-definition stx #'lambda #t #t))
|
||||
(syntax-parse lam
|
||||
[(_ args . body)
|
||||
#`(define-inline-helper (#,name . args) . body)])]
|
||||
[_
|
||||
(raise-syntax-error
|
||||
'define-inline "only supports definitions with function headers" stx)]))
|
||||
|
||||
(define-syntax (define-inline-helper stx)
|
||||
(syntax-parse stx
|
||||
[(_ (name:id . args:formals) . body)
|
||||
(with-syntax* ([internal-name (format-id #'name "~a-internal" #'name)]
|
||||
[inline-name (format-id #'name "~a-inline" #'name)]
|
||||
[function-aux (format-id #'name "~a-aux" #'name)]
|
||||
[(arg-id ...) #'args.ids]
|
||||
[(rest-arg-id ...) #'args.rest-arg]
|
||||
[(tmp-arg-id ...) (generate-temporaries #'(arg-id ...))]
|
||||
[(tmp-rest-arg-id ...)
|
||||
(generate-temporaries #'(rest-arg-id ...))]
|
||||
[body*
|
||||
#'(let-syntax ([name (make-rename-transformer
|
||||
(quote-syntax internal-name))])
|
||||
. body)])
|
||||
#`(begin
|
||||
;; define a function version that recursive calls fall back to, to
|
||||
;; avoid infinite expansion
|
||||
(define (internal-name . args) body*)
|
||||
(define-syntax-parameter name
|
||||
(syntax-id-rules ()
|
||||
[(_ . rest) (inline-name . rest)]
|
||||
[_ internal-name])) ; higher-order use
|
||||
(define-syntax (inline-name stx*)
|
||||
;; generate a compile-time function that takes care of linking
|
||||
;; formals and actuals (so we don't have to handle keyword
|
||||
;; arguments manually)
|
||||
(define (function-aux . args.aux-args)
|
||||
;; default values for optional arguments can refer to previous
|
||||
;; arguments, which makes things tricky
|
||||
(with-syntax* ([tmp-arg-id arg-id] ...
|
||||
[tmp-rest-arg-id rest-arg-id] ...)
|
||||
#'(let* ([arg-id tmp-arg-id] ...
|
||||
[rest-arg-id
|
||||
(list . tmp-rest-arg-id)] ...)
|
||||
body*)))
|
||||
(...
|
||||
(syntax-parse stx*
|
||||
[(_ arg*:actual ...)
|
||||
;; let*-bind the actuals, to ensure that they're evaluated
|
||||
;; only once, and in order
|
||||
#`(syntax-parameterize
|
||||
([name (make-rename-transformer #'internal-name)])
|
||||
(let* ([arg*.tmp arg*.arg] ...)
|
||||
#,(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 kw))))])
|
||||
(keyword-apply
|
||||
function-aux
|
||||
(map (lambda (x) (syntax-e (car x)))
|
||||
sorted-keyword-entries)
|
||||
(map cadr sorted-keyword-entries)
|
||||
(map cadr positional-entries)))))])))))]))
|
||||
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
;; Compares output to make sure that things are evaluated the right number of
|
||||
;; times, and in the right order.
|
||||
(define-syntax-rule (test/output expr res out)
|
||||
(let ()
|
||||
(define str (open-output-string))
|
||||
(check-equal? (parameterize ([current-output-port str]) expr) res)
|
||||
(check-equal? (get-output-string str) out)))
|
||||
|
||||
(define-inline (f x)
|
||||
(+ x x))
|
||||
(test/output (f (begin (display "arg1") 1)) 2 "arg1")
|
||||
|
||||
(define-inline (f2 x y)
|
||||
(+ x y))
|
||||
(test/output (f2 (begin (display "arg1") 1) (begin (display "arg2") 1))
|
||||
2 "arg1arg2")
|
||||
|
||||
(define-inline (g #:x [x 0])
|
||||
(f x))
|
||||
(test/output (g #:x (begin (display "arg1") 1)) 2 "arg1")
|
||||
(test/output (g) 0 "")
|
||||
|
||||
(define-inline (h #:x x)
|
||||
(f x))
|
||||
(test/output (h #:x (begin (display "arg1") 1)) 2 "arg1")
|
||||
|
||||
(define-inline (i [x 0])
|
||||
(f x))
|
||||
(test/output (i (begin (display "arg1") 1)) 2 "arg1")
|
||||
(test/output (i) 0 "")
|
||||
|
||||
(define-inline (j x #:y [y 0])
|
||||
(+ x y))
|
||||
(test/output (j (begin (display "arg1") 1) #:y (begin (display "arg2") 2))
|
||||
3 "arg1arg2")
|
||||
(test/output (j #:y (begin (display "arg1") 2) (begin (display "arg2") 1))
|
||||
3 "arg1arg2")
|
||||
(test/output (j (begin (display "arg1") 1)) 1 "arg1")
|
||||
|
||||
(define-inline (k x [y x])
|
||||
(+ x y))
|
||||
(test/output (k (begin (display "arg1") 1) (begin (display "arg2") 2))
|
||||
3 "arg1arg2")
|
||||
(test/output (k (begin (display "arg1") 1)) 2 "arg1")
|
||||
|
||||
(define-inline (l . x)
|
||||
(+ (apply + x) (apply + x)))
|
||||
(test/output (l (begin (display "arg1") 1) (begin (display "arg2") 2))
|
||||
6 "arg1arg2")
|
||||
|
||||
(define-inline (l2 y . x)
|
||||
(+ y y (apply + x) (apply + x)))
|
||||
(test/output (l2 (begin (display "arg0") 3)
|
||||
(begin (display "arg1") 1)
|
||||
(begin (display "arg2") 2))
|
||||
12 "arg0arg1arg2")
|
||||
|
||||
(define-inline (l3 y [z 0] . x)
|
||||
(+ y y z z z (apply + x) (apply + x)))
|
||||
(test/output (l3 (begin (display "arg0") 3)
|
||||
(begin (display "arg1") 1)
|
||||
(begin (display "arg2") 2))
|
||||
13 "arg0arg1arg2")
|
||||
(test/output (l3 (begin (display "arg0") 3))
|
||||
6 "arg0")
|
||||
|
||||
(define-inline (l4 #:x [x 0] . y)
|
||||
(+ x x x (apply + y) (apply + y)))
|
||||
(test/output (l4 #:x (begin (display "arg1") 1))
|
||||
3 "arg1")
|
||||
(test/output (l4 #:x (begin (display "arg1") 1)
|
||||
(begin (display "arg2") 2)
|
||||
(begin (display "arg3") 3))
|
||||
13 "arg1arg2arg3")
|
||||
(test/output (l4 (begin (display "arg2") 2)
|
||||
(begin (display "arg3") 3))
|
||||
10 "arg2arg3")
|
||||
|
||||
;; test for function fallback (recursion)
|
||||
(define-inline (sum . l)
|
||||
(if (null? l) 0 (+ (car l) (apply sum (cdr l)))))
|
||||
(check-equal? (sum 1 2 3 4) 10)
|
||||
|
||||
;; higher-order use
|
||||
(define-inline (add2 x)
|
||||
(+ x 2))
|
||||
(check-equal? (add2 3) 5)
|
||||
(check-equal? (map add2 '(1 2 3)) '(3 4 5))
|
||||
|
||||
;; currying syntax
|
||||
(define-inline ((adder x) y) (+ x y))
|
||||
(test/output (let ([add2 (adder (begin (display "arg1") 2))])
|
||||
(+ (add2 (begin (display "arg2") 1))
|
||||
(add2 (begin (display "arg2") 2))))
|
||||
7 "arg1arg2arg2")
|
||||
|
||||
(define-inline (even? x) (if (zero? x) #t (odd? (sub1 x))))
|
||||
(define-inline (odd? x) (if (zero? x) #f (even? (sub1 x))))
|
||||
(check-equal? (odd? 2) #f)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
(module map '#%kernel
|
||||
(#%require '#%utils ; built into mzscheme
|
||||
"small-scheme.rkt" "define.rkt"
|
||||
"../performance-hint.rkt")
|
||||
"performance-hint.rkt")
|
||||
|
||||
(#%provide (rename map2 map)
|
||||
(rename for-each2 for-each)
|
||||
|
|
|
|||
24
collects/racket/private/performance-hint.rkt
Normal file
24
collects/racket/private/performance-hint.rkt
Normal file
|
|
@ -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))))))
|
||||
|
|
@ -2789,6 +2789,26 @@ 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].}
|
||||
|
||||
@defform*/subs[[(define-inline id expr)
|
||||
(define-inline (head args) body ...+)]
|
||||
([head id
|
||||
(head args)]
|
||||
[args (code:line arg ...)
|
||||
(code:line arg ... @#,racketparenfont{.} rest-id)]
|
||||
[arg arg-id
|
||||
[arg-id default-expr]
|
||||
(code:line keyword arg-id)
|
||||
(code:line keyword [arg-id default-expr])])]{
|
||||
Like @racket[define], but ensures that the definition will be inlined at its
|
||||
call sites. Recursive calls are not inlined, to avoid infinite inlining.
|
||||
Higher-order uses are supported, but also not inlined.
|
||||
|
||||
@racket[define-inline] may interfere with the Racket compiler's own inlining
|
||||
heuristics, and should only be used when other inlining attempts (such as
|
||||
@racket[begin-encourage-inline]) fail.
|
||||
}
|
||||
|
||||
|
||||
@;------------------------------------------------------------------------
|
||||
@section[#:tag "lazy-require"]{Importing Modules Lazily: @racket[lazy-require]}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,219 +0,0 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-syntax syntax/parse syntax/define
|
||||
racket/syntax racket/base)
|
||||
racket/stxparam)
|
||||
|
||||
(provide define-inline)
|
||||
|
||||
(begin-for-syntax
|
||||
|
||||
(define-splicing-syntax-class actual
|
||||
(pattern (~seq (~optional kw:keyword) arg:expr)
|
||||
#:with tmp (generate-temporary #'arg)
|
||||
#:attr for-aux (list (attribute kw) (attribute tmp))))
|
||||
|
||||
(define-syntax-class formals
|
||||
(pattern () ; done
|
||||
#:with aux-args #'()
|
||||
#:with ids #'()
|
||||
#:with rest-arg #'()) ; rest-arg is () for no rest arg or (id)
|
||||
(pattern rest:id
|
||||
#:with aux-args #'rest
|
||||
#:with ids #'()
|
||||
#:with rest-arg #'(rest))
|
||||
(pattern (x:id . rest:formals)
|
||||
#:with aux-args #'(x . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)
|
||||
(pattern ([x:id default:expr] . rest:formals)
|
||||
;; for aux-args, wrap defaults in syntax
|
||||
#:with aux-args #'([x #'default] . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)
|
||||
(pattern (kw:keyword x:id . rest:formals)
|
||||
#:with aux-args #'(kw x . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)
|
||||
(pattern (kw:keyword [x:id default:expr] . rest:formals)
|
||||
#:with aux-args #'(kw [x #'default] . rest.aux-args)
|
||||
#:with ids #'(x . rest.ids)
|
||||
#:with rest-arg #'rest.rest-arg)))
|
||||
|
||||
(define-syntax (define-inline stx)
|
||||
(syntax-parse stx
|
||||
[(_ (name . formals) . body)
|
||||
(define-values (name lam) (normalize-definition stx #'lambda #t #t))
|
||||
(syntax-parse lam
|
||||
[(_ args . body)
|
||||
#`(define-inline-helper (#,name . args) . body)])]
|
||||
[_
|
||||
(raise-syntax-error
|
||||
'define-inline "only supports definitions with function headers" stx)]))
|
||||
|
||||
(define-syntax (define-inline-helper stx)
|
||||
(syntax-parse stx
|
||||
[(_ (name:id . args:formals) . body)
|
||||
(with-syntax* ([internal-name (format-id #'name "~a-internal" #'name)]
|
||||
[inline-name (format-id #'name "~a-inline" #'name)]
|
||||
[function-aux (format-id #'name "~a-aux" #'name)]
|
||||
[(arg-id ...) #'args.ids]
|
||||
[(rest-arg-id ...) #'args.rest-arg]
|
||||
[(tmp-arg-id ...) (generate-temporaries #'(arg-id ...))]
|
||||
[(tmp-rest-arg-id ...)
|
||||
(generate-temporaries #'(rest-arg-id ...))]
|
||||
[body*
|
||||
#'(let-syntax ([name (make-rename-transformer
|
||||
(quote-syntax internal-name))])
|
||||
. body)])
|
||||
#`(begin
|
||||
;; define a function version that recursive calls fall back to, to
|
||||
;; avoid infinite expansion
|
||||
(define (internal-name . args) body*)
|
||||
(define-syntax-parameter name
|
||||
(syntax-id-rules ()
|
||||
[(_ . rest) (inline-name . rest)]
|
||||
[_ internal-name])) ; higher-order use
|
||||
(define-syntax (inline-name stx*)
|
||||
;; generate a compile-time function that takes care of linking
|
||||
;; formals and actuals (so we don't have to handle keyword
|
||||
;; arguments manually)
|
||||
(define (function-aux . args.aux-args)
|
||||
;; default values for optional arguments can refer to previous
|
||||
;; arguments, which makes things tricky
|
||||
(with-syntax* ([tmp-arg-id arg-id] ...
|
||||
[tmp-rest-arg-id rest-arg-id] ...)
|
||||
#'(let* ([arg-id tmp-arg-id] ...
|
||||
[rest-arg-id
|
||||
(list . tmp-rest-arg-id)] ...)
|
||||
body*)))
|
||||
(...
|
||||
(syntax-parse stx*
|
||||
[(_ arg*:actual ...)
|
||||
;; let*-bind the actuals, to ensure that they're evaluated
|
||||
;; only once, and in order
|
||||
#`(syntax-parameterize
|
||||
([name (make-rename-transformer #'internal-name)])
|
||||
(let* ([arg*.tmp arg*.arg] ...)
|
||||
#,(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 kw))))])
|
||||
(keyword-apply
|
||||
function-aux
|
||||
(map (lambda (x) (syntax-e (car x)))
|
||||
sorted-keyword-entries)
|
||||
(map cadr sorted-keyword-entries)
|
||||
(map cadr positional-entries)))))])))))]))
|
||||
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
;; Compares output to make sure that things are evaluated the right number of
|
||||
;; times, and in the right order.
|
||||
(define-syntax-rule (test/output expr res out)
|
||||
(let ()
|
||||
(define str (open-output-string))
|
||||
(check-equal? (parameterize ([current-output-port str]) expr) res)
|
||||
(check-equal? (get-output-string str) out)))
|
||||
|
||||
(define-inline (f x)
|
||||
(+ x x))
|
||||
(test/output (f (begin (display "arg1") 1)) 2 "arg1")
|
||||
|
||||
(define-inline (f2 x y)
|
||||
(+ x y))
|
||||
(test/output (f2 (begin (display "arg1") 1) (begin (display "arg2") 1))
|
||||
2 "arg1arg2")
|
||||
|
||||
(define-inline (g #:x [x 0])
|
||||
(f x))
|
||||
(test/output (g #:x (begin (display "arg1") 1)) 2 "arg1")
|
||||
(test/output (g) 0 "")
|
||||
|
||||
(define-inline (h #:x x)
|
||||
(f x))
|
||||
(test/output (h #:x (begin (display "arg1") 1)) 2 "arg1")
|
||||
|
||||
(define-inline (i [x 0])
|
||||
(f x))
|
||||
(test/output (i (begin (display "arg1") 1)) 2 "arg1")
|
||||
(test/output (i) 0 "")
|
||||
|
||||
(define-inline (j x #:y [y 0])
|
||||
(+ x y))
|
||||
(test/output (j (begin (display "arg1") 1) #:y (begin (display "arg2") 2))
|
||||
3 "arg1arg2")
|
||||
(test/output (j #:y (begin (display "arg1") 2) (begin (display "arg2") 1))
|
||||
3 "arg1arg2")
|
||||
(test/output (j (begin (display "arg1") 1)) 1 "arg1")
|
||||
|
||||
(define-inline (k x [y x])
|
||||
(+ x y))
|
||||
(test/output (k (begin (display "arg1") 1) (begin (display "arg2") 2))
|
||||
3 "arg1arg2")
|
||||
(test/output (k (begin (display "arg1") 1)) 2 "arg1")
|
||||
|
||||
(define-inline (l . x)
|
||||
(+ (apply + x) (apply + x)))
|
||||
(test/output (l (begin (display "arg1") 1) (begin (display "arg2") 2))
|
||||
6 "arg1arg2")
|
||||
|
||||
(define-inline (l2 y . x)
|
||||
(+ y y (apply + x) (apply + x)))
|
||||
(test/output (l2 (begin (display "arg0") 3)
|
||||
(begin (display "arg1") 1)
|
||||
(begin (display "arg2") 2))
|
||||
12 "arg0arg1arg2")
|
||||
|
||||
(define-inline (l3 y [z 0] . x)
|
||||
(+ y y z z z (apply + x) (apply + x)))
|
||||
(test/output (l3 (begin (display "arg0") 3)
|
||||
(begin (display "arg1") 1)
|
||||
(begin (display "arg2") 2))
|
||||
13 "arg0arg1arg2")
|
||||
(test/output (l3 (begin (display "arg0") 3))
|
||||
6 "arg0")
|
||||
|
||||
(define-inline (l4 #:x [x 0] . y)
|
||||
(+ x x x (apply + y) (apply + y)))
|
||||
(test/output (l4 #:x (begin (display "arg1") 1))
|
||||
3 "arg1")
|
||||
(test/output (l4 #:x (begin (display "arg1") 1)
|
||||
(begin (display "arg2") 2)
|
||||
(begin (display "arg3") 3))
|
||||
13 "arg1arg2arg3")
|
||||
(test/output (l4 (begin (display "arg2") 2)
|
||||
(begin (display "arg3") 3))
|
||||
10 "arg2arg3")
|
||||
|
||||
;; test for function fallback (recursion)
|
||||
(define-inline (sum . l)
|
||||
(if (null? l) 0 (+ (car l) (apply sum (cdr l)))))
|
||||
(check-equal? (sum 1 2 3 4) 10)
|
||||
|
||||
;; higher-order use
|
||||
(define-inline (add2 x)
|
||||
(+ x 2))
|
||||
(check-equal? (add2 3) 5)
|
||||
(check-equal? (map add2 '(1 2 3)) '(3 4 5))
|
||||
|
||||
;; currying syntax
|
||||
(define-inline ((adder x) y) (+ x y))
|
||||
(test/output (let ([add2 (adder (begin (display "arg1") 2))])
|
||||
(+ (add2 (begin (display "arg2") 1))
|
||||
(add2 (begin (display "arg2") 2))))
|
||||
7 "arg1arg2arg2")
|
||||
|
||||
(define-inline (even? x) (if (zero? x) #t (odd? (sub1 x))))
|
||||
(define-inline (odd? x) (if (zero? x) #f (even? (sub1 x))))
|
||||
(check-equal? (odd? 2) #f)
|
||||
)
|
||||
|
|
@ -1,34 +0,0 @@
|
|||
#lang scribble/doc
|
||||
@(require scribble/base
|
||||
scribble/manual
|
||||
"utils.rkt"
|
||||
(for-label unstable/inline
|
||||
racket/contract
|
||||
racket/base
|
||||
racket/performance-hint))
|
||||
|
||||
@title[#:tag "inline"]{Inlining}
|
||||
@unstable-header[]
|
||||
|
||||
@defmodule[unstable/inline]
|
||||
|
||||
@addition{Vincent St-Amour}
|
||||
|
||||
@defform*/subs[[(define-inline id expr)
|
||||
(define-inline (head args) body ...+)]
|
||||
([head id
|
||||
(head args)]
|
||||
[args (code:line arg ...)
|
||||
(code:line arg ... @#,racketparenfont{.} rest-id)]
|
||||
[arg arg-id
|
||||
[arg-id default-expr]
|
||||
(code:line keyword arg-id)
|
||||
(code:line keyword [arg-id default-expr])])]{
|
||||
Like @racket[define], but ensures that the definition will be inlined at its
|
||||
call sites. Recursive calls are not inlined, to avoid infinite inlining.
|
||||
Higher-order uses are supported, but also not inlined.
|
||||
|
||||
@racket[define-inline] may interfere with the Racket compiler's own inlining
|
||||
heuristics, and should only be used when other inlining attempts (such as
|
||||
@racket[begin-encourage-inline]) fail.
|
||||
}
|
||||
|
|
@ -87,7 +87,6 @@ Keep documentation and tests up to date.
|
|||
@include-section["future.scrbl"]
|
||||
@include-section["function.scrbl"]
|
||||
@include-section["hash.scrbl"]
|
||||
@include-section["inline.scrbl"]
|
||||
@include-section["class-iop.scrbl"] ;; Interface-oriented Programming
|
||||
@include-section["lazy-require.scrbl"]
|
||||
@include-section["list.scrbl"]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user