A new start (again)

1 files changed, 50 insertions, 0 deletions

@@ -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))
+
+    ))