From eeb3da0c231548fdfcbe676c63e70a59cc0f6573 Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Fri, 25 May 2012 14:16:19 +0900 Subject: [PATCH] Changed macros into functions + begin-encourage-inline; drops a few seconds from `images' compile, no measured performance penalty --- .../images/private/deep-flomap-render.rkt | 8 +- collects/images/private/flomap-struct.rkt | 56 +++--- collects/images/private/flomap-transform.rkt | 14 +- collects/images/private/flonum.rkt | 170 +++++++++--------- 4 files changed, 127 insertions(+), 121 deletions(-) diff --git a/collects/images/private/deep-flomap-render.rkt b/collects/images/private/deep-flomap-render.rkt index 3e876d9721..c48e5f6a8b 100644 --- a/collects/images/private/deep-flomap-render.rkt +++ b/collects/images/private/deep-flomap-render.rkt @@ -175,8 +175,8 @@ (define dist (/ (- 0.0 z) tz)) (when (and (dist . >= . 0.0) (dist . < . +inf.0)) ;; transmitted ray intersects with shadow plane at sx sy 0.0 - (define sx (+ 0.5 (fx->fl int-x) (* dist tx))) - (define sy (+ 0.5 (fx->fl int-y) (* dist ty))) + (define sx (+ 0.5 (->fl int-x) (* dist tx))) + (define sy (+ 0.5 (->fl int-y) (* dist ty))) ;; actual transmission proportion (Fresnel's law) (define T (* Ti (transmission-intensity n-dot-l 1.0 η2))) ;; intensity of incident light (Lambert's cosine law) @@ -387,8 +387,8 @@ (define T (* Ti orig-T)) (define R (* Ri (- 1.0 orig-T))) ;; surface coordinates - (define x (+ 0.5 (fx->fl int-x))) - (define y (+ 0.5 (fx->fl int-y))) + (define x (+ 0.5 (->fl int-x))) + (define y (+ 0.5 (->fl int-y))) (define z (flvector-ref z-vs i)) ;; reflection (when (and (Ri . > . 0.0) diff --git a/collects/images/private/flomap-struct.rkt b/collects/images/private/flomap-struct.rkt index 2a0f957266..8c8d0ed983 100644 --- a/collects/images/private/flomap-struct.rkt +++ b/collects/images/private/flomap-struct.rkt @@ -4,6 +4,7 @@ (only-in racket/unsafe/ops unsafe-flvector-ref unsafe-flvector-set! unsafe-fx+) + racket/performance-hint "flonum.rkt") (provide flomap flomap? flomap-values flomap-components flomap-width flomap-height @@ -23,32 +24,33 @@ (* c w h) (flvector-length vs))) (values vs c w h)))) -(: flomap-size (flomap -> (values Nonnegative-Fixnum Nonnegative-Fixnum))) -(define (flomap-size fm) - (match-define (flomap _vs _c w h) fm) - (with-asserts ([w nonnegative-fixnum?] [h nonnegative-fixnum?]) - (values w h))) +(begin-encourage-inline -#;;(: coords->index (Integer Integer Integer Integer Integer -> Fixnum)) -(define (coords->index c w k x y) - (fx+ k (fx* c (fx+ x (fx* y w))))) - -(define-syntax-rule (coords->index c w k x y) - (fx+ k (fx* c (fx+ x (fx* y w))))) - -(: unsafe-flomap-ref (FlVector Integer Integer Integer Integer Integer Integer -> Flonum)) -(define (unsafe-flomap-ref vs c w h k x y) - (cond [(and (x . fx>= . 0) (x . fx< . w) - (y . fx>= . 0) (y . fx< . h)) - (unsafe-flvector-ref vs (coords->index c w k x y))] - [else 0.0])) - -(: flomap-ref (flomap Integer Integer Integer -> Flonum)) -(define (flomap-ref fm k x y) - (match-define (flomap vs c w h) fm) - (unless (and (k . >= . 0) (k . < . c)) - (raise-type-error 'flomap-ref (format "nonnegative fixnum < ~e" c) k)) - (unsafe-flomap-ref vs c w h k x y)) + (: flomap-size (flomap -> (values Nonnegative-Fixnum Nonnegative-Fixnum))) + (define (flomap-size fm) + (match-define (flomap _vs _c w h) fm) + (with-asserts ([w nonnegative-fixnum?] [h nonnegative-fixnum?]) + (values w h))) + + (: coords->index (Integer Integer Integer Integer Integer -> Fixnum)) + (define (coords->index c w k x y) + (fx+ k (fx* c (fx+ x (fx* y w))))) + + (: unsafe-flomap-ref (FlVector Integer Integer Integer Integer Integer Integer -> Flonum)) + (define (unsafe-flomap-ref vs c w h k x y) + (cond [(and (x . fx>= . 0) (x . fx< . w) + (y . fx>= . 0) (y . fx< . h)) + (unsafe-flvector-ref vs (coords->index c w k x y))] + [else 0.0])) + + (: flomap-ref (flomap Integer Integer Integer -> Flonum)) + (define (flomap-ref fm k x y) + (match-define (flomap vs c w h) fm) + (unless (and (k . >= . 0) (k . < . c)) + (raise-type-error 'flomap-ref (format "nonnegative fixnum < ~e" c) k)) + (unsafe-flomap-ref vs c w h k x y)) + + ) ; begin-encourage-inline (: flomap-bilinear-ref (flomap Integer Real Real -> Flonum)) (define (flomap-bilinear-ref fm k x y) @@ -56,8 +58,8 @@ (cond [(and (k . >= . 0) (k . < . c)) (let ([x (- (exact->inexact x) 0.5)] [y (- (exact->inexact y) 0.5)]) - (cond [(and (x . > . -0.5) (x . < . (+ 0.5 (fx->fl w))) - (y . > . -0.5) (y . < . (+ 0.5 (fx->fl h)))) + (cond [(and (x . > . -0.5) (x . < . (+ 0.5 (->fl w))) + (y . > . -0.5) (y . < . (+ 0.5 (->fl h)))) (define floor-x (floor x)) (define floor-y (floor y)) (define x0 (fl->fx floor-x)) diff --git a/collects/images/private/flomap-transform.rkt b/collects/images/private/flomap-transform.rkt index a3635bb392..1b0374fb19 100644 --- a/collects/images/private/flomap-transform.rkt +++ b/collects/images/private/flomap-transform.rkt @@ -109,8 +109,8 @@ (let ([θ (- (exact->inexact θ))]) (define cos-θ (cos θ)) (define sin-θ (sin θ)) - (define x-mid (* 0.5 (fx->fl w))) - (define y-mid (* 0.5 (fx->fl h))) + (define x-mid (* 0.5 (->fl w))) + (define y-mid (* 0.5 (->fl h))) (invertible-2d-function (λ: ([x : Flonum] [y : Flonum]) (let ([x (- x x-mid)] @@ -132,16 +132,16 @@ (define pinch-exp (cond [(pinch . >= . 0.0) pinch] [else (/ pinch (- 1.0 pinch))])) - (define x-mid (* 0.5 (fx->fl w))) - (define y-mid (* 0.5 (fx->fl h))) + (define x-mid (* 0.5 (->fl w))) + (define y-mid (* 0.5 (->fl h))) (define-values (x-scale y-scale) (cond [(x-mid . < . y-mid) (values (/ y-mid x-mid) 1.0)] [(x-mid . > . y-mid) (values 1.0 (/ x-mid y-mid))] [else (values 1.0 1.0)])) - (define fm-radius (* 0.5 (fx->fl (max w h)))) + (define fm-radius (* 0.5 (->fl (max w h)))) (define fm-radius^2 (* radius (sqr fm-radius))) - (define x-max (+ 0.5 (fx->fl w))) - (define y-max (+ 0.5 (fx->fl h))) + (define x-max (+ 0.5 (->fl w))) + (define y-max (+ 0.5 (->fl h))) (λ: ([x : Flonum] [y : Flonum]) (define dx (* (- x x-mid) x-scale)) (define dy (* (- y y-mid) y-scale)) diff --git a/collects/images/private/flonum.rkt b/collects/images/private/flonum.rkt index c26a86ad83..e9d6288609 100644 --- a/collects/images/private/flonum.rkt +++ b/collects/images/private/flonum.rkt @@ -6,7 +6,8 @@ [flvector-set! old:flvector-set!]) (except-in racket/fixnum fl->fx fx->fl) ; these two functions are untyped racket/math - (only-in racket/unsafe/ops unsafe-flvector-set! unsafe-fx+)) + (only-in racket/unsafe/ops unsafe-flvector-set! unsafe-fx+) + racket/performance-hint) (provide (all-defined-out) (except-out (all-from-out racket/flonum @@ -25,89 +26,92 @@ (: flvector-set! (FlVector Integer Flonum -> Void)) (define flvector-set! old:flvector-set!) -(define-syntax (fl->fx stx) - (syntax-case stx () - [(_ x) - (syntax/loc stx - (let ([i (fl->exact-integer x)]) - (with-asserts ([i fixnum?]) - i)))])) - -(define-syntax-rule (fx->fl i) - (->fl i)) - -(define-syntax-rule (flrational? x) - (let: ([x* : Flonum x]) - ;; if x = +nan.0, both tests return #f - (and (x . > . -inf.0) (x . < . +inf.0)))) - -(define-syntax-rule (fl-convex-combination dv sv sa) - (let: ([sa* : Flonum sa]) - (+ (fl* sv sa*) (fl* dv (- 1.0 sa*))))) - -(define-syntax-rule (fl-alpha-blend dca sca sa) - (+ sca (* dca (- 1.0 sa)))) - -(define-syntax-rule (flgaussian x s) - (let*: ([sigma : Flonum s] - [x/s : Flonum (fl/ x sigma)]) - (/ (exp (* -0.5 (* x/s x/s))) - (* (sqrt (* 2.0 pi)) sigma)))) - -(define-syntax-rule (flsigmoid x) - (/ 1.0 (+ 1.0 (exp (fl- 0.0 x))))) - (define-syntax-rule (inline-build-flvector size f) (let: ([n : Integer size]) (with-asserts ([n nonnegative-fixnum?]) - (let: ([vs : FlVector (make-flvector n)]) - (let: loop : FlVector ([i : Nonnegative-Fixnum 0]) - (cond [(i . fx< . n) (unsafe-flvector-set! vs i (f i)) - (loop (unsafe-fx+ i 1))] - [else vs])))))) + (define vs (make-flvector n)) + (let: loop : FlVector ([i : Nonnegative-Fixnum 0]) + (cond [(i . fx< . n) (unsafe-flvector-set! vs i (f i)) + (loop (unsafe-fx+ i 1))] + [else vs]))))) -;; =================================================================================================== -;; 3-vectors - -(define-syntax-rule (fl3dot x1 y1 z1 x2 y2 z2) - (+ (fl* x1 x2) (fl* y1 y2) (fl* z1 z2))) - -(define-syntax (fl3* stx) - (syntax-case stx () - [(_ x y z c) - (syntax/loc stx - (let: ([c* : Flonum c]) - (values (fl* x c*) (fl* y c*) (fl* z c*))))] - [(_ x1 y1 z1 x2 y2 z2) - (syntax/loc stx - (values (fl* x1 x2) (fl* y1 y2) (fl* z1 z2)))])) - -(define-syntax-rule (fl3+ x1 y1 z1 x2 y2 z2) - (values (fl+ x1 x2) (fl+ y1 y2) (fl+ z1 z2))) - -(define-syntax (fl3- stx) - (syntax-case stx () - [(_ x y z) - (syntax/loc stx - (values (fl- 0.0 x) (fl- 0.0 y) (fl- 0.0 z)))] - [(_ x1 y1 z1 x2 y2 z2) - (syntax/loc stx - (values (fl- x1 x2) (fl- y1 y2) (fl- z1 z2)))])) - -(define-syntax-rule (fl3mag^2 x y z) - (let: ([x* : Flonum x] [y* : Flonum y] [z* : Flonum z]) - (+ (* x* x*) (* y* y*) (* z* z*)))) - -(define-syntax-rule (fl3mag x y z) - (flsqrt (fl3mag^2 x y z))) - -(define-syntax-rule (fl3dist x1 y1 z1 x2 y2 z2) - (fl3mag (fl- x1 x2) (fl- y1 y2) (fl- z1 z2))) - -(define-syntax-rule (fl3normalize x y z) - (let: ([x* : Flonum x] [y* : Flonum y] [z* : Flonum z]) - (let: ([d : Flonum (fl3mag x* y* z*)]) - (values (/ x* d) (/ y* d) (/ z* d))))) - -(define-syntax-rule (fl3-half-norm x1 y1 z1 x2 y2 z2) - (fl3normalize (fl+ x1 x2) (fl+ y1 y2) (fl+ z1 z2))) +(begin-encourage-inline + + (: fx->fl (Fixnum -> Flonum)) + (define fx->fl ->fl) + + (: fl->fx (Flonum -> Fixnum)) + (define (fl->fx x) + (define i (fl->exact-integer x)) + (with-asserts ([i fixnum?]) i)) + + (: flrational? (Flonum -> Boolean)) + (define (flrational? x) + ;; if x = +nan.0, both tests return #f + (and (x . > . -inf.0) (x . < . +inf.0))) + + (: fl-convex-combination (Flonum Flonum Flonum -> Flonum)) + (define (fl-convex-combination dv sv sa) + (+ (* sv sa) (* dv (- 1.0 sa)))) + + (: fl-alpha-blend (Flonum Flonum Flonum -> Flonum)) + (define (fl-alpha-blend dca sca sa) + (+ sca (* dca (- 1.0 sa)))) + + (: flgaussian (Flonum Flonum -> Flonum)) + (define (flgaussian x s) + (define x/s (/ x s)) + (/ (exp (* -0.5 (* x/s x/s))) + (* (sqrt (* 2.0 pi)) s))) + + (: flsigmoid (Flonum -> Flonum)) + (define (flsigmoid x) + (/ 1.0 (+ 1.0 (exp (- x))))) + + ;; ================================================================================================= + ;; 3-vectors + + (: fl3dot (Flonum Flonum Flonum Flonum Flonum Flonum -> Flonum)) + (define (fl3dot x1 y1 z1 x2 y2 z2) + (+ (* x1 x2) (* y1 y2) (* z1 z2))) + + (: fl3* (case-> (Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum)) + (Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum)))) + (define fl3* + (case-lambda + [(x y z c) (values (* x c) (* y c) (* z c))] + [(x1 y1 z1 x2 y2 z2) (values (* x1 x2) (* y1 y2) (* z1 z2))])) + + (: fl3+ (Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum))) + (define (fl3+ x1 y1 z1 x2 y2 z2) + (values (+ x1 x2) (+ y1 y2) (+ z1 z2))) + + (: fl3- (case-> (Flonum Flonum Flonum -> (values Flonum Flonum Flonum)) + (Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum)))) + (define fl3- + (case-lambda + [(x y z) (values (- x) (- y) (- z))] + [(x1 y1 z1 x2 y2 z2) (values (- x1 x2) (- y1 y2) (- z1 z2))])) + + (: fl3mag^2 (Flonum Flonum Flonum -> Flonum)) + (define (fl3mag^2 x y z) + (+ (* x x) (* y y) (* z z))) + + (: fl3mag (Flonum Flonum Flonum -> Flonum)) + (define (fl3mag x y z) + (flsqrt (fl3mag^2 x y z))) + + (: fl3dist (Flonum Flonum Flonum Flonum Flonum Flonum -> Flonum)) + (define (fl3dist x1 y1 z1 x2 y2 z2) + (fl3mag (- x1 x2) (- y1 y2) (- z1 z2))) + + (: fl3normalize (Flonum Flonum Flonum -> (values Flonum Flonum Flonum))) + (define (fl3normalize x y z) + (define d (fl3mag x y z)) + (values (/ x d) (/ y d) (/ z d))) + + (: fl3-half-norm (Flonum Flonum Flonum Flonum Flonum Flonum -> (values Flonum Flonum Flonum))) + (define (fl3-half-norm x1 y1 z1 x2 y2 z2) + (fl3normalize (+ x1 x2) (+ y1 y2) (+ z1 z2))) + + ) ; begin-encourage-inline