Mercurial > lasercutter
comparison src/clojure/contrib/test_contrib/types/examples.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
3 ;; | |
4 ;; Application examples for data types | |
5 ;; | |
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
8 | |
9 (ns | |
10 #^{:author "Konrad Hinsen" | |
11 :skip-wiki true | |
12 :doc "Examples for data type definitions"} | |
13 clojure.contrib.types.examples | |
14 (:refer-clojure :exclude (deftype)) | |
15 (:use [clojure.contrib.types | |
16 :only (deftype defadt match)]) | |
17 (:require [clojure.contrib.generic.collection :as gc]) | |
18 (:require [clojure.contrib.generic.functor :as gf])) | |
19 | |
20 ; | |
21 ; Multisets implemented as maps to integers | |
22 ; | |
23 | |
24 ; The most basic type definition. A more elaborate version could add | |
25 ; a constructor that verifies that its argument is a map with integer values. | |
26 (deftype ::multiset multiset | |
27 "Multiset (demo implementation)") | |
28 | |
29 ; Some set operations generalized to multisets | |
30 ; Note that the multiset constructor is nowhere called explicitly, as the | |
31 ; map operations all preserve the metadata. | |
32 (defmethod gc/conj ::multiset | |
33 ([ms x] | |
34 (assoc ms x (inc (get ms x 0)))) | |
35 ([ms x & xs] | |
36 (reduce gc/conj (gc/conj ms x) xs))) | |
37 | |
38 (defmulti union (fn [& sets] (type (first sets)))) | |
39 | |
40 (defmethod union clojure.lang.IPersistentSet | |
41 [& sets] | |
42 (apply clojure.set/union sets)) | |
43 | |
44 ; Note: a production-quality implementation should accept standard sets | |
45 ; and perhaps other collections for its second argument. | |
46 (defmethod union ::multiset | |
47 ([ms] ms) | |
48 ([ms1 ms2] | |
49 (letfn [(add-item [ms [item n]] | |
50 (assoc ms item (+ n (get ms item 0))))] | |
51 (reduce add-item ms1 ms2))) | |
52 ([ms1 ms2 & mss] | |
53 (reduce union (union ms1 ms2) mss))) | |
54 | |
55 ; Let's use it: | |
56 (gc/conj #{} :a :a :b :c) | |
57 (gc/conj (multiset {}) :a :a :b :c) | |
58 | |
59 (union #{:a :b} #{:b :c}) | |
60 (union (multiset {:a 1 :b 1}) (multiset {:b 1 :c 2})) | |
61 | |
62 ; | |
63 ; A simple tree structure defined as an algebraic data type | |
64 ; | |
65 (defadt ::tree | |
66 empty-tree | |
67 (leaf value) | |
68 (node left-tree right-tree)) | |
69 | |
70 (def a-tree (node (leaf :a) | |
71 (node (leaf :b) | |
72 (leaf :c)))) | |
73 | |
74 (defn depth | |
75 [t] | |
76 (match t | |
77 empty-tree 0 | |
78 (leaf _) 1 | |
79 (node l r) (inc (max (depth l) (depth r))))) | |
80 | |
81 (depth empty-tree) | |
82 (depth (leaf 42)) | |
83 (depth a-tree) | |
84 | |
85 ; Algebraic data types with multimethods: fmap on a tree | |
86 (defmethod gf/fmap ::tree | |
87 [f t] | |
88 (match t | |
89 empty-tree empty-tree | |
90 (leaf v) (leaf (f v)) | |
91 (node l r) (node (gf/fmap f l) (gf/fmap f r)))) | |
92 | |
93 (gf/fmap str a-tree) | |
94 | |
95 ; | |
96 ; Nonsense examples to illustrate all the features of match | |
97 ; for type constructors. | |
98 ; | |
99 (defadt ::foo | |
100 (bar a b c)) | |
101 | |
102 (defn foo-to-int | |
103 [a-foo] | |
104 (match a-foo | |
105 (bar x x x) x | |
106 (bar 0 x y) (+ x y) | |
107 (bar 1 2 3) -1 | |
108 (bar a b 1) (* a b) | |
109 :else 42)) | |
110 | |
111 (foo-to-int (bar 0 0 0)) ; 0 | |
112 (foo-to-int (bar 0 5 6)) ; 11 | |
113 (foo-to-int (bar 1 2 3)) ; -1 | |
114 (foo-to-int (bar 3 3 1)) ; 9 | |
115 (foo-to-int (bar 0 3 1)) ; 4 | |
116 (foo-to-int (bar 10 20 30)) ; 42 | |
117 | |
118 ; | |
119 ; Match can also be used for lists, vectors, and maps. Note that since | |
120 ; algebraic data types are represented as maps, they can be matched | |
121 ; either with their type constructor and positional arguments, or | |
122 ; with a map template. | |
123 ; | |
124 | |
125 ; Tree depth once again with map templates | |
126 (defn depth | |
127 [t] | |
128 (match t | |
129 empty-tree 0 | |
130 {:value _} 1 | |
131 {:left-tree l :right-tree r} (inc (max (depth l) (depth r))))) | |
132 | |
133 (depth empty-tree) | |
134 (depth (leaf 42)) | |
135 (depth a-tree) | |
136 | |
137 ; Match for lists, vectors, and maps: | |
138 | |
139 (for [x ['(1 2 3) | |
140 [1 2 3] | |
141 {:x 1 :y 2 :z 3} | |
142 '(1 1 1) | |
143 [2 1 2] | |
144 {:x 1 :y 1 :z 2}]] | |
145 (match x | |
146 '(a a a) 'list-of-three-equal-values | |
147 '(a b c) 'list | |
148 [a a a] 'vector-of-three-equal-values | |
149 [a b a] 'vector-of-three-with-first-and-last-equal | |
150 [a b c] 'vector | |
151 {:x a :y z} 'map-with-x-equal-y | |
152 {} 'any-map)) |