From 03fa9a546c27f95d3b039ded5408917024761250 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 5 Mar 2019 16:56:25 +0100
Subject: Add util module.

---
 util.scm | 45 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 45 insertions(+)
 create mode 100644 util.scm

(limited to 'util.scm')

diff --git a/util.scm b/util.scm
new file mode 100644
index 00000000..bc889386
--- /dev/null
+++ b/util.scm
@@ -0,0 +1,45 @@
+(define-module (util)
+  #:use-module (srfi srfi-1)
+  #:export (destructure-lambda let-multi fold-lists catch-let)
+  )
+
+(define-public upstring->symbol (compose string->symbol string-upcase))
+
+(define-public symbol-upcase (compose string->symbol string-upcase symbol->string))
+
+(define-public symbol-downcase (compose string->symbol string-downcase symbol->string))
+       
+(define-syntax destructure-lambda
+  (syntax-rules ()
+    ((_ expr-list body ...)
+     (lambda (expr)
+       (apply (lambda expr-list body ...) expr)))))
+
+#; 
+(map (destructure-lambda (a b) (+ a b))
+     (map list (iota 10) (iota 10 10)))
+
+(define-syntax let-multi
+  (syntax-rules ()
+      ((let-m identifiers lst body ...)
+       (apply (lambda identifiers body ...)
+              lst))))
+
+(define-syntax fold-lists
+  (syntax-rules (lambda)
+    ((_ (lambda ((list-part ...) object) body ...) seed list)
+     (fold (lambda (kv object)
+             (let-multi (list-part ...) kv
+                        body ...))
+           seed
+           list))))
+
+(define-syntax catch-let
+  (syntax-rules ()
+    ((_ thunk ((type handler) ...))
+     (catch #t thunk
+       (lambda (err . args)
+         (case err
+           ((type) (apply handler err args)) ...
+           (else (format #t "Unhandled error type ~a, rethrowing ~%" err)
+                 (apply throw err args))))))))
-- 
cgit v1.2.3