blob: 1fff10a269c7f6c6fded808d801e8eae49203b62 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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)))))))
|
