Mailing List Archive

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [tlug] Pattern Matching

On Wed, Nov 4, 2009 at 10:45 AM, Curt Sampson <> wrote:
Actually, let me extend my pattern matching sample almost trivially by
adding another constructor to what used to be called Pair:

>     data Maybe a = Nothing | Just a     -- standard library definition
>     data N       = Singleton Int | Pair Int Int
>     nonZeroValueOf :: Maybe N -> Maybe Int
>     nonZeroValueOf x =
>         case x of
>              Nothing            -> Nothing
>              Just (Singleton 0) -> Nothing
>              Just (Singleton n) -> Just n
>              Just (Pair 0 0)    -> Nothing
>              Just (Pair 0 m)    -> Just m
>              Just (Pair n _)    -> Just n

Sorry for the rush here, nor am I a Clojure master yet, but...

Illustrating the value of macros, it looks like some other people have been busy adding support for this to Clojure,

Using James Reeves implementation, I imagine it would look like this,
(defn nonZeroValueOf [x]
  (match x
    [nil] nil
    [0]   nil
    [n]   n
    [0 0] nil
    [0 m] m
    [n m] n))

A quick test;
user> (nonZeroValueOf [nil])
user> (nonZeroValueOf [0])
user> (nonZeroValueOf [1])
user> (nonZeroValueOf [0 1])
user> (nonZeroValueOf [0 0])
user> (nonZeroValueOf [2 0])
user> (nonZeroValueOf [2 3])

Here is the version of James Reeves implementation I'm using;

(defn has-match
  (if (some (partial = :no-match) matches)
    (apply concat matches)))

(def matches?)

(defn match-map
  [x-map y-map]
   (map (fn [[k v]]
          (if-let [y (y-map k)]
                  (matches? v y)

(defn match-seq
  [xs ys]
  (if (= (count xs) (count ys))
    (has-match (map matches? xs ys))

(defn matches?
  [x y]
  (let [both #(and (% x) (% y))]
      (= x `'~y) '()
      (both seq?) (match-seq x y)
      (both vector?) (match-seq x y)
      (both map?) (match-map x y)
      (symbol? x) (list x y)
      (= x y) '()
      true :no-match)))

(defmacro match [value & clauses]
  (when clauses
    `(let [~'derefs (matches? '~(first clauses) ~value)]
       (if (not= ~'derefs :no-match)
         (eval (list 'let (apply vector ~'derefs)
                     '~(second clauses)))
         (match ~value ~@(nnext clauses))))))

Home | Main Index | Thread Index

Home Page Mailing List Linux and Japan TLUG Members Links