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

;; Issues
;;
;; - Uses ##sys#print-to-string

(define (string-interpolate/sanity str #!key (eval-tag #\#) (bracing? #f))
  (let (
    (inp (open-input-string str)) )
    (let advance (
      ;stack of objects (string components)
      (objs '())
      ;stack of chars (substring components)
      (chrs #f) )
      ;
      ;"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-char inp)) )
        (cond
          ;
          ;we're done?
          ((eof-object? ch)
            `(##sys#print-to-string (list ,@(reverse! (pop-string)))) )
          ;
          ;we're interpolating?
          ((char=? eval-tag ch)
            ;lookahead 1
            (let (
              (ch (peek-char inp)) )
              (cond
                ;
                ;trailing tag? then literal
                ((eof-object? ch)
                  (advance objs (push-char eval-tag)) )
                ;
                ;read tag : <tag><tag> -> <tag>
                ((char=? eval-tag ch)
                  (advance objs (push-char (read-char inp))) )
                ;
                ;WART read wrapped expression
                ((and bracing? (char=? #\{ ch))
                  ;!!! we do not test for #\} !!!
                  (advance (push-object (car (read inp))) #f) )
                ;
                ;read expression
                (else
                  (advance (push-object (read inp)) #f) ) ) ) )
          ;
          ;ordinary char!
          (else
            (advance objs (push-char ch)) ) ) ) ) ) )

(define (string-interpolate str #!key (eval-tag #\#))
  (parameterize ((parentheses-synonyms #t))
    (string-interpolate/sanity str #:eval-tag eval-tag #:bracing? #t) ) )