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

Last change on this file since 35791 was 35791, checked in by kon, 13 months ago

C5 initial

File size: 1.9 KB
Line 
1;;;; string-interpolation-body.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Sep '17
4
5;(: string-interpolate (string #!key (eval-env environment) (eval-tag char) --> string))
6(: string-interpolate (string #!rest --> string))
7;
8(define (string-interpolate str
9          #!key (eval-env (interaction-environment)) (eval-tag #\#))
10  (let ((strp (open-input-string (check-string 'string-interpolate str))))
11    (parameterize ((parentheses-synonyms #t))
12      (let loop ((ls '()) (sl #f))
13        ;"inject" char in front
14        (define (push-char ch)
15          (if sl
16            (cons ch sl)
17            (list ch) ) )
18        ;end of interp
19        (define (end-str)
20          (if sl
21            (cons (reverse-list->string sl) ls)
22            ls ) )
23        ;in the text to interpolated
24        (define (interpolate-body)
25          (let ((ch (peek-char strp)))
26            (cond
27              ((eof-object? ch)
28                (loop ls sl) )
29              ;dup so identity
30              ((char=? eval-tag ch)
31                (begin
32                  (read-char strp) ;drop char
33                  (loop ls (push-char eval-tag)) ) )
34              ;begin special eval region
35              ((char=? #\{ ch)
36                (loop
37                  (cons (->string (eval (car (read strp)) eval-env)) (end-str))
38                  #f) )
39              ;end special eval region no matter what
40              ;!!! we do not test for #\} !!!
41              (else
42                (loop
43                  (cons (->string (eval (read strp) eval-env)) (end-str))
44                  #f) ) ) ) )
45        ;in the body or not
46        (let ((ch (read-char strp)))
47          (cond
48            ;we're done
49            ((eof-object? ch)
50              (string-concatenate-reverse (end-str)) )
51            ;we're interpolating
52            ((char=? eval-tag ch)
53              (interpolate-body) )
54            ;ordinary char
55            (else
56              (loop ls (push-char ch)) ) ) ) ) ) ) )
Note: See TracBrowser for help on using the repository browser.