From 6b0093aa5acdbd79925b8bb89baa73e09f37cdab Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Mon, 1 May 2023 13:12:46 -0500
Subject: Initial commit

---
 ruse.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100755 ruse.scm

diff --git a/ruse.scm b/ruse.scm
new file mode 100755
index 0000000..1fff10a
--- /dev/null
+++ b/ruse.scm
@@ -0,0 +1,50 @@
+#!/bin/sh
+#| -*- mode: scheme; geiser-scheme-implementation: chicken -*-
+exec csi -R r7rs -ss "$0" "$@"
+RUSE --- by case duckworth
+Make r7rs library files out of source scheme files
+|#
+
+#+chicken (import (r7rs))
+(import (scheme base)
+        (scheme file))
+
+(define (filter pred xs)
+  (let loop ((pred pred)
+             (xs xs)
+             (acc '()))
+    (cond
+     ((null? xs)
+      (reverse acc))
+     ((pred (car xs))
+      (loop pred (cdr xs) (cons (car xs) acc)))
+     (else
+      (loop pred (cdr xs) acc)))))
+
+(define (top-level-defines tree)
+  (filter (lambda (x)
+            (memq (car x)
+                  '( define
+                     define-syntax
+                     define-record-type
+                     define-values
+                     ;; others ?
+                     )))
+          tree))
+
+(define (top-level-names tree)
+  (map (lambda (d)
+         (if (pair? (cadr d))
+             (caadr d)
+             (cadr d)))
+       (top-level-defines tree)))
+
+(define (slurp-file file)
+  (with-input-from-file file
+    (lambda ()
+      (let loop ((next (read))
+                 (it '()))
+        (if (eof-object? next)
+            (reverse it)
+            (loop (read) (cons next it)))))))
+
-- 
cgit 1.4.1-21-gabe81