fix: re-add benchmarks (#1166)

examples/benchmark_mandelbrot.carp

@@ -0,0 +1,61 @@
+;;; Taken from
+;;; http://benchmarksgame.alioth.debian.org/u64q/program.php?test=mandelbrot&lang=gcc&id=2
+
+(add-cflag "-pipe -O3 -fomit-frame-pointer -march=native -mfpmath=sse -msse3")
+
+(use Double)
+(use Int)
+(use String)
+(use IO)
+
+(def w 16000.0)
+(def h 16000.0)
+
+(defn main []
+  (do
+    (print &(str* @"P4\n" (str w) @" " (str h) @"\n"))
+    (let-do [iter 50
+             limit 2.0
+             byte_acc 0b
+             bytes []
+             bit_num 0]
+      (for [y 0 (to-int h)]
+        (for [x 0 (to-int w)]
+          (let [Zr 0.0
+                Zi 0.0
+                Tr 0.0
+                Ti 0.0
+                Cr (- (/ (* 2.0 (from-int x)) w) 1.5)
+                Ci (- (/ (* 2.0 (from-int y)) w) 1.0)]
+            (do
+              (let [i 0]
+                (while (and (< i iter)
+                      (<= (+ Tr Ti) (* limit limit)))
+                  (do
+                    (set! Zi (+ (* 2.0 (* Zr Zi)) Ci))
+                    (set! Zr (+ (- Tr Ti) Cr))
+                    (set! Tr (* Zr Zr))
+                    (set! Ti (* Zi Zi))
+                    (set! i (inc i)))))
+
+              (set! byte_acc (* 2b byte_acc))
+
+              (when (<= (+ Tr Ti) (* limit limit))
+                (set! byte_acc (bit-or byte_acc 1b)))
+
+              (set! bit_num (inc bit_num))
+
+              (if (= bit_num 8)
+                (do
+                  (set! bytes (Array.push-back bytes byte_acc))
+                  (set! byte_acc 0b)
+                  (set! bit_num 0))
+                (if (= x (- (to-int w) 1))
+                  (do
+                    (set! byte_acc
+                      (bit-shift-left byte_acc (- 8b (mod (from-int (to-int w)) 8b))))
+                    (set! bytes (Array.push-back bytes byte_acc))
+                    (set! byte_acc 0b)
+                    (set! bit_num 0))
+                  ()))))))
+        (print &(String.from-bytes &bytes)))))

examples/benchmark_n-body.carp

@@ -0,0 +1,159 @@
+;;; Taken from
+;;; http://benchmarksgame.alioth.debian.org/u64q/program.php?test=nbody&lang=gcc&id=1
+
+(add-cflag "-pipe -O3 -fomit-frame-pointer -march=native -mfpmath=sse -msse3")
+
+(use IO)
+(use Double)
+(use Array)
+(use Int)
+
+;;; pow(double, double) is 5 times slower for (pow x 3)
+; int Int_pow(int x, int y) {
+;     int r = 1;
+;     while (y) {
+;         if (y & 1)
+;             r *= x;
+;         y >>= 1;
+;         x *= x;
+;     }
+;     return r;
+; }
+(defn ipow [x y]
+  (let-do [r 1.0]
+    (while (/= y 0)
+      (do
+        (when (/= (bit-and y 1) 0)
+          (set! r (* r x)))
+        (set! y (/ y 2))
+        (set! x (* x x))))
+    r))
+
+(def n 50000000)
+
+(defn solar_mass [] (* (* 4.0 pi) pi)) ;; I cannot #DEFINE, so solar_mass cannot be a `def`
+(def days_per_year 365.24)
+
+(deftype Planet
+  [ x Double y Double z Double
+    vx Double vy Double vz Double
+    mass Double ])
+
+; for eg. 1.03e-03
+(defn e [d exp]
+  (* d (pow 10.0 (from-int exp))))
+
+
+
+; currying would make this a single line
+; + lambdas would make this unneeded
+(defn reduce-px [t b] (+ t (* @(Planet.vx b) @(Planet.mass b))))
+(defn reduce-py [t b] (+ t (* @(Planet.vy b) @(Planet.mass b))))
+(defn reduce-pz [t b] (+ t (* @(Planet.vz b) @(Planet.mass b))))
+
+(defn offset_momentum [bodies]
+  (let [b (unsafe-nth bodies 0)
+        px (reduce &reduce-px 0.0 bodies)
+        py (reduce &reduce-py 0.0 bodies)
+        pz (reduce &reduce-pz 0.0 bodies)]
+    (do
+      (Planet.set-vx! b (/ (neg px) (solar_mass)))
+      (Planet.set-vy! b (/ (neg py) (solar_mass)))
+      (Planet.set-vz! b (/ (neg pz) (solar_mass))))))
+
+
+
+(defn energy [bodies]
+  (let-do [e 0.0]
+    (for [i 0 (length bodies)]
+      (let-do [b (unsafe-nth bodies i)]
+          (set! e (+ e (* 0.5 (* @(Planet.mass b)
+                                  (+ (ipow @(Planet.vx b) 2)
+                                     (+ (ipow @(Planet.vy b) 2)
+                                        (ipow @(Planet.vz b) 2)))))))
+
+          (for [j (+ i 1) (length bodies)]
+            (let [b2 (unsafe-nth bodies j)
+                  dx (- @(Planet.x b) @(Planet.x b2))
+                  dy (- @(Planet.y b) @(Planet.y b2))
+                  dz (- @(Planet.z b) @(Planet.z b2))
+                  dist (sqrt (+ (ipow dx 2) (+ (ipow dy 2) (ipow dz 2))))]
+              (set! e (- e (/ (* @(Planet.mass b) @(Planet.mass b2)) dist)))))))
+      e))
+
+
+(defn update-planet [i bodies dt]
+  (let [b (unsafe-nth bodies i)]
+    (do
+      (Planet.set-x! b (+ @(Planet.x b) (* dt @(Planet.vx b))))
+      (Planet.set-y! b (+ @(Planet.y b) (* dt @(Planet.vy b))))
+      (Planet.set-z! b (+ @(Planet.z b) (* dt @(Planet.vz b)))))))
+
+(defn advance [bodies dt]
+  (do
+    (for [i 0 (length bodies)]
+      (let [b (unsafe-nth bodies i)]
+        (for [j (+ i 1) (length bodies)]
+          (let [b2 (unsafe-nth bodies j)
+                dx (- @(Planet.x b) @(Planet.x b2))
+                dy (- @(Planet.y b) @(Planet.y b2))
+                dz (- @(Planet.z b) @(Planet.z b2))
+                dist (sqrt (+ (ipow dx 2) (+ (ipow dy 2) (ipow dz 2))))
+                mag (/ dt (ipow dist 3))]
+            (do
+              (Planet.set-vx! b (- @(Planet.vx b) (* dx (* @(Planet.mass b2) mag))))
+              (Planet.set-vy! b (- @(Planet.vy b) (* dy (* @(Planet.mass b2) mag))))
+              (Planet.set-vz! b (- @(Planet.vz b) (* dz (* @(Planet.mass b2) mag))))
+
+              (Planet.set-vx! b2 (+ @(Planet.vx b2) (* dx (* @(Planet.mass b) mag))))
+              (Planet.set-vy! b2 (+ @(Planet.vy b2) (* dy (* @(Planet.mass b) mag))))
+              (Planet.set-vz! b2 (+ @(Planet.vz b2) (* dz (* @(Planet.mass b) mag)))))))))
+
+    (for [i 0 (length bodies)]
+      (update-planet i bodies dt))))
+
+; defining bodies outside main (`def`) results in c compile error:
+; - solar mass is a function
+; - i cannot do eg. 1.01e-03
+(defn main []
+  (let-do [bodies [
+          (Planet.init 0.0 0.0 0.0 0.0 0.0 0.0 (solar_mass))
+          (Planet.init                                ; jupiter
+            (e 4.84143144246472090   0)
+            (e -1.16032004402742839  0)
+            (e -1.03622044471123109 -1)
+            (* (e 1.66007664274403694 -3) days_per_year)
+            (* (e 7.69901118419740425 -3) days_per_year)
+            (* (e -6.90460016972063023 -5) days_per_year)
+            (* (e 9.54791938424326609 -4) (solar_mass)))
+          (Planet.init                               ; saturn
+            (e 8.34336671824457987   0)
+            (e 4.12479856412430479   0)
+            (e -4.03523417114321381 -1)
+            (* (e -2.76742510726862411 -3) days_per_year)
+            (* (e 4.99852801234917238 -3) days_per_year)
+            (* (e 2.30417297573763929 -5) days_per_year)
+            (* (e 2.85885980666130812 -4) (solar_mass)))
+          (Planet.init                               ; uranus
+            (e 1.28943695621391310   1)
+            (e -1.51111514016986312  1)
+            (e -2.23307578892655734 -1)
+            (* (e 2.96460137564761618 -3) days_per_year)
+            (* (e 2.37847173959480950 -3) days_per_year)
+            (* (e -2.96589568540237556 -5) days_per_year)
+            (* (e 4.36624404335156298 -5) (solar_mass)))
+          (Planet.init                               ; neptune
+            (e 1.53796971148509165  1)
+            (e -2.59193146099879641 1)
+            (e 1.79258772950371181 -1)
+            (* (e 2.68067772490389322 -3) days_per_year)
+            (* (e 1.62824170038242295 -3) days_per_year)
+            (* (e -9.51592254519715870 -5) days_per_year)
+            (* (e 5.15138902046611451 -5) (solar_mass)))
+        ]]
+      (offset_momentum &bodies)
+      (println &(str (energy &bodies))) ; printf %.9f
+      (for [i 0 n]
+        (do
+          (advance &bodies 0.01)))
+      (println &(str (energy &bodies))))) ;

scripts/run_carp_tests.ps1

@@ -31,6 +31,7 @@ exitOnError { stack exec carp "--" ./examples/mutual_recursion.carp -b }
 exitOnError { stack exec carp "--" ./examples/guessing_game.carp -b }
 exitOnError { stack exec carp "--" ./examples/no_core.carp --no-core --no-profile -b }
 exitOnError { stack exec carp "--" ./examples/check_malloc.carp -b }
+exitOnError { stack exec carp "--" ./examples/benchmark_*.carp -b }
 
 # Generate docs
 exitOnError { stack exec carp "--" ./docs/core/generate_core_docs.carp }

scripts/run_carp_tests.sh

@@ -50,6 +50,7 @@ compileOnlyExamples="\
                    examples/mutual_recursion.carp \
                    examples/guessing_game.carp \
                    examples/unicode.carp \
+                   examples/benchmark_*.carp \
                    examples/nested_lambdas.carp
 "