diff options
| -rw-r--r-- | build.xml | 1 | ||||
| -rw-r--r-- | src/clojure/contrib/gen_html_docs.clj | 1 | ||||
| -rw-r--r-- | src/clojure/contrib/load_all.clj | 1 | ||||
| -rw-r--r-- | src/clojure/contrib/types.clj | 110 | ||||
| -rw-r--r-- | src/clojure/contrib/types/examples.clj | 81 |
5 files changed, 194 insertions, 0 deletions
@@ -92,6 +92,7 @@ <arg value="clojure.contrib.test-clojure"/> <arg value="clojure.contrib.test-is"/> <arg value="clojure.contrib.trace"/> + <arg value="clojure.contrib.type"/> <arg value="clojure.contrib.zip-filter"/> <arg value="clojure.contrib.graph"/> </java> diff --git a/src/clojure/contrib/gen_html_docs.clj b/src/clojure/contrib/gen_html_docs.clj index 6f08ebeb..df9f9580 100644 --- a/src/clojure/contrib/gen_html_docs.clj +++ b/src/clojure/contrib/gen_html_docs.clj @@ -508,6 +508,7 @@ emits the generated HTML to the path named by path." 'clojure.contrib.test-contrib 'clojure.contrib.test-is 'clojure.contrib.trace + 'clojure.contrib.types 'clojure.contrib.walk 'clojure.contrib.zip-filter 'clojure.contrib.javadoc.browse diff --git a/src/clojure/contrib/load_all.clj b/src/clojure/contrib/load_all.clj index 28865cb1..94bc8e91 100644 --- a/src/clojure/contrib/load_all.clj +++ b/src/clojure/contrib/load_all.clj @@ -85,6 +85,7 @@ test-clojure.sequences test-contrib.shell-out test-contrib.str-utils trace +types walk zip-filter ]) diff --git a/src/clojure/contrib/types.clj b/src/clojure/contrib/types.clj new file mode 100644 index 00000000..790d0bf0 --- /dev/null +++ b/src/clojure/contrib/types.clj @@ -0,0 +1,110 @@ +;; Algebraic data types + +;; by Konrad Hinsen +;; last updated February 25, 2009 + +;; WARNING: This is a proof-of-concept implementation of algebratic data +;; types. Expect this module to change in the near future! + +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use +;; and distribution terms for this software are covered by the Eclipse +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + +(ns clojure.contrib.types + "Algebraic data types + + NOTE: This library is experimental. It may change significantly + with future release. + + NOTE: The major limitation of this implementation of algebraic data + types is that the objects created with it are compared for equality + by identity, not by value. Equality tests are therefore almost useless.") + +(defn- constructor-code + [constructor] + (if (symbol? constructor) + `(def ~constructor (~'make (quote ~constructor))) + (let [[name & args] constructor] + (if (empty? args) + (throw (IllegalArgumentException. "zero argument constructor")) + `(defn ~name ~(vec args) (~'make (quote ~name) ~@args)))))) + +(defmacro deftype + "Define the algebraic data type name by an exhaustive list of constructors. + Each constructor can be a symbol (argument-free constructor) or a + list consisting of a tag symbol followed by the argument symbols. + The data type itself is a class object, argument-free constructors + become singleton instances of that class, and constructors with arguments + are functions that return a new object." + [name & constructors] + `(let [~'make (fn [~'tag & ~'values] + (fn ~name [] + (if (nil? ~'values) ~'tag (cons ~'tag ~'values))))] + (def ~name (class (~'make (quote ~name)))) + ~@(map constructor-code constructors) + (defmethod clojure.core/print-method ~name [~'o ~'w] + (clojure.core/print-method (~'o) ~'w)) + (defmethod clojure.core/print-dup ~name [~'o ~'w] + (clojure.core/print-dup (~'o) ~'w)))) + +(defn- tests-and-bindings + [template vsymbol] + (if (symbol? template) + [`(= (quote ~template) ~vsymbol) + []] + (let [[tag & values] template + enum-values (map list values (range 1 (inc (count values)))) + ; Non-symbols in the template create an equality test with the + ; corresponding value in the object's value list + tests (map (fn [[v i]] `(= ~v (nth ~vsymbol ~i))) + (filter (complement #(symbol? (first %))) enum-values)) + ; Symbols in the template become bindings to the corresponding + ; value in the object. However, if a symbol occurs more than once, + ; only one binding is generated, and equality tests are added + ; for the other values. + bindings (reduce (fn [map [symbol index]] + (assoc map symbol + (conj (get map symbol []) index))) + {} + (filter #(symbol? (first %)) enum-values)) + tests (concat tests + (map (fn [[symbol indices]] + (cons `= (map #(list `nth vsymbol %) indices))) + (filter #(> (count (second %)) 1) bindings))) + bindings (apply concat + (map (fn [[symbol indices]] + [symbol (list `nth vsymbol (first indices))]) + bindings))] + [(cons `and + (cons `(seq? ~vsymbol) + (cons `(= (quote ~tag) (first ~vsymbol)) tests))) + (vec bindings)]))) + +(defmacro match + "Given a value and a list of template-expr clauses, evaluate the first + expr whose template matches the value. Templates have the same form + as constructors. The arguments can be expressions, which must be equal + to the corresponding elements of value for the template to match, or + symbols, which will be bound to the corresponding elements of value + in the evaluation of expr. If the same symbol occurs more than once, + the corresponding elements of value must be equal for the template + to match." + [value & clauses] + (let [vsymbol (gensym) + terms (apply concat + (map (fn [[template expr]] + (if (= template :else) + [template expr] + (let [[tests bindings] + (tests-and-bindings template vsymbol)] + [tests + (if (empty? bindings) + expr + `(let ~bindings ~expr))]))) + (partition 2 clauses)))] + `(let [~vsymbol (~value)] + (cond ~@terms)))) diff --git a/src/clojure/contrib/types/examples.clj b/src/clojure/contrib/types/examples.clj new file mode 100644 index 00000000..26421697 --- /dev/null +++ b/src/clojure/contrib/types/examples.clj @@ -0,0 +1,81 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Application examples for algebraic data types +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ns clojure.contrib.types.examples + (:use clojure.contrib.types)) + +; +; A simple tree structure +; +(deftype tree + empty-tree + (leaf value) + (node left-tree right-tree)) + +(def a-tree (node (leaf :a) + (node (leaf :b) + (leaf :c)))) + +(defn depth + [#^tree t] + (match t + empty-tree 0 + (leaf n) 1 + (node l r) (inc (max (depth l) (depth r))))) + +(depth empty-tree) +(depth a-tree) + +; +; Algebraic data types with multimethods: Haskell-style functors +; +(defmulti fmap (fn [f s] (class s))) + +; Sequences +(defmethod fmap clojure.lang.ISeq + [f s] + (map f s)) + +; Vectors +(defmethod fmap clojure.lang.IPersistentVector + [f v] + (into [] (map f v))) + +; Trees +(defmethod fmap tree + [f t] + (match t + empty-tree empty-tree + (leaf v) (leaf (f v)) + (node l r) (node (fmap f l) (fmap f r)))) + +(fmap str '(:a :b :c)) +(fmap str [:a :b :c]) +(fmap str a-tree) + +; +; Nonsense examples to illustrate all the features of match +; +(deftype foo + (bar a b c)) + +(defn foo-to-int + [a-foo] + (match a-foo + (bar x x x) x + (bar 0 x y) (+ x y) + (bar 1 2 3) -1 + (bar a b 1) (* a b) + :else 42)) + +(foo-to-int (bar 0 0 0)) +(foo-to-int (bar 0 5 6)) +(foo-to-int (bar 1 2 3)) +(foo-to-int (bar 3 3 1)) +(foo-to-int (bar 0 3 1)) +(foo-to-int (bar 10 20 30)) |