scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make LET-MATCH/IF-MATCH conform to documentation & comments. 

In the process, rewrite LET-MATCH as a SYNTAX-RULES macro.
This commit is contained in:
sperber 2002-12-17 13:33:33 +00:00
parent 465e012cf8
commit aa1481450d
1 changed files with 11 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
scsh/rx/re-match-syntax.scm
View File

@ -11,34 +11,18 @@
;;; of blowing up, we execute the ALT form instead. ;;; of blowing up, we execute the ALT form instead.
(define-syntax let-match (define-syntax let-match
(lambda (exp r c) (syntax-rules ()
(if (< (length exp) 3) ((let-match ?match-exp (?mvars ...) ?body0 ?body ...)
(error "No match-vars list in LET-MATCH" exp)) (let ((?match-var ?match-exp))
(let ((m (cadr exp)) ; The match expression (let-match-aux ?match-var 0 (?mvars ...) ?body0 ?body ...)))))
(mvars (caddr exp)) ; The match vars
(body (cdddr exp)) ; The expression's body forms
(%begin (r 'begin)) (define-syntax let-match-aux
(%match:substring (r 'match:substring)) (syntax-rules ()
(%let* (r 'let*))) ((let-match-aux ?match-var ?i0 (?mvar0 ?mvars ...) ?body0 ?body ...)
(let ((?mvar0 (match:substring ?match-var ?i0)))
(cond ((null? mvars) `(,%begin ,@body)) (let-match-aux ?match-var (+ 1 ?i0) (?mvars ...) ?body0 ?body ...)))
((let-match-aux ?match-var ?i0 () ?body0 ?body ...)
((pair? mvars) (begin ?body0 ?body ...))))
(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 if-match (define-syntax if-match
(syntax-rules () (syntax-rules ()