From 7f6cdf2d96ff1ea4f55efebdaa0769693d4892c0 Mon Sep 17 00:00:00 2001 From: Izaak Walton Date: Tue, 29 Oct 2024 12:38:44 -0700 Subject: [PATCH] Fixed package system, misc fixes --- benchmarking/README.md | 25 +- benchmarking/benchmarking.lisp | 387 +++++++++++------- benchmarking/benchmarks/big-float.lisp | 8 +- benchmarking/benchmarks/fibonacci.lisp | 6 +- .../gabriel-benchmarks/package.lisp | 16 +- .../benchmarks/gabriel-benchmarks/tak.lisp | 3 +- .../benchmarks/gabriel-benchmarks/takl.lisp | 1 + .../benchmarks/gabriel-benchmarks/takr.lisp | 7 +- benchmarking/benchmarks/package.lisp | 26 +- benchmarking/printing.lisp | 64 +-- 10 files changed, 316 insertions(+), 227 deletions(-) diff --git a/benchmarking/README.md b/benchmarking/README.md index 730b26a4..02c5a48e 100644 --- a/benchmarking/README.md +++ b/benchmarking/README.md @@ -10,10 +10,6 @@ Benchmarks can be written in any Coalton project, as long as the package imports or nicknames `#:coalton-benchmarking`. -Benchmarks are attached to the package they are defined in, though they can be reexported to other packages. - -This allows them to be embedded amongst the relevant code, in a standalone suite, or both! - ## Benchmark Settings ### Verbose @@ -53,7 +49,7 @@ Benchmarks can be defined in any Coalton package (that imports or nicknames `#:c Unit)) ;; Defining a Lisp Benchmark -(define-benchmark lisp-stak 1000 ; iterations +(define-benchmark lisp-stak 1000 (fn () (lisp Unit () (lisp-stak 18 12 6) @@ -62,7 +58,7 @@ Benchmarks can be defined in any Coalton package (that imports or nicknames `#:c ## Running individual benchmarks -Individual benchmarks can be run with `#'run-benchmark`, as long as the benchmark is defined. +Individual benchmarks can be run with `#'run-benchmark`, as long as the benchmark is defined in the current package. `#'run-benchmark` returns a `BenchmarkResults` object. @@ -85,7 +81,7 @@ COALTON-BENCHMARKS> (coalton (run-benchmark "tak")) ## Running package benchmarks -Package benchmarks can be run with #'run-package-benchmarks, from any package that imports coalton-benchmarking. +Package benchmarks can be run with `#'run-package-benchmarks`. `#'run-package-benchmarks` returns a `PackageBenchmarkResults` object. @@ -109,14 +105,19 @@ COALTON-BENCHMARKS> (coalton (run-package-benchmarks "coalton-benchmarks/gabriel #.(BENCHMARKRESULTS "LISP-TAK" 1000 83104 83040 65520))) ``` +`#:run-benchmarks` runs the current package's benchmarks. + ## Reexporting package benchmarks -Package benchmarks can be reexported to other packages: +Package benchmarks can be manually run from other packages simply by defining a helper function, as in `#:coalton-benchmarks/gabriel`. ``` -(reexport-benchmarks - "coalton-benchmarks/fibonacci" - "coalton-benchmarks/big-float" - "coalton-benchmarks/gabriel") +(coalton-toplevel + + (define (run-gabriel-benchmarks) + (run-package-benchmarks "coalton-benchmarks/gabriel/tak") + (run-package-benchmarks "coalton-benchmarks/gabriel/takr") + (run-package-benchmarks "coalton-benchmarks/gabriel/stak") + (run-package-benchmarks "coalton-benchmarks/gabriel/takl"))) ``` This is useful for package-per-file projects. diff --git a/benchmarking/benchmarking.lisp b/benchmarking/benchmarking.lisp index 6c050a2a..b3c94020 100644 --- a/benchmarking/benchmarking.lisp +++ b/benchmarking/benchmarking.lisp @@ -10,20 +10,43 @@ (#:iter #:coalton-library/iterator) (#:sys #:coalton-library/system) (#:list #:coalton-library/list) - (#:state #:coalton-library/monad/state)) + (#:state #:coalton-library/monad/state) + (#:math #:coalton-library/math) + (#:seq #:coalton-library/seq)) (:export + + ;; settings/options + #:*verbose-benchmarking* + #:verbose? + #:*benchmark-width* + #:benchmark-width + #:*benchmark-sci-notation* + #:sci-notation? + + #:BenchmarkName + #:Benchmark + #:BenchmarkSuite + + #:add-benchmark-suite + #:find-benchmark-suite + #:current-package + #:ensure-benchmark-suite + + #:add-benchmark + #:package-benchmarks + #:local-benchmarks + #:find-benchmark + #:define-benchmark + #:BenchmarkResults + #:BenchmarkSystem + #:benchmark-system-info #:PackageBenchmarkResults - #:define-benchmark - #:find-benchmark - #:find-package-benchmarks #:run-benchmark #:run-package-benchmarks - - #:import-benchmarks - #:reexport-benchmarks)) + #:run-benchmarks)) (in-package #:coalton-benchmarking/benchmarking) @@ -31,49 +54,163 @@ ;;; Settings/options ;;; -(cl:defvar *coalton-verbose-benchmarking* cl:t - "Toggles whether benchmarking will print to the repl.") +(coalton-toplevel -(cl:defvar *coalton-benchmark-width* 90 - "The width that benchmarks will be printed to.") + (declare *verbose-benchmarking* (Cell Boolean)) + (define *verbose-benchmarking* + "When true, benchmarks will print to the repl in addition to returning a BenchmarkResults object." + (cell:new True)) -(cl:defvar *coalton-benchmark-sci-notation* cl:t - "Coalton benchmarks should use scientific notation for times (or not).") + (declare verbose? (Unit -> Boolean)) + (define (verbose?) + "Should benchmarks print to the repl? -(coalton-toplevel +Is `*verbose-benchmarking*` set to `True`?" + (cell:read *verbose-benchmarking*)) - (declare verbose-benchmarking (Unit -> Boolean)) - (define (verbose-benchmarking) - "This returns whether benchmarks will print to the repl or just return a BenchmarkResults object." - (lisp Boolean () *coalton-verbose-benchmarking*)) + (declare *benchmark-width* (Cell UFix)) + (define *benchmark-width* + "This is the printed width of the benchmark table output." + (cell:new 80)) (declare benchmark-width (Unit -> UFix)) (define (benchmark-width) - "This returns the width of the benchmark table output. Ideally should be divisible by 5." - (lisp UFix () *coalton-benchmark-width*)) + "The width in characters for printing benchmark table output." + (cell:read *benchmark-width*)) + + (declare *benchmark-sci-notation* (Cell Boolean)) + (define *benchmark-sci-notation* + "When `True`, benchmarks will print times with scientific notation. + +When `False`, they will print in microseconds." + (cell:new False)) + + (declare sci-notation? (Unit -> Boolean)) + (define (sci-notation?) + "Should benchmark times be printed in scientific notation? + +Is `*benchmark-sci-notation*` set to `True`?" + (cell:read *benchmark-sci-notation*))) - (declare benchmark-sci-notation (Unit -> Boolean)) - (define (benchmark-sci-notation) - "This returns whether benchmarks will print time with scientific notation." - (lisp Boolean () *coalton-benchmark-sci-notation*))) ;;; ;;; Benchmark environment ;;; +(coalton-toplevel + + (repr :native cl:symbol) + (define-type BenchmarkName) + + (define-instance (EQ BenchmarkName) + (define (== a b) + (lisp Boolean (a b) + (cl:eq a b)))) + + (define-instance (Into BenchmarkName String) + (define (into s) + (lisp String (s) + (cl:string s)))) + + (define-instance (Into String BenchmarkName) + (define (into s) + (lisp BenchmarkName (s) + (cl:intern s)))) + + (declare BenchmarkName (String -> BenchmarkName)) + (define (BenchmarkName str) + (into str))) + +(coalton-library/hash:define-sxhash-hasher BenchmarkName) + (coalton-toplevel (define-struct Benchmark - "A benchmark object" - (name String) + "A Coalton benchmark." + (name BenchmarkName) (iterations UFix) - (code (Unit -> Unit)) - (packages (Vector String))) + (code (Unit -> Unit))) - (declare benchmark-environment (hash:Hashtable String Benchmark)) - (define benchmark-environment - "A global environment holding Coalton benchmarks. Key is benchmark name." - (hash:new))) + (define-struct BenchmarkSuite + "A suite of benchmarks for a Coalton package." + (package-name String) + (benchmarks (Hashtable BenchmarkName Benchmark))) + + (declare *benchmark-environment* (hash:Hashtable String BenchmarkSuite)) + (define *benchmark-environment* + "A global environment holding Coalton benchmarks. Key is package name." + (hash:new)) + + (declare add-benchmark-suite (BenchmarkSuite -> Unit)) + (define (add-benchmark-suite suite) + "Adds a benchmarksuite to *benchmark-environment*." + (hash:set! *benchmark-environment* + (.package-name suite) + suite)) + + (declare find-benchmark-suite (String -> (Optional BenchmarkSuite))) + (define (find-benchmark-suite name) + "Finds a package's benchmark suite given its name." + (let package = (lisp String (name) + (cl:string-upcase name))) + (hash:get *benchmark-environment* package)) + + (declare current-package (Unit -> String)) + (define (current-package) + "Returns the current local package, `cl:*package*`" + (lisp String () + (cl:package-name cl:*package*))) + + (declare ensure-benchmark-suite (Unit -> BenchmarkSuite)) + (define (ensure-benchmark-suite) + "Ensures that a local benchmark suite exists for the current package, returns the suite." + (unwrap-or-else (fn (suite) + suite) + (fn () + (let ((suite (BenchmarkSuite + (current-package) + (hash:new)))) + (add-benchmark-suite suite) + suite)) + (find-benchmark-suite (current-package)))) + + (declare add-benchmark (Benchmark -> Unit)) + (define (add-benchmark bmark) + "Adds a benchmark to the current package's benchmark suite." + (let suite = (ensure-benchmark-suite)) + (hash:set! (.benchmarks suite) + (.name bmark) + bmark)) + + (declare package-benchmarks (String -> (Iterator Benchmark))) + (define (package-benchmarks package-name) + "Returns an iterator of all benchmarks contained within a package." + (hash:values (.benchmarks (unwrap (find-benchmark-suite package-name))))) + + (declare local-benchmarks (Unit -> (Iterator Benchmark))) + (define (local-benchmarks) + "Returns an iterator of all benchmarks contained within the current package." + (package-benchmarks (current-package))) + + (declare find-benchmark (BenchmarkName -> (Optional Benchmark))) + (define (find-benchmark name) + "Finds a benchmark in the current package." + (iter:find! (fn (b) + (== (.name b) name)) + (local-benchmarks))) + + (declare %define-benchmark (String -> UFix -> (Unit -> Unit) -> Unit)) + (define (%define-benchmark name iterations fn) + (add-benchmark + (Benchmark + (into name) + iterations + fn)))) + +(cl:defmacro define-benchmark (name iterations func) + "Define a coalton benchmark- defined in lisp space." + (cl:let* ((name (cl:string name))) + `(coalton (%define-benchmark ,name ,iterations ,func)))) ;;; ;;; Benchmark Results @@ -84,7 +221,7 @@ (define-struct BenchmarkResults "Results from a Benchmark run." - (name String) + (name BenchmarkName) (iterations UFix) (time-elapsed Integer) (bytes-consed (Optional Integer))) @@ -120,74 +257,7 @@ (Results (vector BenchmarkResults)))) ;;; -;;; Benchmark definition -;;; - -(coalton-toplevel - - (declare current-package (Unit -> String)) - (define (current-package) - "Returns the current local package." - (lisp String () - (cl:package-name cl:*package*))) - - (declare %define-benchmark (String -> UFix -> (Unit -> Unit) -> Unit)) - (define (%define-benchmark name iterations fn) - "Defines a Coalton benchmark, stored in `benchmark-environment`." - (hash:set! - benchmark-environment - name - (Benchmark - name - iterations - fn - (vec:make (current-package))))) - - (declare find-benchmark (String -> (Optional Benchmark))) - (define (find-benchmark name) - "Finds a benchmark given its name." - (hash:get benchmark-environment name)) - - (declare find-package-benchmarks (String -> (Iterator Benchmark))) - (define (find-package-benchmarks package) - "Finds all benchmarks defined in a `package`" - (let pkg = (lisp String (package) (cl:string-upcase package))) - (iter:filter! (fn (b) (unwrap-or-else (fn (_x) True) - (fn () False) - (vec:find-elem pkg (.packages b)))) - (hash:values benchmark-environment)))) - -(cl:defmacro define-benchmark (name iterations func) - "Defines a Coalton benchmark" - (cl:let ((name (cl:string name))) - `(coalton (%define-benchmark ,name ,iterations ,func)))) - -;;; -;;; Allow importing of benchmarks into other packages, -;;; for the sake of building package-per-file benchmark hierarchies. -;;; - -(coalton-toplevel - - (declare %add-package (String -> Benchmark -> Unit)) - (define (%add-package package-name benchmark) - "Adds a package to the benchmark's packages." - (vec:push! package-name (.packages benchmark)) - Unit) - - (declare %reexport-package-benchmarks (String -> Unit)) - (define (%reexport-package-benchmarks package) - (for bmark in (find-package-benchmarks package) - (%add-package (current-package) bmark) - Unit))) - -(cl:defun reexport-benchmarks (cl:&rest packages) - "This imports and reexports benchmarks from another package, for package-per-file hierarchy." - (cl:loop :for pkg :in packages - :do (%reexport-package-benchmarks pkg))) - -;;; -;;; Running and Printing +;;; Print formatting utilities ;;; (coalton-toplevel @@ -200,31 +270,47 @@ (cl:format cl:*standard-output* "~A" str) Unit)) + (define (%format-time-microseconds rtime) + "Formats time units into microseconds." + (let t = (math:round/ (sys:time-units->rounded-microseconds rtime) 1000)) + (lisp String (t) + (cl:format cl:nil "~d" t))) + + (define (%format-time-scientific rtime) + "Formats time units into seconds in scientific notation." + (let t = (sys:time-units->seconds rtime)) + (lisp String (t) + (cl:format cl:nil "~,4e" t))) + (declare format-time (Integer -> String)) (define (format-time rtime) "Converts time from microseconds to seconds then prunes down to a 10 characters." - (let t = (sys:time-units->seconds rtime)) - (lisp String (t) - (cl:let ((control-string (cl:if *coalton-benchmark-sci-notation* - "~,4e s" - "~,7f s"))) - (cl:format cl:nil control-string t)))) - - (declare benchmark-column-names (Vector String)) - (define benchmark-column-names (vec:make "Benchmark" - "Time Elapsed" - "Bytes consed" - "# Iterations")) - - (declare column-values (BenchmarkResults -> (Vector String))) + (if (sci-notation?) + (%format-time-scientific rtime) + (%format-time-microseconds rtime)))) + +;;; +;;; Table gathering +;;; + +(coalton-toplevel + + (declare benchmark-column-names (seq:Seq String)) + (define benchmark-column-names (seq:make "Benchmark" + "Time (ms)" + "Space (B)" + "# Iterations")) + + (declare column-values (BenchmarkResults -> (seq:Seq String))) (define (column-values (BenchmarkResults name iterations time-elapsed bytes-consed)) "Returns the column values for a row." - (vec:make name + (seq:make (the String (into name)) (format-time time-elapsed) - (unwrap-or-else into + (unwrap-or-else (fn (x) + (into x)) (fn () "n/a") bytes-consed) - (into iterations))) + (the String (into iterations)))) (declare system-header-text (BenchmarkSystem -> (Tuple String String))) (define (system-header-text (BenchmarkSystem architecture os lisp-impl lisp-version release inlining)) @@ -244,8 +330,26 @@ "with" "without"))))) + (declare package-header (String -> BenchmarkSystem -> String)) + (define (package-header name system) + "Returns a formatted package header, including package and system information." + (let sys = (system-header-text system)) + (coalton-table + (benchmark-width) + (Header (lisp String (name) + (cl:format cl:nil "Package '~a'" name))) + (SecondaryHeader (fst sys)) + (SecondaryHeader (snd sys)) + (TopRow benchmark-column-names)))) + +;;; +;;; +;;; + +(coalton-toplevel + (declare %run-benchmark (Benchmark -> BenchmarkResults)) - (define (%run-benchmark (Benchmark name iterations func _package)) + (define (%run-benchmark (Benchmark name iterations func)) "Runs a benchmark." (let profile = (sys:spacetime (fn () (for i in (iter:up-to iterations) @@ -257,16 +361,15 @@ (.time-elapsed profile) (.bytes-consed profile))) - (declare run-benchmark (String -> BenchmarkResults)) + (declare run-benchmark (BenchmarkName -> BenchmarkResults)) (define (run-benchmark name) - "Looks up a benchmark by name and runs it if it exists." + "Runs a benchmark in the current package." (let ((results (unwrap-or-else %run-benchmark (fn () (error (lisp String (name) (cl:format cl:nil "No benchmark defined by this name: ~a" name)))) - (find-benchmark (lisp string (name) - (cl:string-upcase name))))) + (find-benchmark name))) (sys (system-header-text (benchmark-system-info)))) - (when (verbose-benchmarking) + (when (verbose?) (print (coalton-table (benchmark-width) @@ -275,48 +378,40 @@ (SecondaryHeader (snd sys)) (TopRow benchmark-column-names) (Row (column-values results)) - (Bottom (vec:length benchmark-column-names))))) + (Bottom (seq:size benchmark-column-names))))) results)) - (declare package-header (String -> BenchmarkSystem -> String)) - (define (package-header name system) - "Returns a formatted package header, including package and system information." - (let sys = (system-header-text system)) - (coalton-table - (benchmark-width) - (Header (lisp String (name) - (cl:format cl:nil "Package '~a'" name))) - (SecondaryHeader (fst sys)) - (SecondaryHeader (snd sys)) - (TopRow benchmark-column-names))) - (declare run-package-benchmarks (String -> PackageBenchmarkResults)) (define (run-package-benchmarks name) "Runs all benchmarks for a package" (let system = (benchmark-system-info)) (let results = (vec:new)) - (when (verbose-benchmarking) + (when (verbose?) (print-item (package-header name system))) - (for b in (find-package-benchmarks name) + (for b in (package-benchmarks name) (let res = (%run-benchmark b)) - (when (verbose-benchmarking) + (when (verbose?) (print-item (coalton-table - (benchmark-width) - (Row (column-values res))))) + (benchmark-width) + (Row (column-values res))))) (vec:push! res results)) - (when (verbose-benchmarking) + (when (verbose?) (print-item (coalton-table - (benchmark-width) - (Bottom 4)))) + (benchmark-width) + (Bottom 4)))) (PackageBenchmarkResults name system results)) - (declare print-results ((List BenchmarkResults) -> (state:ST Table Unit))) + (define (run-benchmarks) + "Runs the benchmarks for the current package." + (run-package-benchmarks (current-package))) + + (declare print-results ((List BenchmarkResults) -> (state:ST TableState Unit))) (define (print-results results) "Adds results to the table object." (match results diff --git a/benchmarking/benchmarks/big-float.lisp b/benchmarking/benchmarks/big-float.lisp index b02373f5..146757bb 100644 --- a/benchmarking/benchmarks/big-float.lisp +++ b/benchmarking/benchmarks/big-float.lisp @@ -85,10 +85,10 @@ (name (cl:string name)) (rand (cl:* (cl:- (cl:random 2)) (cl:random 100.0d0)))) `(coalton (coalton-benchmarking/benchmarking::%define-benchmark ,name (big-float-bench-iterations) - (fn () - (,func (big-float-bench-precision) - ,rand) - Unit))))) + (fn () + (,func (big-float-bench-precision) + ,rand) + Unit))))) (define-big-float-benchmark big-trig) diff --git a/benchmarking/benchmarks/fibonacci.lisp b/benchmarking/benchmarks/fibonacci.lisp index af7edd37..1540a22a 100644 --- a/benchmarking/benchmarks/fibonacci.lisp +++ b/benchmarking/benchmarks/fibonacci.lisp @@ -85,9 +85,9 @@ ;;; (define-benchmark rec-fib 1000 - (fn () - (fib 20) - Unit)) + (fn () + (fib 20) + Unit)) (define-benchmark rec-fib-generic 1000 (fn () diff --git a/benchmarking/benchmarks/gabriel-benchmarks/package.lisp b/benchmarking/benchmarks/gabriel-benchmarks/package.lisp index ba7b99f0..c8522965 100644 --- a/benchmarking/benchmarks/gabriel-benchmarks/package.lisp +++ b/benchmarking/benchmarks/gabriel-benchmarks/package.lisp @@ -7,12 +7,16 @@ #:coalton-benchmarks/gabriel/tak #:coalton-benchmarks/gabriel/takr #:coalton-benchmarks/gabriel/stak - #:coalton-benchmarks/gabriel/takl)) + #:coalton-benchmarks/gabriel/takl) + (:export + #:run-gabriel-benchmarks)) (in-package #:coalton-benchmarks/gabriel) -(reexport-benchmarks - "coalton-benchmarks/gabriel/tak" - "coalton-benchmarks/gabriel/takr" - "coalton-benchmarks/gabriel/stak" - "coalton-benchmarks/gabriel/takl") +(coalton-toplevel + + (define (run-gabriel-benchmarks) + (run-package-benchmarks "coalton-benchmarks/gabriel/tak") + (run-package-benchmarks "coalton-benchmarks/gabriel/takr") + (run-package-benchmarks "coalton-benchmarks/gabriel/stak") + (run-package-benchmarks "coalton-benchmarks/gabriel/takl"))) diff --git a/benchmarking/benchmarks/gabriel-benchmarks/tak.lisp b/benchmarking/benchmarks/gabriel-benchmarks/tak.lisp index 339b3b36..3d4f8031 100644 --- a/benchmarking/benchmarks/gabriel-benchmarks/tak.lisp +++ b/benchmarking/benchmarks/gabriel-benchmarks/tak.lisp @@ -11,7 +11,6 @@ (in-package #:coalton-benchmarks/gabriel/tak) - ;; Defining the lisp version (cl:declaim (cl:ftype (cl:function (cl:fixnum cl:fixnum cl:fixnum) cl:fixnum) lisp-tak)) (cl:defun lisp-tak (x y z) @@ -44,4 +43,4 @@ (fn () (lisp Unit () (lisp-tak 18 12 6) - Unit)))() + Unit))) diff --git a/benchmarking/benchmarks/gabriel-benchmarks/takl.lisp b/benchmarking/benchmarks/gabriel-benchmarks/takl.lisp index 2a5508e7..8dfe0ae2 100644 --- a/benchmarking/benchmarks/gabriel-benchmarks/takl.lisp +++ b/benchmarking/benchmarks/gabriel-benchmarks/takl.lisp @@ -10,6 +10,7 @@ (#:list #:Coalton-library/list))) (in-package #:coalton-benchmarks/gabriel/takl) + ;;; ;;; ;;; diff --git a/benchmarking/benchmarks/gabriel-benchmarks/takr.lisp b/benchmarking/benchmarks/gabriel-benchmarks/takr.lisp index a3d5e439..76e9096c 100644 --- a/benchmarking/benchmarks/gabriel-benchmarks/takr.lisp +++ b/benchmarking/benchmarks/gabriel-benchmarks/takr.lisp @@ -8,7 +8,6 @@ #:lisp-takr)) (in-package #:coalton-benchmarks/gabriel/takr-lisp) - ;;; ;;; ;;; @@ -1434,9 +1433,9 @@ ;; Defining the Coalton benchmark (define-benchmark takr 1000 - (fn () - (takr 18 12 6) - Unit)) + (fn () + (takr 18 12 6) + Unit)) ;; Defining the Lisp Benchmark (define-benchmark lisp-takr 1000 diff --git a/benchmarking/benchmarks/package.lisp b/benchmarking/benchmarks/package.lisp index 101b987a..0777c9a7 100644 --- a/benchmarking/benchmarks/package.lisp +++ b/benchmarking/benchmarks/package.lisp @@ -15,24 +15,12 @@ (in-package #:coalton-benchmarks) -(reexport-benchmarks - "coalton-benchmarks/fibonacci" - "coalton-benchmarks/big-float" - "coalton-benchmarks/gabriel") +(coalton-toplevel -(cl:defun run-coalton-benchmarks () - (coalton (run-package-benchmarks "coalton-benchmarks"))) + (define (%run-coalton-benchmarks) + (run-package-benchmarks "coalton-benchmarks/fibonacci") + (run-package-benchmarks "coalton-benchmarks/big-float") + (run-gabriel-benchmarks))) -#+ig -(defun run-benchmarks-ci () - (let ((result (run-package-benchmarks :package '#:coalton-benchmarks :verbose t))) - (with-open-file (out "bench.json" :direction :output :if-exists :supersede) - (yason:encode - (loop :for name :being :the :hash-keys :of result - :for data :being :the :hash-values :of result - :for real-time := (cdar data) - :for value := (coerce (cdr (find :total (alexandria:plist-alist real-time) :key #'car)) 'double-float) - :collect (alexandria:plist-hash-table (list "name" (symbol-name name) "value" value "unit" "seconds"))) - out) - (format out "~%")) - (values))) +(cl:defun run-coalton-benchmarks () + (coalton (%run-coalton-benchmarks))) diff --git a/benchmarking/printing.lisp b/benchmarking/printing.lisp index 4dfb74f0..c5c34a33 100644 --- a/benchmarking/printing.lisp +++ b/benchmarking/printing.lisp @@ -3,13 +3,14 @@ #:coalton #:coalton-prelude) (:local-nicknames - (#:iter #:coalton-library/iterator) - (#:vec #:coalton-library/vector) - (#:math #:coalton-library/math) - (#:str #:coalton-library/string) - (#:list #:coalton-library/list) - (#:cell #:coalton-library/cell) - (#:state #:coalton-library/monad/state)) + (#:iter #:coalton-library/iterator) + (#:vec #:coalton-library/vector) + (#:math #:coalton-library/math) + (#:str #:coalton-library/string) + (#:list #:coalton-library/list) + (#:cell #:coalton-library/cell) + (#:state #:coalton-library/monad/state) + (#:seq #:coalton-library/seq)) (:export #:render @@ -37,7 +38,7 @@ #:TableRow #:TopTableRow - #:Table + #:TableState #:Header #:SecondaryHeader #:Row @@ -51,8 +52,9 @@ (define-class (Render :a) "Class for rendering portions of tables." - (render "Renders a portion of a table in string form." - (:a -> String)))) + (render + "Renders a portion of a table in string form." + (:a -> String)))) (coalton-toplevel @@ -153,10 +155,10 @@ ;; ;; - (declare %write-row-component (UFix -> (vec:Vector String) -> TableComponent -> String)) + (declare %write-row-component (UFix -> (seq:Seq String) -> TableComponent -> String)) (define (%write-row-component width column-texts top-edge) "Writes a full table row of width `width` containing `column-texts`." - (let ((columns (vec:length column-texts)) + (let ((columns (seq:size column-texts)) (spacing (%column-spacing width columns)) (out (the (vec:Vector String) (vec:new)))) (vec:push! (render top-edge) out) @@ -168,15 +170,15 @@ (vec:push! (render NewLine) out) (mconcat out))) - (declare %write-top-row (UFix -> (vec:Vector String) -> String)) + (declare %write-top-row (UFix -> (seq:Seq String) -> String)) (define (%write-top-row width column-texts) "Writes the top-row of a table- has no lines crossing above the top." - (%write-row-component width column-texts (TopInternalEdge width (vec:length column-texts)))) + (%write-row-component width column-texts (TopInternalEdge width (seq:size column-texts)))) - (declare %write-row (UFix -> (vec:Vector String) -> String)) + (declare %write-row (UFix -> (seq:Seq String) -> String)) (define (%write-row width column-texts) "Writes a row of a table." - (%write-row-component width column-texts (InternalEdge width (vec:length column-texts)))) + (%write-row-component width column-texts (InternalEdge width (seq:size column-texts)))) (define-instance (Render TableComponent) (define (render tc) @@ -226,12 +228,12 @@ (define-struct TableRow "A struct that can be used to generate a printed table row." (width "The width of the table row." UFix) - (column-contents "A vector of column contents." (vec:Vector String))) + (column-contents "A vector of column contents." (seq:Seq String))) (define-struct TopTableRow "A struct that can be used to generate a printed table row with no row above." (width UFix) - (column-contents (vec:Vector String))) + (column-contents (seq:Seq String))) (define-instance (Render TableRow) (define (render (TableRow width contents)) @@ -260,7 +262,7 @@ (coalton-toplevel - (declare %add-component ((Render :a) => :a -> (state:ST Table Unit))) + (declare %add-component ((Render :a) => :a -> (state:ST TableState Unit))) (define (%add-component component) "Adds a rendered component to the table printout." (do @@ -270,21 +272,21 @@ (.printout table))) (state:put table))) - (define-struct Table - (printout "The table being rendered." (Cell String)) + (define-struct TableState + (printout "The table string being rendered." (Cell String)) (width "The width of the table" UFix)) - (define-instance (Into Table String) - (define (into (Table printout width)) + (define-instance (Into TableState String) + (define (into (TableState printout width)) (cell:read printout))) - (define-instance (Default Table) + (define-instance (Default TableState) (define (default) - (Table + (TableState (cell:new "") 90))) - (declare Header (String -> (state:ST Table Unit))) + (declare Header (String -> (state:ST TableState Unit))) (define (Header text) "Add a header to the table printout." (do @@ -295,23 +297,23 @@ "Adds a header below the first header." (do (table <- state:get) - (%add-component (TableRow (1- (.width table)) (vec:make text))))) + (%add-component (TableRow (1- (.width table)) (seq:make text))))) - (declare Row ((Vector String) -> (state:ST Table Unit))) + (declare Row ((seq:Seq String) -> (state:ST TableState Unit))) (define (Row texts) "Add a row to the table printout." (do (table <- state:get) (%add-component (TableRow (.width table) texts)))) - (declare TopRow ((Vector String) -> (state:ST Table Unit))) + (declare TopRow ((seq:Seq String) -> (state:ST TableState Unit))) (define (TopRow texts) "Add a top row to the table printout (no upward cross characters)." (do (table <- state:get) (%add-component (TopTableRow (.width table) texts)))) - (declare Bottom (UFix -> (state:ST Table Unit))) + (declare Bottom (UFix -> (state:ST TableState Unit))) (define (Bottom columns) "Add the bottom edge to the table printout." (do @@ -322,4 +324,4 @@ "Can be used for building tables or portions of tables. Forms should be provided with the understanding that they are embedded in a `do` form." (cl:let ((forms (cl:append '(do) forms))) - `(cell:read (.printout (fst (state:run ,forms (Table (cell:new "") ,width))))))) + `(cell:read (.printout (fst (state:run ,forms (TableState (cell:new "") ,width)))))))