1 files changed, 50 insertions, 0 deletions

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