bench: first version

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! &times (Array.push-back (Array.copy &times) (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)

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]

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)))
+
 )

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);

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

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