Changeset 37858 in project


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

use -local, protect against negative length in hex conversion, #"..." shouldn't use parentheses-synonyms

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

Legend:

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

    r37811 r37858  
    66;; Issues
    77;;
     8;; - #{...} is a WART! Use #..., hello!
     9;;
    810;; - Uses ##sys#print-to-string
     11
     12(: string-interpolate/sanity (string #!rest --> list))
     13;
     14(define (string-interpolate/sanity str #!key (eval-tag #\#))
     15  (let ((strp (open-input-string str)))
     16    ;objs - LIFO queue (list) of objects
     17    ;chrs - LIFO queue (list) of chars
     18    (let advance ((objs '()) (chrs #f))
     19
     20      ;"inject" char in front
     21      (define (push-char ch)
     22        `(,ch ,@(or chrs '())) )
     23
     24      ;end of, possible, intermediate string
     25      (define (pop-string)
     26        (if (not chrs)
     27          objs
     28          `(,(reverse-list->string chrs) ,@objs) ) )
     29
     30      ;"inject" object in front
     31      (define (push-object obj)
     32        `(,obj ,@(pop-string)) )
     33
     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
     53      ;in the body or not
     54      (let ((ch (read-char strp)))
     55        (cond
     56          ;we're done
     57          ((eof-object? ch)
     58            `(##sys#print-to-string (list ,@(reverse! (pop-string)))) )
     59          ;we're interpolating
     60          ((char=? eval-tag ch)
     61            (interpolate-next) )
     62          ;ordinary char
     63          (else
     64            (advance objs (push-char ch)) ) ) ) ) ) )
    965
    1066(: string-interpolate (string #!rest --> list))
    1167;
    1268(define (string-interpolate str #!key (eval-tag #\#))
    13   (let ((strp (open-input-string str)))
    14     (parameterize ((parentheses-synonyms #t))
    15       (let loop ((exs '()) (sbf #f))
    16         ;"inject" char in front
    17         (define (push-char ch)
    18           (if sbf
    19             (cons ch sbf)
    20             (list ch) ) )
    21         ;end of, possible, intermediate string
    22         (define (end-str)
    23           (if sbf
    24             (cons (reverse-list->string sbf) exs)
    25             exs ) )
    26         ;in the text to interpolated
    27         (define (interpolate-body)
    28           (let ((ch (peek-char strp)))
    29             (cond
    30               ((eof-object? ch)
    31                 (loop exs sbf) )
    32               ;dup so identity
    33               ((char=? eval-tag ch)
    34                 (begin
    35                   (read-char strp) ;drop char
    36                   (loop exs (push-char eval-tag)) ) )
    37               ;begin special eval region
    38               ((char=? #\{ ch)
    39                 (let* (
    40                   (wrapped (read strp))
    41                   (current (car wrapped)) )
    42                   (loop (cons current (end-str)) #f) ) )
    43               ;end special eval region no matter what
    44               ;!!! we do not test for #\} !!!
    45               (else
    46                 (let* (
    47                   (wrapped (read strp))
    48                   (current wrapped) )
    49                   (loop (cons current (end-str)) #f) ) ) ) ) )
    50         ;in the body or not
    51         (let ((ch (read-char strp)))
    52           (cond
    53             ;we're done
    54             ((eof-object? ch)
    55               `(##sys#print-to-string (list ,@(reverse (end-str)))) )
    56             ;we're interpolating
    57             ((char=? eval-tag ch)
    58               (interpolate-body) )
    59             ;ordinary char
    60             (else
    61               (loop exs (push-char ch)) ) ) ) ) ) ) )
     69  (parameterize ((parentheses-synonyms #t))
     70    (string-interpolate/sanity str #:eval-tag eval-tag) ) )
     71
     72;;;
     73
     74(set-sharp-string-interpolation-syntax
     75  (if (feature? 'sanity)
     76    string-interpolate/sanity
     77    string-interpolate))
  • release/5/string-utils/trunk/string-interpolation-syntax.scm

    r37679 r37858  
    1717;;;
    1818
    19 ;(string --> string)
    2019(: set-sharp-string-interpolation-syntax ((or boolean procedure) -> void))
    2120;
  • release/5/string-utils/trunk/string-interpolation.scm

    r37679 r37858  
    1212(import scheme
    1313  (chicken base)
     14  (chicken platform)
     15  (chicken type)
    1416  (only (chicken string) ->string reverse-list->string)
    15   (chicken type)
    1617  (only (srfi 1) reverse!)
    1718  (only (srfi 13) string-concatenate-reverse)
     
    2021;refs parentheses-synonyms
    2122
    22 ;;;
    23 
    2423(include "string-interpolation-body")
    2524
    26 ;;;
    27 
    28 (set-sharp-string-interpolation-syntax string-interpolate)
    29 
    3025) ;string-interpolation
  • release/5/string-utils/trunk/string-utils.egg

    r37679 r37858  
    33
    44((synopsis "String Utilities")
    5  (version "2.2.0")
     5 (version "2.2.1")
    66 (category data)
    77 (author "[[kon lovett]]")
     
    1919    #;(inline-file)
    2020    (types-file)
    21     (csc-options "-O3" "-d1" "-no-procedure-checks") )
     21    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") )
    2222  (extension string-hexadecimal
    2323    #;(inline-file)
    2424    (types-file)
    2525    (component-dependencies to-hex)
    26     (csc-options "-O3" "-d1" "-no-procedure-checks") )
     26    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") )
    2727  (extension unicode-utils
    2828    #;(inline-file)
    2929    (types-file)
    30     (csc-options "-O3" "-d1" "-no-procedure-checks") )
     30    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") )
    3131  (extension memoized-string
    3232    #;(inline-file)
    3333    (types-file)
    3434    (component-dependencies unicode-utils)
    35     (csc-options "-O3" "-d1" "-no-procedure-checks") )
     35    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") )
    3636  (extension string-interpolation-syntax
    3737    #;(inline-file)
    3838    (types-file)
    39     (csc-options "-O3" "-d1" "-no-procedure-checks") )
     39    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") )
    4040  (extension string-interpolation
    4141    #;(inline-file)
    4242    (types-file)
    4343    (component-dependencies string-interpolation-syntax)
    44     (csc-options "-O3" "-d1" "-no-procedure-checks") )
     44    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") )
    4545  (extension utf8-string-interpolation
    4646    #;(inline-file)
    4747    (types-file)
    4848    (component-dependencies string-interpolation-syntax)
    49     (csc-options "-O3" "-d1" "-no-procedure-checks") )
     49    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") )
    5050  (extension string-utils
    5151    #;(inline-file)
    5252    (types-file)
    5353    (component-dependencies memoized-string)
    54     (csc-options "-O3" "-d1" "-no-procedure-checks") ) ) )
     54    (csc-options "-local" "-O3" "-d1" "-no-procedure-checks") ) ) )
  • release/5/string-utils/trunk/to-hex.scm

    r35834 r37858  
    1010  static char digits[] = "0123456789abcdef";
    1111
     12  if (len <= 0) return;
     13
    1214  in += off;
    13   while( len-- ) {
     15  while (len--) {
    1416    *out++ = digits[ *in >> 4 ];
    1517    *out++ = digits[ *in++ & 0x0f ];
     
    2224# define hex_nibble(c)  (isdigit(c) ? ((c) - '0') : (((c) - 'a') + 10))
    2325
     26  if (len <= 0) return;
     27
    2428  in += off;
    25   while( 0 <= (len -= 2) ) {
     29  while (0 <= (len -= 2)) {
    2630    unsigned char in0 = tolower( in[0] );
    2731    unsigned char in1 = tolower( in[1] );
  • release/5/string-utils/trunk/utf8-string-interpolation.scm

    r37679 r37858  
    1010(import (except scheme read-char #;peek-char #;read)
    1111  (chicken base)
     12  (chicken platform)
    1213  (chicken type)
    1314  (only (chicken string) ->string)
     15  (only (srfi 1) reverse!)
    1416  (only utf8-srfi-13 string-concatenate-reverse #;reverse-list->string)
    1517  (only utf8 read-char list->string #;peek-char #;read)
    16   (only (srfi 1) reverse!)
    1718  string-interpolation-syntax)
    1819
    1920;refs parentheses-synonyms
    20 
    21 ;;;
    2221
    2322(define-inline (reverse-list->string clist)
     
    2625(include "string-interpolation-body")
    2726
    28 ;;;
    29 
    30 (set-sharp-string-interpolation-syntax string-interpolate)
    31 
    3227) ;utf8-string-interpolation
Note: See TracChangeset for help on using the changeset viewer.