diff --git a/core/Bench.carp b/core/Bench.carp index b236075d..caa966dd 100644 --- a/core/Bench.carp +++ b/core/Bench.carp @@ -1,60 +1,86 @@ -(defmodule Bench - (system-include "bench.h") +(system-include "bench.h") +(register get-time-elapsed (Fn [] Double)) - (register get-time-elapsed (Fn [] Double)) +(defmodule Bench (defn get-unit [n] (cond - (> n 1000.0) (String.append (Double.str n) "µs") - (> n 1000000.0) (String.append (Double.str (/ n 1000.0)) "ms") - (> n 1000000000.0) (String.append (Double.str (/ n 1000000.0)) "s") - (String.append (Double.str (/ n 1000000000.0)) "s"))) + (< n 1000.0) (String.append (Double.str n) @"µs") + (< n 1000000.0) (String.append (Double.str (/ n 1000.0)) @"ms") + (< n 1000000000.0) (String.append (Double.str (/ n 1000000.0)) @"s") + (String.append (Double.str (/ n 1000000000.0)) @"s"))) (defn print [title n] (let [unit (get-unit n)] (do - (IO.println title) + (IO.print title) (IO.println &unit)))) - (defn ns-iter-inner [f k] + (defn ns-iter-inner [f n] (let [start (get-time-elapsed)] (do - (for [i 0 n] (f)) - (Double.- (Bench.get-time-elapsed) before)))) - - (defn dbl-cmp [a b] - (Double.- a b)) - - (defn winsorize [samples pct] - (let [tmp (Array.sort samples dbl-cmp) - ; and now? - )) + (for [i 0 n] + (let [x (f)] ; this little trick guarantees that f can be any snippet and return whatever + ())) + (Double.- (get-time-elapsed) start)))) (defn bench [f] (let [ns (ns-iter-inner f 1) ns-target-total 1000000.0 - n (Double./ ns-target-total (if (> 1 ns) 1 ns)) - n (if (> 1 n) 1 n) - total 0 - samples []] - (while (< total 3000000000) - (let [loop-start (get-time-elapsed)] - (do - (for [i 0 50] - (set! &samples &(Array.push-back (Double./ (ns-iter-inner f n) n)))) - ; and now? - )))))) + _n (Double./ ns-target-total (if (> 1.0 ns) 1.0 ns)) + n (if (> 1.0 _n) 1.0 _n) + total 0.0 + zero 0.0 + samples (Array.replicate 50 &zero) + done false + res &(Statistics.summary &[0.0])] + (do + (while (and (Double.< total 3000000000.0) (not done)) + (let [loop-start (get-time-elapsed)] + (do + (for [i 0 50] + (Array.aset! &samples i (Double./ (ns-iter-inner f (Double.to-int n)) n))) + (let [summ (Statistics.summary &(Statistics.winsorize &samples 5.0))] + (do + (for [i 0 50] + (Array.aset! &samples i (Double./ (ns-iter-inner f (Double.to-int n)) n))) + (let [summ5 (Statistics.summary &(Statistics.winsorize &samples 5.0))] + (let [loop-run (- (get-time-elapsed) loop-start)] + (if (and + (Double.> loop-run 100000.0) + (and + (Double.< (Statistics.Summary.median-abs-dev-pct &summ) 1.0) + (Double.< (Double.- (Statistics.Summary.median &summ) + (Statistics.Summary.median &summ5)) + (Statistics.Summary.median-abs-dev &summ5)))) + (do + (set! &done true) + (set! &res &summ5)) + (do + (set! &total (Double.+ total loop-run)) + (cond + (< (Double.* n 10.0) n) (set! &total (Double.+ total 30000000000.0)) ; abort + (set! &n (Double.* n 2.0)))))))))))) + (if done + (do + (print "Total time elapsed: " total) + (print "Best case: " (Statistics.Summary.min res)) + (print "Worst case: " (Statistics.Summary.max res)) + (print "Standard deviation: " (Statistics.Summary.stdev res))) + (IO.println "Could not stabilize benchmark after 3 seconds!"))))) +) + (defmacro benchn [n form] - (list 'let ['before (Bench.get-time-elapsed) + (list 'let ['before (get-time-elapsed) 'times []] (list 'do (list 'for ['i 0 n] - (list 'let ['before-once (Bench.get-time-elapsed)] + (list 'let ['before-once (get-time-elapsed)] (list 'do form (list 'set! × (Array.push-back (Array.copy ×) (Double.- (get-time-elapsed) before-once)))))) - (list 'let ['total (Double.- (Bench.get-time-elapsed) before) + (list 'let ['total (Double.- (get-time-elapsed) before) 'per (list 'Double./ 'total (list 'Double.from-int n))] (do (Bench.print "Total time elapsed: " total) diff --git a/core/Double.carp b/core/Double.carp index 65b9b26b..fab587bb 100644 --- a/core/Double.carp +++ b/core/Double.carp @@ -15,6 +15,7 @@ (register atan2 (Fn [Double Double] Double)) (register sqrt (Fn [Double] Double)) (register str (Fn [Double] String)) + (register floor (Fn [Double] Double)) (register copy (Fn [(Ref Double)] Double)) (defn clamp [min, max, val] diff --git a/core/Statistics.carp b/core/Statistics.carp index eeee48f1..b8fd2f09 100644 --- a/core/Statistics.carp +++ b/core/Statistics.carp @@ -2,6 +2,21 @@ (use Double) (defmodule Statistics + (deftype Summary [ + sum Double, + min Double, + max Double, + mean Double, + median Double, + var Double, + stdev Double, + stdev-pct Double, + median-abs-dev Double, + median-abs-dev-pct Double, + quartiles (Array Double), + iqr Double + ]) + (defn sorter [a b] (to-int (- @a @b))) @@ -110,4 +125,78 @@ (defn pstdev [data] (Double.sqrt (pvariance data))) + + (defn stdev-pct [data] + (* (/ (stdev data) (mean data)) 100.0)) + + (defn median-abs-dev [data] + (let [med (median data) + zero 0.0 + abs-devs (Array.replicate (Array.count data) &zero) + n 1.4826] ; taken from Rust and R, because that’s how it’s done apparently + (do + (for [i 0 (Array.count data)] + (Array.aset! &abs-devs i (- med @(Array.nth data i)))) + (* (median &abs-devs) n)))) + + (defn median-abs-dev-pct [data] + (* (/ (median-abs-dev data) (median data)) 100.0)) + + (defn percentile-of-sorted [sorted pct] + (cond + (Int.= 0 (Array.count sorted)) -1.0 ; should abort here + (Double.< pct 0.0) -1.0 ; should abort here + (Double.> pct 100.0) -1.0 ; should abort here + (Int.= 1 (Array.count sorted)) @(Array.nth sorted 0) + (Double.= 100.0 pct) @(Array.nth sorted (Int.dec (Array.count sorted))) + (let [len (Int.dec (Array.count sorted)) + rank (Double.* (Double./ pct 100.0) (Double.from-int len)) + lrank (Double.floor rank) + d (Double.- rank lrank) + n (Double.to-int lrank) + lo @(Array.nth sorted n) + hi @(Array.nth sorted (Int.inc n))] + (Double.+ lo (Double.* d (Double.- hi lo)))))) + + (defn quartiles [data] + (let [tmp (Array.sort data sorter) + first 25.0 + second 50.0 + third 75.0 + a (percentile-of-sorted tmp first) + b (percentile-of-sorted tmp second) + c (percentile-of-sorted tmp third)] + [a b c])) + + (defn iqr [data] + (let [s &(quartiles data)] + (the Double (- @(Array.nth s 2) @(Array.nth s 0))))) + + (defn winsorize [samples pct] + (let [tmp (the (Ref (Array Double)) (Array.sort samples sorter)) + lo (Statistics.percentile-of-sorted tmp pct) + hi (Statistics.percentile-of-sorted tmp (Double.- 100.0 pct))] + (do + (for [i 0 (Array.count tmp)] + (let [samp @(Array.nth tmp i)] + (cond + (> samp hi) (Array.aset! tmp i hi) + (< samp lo) (Array.aset! tmp i lo)))) + (Array.copy tmp)))) + + (defn summary [samples] + (Summary.init + (sum samples) + (min samples) + (max samples) + (mean samples) + (median samples) + (variance samples) + (stdev samples) + (stdev-pct samples) + (median-abs-dev samples) + (median-abs-dev-pct samples) + (quartiles samples) + (iqr samples))) + ) diff --git a/core/prelude.h b/core/prelude.h index 06cd85a0..24378069 100644 --- a/core/prelude.h +++ b/core/prelude.h @@ -262,6 +262,10 @@ double Double_atan2(double x, double y) { return atan2(x, y); } +double Double_floor(double x) { + return floor(x); +} + string Double_str(double x) { char *buffer = CARP_MALLOC(32); snprintf(buffer, 32, "%g", x); diff --git a/src/Deftype.hs b/src/Deftype.hs index 117cafc4..1cb4122f 100644 --- a/src/Deftype.hs +++ b/src/Deftype.hs @@ -130,7 +130,7 @@ templateForCopy _ _ _ _ _ = Nothing -- | Get a list of pairs from a deftype declaration. memberXObjsToPairs :: [XObj] -> [(String, Ty)] -memberXObjsToPairs xobjs = map (\(n, t) -> (getName n, fromJust (xobjToTy t))) (pairwise xobjs) +memberXObjsToPairs xobjs = map (\(n, t) -> (mangle (getName n), fromJust (xobjToTy t))) (pairwise xobjs) -- | Generate all the templates for ALL the member variables in a deftype declaration. templatesForMembers :: TypeEnv -> Env -> [String] -> String -> [XObj] -> Maybe ([(String, Binder)], [XObj]) @@ -146,11 +146,11 @@ templatesForSingleMember typeEnv env insidePath typeName (nameXObj, typeXObj) = p = StructTy typeName [] memberName = getName nameXObj fixedMemberTy = if isManaged typeEnv t then (RefTy t) else t - in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [(RefTy p)] fixedMemberTy) (templateGetter memberName fixedMemberTy) - ,instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p) (templateSetter typeEnv env memberName t) + in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [(RefTy p)] fixedMemberTy) (templateGetter (mangle memberName) fixedMemberTy) + ,instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p) (templateSetter typeEnv env (mangle memberName) t) ,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName)) (FuncTy [p, (FuncTy [t] t)] p) - (templateUpdater memberName)] + (templateUpdater (mangle memberName))] -- | The template for the 'init' and 'new' functions for a deftype. templateInit :: AllocationMode -> String -> [(String, Ty)] -> Template diff --git a/src/Emit.hs b/src/Emit.hs index 6aacc6f8..c0f293e8 100644 --- a/src/Emit.hs +++ b/src/Emit.hs @@ -241,6 +241,7 @@ toC root = emitterSrc (execState (visit 0 root) (EmitterState "")) -- Ref XObj Ref _ _ : value : [] -> + if isNumeric do var <- visit indent value let Just t' = t fresh = mangle (freshVar i) @@ -362,7 +363,7 @@ deftypeToDeclaration path rest = memberToDecl :: (XObj, XObj) -> State EmitterState () memberToDecl (memberName, memberType) = case xobjToTy memberType of - Just t -> appendToSrc (addIndent indent' ++ tyToC t ++ " " ++ getName memberName ++ ";\n") + Just t -> appendToSrc (addIndent indent' ++ tyToC t ++ " " ++ mangle (getName memberName) ++ ";\n") Nothing -> error ("Invalid memberType: " ++ show memberType) -- Note: the names of types are not namespaced