diff --git a/scsh/rx/re-match-syntax.scm b/scsh/rx/re-match-syntax.scm index 4ff7479..666f0b0 100644 --- a/scsh/rx/re-match-syntax.scm +++ b/scsh/rx/re-match-syntax.scm @@ -11,34 +11,18 @@ ;;; of blowing up, we execute the ALT form instead. (define-syntax let-match - (lambda (exp r c) - (if (< (length exp) 3) - (error "No match-vars list in LET-MATCH" exp)) - (let ((m (cadr exp)) ; The match expression - (mvars (caddr exp)) ; The match vars - (body (cdddr exp)) ; The expression's body forms + (syntax-rules () + ((let-match ?match-exp (?mvars ...) ?body0 ?body ...) + (let ((?match-var ?match-exp)) + (let-match-aux ?match-var 0 (?mvars ...) ?body0 ?body ...))))) - (%begin (r 'begin)) - (%match:substring (r 'match:substring)) - (%let* (r 'let*))) - - (cond ((null? mvars) `(,%begin ,@body)) - - ((pair? mvars) - (let* ((msv (or (car mvars) (r 'match-val))) ; "match-struct var" - (sm-bindings (let recur ((i 0) (vars (cdr mvars))) - (if (pair? vars) - (let ((var (car vars)) - (bindings (recur (+ i 1) (cdr vars)))) - (if var - (cons `(,var (,%match:substring ,msv ,i)) - bindings) - bindings)) - '())))) - `(,%let* ((,msv ,m) ,@sm-bindings) ,@body))) - - - (else (error "Illegal match-vars list in LET-MATCH" mvars exp)))))) +(define-syntax let-match-aux + (syntax-rules () + ((let-match-aux ?match-var ?i0 (?mvar0 ?mvars ...) ?body0 ?body ...) + (let ((?mvar0 (match:substring ?match-var ?i0))) + (let-match-aux ?match-var (+ 1 ?i0) (?mvars ...) ?body0 ?body ...))) + ((let-match-aux ?match-var ?i0 () ?body0 ?body ...) + (begin ?body0 ?body ...)))) (define-syntax if-match (syntax-rules ()