diff options
author | Case Duckworth | 2023-06-08 23:03:54 -0500 |
---|---|---|
committer | Case Duckworth | 2023-06-08 23:03:54 -0500 |
commit | 0c594ea788f31c561a9d617d5c0764f99429599b (patch) | |
tree | 1a2d54077f4f9428853ddb1534b913652846ca77 /chicken-scratch.scm | |
parent | Initial commit (diff) | |
download | chicken-scratch-0c594ea788f31c561a9d617d5c0764f99429599b.tar.gz chicken-scratch-0c594ea788f31c561a9d617d5c0764f99429599b.zip |
Rewrite; rename to chicken-scratch
Diffstat (limited to 'chicken-scratch.scm')
-rwxr-xr-x | chicken-scratch.scm | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/chicken-scratch.scm b/chicken-scratch.scm new file mode 100755 index 0000000..e47ad67 --- /dev/null +++ b/chicken-scratch.scm | |||
@@ -0,0 +1,78 @@ | |||
1 | ;;; CHICKEN-SCRATCH --- heredocs for CHICKEN | ||
2 | ;; written by Case Duckworth <acdw@acdw.net> off an idea by evhan | ||
3 | ;; Licensed under BSD-3. See COPYING for details. | ||
4 | |||
5 | ;; CHICKEN has "Multiline string constants with embedded expressions" syntax, | ||
6 | ;; which is basically shell here-doc syntax but schemier and with a real | ||
7 | ;; programming langugage to embed. evhan's beaker tool (which is great, btw) | ||
8 | ;; uses this facility to do a quick-and-dirty templating for wiki generation. I | ||
9 | ;; realized that I could use the same facility for the same kind of | ||
10 | ;; heredoc-style templating I have done in various other SSGs like unk and | ||
11 | ;; vienna, but with scheme. Thus, CHICKEN-SCRATCH was born. | ||
12 | |||
13 | ;; USAGE | ||
14 | |||
15 | ;; `expand-string' is the main entry point to this module. It takes a string and | ||
16 | ;; returns a string with all #( ... ) forms expanded according to the CHICKEN | ||
17 | ;; rules. `expand-port' is a port version of `expand-string'. | ||
18 | |||
19 | ;; To enable truly invisible definitions within the expanded string, the `def' | ||
20 | ;; macro is provided which performs a `set!' on its variables, then returns a | ||
21 | ;; string guaranteed not to be in the input string, which is then filtered out | ||
22 | ;; in the expanded string. | ||
23 | |||
24 | ;; Finally, to enable CHICKEN-SCRATCH to be used in a shebang, if the first line | ||
25 | ;; of the input string begins with #!, it's deleted from the input. | ||
26 | |||
27 | (module chicken-scratch | ||
28 | (expand-string | ||
29 | expand-port | ||
30 | def | ||
31 | %def/replacer) | ||
32 | |||
33 | (import scheme | ||
34 | (chicken base) | ||
35 | (only (chicken io) | ||
36 | read-string) | ||
37 | (only (chicken irregex) | ||
38 | irregex-replace | ||
39 | irregex-replace/all | ||
40 | irregex-search) | ||
41 | (only (chicken port) | ||
42 | make-concatenated-port) | ||
43 | (only (chicken random) | ||
44 | pseudo-random-real)) | ||
45 | |||
46 | (define %def/replacer (make-parameter #f)) | ||
47 | |||
48 | (define (expand-string str) | ||
49 | (parameterize ((%def/replacer (random-string-not-in str))) | ||
50 | (let* ((delim (random-string-not-in str)) | ||
51 | (template (make-concatenated-port | ||
52 | (open-input-string (string-append "#<#" delim "\n")) | ||
53 | (open-input-string (irregex-replace "^#!.*\n" str "")) | ||
54 | (open-input-string (string-append "\n" delim "\n")))) | ||
55 | (expanded (open-output-string)) | ||
56 | (output (begin | ||
57 | (display (eval (read template)) expanded) | ||
58 | (get-output-string expanded)))) | ||
59 | (irregex-replace/all `(seq ,(%def/replacer) (* "\n")) | ||
60 | output | ||
61 | "")))) | ||
62 | |||
63 | (define (expand-port #!optional port) | ||
64 | (let ((port (or port (current-input-port)))) | ||
65 | (expand-string (read-string #f port)))) | ||
66 | |||
67 | (define-syntax def | ||
68 | (syntax-rules () | ||
69 | ((def var val) | ||
70 | ;; I think this only works in CHICKEN. | ||
71 | (begin (set! var val) | ||
72 | (%def/replacer))))) | ||
73 | |||
74 | (define (random-string-not-in str) | ||
75 | (let ((attempt (number->string (pseudo-random-real)))) | ||
76 | (if (irregex-search attempt str) | ||
77 | (random-string-not-in str) | ||
78 | attempt)))) | ||