Page:Scheme - An interpreter for extended lambda calculus.djvu/13

From Wikisource
Jump to navigation Jump to search
This page has been proofread, but needs to be validated.
Sussman and Steele December 22, 1975 12 SCHEME Programming Examples

(DEFINE MATCH
   (LAMBDA (PATTERN EXPRESSION)
       (LABELS ((MATCH1
           (LAMBDA (P E ALIST LOSE)
               (IF (NULL P) (IF (NULL E) (LIST ALIST LOSE) (LOSE))
                   (IF (ATOM (CAR P))
                       (IF (NULL E) (LOSE)
                           (IF (EQ (CAR E) (CAR P))
                               (MATCH1 (CDR P) (CDR E) ALIST LOSE)
                               (LOSE)))
                       (IF (EQ (CAAR P) 'THV)
                           (IF (NULL E) (LOSE)
                               ((LAMBDA (V)
                                    (IF V (IF (EQ (CAR E) (CADR V))
                                              (MATCH1 (CDR P) (CDR E) ALIST LOSE)
                                              (LOSE))
                                        (MATCH1 (CDR P) (CDR E)
                                                (CONS (LIST (CADAR P) (CAR E)) ALIST)
                                                LOSE)))
                                (ASSQ (CADAR P) ALIST)))
                           (IF (EQ (CAAR P) 'THV*)
                               ((LAMBDA (V)
                                    (IF V
                                        (IF (< (LENGTH E) (LENGTH (CADR V))) (LOSE)
                                            (IF (EQUAL (NFIRST E (LENGTH (CADR V)))
                                                       (CADR V))
                                                (MATCH1 (CDR P)
                                                        (NREST E (LENGTH (CADR V)))
                                                        ALIST
                                                        LOSE)
                                                (LOSE)))
                                        (LABELS ((MATCH*
                                            (LAMBDA (N)
                                                (IF (> N (LENGTH E)) (LOSE)
                                                    (MATCH1 (CDR P) (NREST E N)
                                                            (CONS (LIST (CADAR P)
                                                                        (NFIRST E N))
                                                                  ALIST)
                                                            (LAMBDA ()
                                                                (MATCH* (+ N 1))))))))
                                                (MATCH* 0))))
                                (ASSQ (CADAR P) ALIST))
                               (LOSE))))))))
               (MATCH1 PATTERN
                       EXPRESSION
                       NIL
                       (LAMBDA () NIL)))))