Changed macros into functions + begin-encourage-inline; drops a few seconds from `images' compile, no measured performance penalty
This commit is contained in:
Neil Toronto
parent
50ad8dac1f
commit
eeb3da0c23
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user