@@ -106,6 +106,4 @@ COMPLETED * nuke builds for apps with spaces in their names. -* ocaml-like pattern matching, a.k.a. destructuring-bind, though there is still room for improvement here. - It would be nice to have something called dcase (destructuring case) that would match the input - with the first compatible template, binding variables in it. \ No newline at end of file +* ocaml-like pattern matching, a.k.a. destructuring-bind, in destructuring.nu as dbind, dset, and match. notes/TODO @@ -41,8 +41,9 @@ ;; returns a list of bindings like '((a 1) (b 2) (c 3)). (function destructure (pat seq) (cond - ((null? pat) - nil) + ((and (not pat) seq) + (destruc-throw "Attempt to match empty pattern to non-empty object")) + ((not pat) nil) ((symbol? pat) (let (seq (if (or (pair? seq) (symbol? seq)) (then (list 'quote seq)) @@ -52,7 +53,7 @@ (then (let ((bindings1 (destructure (car pat) (car seq))) (bindings2 (destructure (cdr pat) (cdr seq)))) (append bindings1 bindings2)))) - (else (print "ERROR: pat is not nil, a symbol or a pair: " pat "\n")))) + (else (destruc-throw "pattern is not nil, a symbol or a pair: #{pat}")))) ;; Makes sure that no key is set to two different values. ;; For example (check-bindings '((a 1) (a 1) (b 2))) just returns its argument, @@ -70,9 +71,31 @@ (then ;; TODO(issac.trotts@gmail.com): Add a more informative ;; error message. - (set exn - ((NSException alloc) initWithName:"NuDestructuringException" - reason:"Inconsistent bindings" - userInfo:nil)) - (exn raise))))))) + (destruc-throw "Inconsistent bindings"))))))) bindings) + +(macro match + (set __obj (eval (first margs))) + (set __patterns (rest margs)) + ;; Make __result a list with nils for patterns that don't match, and expressions for ones that do. + (set __result + (__patterns map:(do (pat-and-body) + (set __pat (first pat-and-body)) + (set __body (rest pat-and-body)) + (if (eq __pat 'else) + (then __body) + (else + (try + (set __bindings (destructure __pat __obj)) + (cons 'let (cons __bindings __body)) + (catch (exception) nil))))))) + + ;; Evaluate and return the first expression that matches. + (set __todo (any __result)) + (eval __todo)) + +(function destruc-throw (reason) + (throw ((NSException alloc) initWithName:"NuDestructuringException" + reason:reason + userInfo:nil))) + nu/destructuring.nu @@ -6,7 +6,20 @@ (load "destructuring") (class TestDestructuring is NuTestCase - + + ;; match + (imethod (id) testMatch is + (function people-to-string (people) + (match people + (() "no people") + ((p1) "one person: #{p1}") + ((p1 p2) "two people: #{p1} and #{p2}") + (else "too many people: #{(people length)}"))) + (assert_equal "no people" (people-to-string '())) + (assert_equal "one person: Tim" (people-to-string '(Tim))) + (assert_equal "two people: Tim and Matz" (people-to-string '(Tim Matz))) + (assert_equal "too many people: 3" (people-to-string '(Tim Guido Matz)))) + (imethod (id) testCheckBindings is (check-bindings '()) ;; empty set of bindings should not throw (check-bindings '((a 1))) test/test_destructuring.nu e2217384a5cc858d6f42708d8b2d4daeb534124d Issac Trotts issac.trotts@gmail.com http://github.com/timburks/nu/commit/b499885440d4c77da115eee0f96ecdea1adbf608 b499885440d4c77da115eee0f96ecdea1adbf608 2008-07-21T00:07:06-07:00 2008-07-21T00:06:44-07:00 Added an OCaml-like match macro. 9ca5604a7538553c5f9b009a22340935d2402494 Issac Trotts issac.trotts@gmail.com