1 files changed, 0 insertions, 167 deletions
diff --git a/rego-proofs/compiler/utilities.scm b/rego-proofs/compiler/utilities.scm
deleted file mode 100644
index 783d153..0000000
--- a/rego-proofs/compiler/utilities.scm
+++ /dev/null
@@ -1,167 +0,0 @@
-;;; Copyright © 2023 Jakob L. Kreuze <zerodaysfordays@sdf.org>
-;;;
-;;; This program is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License as
-;;; published by the Free Software Foundation; either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-(define-module (compiler utilities)
-  #:use-module (ice-9 match)
-  #:use-module (oop goops)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-31)
-  #:use-module (srfi srfi-69)
-  #:export (alist?
-            map-key
-            update-alist
-
-            add-to-end
-
-            hash-table-append!
-            hash-table-append-item!
-
-            fresh-identifier
-            number->subscript
-
-            map-slot
-            define-slot-lens
-            with-modified-slot
-            derive-display
-            to-pretty-sexp
-
-            partition-on
-            flat-map))
-
-(define (alist? xs)
-  "Return #t when XS is an alist"
-  (and (list? xs)
-       (every (lambda (elem)
-                (and (pair? elem)
-                     (string? (car elem))))
-              xs)))
-
-(define (map-key f key alist)
-  "Return ALIST where F has been applied to the value of KEY"
-  (map (lambda (kv)
-         (if (equal? key (car kv))
-             (cons (car kv) (f (cdr kv)))
-             kv))
-       alist))
-
-(define (update-alist x y)
-  "Return X ∪ Y where the values for any duplicate keys come from Y"
-  (append y (filter (lambda (kv) (not (member (car kv) y))) x)))
-
-(define (add-to-end xs x)
-  "Add a single item X to the end of XS"
-  (append xs (list x)))
-
-(define (hash-table-append! hash-table key xs)
-  "Append list XS to the value stored at KEY in HASH-TABLE, or '() if KEY not present"
-  (if (hash-table-exists? hash-table key)
-      (hash-table-set! hash-table key (append (hash-table-ref hash-table key) xs))
-      (hash-table-set! hash-table key xs)))
-
-(define (hash-table-append-item! hash-table key item)
-  "Append single ITEM to the value stored at KEY in HASH-TABLE, or '() if KEY not present"
-  (if (hash-table-exists? hash-table key)
-      (hash-table-set! hash-table key (add-to-end (hash-table-ref hash-table key) item))
-      (hash-table-set! hash-table key (list item))))
-
-(define* (fresh-identifier identifiers #:optional (pre "anonym"))
-  "Return an identifier which does not occur in IDENTIFIERS"
-  (define (try n)
-    (let ((candidate-identifier (string-append pre (number->subscript n))))
-      (if (member candidate-identifier identifiers)
-        (try (+ n 1))
-        candidate-identifier)))
-  (try 0))
-
-(define (number->subscript n)
-  "Return N as a string consisting of subscript numerals"
-  (string-map (match-lambda
-                (#\0 #\₀)
-                (#\1 #\₁)
-                (#\2 #\₂)
-                (#\3 #\₃)
-                (#\4 #\₄)
-                (#\5 #\₅)
-                (#\6 #\₆)
-                (#\7 #\₇)
-                (#\8 #\₈)
-                (#\9 #\₉))
-              (number->string n)))
-
-(define-syntax map-slot
-  (syntax-rules ()
-    ((map-slot instance slot f)
-     (let ((clone (shallow-clone instance)))
-       (slot-set! clone slot (f (slot-ref clone slot)))
-       clone))))
-
-(define-syntax define-slot-lens
-  (syntax-rules ()
-    ((define-slot-lens name slot)
-     (define (name)
-       (lens (lambda (s)   (slot-ref s slot))
-             (lambda (s f) (map-slot s slot f)))))))
-
-(define-syntax with-modified-slot
-  (syntax-rules ()
-    ((with-modified-slot instance slot new-value)
-     (let ((clone (shallow-clone instance)))
-       (slot-set! clone slot new-value)
-       clone))))
-
-(define-syntax derive-display
-  (syntax-rules ()
-    ((derive-display class)
-     (define-method (display (x class) port)
-       (format port "#<~a " (class-name class))
-       (for-each (compose (lambda (y)
-                            (display y port)
-                            (display " "))
-                          (cut slot-ref x <>)
-                          (cut slot-definition-name <>))
-                 (class-slots class))
-       (display ">" port)))))
-
-(define (to-pretty-sexp form)
-  (cond ((hash-table? form)
-         (to-pretty-sexp (hash-table->alist form)))
-        ((instance? form)
-         `(,(class-name (class-of form))
-           ,@(map (compose to-pretty-sexp
-                           (cut slot-ref form <>)
-                           (cut slot-definition-name <>))
-                  (class-slots (class-of form)))))
-        ((list? form) (map to-pretty-sexp form))
-        ((and (array? form) (not (string? form)))
-         (list->array 1 (map to-pretty-sexp (array->list form))))
-        ((pair? form) (cons (to-pretty-sexp (car form))
-                            (to-pretty-sexp (cdr form))))
-        (else form)))
-
-
-(define (partition-on xs pred)
-  (define (recur result running cur)
-    (cond ((null? cur)
-           (cons (reverse! running) result))
-          ((pred (first cur))
-           (recur (cons (reverse! running) result) (list (first cur)) (cdr cur)))
-          (else
-           (recur result (cons (car cur) running) (cdr cur)))))
-  (reverse! (filter (negate null?) (recur '() '() xs))))
-
-(define* (flat-map proc #:rest args)
-  (fold append '() (apply map proc args)))