Add to benchmark script

1 files changed, 70 insertions, 36 deletions

diff --git a/scripts/synthesis-results.scm b/scripts/synthesis-results.scm
index 94c169f..b1a7349 100755
--- a/scripts/synthesis-results.scm
+++ b/scripts/synthesis-results.scm
@@ -1,4 +1,4 @@
-#! /usr/bin/chicken-csi -s
+#! /usr/bin/chicken-csi -ss
 ;; -*- mode: scheme -*-
 ;;
 ;; Copyright (C) 2022 Yann Herklotz <yann@yannherklotz.com>
@@ -16,11 +16,13 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
-(import (chicken port)
+(import (chicken file)
+        (chicken io)
+        (chicken irregex)
+        (chicken port)
         (chicken process-context)
+        (chicken sort)
         (chicken string)
-        (chicken irregex)
-        (chicken file)
         args
         matchable
         srfi-193
@@ -32,32 +34,34 @@
 (define (check-opt b) (cdr (or (assoc b options) `(,b . #f))))
 
 (define opts
-	(list (args:make-option (v verbose) (optional: "LEVEL") "Debug level [default: 0]"
-	                        (set! arg (or arg "0")))
+  (list (args:make-option (v verbose) (optional: "LEVEL") "Debug level [default: 0]"
+                          (set! arg (or arg "0")))
         (args:make-option (k keys) (required: "KEY,KEY,...") "Keys to display [default: slice,ramfifo,delay]")
         (args:make-option (o output) (required: "FILE") "Output file")
-        (args:make-option (s suppress) (required: "TYPE,TYPE,...") "Values to suppress from output [default: none]")
-        (args:make-option (x xml) #:none "Output raw XML from the synthesis tool")
+        (args:make-option (default-sort) #:none "Don't the names of the benchmarks")
+        (args:make-option (suppress) (required: "TYPE,TYPE,...") "Values to suppress from output [default: none]")
         (args:make-option (c csv) #:none "Output processed CSV")
-	      (args:make-option (V version) #:none "Display version"
-	                        (print "synthesise v0.1.0")
-	                        (exit))
-	      (args:make-option (h help) #:none "Display this text"
-	                        (usage))))
+        (args:make-option (cycle-file) (required: "FILE") "File which contains the cycle counts for the benchmark")
+        (args:make-option (org) #:none "Output processed Org")
+        (args:make-option (V version) #:none "Display version"
+                          (print "synthesis-results v0.2.0")
+                          (exit))
+        (args:make-option (h help) #:none "Display this text"
+                          (usage))))
 
 (: description string)
 (define description
   "synthesis-results: sends a verilog file to be synthesised and returns results as a CSV file.")
 
 (define (usage)
-	(with-output-to-port (current-error-port)
-	  (lambda ()
+  (with-output-to-port (current-error-port)
+    (lambda ()
       (print description)
       (newline)
-	    (print "Usage: " (program-name) " [options...] [files...]")
-	    (newline)
-	    (print (args:usage opts))
-	    (print "Report bugs to git at yannherklotz dot com.")))
+      (print "Usage: " (program-name) " [options...] [files...]")
+      (newline)
+      (print (args:usage opts))
+      (print "Report bugs to git at yannherklotz dot com.")))
   (exit 1))
 
 (define (map-names n)
@@ -75,6 +79,8 @@
 
 (define (csv:fmt-row l) (string-intersperse (map ->string l) ","))
 
+(define (org:fmt-row l) (string-append "| " (string-intersperse (map ->string l) " | ") " |"))
+
 (define (csv:fmt-table-string l) (apply string-append (map (lambda (s) (string-append s "\n")) l)))
 
 (define (csv:fmt-table l) (apply string-append (map (lambda (s) (string-append s "\n"))
@@ -84,28 +90,40 @@
   (match xml
     [('*TOP* _ ('document ('application ('section _ . r))))
      (map (match-lambda
-            [('item ('@ ('value v) ('stringID s))) (list (map-names s) (string->number v))]) r)]))
+            [('item ('@ ('value v) ('stringID s))) (cons (map-names s) (string->number v))]) r)]))
 
 (define (parse-xml name file)
   (with-input-from-file file
     (lambda ()
-      (list name (xml-matcher (ssax:xml->sxml (current-input-port) '()))))))
+      (cons name (xml-matcher (ssax:xml->sxml (current-input-port) '()))))))
+
+(define (ifn-cons b c l)
+  (if b l (cons c l)))
 
-(define ((to-csv-record b head) results)
+(define ((to-csv-record fmt-row b head) results)
   (let ((res (map (lambda (key)
-                    (cadr (assoc key (cadr results)))) head)))
-    (csv:fmt-row (if b res (cons (car results) res)))))
+                    (cdr (assoc key (cadr results)))) head)))
+    (fmt-row (ifn-cons b (car results) res))))
 
 (: path-to-name (string -> string))
 (define (path-to-name path)
   (irregex-replace "^.*?([^/]+)_report\\.xml$" path 1))
 
-(define (convert-files files)
-  (map (lambda (f) (parse-xml (path-to-name f) f)) files))
+(define (order-data d1 d2)
+  (match (list d1 d2)
+    [((n1 . _) (n2 . _)) (string<? n1 n2)]))
+
+(define (convert-files sort? files)
+  ((if sort? (lambda (l) (sort l order-data)) identity)
+   (map (lambda (f) (parse-xml (path-to-name f) f)) files)))
 
 (: split-at-comma (string -> (list-of string)))
 (define (split-at-comma s) (string-split s ","))
 
+(define (parse-cycles f)
+  (if f (with-input-from-file f
+          (lambda () (map (match-lambda [(a b) (cons a b)]) (map split-at-comma (read-lines))))) #f))
+
 (: find-all-xml (string -> (list-of string)))
 (define (find-all-xml dir) (find-files dir #:test ".*\\.xml$"))
 
@@ -120,17 +138,33 @@
       (with-output-to-file (check-opt 'output) thk)
       (thk)))
 
+(define (row-fmt)
+  (if (check-opt 'org) org:fmt-row csv:fmt-row))
+
+(define (cycle-file operands)
+  (let ((dir (match operands
+               [(d) (when (directory-exists? d) d)]
+               [_ #f])))
+    (or (check-opt 'cycle-file) (if dir (string-append dir "/exec.csv") #f))))
+
+(define (add-cycles data cycles)
+  (if cycles
+      (map (lambda (f) (list (car f) (cons (cons "cycles" (cdr (assoc (car f) cycles))) (cdr f)))) data)
+      data))
+
 (define (main args)
   (set!-values (options operands)
-	             (args:parse args opts))
-  (let ((head (split-at-comma (or (check-opt 'keys) "slice,ramfifo,delay")))
+               (args:parse args opts))
+  (let ((head (split-at-comma (or (check-opt 'keys) "slice,ramfifo,delay,cycles")))
         (suppress (split-at-comma (or (check-opt 'suppress) "none")))
         (files (get-files-from-op operands)))
-    (let ((body (map (to-csv-record (member "name" suppress) head) (convert-files files)))
-          (header (csv:fmt-row (if (member "name" suppress) head (cons "name" head)))))
-    (with-output
-        (lambda ()
-          (display (csv:fmt-table-string
-                    (if (member "header" suppress) body (cons header body)))))))))
-
-(main (command-line-arguments))
+    (let ((data (convert-files (not (check-opt 'default-sort)) files))
+          (header ((row-fmt) (ifn-cons (member "name" suppress) "name" head)))
+          (cycles (parse-cycles (cycle-file operands))))
+      (with-output
+       (lambda ()
+         (display (csv:fmt-table-string
+                   (ifn-cons (member "header" suppress) header
+                             (map (to-csv-record (row-fmt)
+                                                 (member "name" suppress)
+                                                 head) (add-cycles data cycles))))))))))