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

remove let-match package, because it's already includeded in scsh.

This commit is contained in:
frese 2004-07-20 14:17:54 +00:00
parent 66b4c7abf8
commit 9a645ede38
2 changed files with 1 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
scheme/let-match.scm
View File

@ -1,99 +0,0 @@
;;; These are some macros to support using regexp matching.
;;; (let-match m mvars body ...)
;;; Bind the match & submatch vars, and eval the body forms.
(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
(%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 if-match
(syntax-rules ()
((if-match match-exp mvars on-match no-match)
(cond (match-exp => (lambda (m) (let-match m mvars on-match)))
(else no-match)))))
;;; (MATCH-COND (<match-exp> <match-vars> <body> ...)
;;; (TEST <exp> <body> ...)
;;; (TEST <exp> => <proc>)
;;; (ELSE <body> ...))
;;;
;;; The first clause is as-in IF-MATCH; the next three clauses are as-in COND.
;;;
;;; It would be slicker if we could *add* extra clauses to the syntax
;;; of COND, but Scheme macros aren't extensible this way.
(define-syntax match-cond
(syntax-rules (else test =>)
((match-cond (else body ...) clause2 ...) (begin body ...))
((match-cond) (cond))
((match-cond (TEST exp => proc) clause2 ...)
(let ((v exp)) (if v (proc v) (match-cond clause2 ...))))
((match-cond (TEST exp body ...) clause2 ...)
(if exp (begin body ...) (match-cond clause2 ...)))
((match-cond (TEST exp) clause2 ...)
(or exp (match-cond clause2 ...)))
((match-cond (match-exp mvars body ...) clause2 ...)
(if-match match-exp mvars (begin body ...)
(match-cond clause2 ...)))))
(define-syntax match-cond
(syntax-rules ()
((match-cond clause ...) (match-cond-aux () clause ...))))
(define-syntax match-cond-aux
(syntax-rules (test else)
;; No more clauses.
((match-cond-aux (cond-clause ...))
(cond cond-clause ...))
;; (TEST . <cond-clause>)
((match-cond-aux (cond-clause ...)
(test . another-cond-clause) clause2 ...)
(match-cond-aux (cond-clause ... another-cond-clause)
clause2 ...))
;; (ELSE <body> ...)
((match-cond-aux (cond-clause ...)
(else body ...) clause2 ...)
(match-cond-aux (cond-clause ... (else body ...))))
;; (<match-exp> <mvars> <body> ...)
((match-cond-aux (cond-clause ...)
(match-exp mvars body ...) clause2 ...)
(match-cond-aux (cond-clause ... (match-exp => (lambda (m)
(let-match m mvars
body ...))))
clause2 ...))))

14
scheme/packages.scm
View File

@ -3,18 +3,6 @@
(open scsh let-opt scheme) (open scsh let-opt scheme)
(files tty-utils)) (files tty-utils))
(define-structure let-match-package
(export (let-match :syntax)
(if-match :syntax)
(match-cond :syntax))
(for-syntax (open scheme
signals)) ; For ERROR
(open scsh scheme)
(access signals) ; for ERROR
(files let-match))
(define-structure expect-syntax-support (define-structure expect-syntax-support
(export expand-expect) (export expand-expect)
(open scheme structure-refs (open scheme structure-refs
@ -38,7 +26,7 @@
(expect :syntax)) (expect :syntax))
(for-syntax (open expect-syntax-support scheme)) (for-syntax (open expect-syntax-support scheme))
(open scsh formats structure-refs let-match-package (open scsh formats structure-refs
receiving defrec-package scheme srfi-13) receiving defrec-package scheme srfi-13)
(access signals) ; for ERROR (access signals) ; for ERROR