From d4830cdd422258a7c91a5ed07af50f8c208a29ee Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 15 Aug 2023 23:33:17 -0500
Subject: A new start (again)

---
 lib/util.sld | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 lib/util.sld

(limited to 'lib/util.sld')

diff --git a/lib/util.sld b/lib/util.sld
new file mode 100644
index 0000000..64c633e
--- /dev/null
+++ b/lib/util.sld
@@ -0,0 +1,50 @@
+;;; (boudin util) --- utility functions
+
+(define-library (boudin util)
+  (import (scheme base)
+          (scheme case-lambda)
+          (scheme eval))
+
+  (export identity
+          o
+          assoc-ref
+          slurp
+          eval/q)
+
+  (begin
+    (define (identity x) x)
+
+    (define (o . procs)                     ; stole from chicken core
+      (if (null? procs)
+          identity
+          (let loop ((procs procs))
+            (let ((h (car procs))
+                  (t (cdr procs)))
+              (if (null? t)
+                  h
+                  (lambda (x) (h ((loop t) x))))))))
+
+    (define assoc-ref
+      (case-lambda
+        ((key alist)
+         (assoc-ref alist
+                    key
+                    (lambda () (error "Unrecognized key." key))))
+        ((key alist failure)
+         (cond ((assoc key alist) => cdr)
+               (else (failure))))))
+
+    (define slurp
+      (case-lambda
+        (() (slurp (current-input-port)))
+        ((port)
+         (let loop ((ch (read-char))
+                    (acc '()))
+           (if (eof-object? ch)
+               (list->string (reverse acc))
+               (loop (read-char) (cons ch acc)))))))
+
+    (define (eval/q form env)           ; this is probably a bad idea
+      (eval (list 'quasiquote form) env))
+
+    ))
-- 
cgit 1.4.1-21-gabe81