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

;;;; string-interpolation-body.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Sep '17

#|
#<#TAG
foo #{(+ 1 2)} three
TAG

    =>

(##sys#print-to-string (cons "foo " (cons (+ 1 2) (cons " three" '()))))
    =>
(##sys#print-to-string (cons* "foo " (+ 1 2) " three" '()))
    =>
(##sys#print-to-string (list "foo " (+ 1 2) " three"))
    =>
(##sys#print-to-string `("foo " ,(+ 1 2) " three"))

'(list "foo " (+ 1 2) " three")
|#

(: string-interpolate (string #!rest --> list))
;
(define (string-interpolate str #!key (eval-tag #\#))
  (let ((strp (open-input-string str)))
    (parameterize ((parentheses-synonyms #t))
      (let loop ((exs '()) (sbf #f))
        ;"inject" char in front
        (define (push-char ch)
          (if sbf
            (cons ch sbf)
            (list ch) ) )
        ;end of, possible, intermediate string
        (define (end-str)
          (if sbf
            (cons (reverse-list->string sbf) exs)
            exs ) )
        ;in the text to interpolated
        (define (interpolate-body)
          (let ((ch (peek-char strp)))
            (cond
              ((eof-object? ch)
                (loop exs sbf) )
              ;dup so identity
              ((char=? eval-tag ch)
                (begin
                  (read-char strp) ;drop char
                  (loop exs (push-char eval-tag)) ) )
              ;begin special eval region
              ((char=? #\{ ch)
                (let* (
                  (wrapped (read strp))
                  (current (car wrapped)) )
                  (loop (cons current (end-str)) #f) ) )
              ;end special eval region no matter what
              ;!!! we do not test for #\} !!!
              (else
                (let* (
                  (wrapped (read strp))
                  (current wrapped) )
                  (loop (cons current (end-str)) #f) ) ) ) ) )
        ;in the body or not
        (let ((ch (read-char strp)))
          (cond
            ;we're done
            ((eof-object? ch)
              `(##sys#print-to-string (list ,@(reverse (end-str)))) )
            ;we're interpolating
            ((char=? eval-tag ch)
              (interpolate-body) )
            ;ordinary char
            (else
              (loop exs (push-char ch)) ) ) ) ) ) ) )