Permalink
Browse files

Changed macros into functions + begin-encourage-inline; drops a few s…

…econds from `images' compile, no measured performance penalty
  • Loading branch information...
1 parent 50ad8da commit eeb3da0c231548fdfcbe676c63e70a59cc0f6573 Neil Toronto committed May 25, 2012
View
8 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)
View
58 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,41 +24,42 @@
(* 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)))
-
-#;;(: 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))
+(begin-encourage-inline
+
+ (: 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)
(match-define (flomap vs c w h) fm)
(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))
View
14 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))
View
172 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]))))))
-
-;; ===================================================================================================
-;; 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)))
+ (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])))))
+
+(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

0 comments on commit eeb3da0

Please sign in to comment.