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

;; Issues
;;
;; - Uses ##sys#print-to-string
;;
;; - Drop "...#{expression}...".
;;
;; - Add "...{expression}...", like "...#expression...". Needs look lookahead(1)!

(define (string-interpolate str #!key (eval-tag #\#))
  ;
  (define read-codepoint read-char)
  (define peek-codepoint peek-char)
  ;
  (let ((inp (open-input-string str)))

    (let advance ((objs '()) ;stack of objects (string components)
                  (chrs #f)) ;stack of chars (substring components)
      ;"inject" char in front
      (define (push-char ch)
        `(,ch ,@(or chrs '())) )
      ;end of, possible, intermediate string
      (define (pop-string)
        (if (not chrs) objs
            `(,(reverse-list->string chrs) ,@objs) ) )
      ;"inject" object in front
      (define (push-object obj)
        `(,obj ,@(pop-string)) )
      ;in the body or not
      (let ((ch (read-codepoint inp)))
              ;we're done?
        (cond ((eof-object? ch)
                ;`pop-string' => new string
                `(##sys#print-to-string (list ,@(reverse! (pop-string)))) )
              ;we're interpolating?
              ((char=? eval-tag ch)
                      ;lookahead(1)
                (let ((ch (peek-codepoint inp)))
                        ;trailing tag? then treat as literal eval-tag
                  (cond ((eof-object? ch)
                          (read-codepoint inp) ;consume #!eof
                          (advance objs (push-char eval-tag)) )
                        ;read tag : <tag><tag> -> <tag>
                        ((char=? eval-tag ch)
                          (advance objs (push-char (read-codepoint inp))) )
                        ;read expression
                        (else
                          (advance (push-object (read inp)) #f) ) ) ) )
              ;ordinary char!
              (else
                (advance objs (push-char ch)) ) ) ) ) ) )