From 79c4d9cf28d3aba8c6d5659fbff68283ec41436e Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Thu, 17 Mar 2022 14:56:50 +0000
Subject: Add directory traversal to synthesise script

---
 scripts/synthesise | 58 +++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 40 insertions(+), 18 deletions(-)

diff --git a/scripts/synthesise b/scripts/synthesise
index c865577..4e8dbec 100755
--- a/scripts/synthesise
+++ b/scripts/synthesise
@@ -3,10 +3,11 @@
 
 (import (chicken port)
         (chicken process-context)
+        (chicken string)
+        (chicken irregex)
+        (chicken file)
         args
-        csv-abnf
         matchable
-        regex
         srfi-193
         ssax)
 
@@ -29,6 +30,7 @@
 	      (args:make-option (h help) #:none "Display this text"
 	                        (usage))))
 
+(: description string)
 (define description
   "synthesise: sends a verilog file to be synthesised and returns results as a CSV file.")
 
@@ -43,8 +45,6 @@
 	    (print "Report bugs to git at yannherklotz dot com.")))
   (exit 1))
 
-(define-values (fmt-cell fmt-record fmt-csv) (make-format ","))
-
 (define (map-names n)
   (match n
     ["XILINX_LUT_FLIP_FLOP_PAIRS_USED" "lut_flip_flop"]
@@ -58,6 +58,13 @@
     ["XILINX_DESIGN_DELAY" "delay"]
     [_ n]))
 
+(define (csv:fmt-row l) (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"))
+                                                    (map csv:fmt-row l))))
+
 (define (xml-matcher xml)
   (match xml
     [('*TOP* _ ('document ('application ('section _ . r))))
@@ -69,30 +76,45 @@
     (lambda ()
       (list name (xml-matcher (ssax:xml->sxml (current-input-port) '()))))))
 
-;;(define xml-parser
-;;  (with-input-from-file "nussinov_report.xml"
-;;    (lambda () (parse-xml "nussinov" (current-input-port)))))
-
 (define (to-csv-record b head results)
   (let ((res (map (lambda (key)
                     (cadr (assoc key (cadr results)))) head)))
-    (list->csv-record (if b res (cons (car results) res)))))
+    (csv:fmt-row (if b res (cons (car results) res)))))
 
+(: path-to-name (string -> string))
 (define (path-to-name path)
-  (string-substitute "^.*?([^/]+)_report\\.xml$" "\\1" path))
-
-(define (write-file file-name text)
-  (with-output-to-file file-name (lambda () (display text))))
+  (irregex-replace "^.*?([^/]+)_report\\.xml$" path 1))
 
 (define (convert-files files)
   (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 ","))
+
+(: find-all-xml (string -> (list-of string)))
+(define (find-all-xml dir) (find-files dir #:test ".*\\.xml$"))
+
+(define (get-files-from-op operands)
+  (match operands
+    [(d) (cond [(directory-exists? d) (find-all-xml d)]
+               [else (list d)])]
+    [_ operands]))
+
+(define (with-output thk)
+  (if (check-opt 'output)
+      (with-output-to-file (check-opt 'output) thk)
+      (thk)))
+
 (define (main args)
   (set!-values (options operands)
 	             (args:parse args opts))
-  (let ((head (string-split-fields "," (or (check-opt 'keys) "slice,ramfifo,delay") #:infix))
-        (suppress (string-split-fields "," (or (check-opt 'suppress) "none") #:infix)))
+  (let ((head (split-at-comma (or (check-opt 'keys) "slice,ramfifo,delay")))
+        (suppress (split-at-comma (or (check-opt 'suppress) "none")))
+        (files (get-files-from-op operands)))
     (let ((body (map (lambda (f) (to-csv-record (member "name" suppress) head f))
-                     (convert-files operands)))
-          (header (list->csv-record (if (member "name" suppress) head (cons "name" head)))))
-    (display (fmt-csv (if (member "header" suppress) body (cons header body)))))))
+                     (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)))))))))
-- 
cgit