mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
fix: re-add benchmarks (#1166)
This commit is contained in:
parent
3fd04c15a1
commit
c52dae9417
61
examples/benchmark_mandelbrot.carp
Normal file
61
examples/benchmark_mandelbrot.carp
Normal file
@ -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)))))
|
159
examples/benchmark_n-body.carp
Normal file
159
examples/benchmark_n-body.carp
Normal file
@ -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))))) ;
|
@ -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 }
|
||||
|
@ -50,6 +50,7 @@ compileOnlyExamples="\
|
||||
examples/mutual_recursion.carp \
|
||||
examples/guessing_game.carp \
|
||||
examples/unicode.carp \
|
||||
examples/benchmark_*.carp \
|
||||
examples/nested_lambdas.carp
|
||||
"
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user