Re-organize dumping macros and associated functions

Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>

1 files changed, 0 insertions, 208 deletions

diff --git a/dump/utils.scm b/dump/utils.scm
deleted file mode 100644
index 8544eec..0000000
--- a/dump/utils.scm
+++ /dev/null
@@ -1,208 +0,0 @@
-(define-module (dump utils)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-19)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 match)
-  #:export (string-blank?
-            translate-forms
-            collect-forms
-            map-alist
-            time-unix->string))
-
-
-(define (time-unix->string seconds . maybe-format)
-  "Given an integer saying the number of seconds since the Unix
-epoch (1970-01-01 00:00:00), SECONDS, format it as a human readable
-date and time-string, possible using the MAYBE-FORMAT."
-  (letrec ([time-unix->time-utc
-            (lambda (seconds)
-              (add-duration
-               (date->time-utc (make-date 0 0 0 0 1 1 1970 0))
-               (make-time time-duration 0 seconds)))])
-    (apply date->string
-           (time-utc->date (time-unix->time-utc seconds))
-           maybe-format)))
-
-(define (string-blank? str)
-  "Return non-#f if STR consists only of whitespace characters."
-  (string-every char-set:whitespace str))
-
-(define (translate-forms from translator x)
-  "Recursively pass (FROM ...) forms in source X to TRANSLATOR, and
-replace them with the return value."
-  (syntax-case x ()
-    ;; Handle translation base case.
-    ((head tail ...) (eq? (syntax->datum #'head)
-                          from)
-     (translator x))
-    ;; Recurse.
-    ((head tail ...)
-     (cons (translate-forms from translator #'head)
-           (map (cut translate-forms from translator <>)
-                #'(tail ...))))
-    ;; Handle leaf base case.
-    (leaf #'leaf)))
-
-(define (key->assoc-ref alist x)
-  "Recursively translate (key k) forms in source X to (assoc-ref ALIST
-k) forms."
-  (translate-forms 'key
-                   ;; (syntax-rules (key)
-                   ;;   ((key k) (assoc-ref alist k)))
-                   (lambda (x)
-                     (syntax-case x (key)
-                       ((key k) #`(assoc-ref #,alist 'k))))
-                   x))
-
-(define (collect-forms target x)
-  "Recursively collect (TARGET ...) forms in source X and return them
-as a list."
-  (syntax-case x ()
-    ;; Handle collection base case.
-    ((head tail ...) (eq? (syntax->datum #'head)
-                          target)
-     (list x))
-    ;; Recurse.
-    ((head tail ...)
-     (append (collect-forms target #'head)
-             (append-map (cut collect-forms target <>) #'(tail ...))))
-    ;; Handle leaf base case.
-    (leaf (list))))
-
-(define (collect-keys x)
-  "Recursively collect (key k) forms from source X and return as a
-list of all K."
-  (map (syntax-rules (key)
-         ((key k) 'k))
-       (collect-forms 'key x)))
-
-(define (alist-delete* alist keys)
-  "Delete entries from ALIST whose key is equal (in the sense of
-equal?) to any in KEYS, a list."
-  (remove (match-lambda
-            ((key . value)
-             (member key keys))
-            (x (error "malformed alist element" x)))
-          alist))
-
-(define-syntax map-alist
-  (lambda (x)
-    "Transform (aka map) ALIST, an association list, into another
-association list. The returned association list may contain multiple
-associations for the same key. equal? is used in all association list
-key comparisons.
-
-Syntax:
-
-(map-alist alist
-  (verb key expression) ...
-  (else=> proc))
-
-VERB must be one of set, filter-set, multiset and remove.
-
-For the set VERB, KEY is set to the result of evaluating
-EXPRESSION. Multiple set verbs on the same key will result in multiple
-associations for that key.
-
-For the filter-set VERB, KEY is set to the result of evaluating
-EXPRESSION only if that result is not #f.
-
-For the multiset VERB, EXPRESSION must return a list and KEY is
-associated multiple times once with each element of the returned list.
-
-For the remove VERB, KEY is discarded.
-
-EXPRESSIONs must reference elements of ALIST using (key k) forms where
-K is the key to be referenced from ALIST. K must not be quoted. That
-is, if K is the symbol 'bar, it must be referenced as (key bar), not
-as (key 'bar).
-
-The else=> clause is optional.
-
-If the else=> clause is present, PROC is passed all pairs of ALIST
-that are not set by an earlier (verb key expression) action. PROC must
-return #f or a pair to replace its input pair. If PROC returns #f,
-that pair is discarded.
-
-If the else=> clause is absent, all unset pairs are discarded.
-
-Example:
-
-(map-alist '((\"foo\" . 1)
-             (bar . 2)
-             (foobar . 5)
-             (fubar . 3))
-  (set spam (1+ (key \"foo\")))
-  (set ham (* 2 (key bar)))
-  (set eggs (* 3 (key bar)))
-  (set aal (+ (key \"foo\")
-              (key bar)))
-  (multiset vel (iota (* 2 (key bar))))
-  (remove foobar)
-  (else=> (match-lambda
-            ((key . value)
-             (cons key (expt 2 value))))))
-=> ((spam . 2) (ham . 4) (eggs . 6) (aal . 3)
-    (vel . 0) (vel . 1) (vel . 2) (vel . 3) (fubar . 8))"
-    (syntax-case x ()
-      ((_ alist actions ...)
-       ;; TODO: Check that all actions are valid.
-       #`(let ((evaluated-alist alist))
-           (append (remove (match-lambda
-                             ;; Filter out results of filter-set actions.
-                             ((key . #f)
-                              (member key '#,(filter-map (lambda (action)
-                                                           (syntax-case action (filter-set)
-                                                             ((filter-set key expression) #'key)
-                                                             (_ #f)))
-                                                         #'(actions ...))))
-                             (_ #f))
-                           ;; Do set and filter-set.
-                           `#,(filter-map (lambda (action)
-                                            (syntax-case action (set filter-set)
-                                              ((set key expression)
-                                               #`(key . ,#,(key->assoc-ref #'evaluated-alist #'expression)))
-                                              ((filter-set key expression)
-                                               #`(key . ,#,(key->assoc-ref #'evaluated-alist #'expression)))
-                                              (_ #f)))
-                                          #'(actions ...)))
-                   ;; Do multiset.
-                   #,@(filter-map (lambda (action)
-                                    (syntax-case action (multiset)
-                                      ((multiset key expression)
-                                       #`(map (cut cons 'key <>)
-                                              #,(key->assoc-ref #'evaluated-alist #'expression)))
-                                      (_ #f)))
-                                  #'(actions ...))
-                   ;; Apply else=> procedure on unspecified keys. If
-                   ;; no else=> procedure is specified, delete
-                   ;; unspecified keys.
-                   (filter-map #,(or (any (lambda (action)
-                                            (syntax-case action (else=>)
-                                              ((else=> proc) #'proc)
-                                              (_ #f)))
-                                          #'(actions ...))
-                                     #'(const #f))
-                               ;; The unspecified part of the input
-                               ;; alist
-                               (alist-delete* evaluated-alist
-                                              (list
-                                               ;; Keys that were referenced
-                                               #,@(append-map (lambda (action)
-                                                                (syntax-case action ()
-                                                                  ((_ key expression)
-                                                                   (collect-keys #'expression))
-                                                                  (_ '())))
-                                                              #'(actions ...))
-                                               ;; Keys that were deleted
-                                               #,@(filter-map (lambda (action)
-                                                                (syntax-case action (remove)
-                                                                  ((remove key) #''key)
-                                                                  (_ #f)))
-                                                              #'(actions ...))
-                                               ;; Keys that were set
-                                               #,@(filter-map (lambda (action)
-                                                                (syntax-case action ()
-                                                                  ((_ key expression) #''key)
-                                                                  (_ #f)))
-                                                              #'(actions ...)))))))))))