On Tue, Apr 07, 2015 at 10:41:32AM +0200, Felix Winkelmann wrote: > Indeed, I was not trying to make it look otherwise. Apparently Flatt > and Kawei did an excellent job in optimizing their implementations, no > doubt about that.
Or maybe there's some small mistake in our implementation that causes it to retain too much data. I'm not sure of course, just theorizing, because even though it generates a lot of garbage, my gut says it shouldn't need this many major collections. But my gut has been wrong often enough ;) Anyway, if anyone wants to have a crack at it, I've removed the eggs from the benchmark so that it's a bit easier to run and analyze. Find it attached. If anyone wants to add it to the chicken-benchmark repo, I would recommend removing the writing of the output file, as that's really not where the bottleneck is, and writing a file isn't very nice in a benchmark suite. Also, the "(use extras)" can be removed. Finally, the displaying could be killed as well. > But I'm sick and tired of people throwing badly written code into the > net and making gross assumptions about implementation performance. The > possible options, the search-space available is massive and a little > difference in programming style can make a vast difference in > performance. 100% true. However, this seems like a somewhat pathological case of the "functional programming" approach. As such, it's a good benchmark for this type of programming, even if it happens to be a shitty way to write a raytracer ;) > I'm a compiler-writer, my job is to be paranoid about performance. > But otherwise raw speed is in most cases secondary (try to run large > real-world programs on Larceny or Stalin and you know what I mean.) Could you elaborate on that? Does Larceny's compilation time degrade on large programs like Stalin does, so you would have to wait for weeks for your program to compile, or are you referring to the lack of community/infrastructure? > That there are so many implementors in the Lisp and Scheme community > probably makes this irrational emphasis on (execution-time) > performance so apparent in these groups. Or it's the remains of the > trauma of the AI-Winter, I don't know (and I don't care anymore.) > > That is (among a few other reasons) why I don't do much Scheme or Lisp > programming anymore - thinking about the community, reading all this > bullshit makes me sick. That's very sad, because Scheme is such a nice language. Besides, CHICKEN has a nice community so who cares about the trolls? Anyway, I'm happy we got a useful new benchmark out of this, and something to aim for in improving our fantastic compiler. Cheers, Peter
;; Ray tracer for Chicken Scheme. ;; Creates graphic file "junk-trash.ppm". ;; Converted from the original in C at ;; https://wiki.cs.auckland.ac.nz/enggen131/index.php/User:Dols008 ;; ;; This program conses a lot, triggering a huge number of ;; garbage collections, thus it serves as a good GC benchmark. ;; ;; Compile with ;; csc -optimize-level 3 ray-trace.scm (use extras) (define-constant Width 400) (define-constant Height Width) (print Width " x " Height ) (define Start-Time (current-seconds)) (define (square x) (* x x)) (define (add list1 list2) (map + list1 list2)) (define (sub list1 list2) (map - list1 list2)) (define (scale seq n) (map (cut * <> n) seq)) (define (mul list1 list2) (map * list1 list2)) (define (dot list1 list2) (apply + (mul list1 list2))) (define (squared-length alist) (dot alist alist)) (define (normal alist) (let ((len (sqrt (squared-length alist)))) (map (cut / <> len) alist))) (define-record Ray pos dir) (define-record Light pos color) (define-record Sphere pos radius color shine reflect) (define (ray-hit-sphere sphere ray) (let* ((diff (sub (Sphere-pos sphere) (Ray-pos ray))) (proj (dot diff (Ray-dir ray))) (closest (add (Ray-pos ray) (scale (Ray-dir ray) proj))) (tangent (sub closest (Sphere-pos sphere))) (sq-tangent-length (squared-length tangent)) (sq-radius (square (Sphere-radius sphere)))) (if (> sq-tangent-length sq-radius) 0 (- proj (sqrt (- sq-radius sq-tangent-length)))))) (define (calc-lighting pos norm ray sphere light) (let* ((rel (normal (sub (Light-pos light) pos))) (diffuse (max (dot rel norm) 0)) (diff-col (scale (Light-color light) diffuse)) (eye (sub (Ray-pos ray) pos)) (half (normal (add eye rel))) (specular (dot half norm)) (specular (expt (max specular 0) 64)) (spec-col (scale (Light-color light) specular))) (add (mul (Sphere-color sphere) diff-col) (scale spec-col (Sphere-shine sphere))))) (define NUM_SPHERES 7) (define NUM_LIGHTS 3) (define spheres (make-vector NUM_SPHERES )) (define lights (make-vector NUM_LIGHTS )) (define (build-scene) (do ((i 0 (add1 i))) ((= i 5)) (let* ((theta (* 0.4 (- i 2))) (pos (list (* 3 (sin theta)) (* -3 (cos theta)) 5.0))) (vector-set! spheres i (make-Sphere pos 1 '(0.8 0.1 0.1) 0.2 0)))) (vector-set! spheres 5 (make-Sphere '(-3 1 5) 2 '(1 1 0.99) 0.5 1.0 )) (vector-set! spheres 6 (make-Sphere '(3 -3 15) 8 '(0.75 0.5 0) 0.5 1.0 )) (vector-set! lights 0 (make-Light '(2 2 1) '(1 1 1) )) (vector-set! lights 1 (make-Light '(-4 0 5) '(0.1 0.5 0.1)) ) (vector-set! lights 2 (make-Light '(4 0 5) '(0.1 0.5 0.1)))) (define MAX_RECURSION_DEPTH 2) (define (trace ray depth ) (let ((hit #f) (color (list 0 0 0)) (dist 0)) (do ((i 0 (add1 i))) ((= i NUM_SPHERES)) (let ((d (ray-hit-sphere (vector-ref spheres i) ray))) (when (> d 0) (when (or (not hit) (< d dist)) (set! dist d) (set! hit i))))) (if hit (let* ((pos (add (Ray-pos ray) (scale (Ray-dir ray) dist))) (norm (normal (sub pos (Sphere-pos (vector-ref spheres hit)))))) (do ((i 0 (add1 i))) ((= i NUM_LIGHTS)) (set! color (add color (calc-lighting pos norm ray (vector-ref spheres hit) (vector-ref lights i))))) (when (< depth MAX_RECURSION_DEPTH) (let ((reflect-ray (make-Ray pos (sub (Ray-dir ray) (scale norm (* 2 (dot (Ray-dir ray) norm))))))) (set! color (add color (scale (trace reflect-ray (+ 1 depth)) (Sphere-reflect (vector-ref spheres hit))))))) color) (scale (add (Ray-dir ray) '(1 1 1)) 0.125)))) (define r (make-Ray '(0 0 0) '(0 0 0))) (define color '(0 0 0)) (define image '()) (build-scene) (print "-----Rendering------") (do ((y 0 (add1 y))) ((= y Height)) (begin (when (zero? (remainder y (floor (+ 1 (/ Height 20))))) (display "#") ; Progress indicator. (flush-output)) (do ((x 0 (add1 x))) ((= x Width)) (begin (Ray-dir-set! r (normal (list (- (/ x Width) 0.5) (- (- (/ y Height) 0.5)) 0.5))) (set! color (trace r 0)) (set! color (map (lambda (c) (min c 1)) color)) (set! image (cons color image)))))) (print) (print (- (current-seconds) Start-Time) " seconds") (let ((port (open-output-file "junk-trash.ppm" #:binary))) (for-each (cut display <> port) (list "P6\n" Width " " Height "\n255\n")) (let lp ((items (reverse image))) (unless (null? items) (let ((trio (car items))) (for-each (cut write-byte <> port) (map (lambda (x) (inexact->exact (round (* x 255.0)))) trio)) (lp (cdr items))))) (close-output-port port))
signature.asc
Description: Digital signature
_______________________________________________ Chicken-users mailing list Chicken-users@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-users
