about summary refs log tree commit diff stats
path: root/chicken-scratch.scm
diff options
context:
space:
mode:
authorCase Duckworth2023-06-08 23:03:54 -0500
committerCase Duckworth2023-06-08 23:03:54 -0500
commit0c594ea788f31c561a9d617d5c0764f99429599b (patch)
tree1a2d54077f4f9428853ddb1534b913652846ca77 /chicken-scratch.scm
parentInitial commit (diff)
downloadchicken-scratch-0c594ea788f31c561a9d617d5c0764f99429599b.tar.gz
chicken-scratch-0c594ea788f31c561a9d617d5c0764f99429599b.zip
Rewrite; rename to chicken-scratch
Diffstat (limited to 'chicken-scratch.scm')
-rwxr-xr-xchicken-scratch.scm78
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))))