Changeset 37679 in project


Ignore:
Timestamp:
06/09/19 23:16:26 (7 days ago)
Author:
kon
Message:

fix string-interpolation (per #<#TAG)

Location:
release/5/string-utils/trunk
Files:
7 edited

Legend:

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

    r35791 r37679  
    33;;;; Kon Lovett, Sep '17
    44
    5 ;(: string-interpolate (string #!key (eval-env environment) (eval-tag char) --> string))
    6 (: string-interpolate (string #!rest --> string))
     5#|
     6#<#TAG
     7foo #{(+ 1 2)} three
     8TAG
     9
     10    =>
     11
     12(##sys#print-to-string (cons "foo " (cons (+ 1 2) (cons " three" '()))))
     13    =>
     14(##sys#print-to-string (cons* "foo " (+ 1 2) " three" '()))
     15    =>
     16(##sys#print-to-string (list "foo " (+ 1 2) " three"))
     17    =>
     18(##sys#print-to-string `("foo " ,(+ 1 2) " three"))
     19
     20'(list "foo " (+ 1 2) " three")
     21|#
     22
     23(: string-interpolate (string #!rest --> list))
    724;
    8 (define (string-interpolate str
    9           #!key (eval-env (interaction-environment)) (eval-tag #\#))
    10   (let ((strp (open-input-string (check-string 'string-interpolate str))))
     25(define (string-interpolate str #!key (eval-tag #\#))
     26  (let ((strp (open-input-string str)))
    1127    (parameterize ((parentheses-synonyms #t))
    12       (let loop ((ls '()) (sl #f))
     28      (let loop ((exs '()) (sbf #f))
    1329        ;"inject" char in front
    1430        (define (push-char ch)
    15           (if sl
    16             (cons ch sl)
     31          (if sbf
     32            (cons ch sbf)
    1733            (list ch) ) )
    18         ;end of interp
     34        ;end of, possible, intermediate string
    1935        (define (end-str)
    20           (if sl
    21             (cons (reverse-list->string sl) ls)
    22             ls ) )
     36          (if sbf
     37            (cons (reverse-list->string sbf) exs)
     38            exs ) )
    2339        ;in the text to interpolated
    2440        (define (interpolate-body)
     
    2642            (cond
    2743              ((eof-object? ch)
    28                 (loop ls sl) )
     44                (loop exs sbf) )
    2945              ;dup so identity
    3046              ((char=? eval-tag ch)
    3147                (begin
    3248                  (read-char strp) ;drop char
    33                   (loop ls (push-char eval-tag)) ) )
     49                  (loop exs (push-char eval-tag)) ) )
    3450              ;begin special eval region
    3551              ((char=? #\{ ch)
    36                 (loop
    37                   (cons (->string (eval (car (read strp)) eval-env)) (end-str))
    38                   #f) )
     52                (let* (
     53                  (wrapped (read strp))
     54                  (current (car wrapped)) )
     55                  (loop (cons current (end-str)) #f) ) )
    3956              ;end special eval region no matter what
    4057              ;!!! we do not test for #\} !!!
    4158              (else
    42                 (loop
    43                   (cons (->string (eval (read strp) eval-env)) (end-str))
    44                   #f) ) ) ) )
     59                (let* (
     60                  (wrapped (read strp))
     61                  (current wrapped) )
     62                  (loop (cons current (end-str)) #f) ) ) ) ) )
    4563        ;in the body or not
    4664        (let ((ch (read-char strp)))
     
    4866            ;we're done
    4967            ((eof-object? ch)
    50               (string-concatenate-reverse (end-str)) )
     68              `(##sys#print-to-string (list ,@(reverse (end-str)))) )
    5169            ;we're interpolating
    5270            ((char=? eval-tag ch)
     
    5472            ;ordinary char
    5573            (else
    56               (loop ls (push-char ch)) ) ) ) ) ) ) )
     74              (loop exs (push-char ch)) ) ) ) ) ) ) )
  • release/5/string-utils/trunk/string-interpolation-syntax.scm

    r35791 r37679  
    2222(define (set-sharp-string-interpolation-syntax proc)
    2323  (set-sharp-read-syntax! #\"
    24     (if (not proc)
    25       #f
    26       (let ((proc (if (boolean? proc) identity proc)))
     24    (and
     25      proc
     26      (let (
     27        (proc (if (procedure? proc) proc identity)) )
    2728        (lambda (rest-port)
    2829          (call-with-input-string "\""
    2930            (lambda (head-port)
    30               (let* ((port (make-concatenated-port head-port rest-port) )
    31                      (str (read port) ) )
     31              (let* (
     32                (port (make-concatenated-port head-port rest-port))
     33                (str (read port)) )
    3234                (proc str) ) ) ) ) ) ) ) )
    3335
  • release/5/string-utils/trunk/string-interpolation.scm

    r35791 r37679  
    1212(import scheme
    1313  (chicken base)
    14   (only (srfi 13) string-concatenate-reverse)
    1514  (only (chicken string) ->string reverse-list->string)
    1615  (chicken type)
    17   (only type-checks check-string)
     16  (only (srfi 1) reverse!)
     17  (only (srfi 13) string-concatenate-reverse)
    1818  string-interpolation-syntax)
     19
     20;refs parentheses-synonyms
    1921
    2022;;;
  • release/5/string-utils/trunk/string-utils.egg

    r37677 r37679  
    33
    44((synopsis "String Utilities")
    5  (version "2.1.1")
     5 (version "2.2.0")
    66 (category data)
    77 (author "[[kon lovett]]")
  • release/5/string-utils/trunk/tests/run.scm

    r35791 r37679  
    1515(define *csc-options* "-inline-global \
    1616  -specialize -optimize-leaf-routines -clustering -lfa2 \
    17   -local -inline \
    18   -no-trace -no-lambda-info \
    19   -unsafe")
     17  -local -inline")
    2018
    2119(define (test-name #!optional (eggnam EGG-NAME))
  • release/5/string-utils/trunk/tests/string-utils-test.scm

    r36059 r37679  
    7373
    7474(test-group "String Interpolation"
    75         (test "foo 3 bar" (string-interpolate "foo #(+ 1 2) bar"))
    76         (test "foo 3 bar" (string-interpolate "foo #(+ 1 2) bar" eval-env: (scheme-report-environment 5)))
    77         (test "foo 3 bar" (string-interpolate "foo ${(+ 1 2)} bar" eval-tag: #\$))
    78         (test "foo 3 bar" (string-interpolate "foo $(+ 1 2) bar" eval-tag: #\$ eval-env: (scheme-report-environment 5)))
     75  (let ((res '(##sys#print-to-string (list "foo " (+ 1 2) " bar"))))
     76    (test res (string-interpolate "foo #(+ 1 2) bar"))
     77    (test res (string-interpolate "foo #(+ 1 2) bar"))
     78    (test res (string-interpolate "foo ${(+ 1 2)} bar" eval-tag: #\$))
     79    (test res (string-interpolate "foo $(+ 1 2) bar" eval-tag: #\$)) )
    7980)
    8081
     
    8283
    8384(test-group "String Interpolation (UTF-8)"
    84         (test "听诎䞊海的 3 䞜西埈莵" (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
    85         (test "听诎䞊海的 3 䞜西埈莵" (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵" eval-env: (scheme-report-environment 5)))
    86         (test "听诎䞊海的 3 䞜西埈莵" (utf8::string-interpolate "听诎䞊海的 ${(+ 1 2)} 䞜西埈莵" eval-tag: #\$))
    87         (test "听诎䞊海的 3 䞜西埈莵" (utf8::string-interpolate "听诎䞊海的 $(+ 1 2) 䞜西埈莵" eval-tag: #\$ eval-env: (scheme-report-environment 5)))
     85  (let ((res '(##sys#print-to-string (list "听诎䞊海的 " (+ 1 2) " 䞜西埈莵"))))
     86    (test res (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
     87    (test res (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
     88    (test res (utf8::string-interpolate "听诎䞊海的 ${(+ 1 2)} 䞜西埈莵" eval-tag: #\$))
     89    (test res (utf8::string-interpolate "听诎䞊海的 $(+ 1 2) 䞜西埈莵" eval-tag: #\$)) )
    8890)
    8991
     
    9395(test-begin "String Interpolation SYNTAX")
    9496  (set-sharp-string-interpolation-syntax string-interpolate)
    95   (test '("foo 3 bar") (list (call-with-input-string "#\"foo #{(+ 1 2)} bar\"" read)))
     97  (test
     98    '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
     99    (list (call-with-input-string "#\"foo #{(+ 1 2)} bar\"" read)))
    96100  (set-sharp-string-interpolation-syntax #f)
    97101
    98102  (set-sharp-string-interpolation-syntax
    99     (cute string-interpolate <> eval-tag: #\$ eval-env: (scheme-report-environment 5)))
    100   (test '("foo 3 bar") (list (call-with-input-string "#\"foo ${(+ 1 2)} bar\"" read)))
     103    (cute string-interpolate <> eval-tag: #\$))
     104  (test
     105    '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
     106    (list (call-with-input-string "#\"foo ${(+ 1 2)} bar\"" read)))
    101107  (set-sharp-string-interpolation-syntax #f)
    102108(test-end "String Interpolation SYNTAX")
  • release/5/string-utils/trunk/utf8-string-interpolation.scm

    r36059 r37679  
    1515  (only utf8 read-char list->string #;peek-char #;read)
    1616  (only (srfi 1) reverse!)
    17   (only type-checks check-string)
    1817  string-interpolation-syntax)
    1918
    20 ;refs interaction-environment parentheses-synonyms
     19;refs parentheses-synonyms
    2120
    2221;;;
Note: See TracChangeset for help on using the changeset viewer.