1 | ;;;; string-interpolation-body.scm -*- Scheme -*- |
---|
2 | ;;;; Kon Lovett, Jul '18 |
---|
3 | ;;;; Kon Lovett, Sep '17 |
---|
4 | |
---|
5 | #| |
---|
6 | #<#TAG |
---|
7 | foo #{(+ 1 2)} three |
---|
8 | TAG |
---|
9 | |
---|
10 | => |
---|
11 | |
---|
12 | (##sys#print-to-string (cons "foo " (cons (+ 1 2) (cons " three" '())))) |
---|
13 | => |
---|
14 | (##sys#print-to-string (cons* "foo " (+ 1 2) " three" '())) |
---|
15 | => |
---|
16 | (##sys#print-to-string (list "foo " (+ 1 2) " three")) |
---|
17 | => |
---|
18 | (##sys#print-to-string `("foo " ,(+ 1 2) " three")) |
---|
19 | |
---|
20 | '(list "foo " (+ 1 2) " three") |
---|
21 | |# |
---|
22 | |
---|
23 | (: string-interpolate (string #!rest --> list)) |
---|
24 | ; |
---|
25 | (define (string-interpolate str #!key (eval-tag #\#)) |
---|
26 | (let ((strp (open-input-string str))) |
---|
27 | (parameterize ((parentheses-synonyms #t)) |
---|
28 | (let loop ((exs '()) (sbf #f)) |
---|
29 | ;"inject" char in front |
---|
30 | (define (push-char ch) |
---|
31 | (if sbf |
---|
32 | (cons ch sbf) |
---|
33 | (list ch) ) ) |
---|
34 | ;end of, possible, intermediate string |
---|
35 | (define (end-str) |
---|
36 | (if sbf |
---|
37 | (cons (reverse-list->string sbf) exs) |
---|
38 | exs ) ) |
---|
39 | ;in the text to interpolated |
---|
40 | (define (interpolate-body) |
---|
41 | (let ((ch (peek-char strp))) |
---|
42 | (cond |
---|
43 | ((eof-object? ch) |
---|
44 | (loop exs sbf) ) |
---|
45 | ;dup so identity |
---|
46 | ((char=? eval-tag ch) |
---|
47 | (begin |
---|
48 | (read-char strp) ;drop char |
---|
49 | (loop exs (push-char eval-tag)) ) ) |
---|
50 | ;begin special eval region |
---|
51 | ((char=? #\{ ch) |
---|
52 | (let* ( |
---|
53 | (wrapped (read strp)) |
---|
54 | (current (car wrapped)) ) |
---|
55 | (loop (cons current (end-str)) #f) ) ) |
---|
56 | ;end special eval region no matter what |
---|
57 | ;!!! we do not test for #\} !!! |
---|
58 | (else |
---|
59 | (let* ( |
---|
60 | (wrapped (read strp)) |
---|
61 | (current wrapped) ) |
---|
62 | (loop (cons current (end-str)) #f) ) ) ) ) ) |
---|
63 | ;in the body or not |
---|
64 | (let ((ch (read-char strp))) |
---|
65 | (cond |
---|
66 | ;we're done |
---|
67 | ((eof-object? ch) |
---|
68 | `(##sys#print-to-string (list ,@(reverse (end-str)))) ) |
---|
69 | ;we're interpolating |
---|
70 | ((char=? eval-tag ch) |
---|
71 | (interpolate-body) ) |
---|
72 | ;ordinary char |
---|
73 | (else |
---|
74 | (loop exs (push-char ch)) ) ) ) ) ) ) ) |
---|