Changeset 37913 in project


Ignore:
Timestamp:
09/27/19 23:25:40 (3 weeks ago)
Author:
felix winkelmann
Message:

srfi-13 0.3: applied performance improvement patch by sjamaan

Location:
release/5/srfi-13
Files:
2 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/srfi-13/tags/0.3/srfi-13.scm

    r37817 r37913  
    224224;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    225225
     226(define-syntax check-string-lengths
     227  (syntax-rules ()
     228    ((check-string-lengths s start end)
     229     (let* ((slen (string-length s)))
     230       (cond ((not (and (fixnum? start) (>= start 0)))
     231              (##sys#error 'proc "Illegal substring START spec" start s)))
     232       (cond ((not (and (fixnum? end) (<= end slen)))
     233              (##sys#error 'proc "Illegal substring END spec" end s)))
     234       (unless (<= start end)
     235         (##sys#error 'proc "Illegal substring START/END spec" start end s))))))
     236
    226237(define-syntax let-string-start+end2
    227238  (syntax-rules ()
    228     ((_ (s-e1 s-e2 s-e3 s-e4) proc s1 s2 args . body)
    229      (let ((procv proc))
    230        (let-string-start+end
    231         (s-e1 s-e2 rest) procv s1 args
    232         (let-string-start+end
    233          (s-e3 s-e4) procv s2 rest
    234          . body) ) ) ) ) )
     239    ((let-string-start+end2 (start1 end1 start2 end2) proc s1-exp s2-exp args-exp body ...)
     240     (let ((s1 s1-exp) (s2 s2-exp))
     241       (let-optionals* args-exp ((start1 0) (end1 (string-length s1))
     242                                 (start2 0) (end2 (string-length s2)))
     243         (check-string-lengths s1-exp start1 end1)
     244         (check-string-lengths s2-exp start2 end2)
     245         body ...))) ) )
    235246
    236247(define-syntax let-string-start+end
    237   (er-macro-transformer
    238    (lambda (form r c)
    239      (##sys#check-syntax 'let-string-start+end form '(_ _ _ _ _ . _))
    240      (let ((s-e-r (cadr form))
    241            (proc (caddr form))
    242            (s-exp (cadddr form))
    243            (args-exp (car (cddddr form)))
    244            (body (cdr (cddddr form)))
    245            (%receive (r 'receive))
    246            (%string-parse-start+end (r 'string-parse-start+end))
    247            (%string-parse-final-start+end (r 'string-parse-final-start+end)))
    248        (if (pair? (cddr s-e-r))
    249            `(,%receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
    250                        (,%string-parse-start+end ,proc ,s-exp ,args-exp)
    251                        ,@body)
    252            `(,%receive ,s-e-r
    253                        (,%string-parse-final-start+end ,proc ,s-exp ,args-exp)
    254                        ,@body) ) ))))
     248  (syntax-rules ()
     249    ((let-string-start+end (start end) proc s-exp args-exp body ...)
     250     (let ((s s-exp)) ; Note: if this is a complex expression, it's less efficient
     251       (let-optionals* args-exp ((start 0) (end (string-length s)))
     252         (check-string-lengths s start end)
     253         body ...)))
     254    ((let-string-start+end (start end rest) proc s-exp args-exp body ...)
     255     (let ((s s-exp))
     256       (let-optionals* args-exp ((start 0) (end (string-length s)) rest)
     257         (check-string-lengths s start end)
     258         body ...)))))
    255259
    256260
     
    10211025                                                        ;     (<= 0 bound)))
    10221026                                         rest)
    1023     (##sys#check-fixnum bound 'string-hash)
    1024     (if (zero? bound) (set! bound 4194304))
    10251027    (let-string-start+end (start end) string-hash s rest
     1028      (##sys#check-fixnum bound 'string-hash)
     1029      (if (zero? bound) (set! bound 4194304))
    10261030      (%string-hash s char->integer bound start end))))
    10271031
     
    10311035                                                         ;    (<= 0 bound)))
    10321036                                         rest)
    1033     (##sys#check-fixnum bound 'string-hash-ci)
    1034     (if (zero? bound) (set! bound 4194304))
    10351037    (let-string-start+end (start end) string-hash-ci s rest
     1038      (##sys#check-fixnum bound 'string-hash-ci)
     1039      (if (zero? bound) (set! bound 4194304))
    10361040      (%string-hash s (lambda (c) (char->integer (char-downcase c)))
    10371041                    bound start end))))
     
    11681172
    11691173(define (string-pad-right s n . char+start+end)
    1170   (##sys#check-fixnum n 'string-pad-right)
    11711174  (let-optionals* char+start+end ((char #\space) rest) ; (char? char)) rest)
    11721175    (let-string-start+end (start end) string-pad-right s rest
     1176      (##sys#check-fixnum n 'string-pad-right)
    11731177      (let ((len (- end start)))
    11741178        (if (<= n len)
     
    11791183
    11801184(define (string-pad s n . char+start+end)
    1181   (##sys#check-fixnum n 'string-pad)
    11821185  (let-optionals* char+start+end ((char #\space) rest) ; (char? char)) rest)
    11831186    (let-string-start+end (start end) string-pad s rest
     1187      (##sys#check-fixnum n 'string-pad)
    11841188      (let ((len (- end start)))
    11851189        (if (<= n len)
  • release/5/srfi-13/trunk/srfi-13.scm

    r37817 r37913  
    224224;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    225225
     226(define-syntax check-string-lengths
     227  (syntax-rules ()
     228    ((check-string-lengths s start end)
     229     (let* ((slen (string-length s)))
     230       (cond ((not (and (fixnum? start) (>= start 0)))
     231              (##sys#error 'proc "Illegal substring START spec" start s)))
     232       (cond ((not (and (fixnum? end) (<= end slen)))
     233              (##sys#error 'proc "Illegal substring END spec" end s)))
     234       (unless (<= start end)
     235         (##sys#error 'proc "Illegal substring START/END spec" start end s))))))
     236
    226237(define-syntax let-string-start+end2
    227238  (syntax-rules ()
    228     ((_ (s-e1 s-e2 s-e3 s-e4) proc s1 s2 args . body)
    229      (let ((procv proc))
    230        (let-string-start+end
    231         (s-e1 s-e2 rest) procv s1 args
    232         (let-string-start+end
    233          (s-e3 s-e4) procv s2 rest
    234          . body) ) ) ) ) )
     239    ((let-string-start+end2 (start1 end1 start2 end2) proc s1-exp s2-exp args-exp body ...)
     240     (let ((s1 s1-exp) (s2 s2-exp))
     241       (let-optionals* args-exp ((start1 0) (end1 (string-length s1))
     242                                 (start2 0) (end2 (string-length s2)))
     243         (check-string-lengths s1-exp start1 end1)
     244         (check-string-lengths s2-exp start2 end2)
     245         body ...))) ) )
    235246
    236247(define-syntax let-string-start+end
    237   (er-macro-transformer
    238    (lambda (form r c)
    239      (##sys#check-syntax 'let-string-start+end form '(_ _ _ _ _ . _))
    240      (let ((s-e-r (cadr form))
    241            (proc (caddr form))
    242            (s-exp (cadddr form))
    243            (args-exp (car (cddddr form)))
    244            (body (cdr (cddddr form)))
    245            (%receive (r 'receive))
    246            (%string-parse-start+end (r 'string-parse-start+end))
    247            (%string-parse-final-start+end (r 'string-parse-final-start+end)))
    248        (if (pair? (cddr s-e-r))
    249            `(,%receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
    250                        (,%string-parse-start+end ,proc ,s-exp ,args-exp)
    251                        ,@body)
    252            `(,%receive ,s-e-r
    253                        (,%string-parse-final-start+end ,proc ,s-exp ,args-exp)
    254                        ,@body) ) ))))
     248  (syntax-rules ()
     249    ((let-string-start+end (start end) proc s-exp args-exp body ...)
     250     (let ((s s-exp)) ; Note: if this is a complex expression, it's less efficient
     251       (let-optionals* args-exp ((start 0) (end (string-length s)))
     252         (check-string-lengths s start end)
     253         body ...)))
     254    ((let-string-start+end (start end rest) proc s-exp args-exp body ...)
     255     (let ((s s-exp))
     256       (let-optionals* args-exp ((start 0) (end (string-length s)) rest)
     257         (check-string-lengths s start end)
     258         body ...)))))
    255259
    256260
     
    10211025                                                        ;     (<= 0 bound)))
    10221026                                         rest)
    1023     (##sys#check-fixnum bound 'string-hash)
    1024     (if (zero? bound) (set! bound 4194304))
    10251027    (let-string-start+end (start end) string-hash s rest
     1028      (##sys#check-fixnum bound 'string-hash)
     1029      (if (zero? bound) (set! bound 4194304))
    10261030      (%string-hash s char->integer bound start end))))
    10271031
     
    10311035                                                         ;    (<= 0 bound)))
    10321036                                         rest)
    1033     (##sys#check-fixnum bound 'string-hash-ci)
    1034     (if (zero? bound) (set! bound 4194304))
    10351037    (let-string-start+end (start end) string-hash-ci s rest
     1038      (##sys#check-fixnum bound 'string-hash-ci)
     1039      (if (zero? bound) (set! bound 4194304))
    10361040      (%string-hash s (lambda (c) (char->integer (char-downcase c)))
    10371041                    bound start end))))
     
    11681172
    11691173(define (string-pad-right s n . char+start+end)
    1170   (##sys#check-fixnum n 'string-pad-right)
    11711174  (let-optionals* char+start+end ((char #\space) rest) ; (char? char)) rest)
    11721175    (let-string-start+end (start end) string-pad-right s rest
     1176      (##sys#check-fixnum n 'string-pad-right)
    11731177      (let ((len (- end start)))
    11741178        (if (<= n len)
     
    11791183
    11801184(define (string-pad s n . char+start+end)
    1181   (##sys#check-fixnum n 'string-pad)
    11821185  (let-optionals* char+start+end ((char #\space) rest) ; (char? char)) rest)
    11831186    (let-string-start+end (start end) string-pad s rest
     1187      (##sys#check-fixnum n 'string-pad)
    11841188      (let ((len (- end start)))
    11851189        (if (<= n len)
Note: See TracChangeset for help on using the changeset viewer.