Ticket #1020: arrows-and-questionmarks.diff

matchable.scm

@@ -125 +125 @@
 ;; pattern so far.
 
 (define-syntax match-two
-  (syntax-rules (_ ___ ..1 *** quote quasiquote ? $ = and or not set! get!)
+  (syntax-rules (_ ___ ..1 *** quote quasiquote ? -> -?> $ = and or not set! get!)
     ((match-two v () g+s (sk ...) fk i)
      (if (null? v) (sk ... i) fk))
     ((match-two v (quote p) g+s (sk ...) fk i)
@@ -148 +148 @@
      (let ((setter (lambda (x) (s ... x)))) (sk ... i)))
     ((match-two v (? pred . p) g+s sk fk i)
      (if (pred v) (match-one v (and . p) g+s sk fk i) fk))
+    ((match-two v (-> convert . p) g+s sk fk i)
+     (let ((w (convert v))) (match-one w (and . p) g+s sk fk i)))
+    ((match-two v (-?> convert . p) g+s sk fk i)
+     (match-two v (-> convert (? (lambda (x) x) . p)) g+s sk fk i))
     ((match-two v (= proc p) . x)
      (let ((w (proc v))) (match-one w p . x)))
     ((match-two v (p ___ . r) g+s sk fk i)
@@ -515 +519 @@
 ;; (match-extract-vars pattern continuation (ids ...) (new-vars ...))
 
 (define-syntax match-extract-vars
-  (syntax-rules (_ ___ ..1 *** ? $ = quote quasiquote and or not get! set!)
+  (syntax-rules (_ ___ ..1 *** ? -> -?> $ = quote quasiquote and or not get! set!)
     ((match-extract-vars (? pred . p) . x)
      (match-extract-vars p . x))
+    ((match-extract-vars (-> convert . p) . x)
+     (match-extract-vars p . x))
+    ((match-extract-vars (-?> convert . p) . x)
+     (match-extract-vars p . x))
     ((match-extract-vars ($ rec . p) . x)
      (match-extract-vars p . x))
     ((match-extract-vars (= proc p) . x)