diff options
author | Case Duckworth | 2024-06-05 09:21:25 -0500 |
---|---|---|
committer | Case Duckworth | 2024-06-05 09:21:25 -0500 |
commit | 423ac382f9e73bf1ca7fc6b400f98db087cd7d22 (patch) | |
tree | 1992e3dc7e71cd40eb7cdbc0b6d0c3cdf82c4332 /lib/util.scm | |
parent | Update README, add COPYING (diff) | |
download | jimmy-423ac382f9e73bf1ca7fc6b400f98db087cd7d22.tar.gz jimmy-423ac382f9e73bf1ca7fc6b400f98db087cd7d22.zip |
Write executable
This involved moving `src' to `lib' and making `bin'. `bin' holds the program, which only imports `jimmy.main' from lib.
Diffstat (limited to 'lib/util.scm')
-rw-r--r-- | lib/util.scm | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/lib/util.scm b/lib/util.scm new file mode 100644 index 0000000..c71c600 --- /dev/null +++ b/lib/util.scm | |||
@@ -0,0 +1,49 @@ | |||
1 | (module (jimmy util) * | ||
2 | |||
3 | (import scheme (chicken base) | ||
4 | (chicken condition) | ||
5 | (only (chicken irregex) irregex-replace/all) | ||
6 | (chicken string)) | ||
7 | |||
8 | (define-syntax define-public | ||
9 | (syntax-rules () | ||
10 | ((define-public (name . arg) forms ...) | ||
11 | (begin (export name) | ||
12 | (define (name . arg) forms ...))) | ||
13 | ((define-public (name args ...) forms ...) | ||
14 | (begin (export name) | ||
15 | (define (name args ...) forms ...))) | ||
16 | ((define-public name value) | ||
17 | (begin (export name) | ||
18 | (define name value))))) | ||
19 | |||
20 | (define-syntax ignore-errors | ||
21 | (syntax-rules () | ||
22 | ((ignore-errors x) | ||
23 | (handle-exceptions e #f x)))) | ||
24 | |||
25 | (define (alist-walk lis . keys) | ||
26 | (if (null? keys) | ||
27 | lis | ||
28 | (let ((kv (assoc (car keys) lis))) | ||
29 | (cond | ||
30 | ((not kv) #f) | ||
31 | ((atom? (cdr kv)) | ||
32 | (and (null? (cdr keys)) ; this shouldn't error... | ||
33 | (cdr kv))) | ||
34 | ((list? (cdr kv)) | ||
35 | (apply alist-walk (cdr kv) (cdr keys))))))) | ||
36 | |||
37 | (define (string-join ss #!optional (sep " ")) | ||
38 | (string-intersperse ss sep)) | ||
39 | |||
40 | (define (flush-lines-left lines) | ||
41 | (irregex-replace/all '(: bol (* space)) | ||
42 | (string-join lines) "")) | ||
43 | |||
44 | (define (join-lines lines) | ||
45 | (apply string-append lines)) | ||
46 | |||
47 | ) | ||
48 | |||
49 | |||