0
@@ -106,6 +106,4 @@ COMPLETED
0
 
0
 * nuke builds for apps with spaces in their names.
0
 
0
-* ocaml-like pattern matching, a.k.a. destructuring-bind, though there is still room for improvement here.
0
-  It would be nice to have something called dcase (destructuring case) that would match the input
0
-  with the first compatible template, binding variables in it.
0
\ No newline at end of file
0
+* ocaml-like pattern matching, a.k.a. destructuring-bind, in destructuring.nu as dbind, dset, and match.

0
@@ -41,8 +41,9 @@
0
 ;; returns a list of bindings like '((a 1) (b 2) (c 3)).
0
 (function destructure (pat seq)
0
     (cond
0
-     ((null? pat)
0
-      nil)
0
+     ((and (not pat) seq) 
0
+      (destruc-throw "Attempt to match empty pattern to non-empty object"))
0
+     ((not pat) nil)
0
      ((symbol? pat)
0
       (let (seq (if (or (pair? seq) (symbol? seq))
0
                     (then (list 'quote seq))
0
@@ -52,7 +53,7 @@
0
       (then (let ((bindings1 (destructure (car pat) (car seq)))
0
                   (bindings2 (destructure (cdr pat) (cdr seq))))
0
                 (append bindings1 bindings2))))
0
-     (else (print "ERROR: pat is not nil, a symbol or a pair: " pat "\n"))))
0
+     (else (destruc-throw "pattern is not nil, a symbol or a pair: #{pat}"))))
0
 
0
 ;; Makes sure that no key is set to two different values.
0
 ;; For example (check-bindings '((a 1) (a 1) (b 2))) just returns its argument,
0
@@ -70,9 +71,31 @@
0
                                    (then 
0
                                        ;; TODO(issac.trotts@gmail.com): Add a more informative
0
                                        ;; error message.
0
-                                       (set exn
0
-                                            ((NSException alloc) initWithName:"NuDestructuringException"
0
-                                                                       reason:"Inconsistent bindings"
0
-                                                                     userInfo:nil))
0
-                                       (exn raise)))))))
0
+                                       (destruc-throw "Inconsistent bindings")))))))
0
     bindings)
0
+
0
+(macro match
0
+    (set __obj (eval (first margs)))
0
+    (set __patterns (rest margs))
0
+    ;; Make __result a list with nils for patterns that don't match, and expressions for ones that do.
0
+    (set __result
0
+         (__patterns map:(do (pat-and-body)
0
+                             (set __pat (first pat-and-body))
0
+                             (set __body (rest pat-and-body))
0
+                             (if (eq __pat 'else)
0
+                                 (then __body)
0
+                                 (else 
0
+                                     (try
0
+                                      (set __bindings (destructure __pat __obj))
0
+                                      (cons 'let (cons __bindings __body))
0
+                                      (catch (exception) nil)))))))
0
+
0
+    ;; Evaluate and return the first expression that matches.
0
+    (set __todo (any __result))
0
+    (eval __todo))
0
+
0
+(function destruc-throw (reason)
0
+    (throw ((NSException alloc) initWithName:"NuDestructuringException"
0
+                                      reason:reason
0
+                                    userInfo:nil)))
0
+

0
@@ -6,7 +6,20 @@
0
 (load "destructuring")
0
 
0
 (class TestDestructuring is NuTestCase
0
-     
0
+
0
+     ;; match
0
+     (imethod (id) testMatch is
0
+         (function people-to-string (people)
0
+             (match people
0
+                    (() "no people")
0
+                    ((p1) "one person: #{p1}")
0
+                    ((p1 p2) "two people: #{p1} and #{p2}")
0
+                    (else "too many people: #{(people length)}")))
0
+         (assert_equal "no people" (people-to-string '()))
0
+         (assert_equal "one person: Tim" (people-to-string '(Tim)))
0
+         (assert_equal "two people: Tim and Matz" (people-to-string '(Tim Matz)))
0
+         (assert_equal "too many people: 3" (people-to-string '(Tim Guido Matz))))
0
+
0
      (imethod (id) testCheckBindings is
0
          (check-bindings '())  ;; empty set of bindings should not throw
0
          (check-bindings '((a 1)))