1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/types/examples.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,152 @@
     1.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1.6 +;;
     1.7 +;; Application examples for data types
     1.8 +;;
     1.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.11 +
    1.12 +(ns
    1.13 +  #^{:author "Konrad Hinsen"
    1.14 +     :skip-wiki true
    1.15 +     :doc "Examples for data type definitions"}
    1.16 +  clojure.contrib.types.examples
    1.17 +  (:refer-clojure :exclude (deftype))
    1.18 +  (:use [clojure.contrib.types
    1.19 +	 :only (deftype defadt match)])
    1.20 +  (:require [clojure.contrib.generic.collection :as gc])
    1.21 +  (:require [clojure.contrib.generic.functor :as gf]))
    1.22 +
    1.23 +;
    1.24 +; Multisets implemented as maps to integers
    1.25 +;
    1.26 +
    1.27 +; The most basic type definition. A more elaborate version could add
    1.28 +; a constructor that verifies that its argument is a map with integer values.
    1.29 +(deftype ::multiset multiset
    1.30 +  "Multiset (demo implementation)")
    1.31 +
    1.32 +; Some set operations generalized to multisets
    1.33 +; Note that the multiset constructor is nowhere called explicitly, as the
    1.34 +; map operations all preserve the metadata.
    1.35 +(defmethod gc/conj ::multiset
    1.36 +  ([ms x]
    1.37 +   (assoc ms x (inc (get ms x 0))))
    1.38 +  ([ms x & xs]
    1.39 +    (reduce gc/conj (gc/conj ms x) xs)))
    1.40 +
    1.41 +(defmulti union (fn [& sets] (type (first sets))))
    1.42 +
    1.43 +(defmethod union clojure.lang.IPersistentSet
    1.44 +  [& sets]
    1.45 +  (apply clojure.set/union sets))
    1.46 +
    1.47 +; Note: a production-quality implementation should accept standard sets
    1.48 +; and perhaps other collections for its second argument.
    1.49 +(defmethod union ::multiset
    1.50 +  ([ms] ms)
    1.51 +  ([ms1 ms2]
    1.52 +     (letfn [(add-item [ms [item n]]
    1.53 +		       (assoc ms item (+ n (get ms item 0))))]
    1.54 +       (reduce add-item ms1 ms2)))
    1.55 +  ([ms1 ms2 & mss]
    1.56 +     (reduce union (union ms1 ms2) mss)))
    1.57 +
    1.58 +; Let's use it:
    1.59 +(gc/conj #{} :a :a :b :c)
    1.60 +(gc/conj (multiset {}) :a :a :b :c)
    1.61 +
    1.62 +(union #{:a :b} #{:b :c})
    1.63 +(union (multiset {:a 1 :b 1}) (multiset {:b 1 :c 2}))
    1.64 +
    1.65 +;
    1.66 +; A simple tree structure defined as an algebraic data type
    1.67 +;
    1.68 +(defadt ::tree
    1.69 +  empty-tree
    1.70 +  (leaf value)
    1.71 +  (node left-tree right-tree))
    1.72 +
    1.73 +(def a-tree (node (leaf :a) 
    1.74 +		  (node (leaf :b)
    1.75 +			(leaf :c))))
    1.76 +
    1.77 +(defn depth
    1.78 +  [t]
    1.79 +  (match t
    1.80 +    empty-tree  0
    1.81 +    (leaf _)    1
    1.82 +    (node l r)  (inc (max (depth l) (depth r)))))
    1.83 +
    1.84 +(depth empty-tree)
    1.85 +(depth (leaf 42))
    1.86 +(depth a-tree)
    1.87 +
    1.88 +; Algebraic data types with multimethods: fmap on a tree
    1.89 +(defmethod gf/fmap ::tree
    1.90 +  [f t]
    1.91 +  (match t
    1.92 +    empty-tree  empty-tree
    1.93 +    (leaf v)    (leaf (f v))
    1.94 +    (node l r)  (node (gf/fmap f l) (gf/fmap f r))))
    1.95 +
    1.96 +(gf/fmap str a-tree)
    1.97 +
    1.98 +;
    1.99 +; Nonsense examples to illustrate all the features of match
   1.100 +; for type constructors.
   1.101 +;
   1.102 +(defadt ::foo
   1.103 +  (bar a b c))
   1.104 +
   1.105 +(defn foo-to-int
   1.106 +  [a-foo]
   1.107 +  (match a-foo
   1.108 +    (bar x x x)  x
   1.109 +    (bar 0 x y)  (+ x y)
   1.110 +    (bar 1 2 3)  -1
   1.111 +    (bar a b 1)  (* a b)
   1.112 +    :else        42))
   1.113 +
   1.114 +(foo-to-int (bar 0 0 0))    ; 0
   1.115 +(foo-to-int (bar 0 5 6))    ; 11
   1.116 +(foo-to-int (bar 1 2 3))    ; -1
   1.117 +(foo-to-int (bar 3 3 1))    ; 9
   1.118 +(foo-to-int (bar 0 3 1))    ; 4
   1.119 +(foo-to-int (bar 10 20 30)) ; 42
   1.120 +
   1.121 +;
   1.122 +; Match can also be used for lists, vectors, and maps. Note that since
   1.123 +; algebraic data types are represented as maps, they can be matched
   1.124 +; either with their type constructor and positional arguments, or
   1.125 +; with a map template.
   1.126 +;
   1.127 +
   1.128 +; Tree depth once again with map templates
   1.129 +(defn depth
   1.130 +  [t]
   1.131 +  (match t
   1.132 +    empty-tree  0
   1.133 +    {:value _}  1
   1.134 +    {:left-tree l :right-tree r}  (inc (max (depth l) (depth r)))))
   1.135 +
   1.136 +(depth empty-tree)
   1.137 +(depth (leaf 42))
   1.138 +(depth a-tree)
   1.139 +
   1.140 +; Match for lists, vectors, and maps:
   1.141 +
   1.142 +(for [x ['(1 2 3)
   1.143 +	 [1 2 3]
   1.144 +	 {:x 1 :y 2 :z 3}
   1.145 +	 '(1 1 1)
   1.146 +	 [2 1 2]
   1.147 +	 {:x 1 :y 1 :z 2}]]
   1.148 +  (match x
   1.149 +    '(a a a)  	 'list-of-three-equal-values
   1.150 +    '(a b c)  	 'list
   1.151 +    [a a a]   	 'vector-of-three-equal-values
   1.152 +    [a b a]   	 'vector-of-three-with-first-and-last-equal
   1.153 +    [a b c]      'vector
   1.154 +    {:x a :y z}  'map-with-x-equal-y
   1.155 +    {}           'any-map))