Changeset 15057 in project for chicken/trunk/srfi-13.scm


Ignore:
Timestamp:
06/25/09 09:39:06 (11 years ago)
Author:
felix winkelmann
Message:

fix for begin-capturing bug (#47), removed uses of define-macro

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/srfi-13.scm

    r15038 r15057  
    172172;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    173173
    174 (cond-expand
    175  ((not hygienic-macros)
    176   (define-macro (let-string-start+end2 s-e proc s1 s2 args . body)
    177     (let ([procv (gensym)]
    178           [rest (gensym)] )
    179       `(let ((,procv ,proc))
    180          (let-string-start+end
    181           (,(car s-e) ,(cadr s-e) ,rest) ,procv ,s1 ,args
    182           (let-string-start+end
    183            ,(cddr s-e) ,procv ,s2 ,rest
    184            ,@body) ) ) ) ) )
    185  (else
    186   (define-syntax let-string-start+end2
    187     (syntax-rules ()
    188       ((_ (s-e1 s-e2 s-e3 s-e4) proc s1 s2 args . body)
    189        (let ((procv proc))
    190          (let-string-start+end
    191           (s-e1 s-e2 rest) procv s1 args
    192           (let-string-start+end
    193            (s-e3 s-e4) procv s2 rest
    194            . body) ) ) ) ) ) ) )
    195 
    196 (cond-expand
    197  ((not hygienic-macros)
    198   (define-macro (let-string-start+end s-e-r proc s-exp args-exp . body)
    199     (if (pair? (cddr s-e-r))
    200         `(receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
    201              (string-parse-start+end ,proc ,s-exp ,args-exp)
    202            ,@body)
    203         `(receive ,s-e-r
    204              (string-parse-final-start+end ,proc ,s-exp ,args-exp)
    205            ,@body) ) ) )
    206  (else
    207   (define-syntax let-string-start+end
    208     (lambda (form r c)
    209       (##sys#check-syntax 'let-string-start+end form '(_ _ _ _ _ . _))
    210       (let ((s-e-r (cadr form))
    211             (proc (caddr form))
    212             (s-exp (cadddr form))
    213             (args-exp (car (cddddr form)))
    214             (body (cdr (cddddr form)))
    215             (%receive (r 'receive))
    216             (%string-parse-start+end (r 'string-parse-start+end))
    217             (%string-parse-final-start+end (r 'string-parse-final-start+end)))
    218         (if (pair? (cddr s-e-r))
    219             `(,%receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
    220                         (,%string-parse-start+end ,proc ,s-exp ,args-exp)
    221                         ,@body)
    222             `(,%receive ,s-e-r
    223                         (,%string-parse-final-start+end ,proc ,s-exp ,args-exp)
    224                         ,@body) ) )))) )
     174(define-syntax let-string-start+end2
     175  (syntax-rules ()
     176    ((_ (s-e1 s-e2 s-e3 s-e4) proc s1 s2 args . body)
     177     (let ((procv proc))
     178       (let-string-start+end
     179        (s-e1 s-e2 rest) procv s1 args
     180        (let-string-start+end
     181         (s-e3 s-e4) procv s2 rest
     182         . body) ) ) ) ) )
     183
     184(define-syntax let-string-start+end
     185  (lambda (form r c)
     186    (##sys#check-syntax 'let-string-start+end form '(_ _ _ _ _ . _))
     187    (let ((s-e-r (cadr form))
     188          (proc (caddr form))
     189          (s-exp (cadddr form))
     190          (args-exp (car (cddddr form)))
     191          (body (cdr (cddddr form)))
     192          (%receive (r 'receive))
     193          (%string-parse-start+end (r 'string-parse-start+end))
     194          (%string-parse-final-start+end (r 'string-parse-final-start+end)))
     195      (if (pair? (cddr s-e-r))
     196          `(,%receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
     197                      (,%string-parse-start+end ,proc ,s-exp ,args-exp)
     198                      ,@body)
     199          `(,%receive ,s-e-r
     200                      (,%string-parse-final-start+end ,proc ,s-exp ,args-exp)
     201                      ,@body) ) )))
    225202
    226203
Note: See TracChangeset for help on using the changeset viewer.