diff --git a/scheme/let-match.scm b/scheme/let-match.scm deleted file mode 100644 index 6447cb0..0000000 --- a/scheme/let-match.scm +++ /dev/null @@ -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 ( ...) -;;; (TEST ...) -;;; (TEST => ) -;;; (ELSE ...)) -;;; -;;; 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 . ) - ((match-cond-aux (cond-clause ...) - (test . another-cond-clause) clause2 ...) - (match-cond-aux (cond-clause ... another-cond-clause) - clause2 ...)) - - ;; (ELSE ...) - ((match-cond-aux (cond-clause ...) - (else body ...) clause2 ...) - (match-cond-aux (cond-clause ... (else 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 ...)))) diff --git a/scheme/packages.scm b/scheme/packages.scm index 3ad812f..fd959b7 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -3,18 +3,6 @@ (open scsh let-opt scheme) (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 (export expand-expect) (open scheme structure-refs @@ -38,7 +26,7 @@ (expect :syntax)) (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) (access signals) ; for ERROR