source: project/release/5/string-utils/trunk/string-interpolation-body.scm @ 37679

Last change on this file since 37679 was 37679, checked in by kon, 6 weeks ago

fix string-interpolation (per #<#TAG)

File size: 2.2 KB
Line 
1;;;; string-interpolation-body.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Sep '17
4
5#|
6#<#TAG
7foo #{(+ 1 2)} three
8TAG
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)) ) ) ) ) ) ) )
Note: See TracBrowser for help on using the repository browser.