Changeset 37862 in project


Ignore:
Timestamp:
08/31/19 18:34:14 (3 weeks ago)
Author:
Kon Lovett
Message:

#\{ when insane, trailing # is literal (##" = #"), simplify

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/string-utils/trunk/string-interpolation-body.scm

    r37858 r37862  
    1212(: string-interpolate/sanity (string #!rest --> list))
    1313;
    14 (define (string-interpolate/sanity str #!key (eval-tag #\#))
     14(define (string-interpolate/sanity str #!key (eval-tag #\#) (insane #f))
    1515  (let ((strp (open-input-string str)))
    1616    ;objs - LIFO queue (list) of objects
     
    3232        `(,obj ,@(pop-string)) )
    3333
    34       ;in the text to interpolated
    35       (define (interpolate-next)
    36         (let ((ch (peek-char strp)))
    37           (cond
    38             ((eof-object? ch)
    39               (advance objs chrs) )
    40             ;<tag><tag> -> <tag>
    41             ((char=? eval-tag ch)
    42               (begin
    43                 (read-char strp) ;drop char
    44                 (advance objs (push-char eval-tag)) ) )
    45             ;read wrapped expression
    46             ((char=? #\{ ch)
    47               ;!!! we do not test for #\} !!!
    48               (advance (push-object (car (read strp))) #f) )
    49             ;read expression
    50             (else
    51               (advance (push-object (read strp)) #f) ) ) ) )
    52 
    5334      ;in the body or not
    5435      (let ((ch (read-char strp)))
    5536        (cond
    56           ;we're done
     37
     38          ;we're done?
    5739          ((eof-object? ch)
    5840            `(##sys#print-to-string (list ,@(reverse! (pop-string)))) )
    59           ;we're interpolating
     41
     42          ;we're interpolating?
    6043          ((char=? eval-tag ch)
    61             (interpolate-next) )
    62           ;ordinary char
     44            (let ((ch (peek-char strp)))
     45              (cond
     46                ;trailing eval-tag? then literal
     47                ((eof-object? ch)
     48                  (advance objs (push-char eval-tag)) )
     49                ;<tag><tag> -> <tag>
     50                ((char=? eval-tag ch)
     51                  (begin
     52                    (read-char strp) ;drop char
     53                    (advance objs (push-char eval-tag)) ) )
     54                ;WART read wrapped expression
     55                ((and insane (char=? #\{ ch))
     56                  ;!!! we do not test for #\} !!!
     57                  (advance (push-object (car (read strp))) #f) )
     58                ;read expression
     59                (else
     60                  (advance (push-object (read strp)) #f) ) ) ) )
     61
     62          ;ordinary char!
    6363          (else
    6464            (advance objs (push-char ch)) ) ) ) ) ) )
     
    6868(define (string-interpolate str #!key (eval-tag #\#))
    6969  (parameterize ((parentheses-synonyms #t))
    70     (string-interpolate/sanity str #:eval-tag eval-tag) ) )
     70    (string-interpolate/sanity str #:eval-tag eval-tag #:insane #t) ) )
    7171
    7272;;;
Note: See TracChangeset for help on using the changeset viewer.