source: project/release/4/string-utils/trunk/string-interpolation-body.scm @ 34660

Last change on this file since 34660 was 34660, checked in by kon, 11 months ago

fix body

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