match.scm

Scheme跨平台编译器

                                    '(unspecified error fail match)
                                    "invalid value for ##match#error-control, legal values are")))))
           (unreachable (lambda (plist match-expr)
                          (for-each
                            (lambda (x)
                              (if (not (car (cddddr x)))
				  (##sys#warn "Warning: unreachable pattern " (car x) 'in match-expr) ) )
                            plist)))
           (validate-pattern (lambda (pattern)
                               (letrec ((simple? (lambda (x)
                                                   (or (string? x)
                                                       (boolean? x)
                                                       (char? x)
                                                       (number? x)
                                                       (null? x))))
                                        (ordinary (lambda (p)
                                                    (let ((g88 (lambda (x
                                                                        y)
                                                                 (cons (ordinary
                                                                         x)
                                                                       (ordinary
                                                                         y)))))
                                                      (if (simple? p)
                                                          ((lambda (p) p)
                                                           p)
                                                          (if (equal? p '_)
                                                              ((lambda ()
                                                                 '_))
                                                              (if (pattern-var?
                                                                    p)
                                                                  ((lambda (p)
                                                                     p)
                                                                   p)
                                                                  (if (pair?
                                                                        p)
                                                                      (if (equal?
                                                                            (car p)
                                                                            'quasiquote)
                                                                          (if (and (pair?
                                                                                     (cdr p))
                                                                                   (null?
                                                                                     (cddr p)))
                                                                              ((lambda (p)
                                                                                 (quasi
                                                                                   p))
                                                                               (cadr p))
                                                                              (g88 (car p)
                                                                                   (cdr p)))
                                                                          (if (equal?
                                                                                (car p)
                                                                                'quote)
                                                                              (if (and (pair?
                                                                                         (cdr p))
                                                                                       (null?
                                                                                         (cddr p)))
                                                                                  ((lambda (p)
                                                                                     p)
                                                                                   p)
                                                                                  (g88 (car p)
                                                                                       (cdr p)))
                                                                              (if (equal?
                                                                                    (car p)
                                                                                    '?)
                                                                                  (if (and (pair?
                                                                                             (cdr p))
                                                                                           (list?
                                                                                             (cddr p)))
                                                                                      ((lambda (pred
                                                                                                ps)
                                                                                         `(? ,pred
                                                                                             ,@(map ordinary
                                                                                                    ps)))
                                                                                       (cadr p)
                                                                                       (cddr p))
                                                                                      (g88 (car p)
                                                                                           (cdr p)))
                                                                                  (if (equal?
                                                                                        (car p)
                                                                                        '=)
                                                                                      (if (and (pair?
                                                                                                 (cdr p))
                                                                                               (pair?
                                                                                                 (cddr p))
                                                                                               (null?
                                                                                                 (cdddr
                                                                                                   p)))
                                                                                          ((lambda (sel
                                                                                                    p)
                                                                                             `(= ,sel
                                                                                                 ,(ordinary
                                                                                                    p)))
                                                                                           (cadr p)
                                                                                           (caddr
                                                                                             p))
                                                                                          (g88 (car p)
                                                                                               (cdr p)))
                                                                                      (if (equal?
                                                                                            (car p)
                                                                                            'and)
                                                                                          (if (and (list?
                                                                                                     (cdr p))
                                                                                                   (pair?
                                                                                                     (cdr p)))
                                                                                              ((lambda (ps)
                                                                                                 `(and ,@(map ordinary
                                                                                                              ps)))
                                                                                               (cdr p))
                                                                                              (g88 (car p)
                                                                                                   (cdr p)))
                                                                                          (if (equal?
                                                                                                (car p)
                                                                                                'or)
                                                                                              (if (and (list?
                                                                                                         (cdr p))
                                                                                                       (pair?
                                                                                                         (cdr p)))
                                                                                                  ((lambda (ps)
                                                                                                     `(or ,@(map ordinary
                                                                                                                 ps)))
                                                                                                   (cdr p))
                                                                                                  (g88 (car p)
                                                                                                       (cdr p)))
                                                                                              (if (equal?
                                                                                                    (car p)
                                                                                                    'not)
                                                                                                  (if (and (list?
                                                                                                             (cdr p))
                                                                                                           (pair?
                                                                                                             (cdr p)))
                                                                                                      ((lambda (ps)
                                                                                                         `(not ,@(map ordinary
                                                                                                                      ps)))
                                                                                                       (cdr p))
                                                                                                      (g88 (car p)
                                                                                                           (cdr p)))
                                                                                                  (if (equal?
                                                                                                        (car p)
                                                                                                        '$)
                                                                                                      (if (and (pair?
                                                                                                                 (cdr p))
                                                                                                               (symbol?
                                                                                                                 (cadr p))
                                                                                                               (list?
                                                                                                                 (cddr p)))
                                                                                                          ((lambda (r
                                                                                                                    ps)
                                                                                                             `($ ,r
                                                                                                                 ,@(map ordinary
                                                                                                                        ps)))
                                                                                                           (cadr p)
                                                                                                           (cddr p))
                                                                                                          (g88 (car p)
                                                                                                               (cdr p)))
                                                                                                      (if (equal?
                                                                                                            (car p)
                                                                                                            'set!)
                                                                                                          (if (and (pair?
                                                                                                                     (cdr p))
                                                                                                                   (pattern-var?
                                                                                                                     (cadr p))
                                                                                                                   (null?
                                                                                                                     (cddr p)))
                                                                                                              ((lambda (p)
                                                                                                                 p)
                                                                                                               p)
                                                                                                              (g88 (car p)
                                                                                                                   (cdr p)))
                                                                                                          (if (equal?
                                                                                                                (car p)
                                                                                                                'get!)
                                                                                                              (if (and (pair?
                                                                                                                         (cdr p))
                                                                                                                       (pattern-var?
                                                                                                                         (cadr p))
                                                                                                                       (null?
                                                                                                                         (cddr p)))
                                                                                                                  ((lambda (p)
                                                                                                                     p)
                                                                                                                   p)
                                                                                                                  (g88 (car p)
                                                                                                                       (cdr p)))
                                                                                                              (if (equal?
                                                                                                                    (car p)
                                                                                                                    'unquote)
                                                                                                                  (g88 (car p)
                                                                                                                       (cdr p))
                                                                                                                  (if (equal?
                                                                                                                        (car p)
                                                                                                                        'unquote-splicing)
                                                                                                                      (g88 (car p)
                                                                                                                           (cdr p))
                                                                                                                      (if (and (pair?
                                                                                                                                 (cdr p))
                                                                                                                               (dot-dot-k?
                                                                                                                                 (cadr p))
                                                                                                                               (null?
                                                                                                                                 (cddr p)))
                                                                                                                          ((lambda (p
                                                                                                                                    ddk)
                                                                                                                             `(,(ordinary
                                                                                                                                  p)
                                                                                                                                ,ddk))
                                                                                                                           (car p)
                                                                                                                           (cadr p))
                                                                                                                          (g88 (car p)
                                                                                                                               (cdr p)))))))))))))))
                                                                      (if (vector?
                                                                            p)
                                                                          ((lambda (p)
                                                                             (let* ((pl (vector->list
                                                                                          p))
                                                                                    (rpl (reverse