Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Changes to factories and default arguments #16

Merged
merged 4 commits into from

2 participants

@frenchy64
  • remove default arguments for defconstrainedrecord
  • fix positional ->* factory to only accept exact arguments for defconstrainedtype and defconstrainedrecord
  • fix defconstrained record ->* factory to have positional args like the clojure.core version
  • add contracts to defconstrainedrecord map->* factory
  • merged changes with defconstrainedrecord docstring
  • remove zero argument ->* factory
frenchy64 added some commits
@frenchy64 frenchy64 initial version of map->* factory and rid of default args in record 80135bc
@frenchy64 frenchy64 Use reflection 60c0731
@frenchy64 frenchy64 Fix ->* factory to be positional, add map->* factory 12560e4
@frenchy64 frenchy64 Changes to factories and default arguments
- remove default arguments for defconstrainedrecord
- fix positional ->* factory to only accept exact
  arguments for defconstrainedtype and defconstrainedrecord
- fix defconstrained record ->* factory to have positional
  args like the clojure.core version
- add contracts to defconstrainedrecord map->* factory
- merged changes with defconstrainedrecord docstring
8980afa
@frenchy64

I've used this for about a day in Typed Clojure and it's working well. Code's a bit rough, but I think it's robust.

A few design changes also, see ->* factory conforming to clojure.core's.

@fogus fogus merged commit e6fc0b8 into fogus:master
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Mar 30, 2012
  1. @frenchy64
  2. @frenchy64

    Use reflection

    frenchy64 authored
  3. @frenchy64
Commits on Apr 1, 2012
  1. @frenchy64

    Changes to factories and default arguments

    frenchy64 authored
    - remove default arguments for defconstrainedrecord
    - fix positional ->* factory to only accept exact
      arguments for defconstrainedtype and defconstrainedrecord
    - fix defconstrained record ->* factory to have positional
      args like the clojure.core version
    - add contracts to defconstrainedrecord map->* factory
    - merged changes with defconstrainedrecord docstring
This page is out of date. Refresh to see the latest.
Showing with 80 additions and 50 deletions.
  1. +49 −19 src/trammel/core.clj
  2. +31 −31 test/fogus/me/invariant_tests.clj
View
68 src/trammel/core.clj
@@ -224,32 +224,62 @@
~(str (:doc mdata))
~@body)))
+; clojure/core_deftype.clj
+(defn- build-positional-factory
+ "Used to build a positional factory for a given type/record. Because of the
+ limitation of 20 arguments to Clojure functions, this factory needs to be
+ constructed to deal with more arguments. It does this by building a straight
+ forward type/record ctor call in the <=20 case, and a call to the same
+ ctor pulling the extra args out of the & overage parameter. Finally, the
+ arity is constrained to the number of expected fields and an ArityException
+ will be thrown at runtime if the actual arg count does not match."
+ [nom classname fields invariants chk]
+ (let [fn-name (symbol (str '-> nom))
+ [field-args over] (split-at 20 fields)
+ field-count (count fields)
+ arg-count (count field-args)
+ over-count (count over)]
+ `(defconstrainedfn ~fn-name
+ [~@field-args ~@(if (seq over) '[& overage] [])]
+ ~invariants
+ (with-meta
+ ~(if (seq over)
+ `(if (= (count ~'overage) ~over-count)
+ (new ~classname
+ ~@field-args
+ ~@(for [i (range 0 (count over))]
+ (list `nth 'overage i)))
+ (throw (clojure.lang.ArityException. (+ ~arg-count (count ~'overage)) (name '~fn-name))))
+ `(new ~classname ~@field-args))
+ {:contract ~chk}))))
+
+
(defmacro defconstrainedrecord
[name slots inv-description invariants & etc]
- (check-args! name slots inv-description invariants)
- (let [fields (->> slots (partition 2) (map first) vec)
- defaults (->> slots (partition 2) (map second))
- ctor-name (symbol (str name \.))
- factory-name (symbol (str "->" name))]
+ (let [fields (vec slots)
+ ns-part (namespace-munge *ns*)
+ classname (symbol (str ns-part "." name))
+ ctor-name (symbol (str name \.))
+ positional-factory-name (symbol (str "->" name))
+ map-arrow-factory-name (symbol (str "map->" name))
+ chk `(contract ~(symbol (str "chk-" name))
+ ~inv-description
+ [{:keys ~fields :as m#}] ~invariants)]
`(do
(let [t# (defrecord ~name ~fields ~@etc)]
(defn ~(symbol (str name \?)) [r#]
(= t# (type r#))))
+
+ ~(build-positional-factory name classname fields invariants chk)
- (let [chk# (contract ~(symbol (str "chk-" name))
- ~inv-description
- [{:keys ~fields :as m#}] ~invariants)]
- (defconstrainedfn ~factory-name
- ([] [] (with-meta
- (~ctor-name ~@defaults)
- {:contract chk#}))
- ([& {:keys ~fields :as kwargs# :or ~(apply hash-map slots)}]
- ~invariants
- (with-meta
- (-> (~ctor-name ~@defaults)
- (merge kwargs#))
- {:contract chk#}))))
- ~name)))
+ (defconstrainedfn ~map-arrow-factory-name
+ ([{:keys ~fields :as kwargs#}]
+ ~invariants
+ (with-meta
+ (. ~classname ~'create kwargs#)
+ {:contract ~chk})))
+
+ ~classname)))
(defn- apply-contract
[f]
View
62 test/fogus/me/invariant_tests.clj
@@ -12,55 +12,55 @@
;; remove this notice, or any other, from this software.
(ns fogus.me.invariant-tests
+ (:import (clojure.lang ArityException))
(:use [trammel.core :only [defconstrainedrecord defconstrainedtype]])
(:use [clojure.test :only [deftest is]]))
-
-(defconstrainedrecord Foo [a 1 b 2]
- "Foo record fields are expected to hold only numbers."
+(defconstrainedrecord AllNumbersRecord [a b]
+ "AllNumbersRecord record fields are expected to hold only numbers."
[(every? number? [a b])]
Object
- (toString [this] (str "record Foo has " a " and " b)))
+ (toString [this] (str "record AllNumbersRecord has " a " and " b)))
+
+(defconstrainedtype AllNumbersType [a b]
+ "AllNumbersType type fields are expected to hold only numbers."
+ [(every? number? [a b])])
(deftest test-constrained-record-with-vector-spec
- (is (= (:a (->Foo)) 1))
- (is (= (:b (->Foo)) 2))
- (is (= (:a (->Foo :a 42)) 42))
- (is (= (:b (->Foo :b 108)) 108))
- (is (= (:a (->Foo :a 42 :b 108)) 42))
- (is (= (:b (->Foo :a 42 :b 108)) 108))
- (is (= (:a (->Foo :a 42 :b 108 :c 36)) 42))
- (is (= (:b (->Foo :a 42 :b 108 :c 36)) 108))
- (is (= (:c (->Foo :a 42 :b 108 :c 36)) 36))
- (is (thrown? Error (->Foo :a :b)))
- (is (thrown? Error (->Foo :a 42 :b nil))))
+ (is (= (:a (->AllNumbersRecord 42 108)) 42))
+ (is (= (:b (->AllNumbersRecord 42 108)) 108))
+ (is (thrown? ArityException (->AllNumbersRecord)))
+ (is (thrown? ArityException (->AllNumbersRecord 12))))
(defconstrainedtype Bar [a b]
"Bar type fields are expected to hold only numbers."
[(every? number? [a b])])
(deftest test-constrained-type-with-vector-spec
- (is (= (.a (->Bar 1 2)) 1))
- (is (= (.b (->Bar 1 2)) 2))
- (is (thrown? Error (->Bar :a :b))))
+ (is (= (.a (->AllNumbersType 1 2)) 1))
+ (is (= (.b (->AllNumbersType 1 2)) 2))
+ (is (thrown? ArityException (->AllNumbersType)))
+ (is (thrown? ArityException (->AllNumbersType 1)))
+ (is (thrown? Error (->AllNumbersType :a :b))))
;; testing default clojure pre/post maps
-(defconstrainedrecord Baz [a 1 b 2]
+(defconstrainedrecord Buzz [a b]
"Baz record fields are expected to hold only numbers."
{:pre [(every? number? [a b])]}
Object
- (toString [this] (str "record Baz has " a " and " b)))
+ (toString [this] (str "record Buzz has " a " and " b)))
(deftest test-constrained-record-with-map-spec
- (is (= (:a (->Baz)) 1))
- (is (= (:b (->Baz)) 2))
- (is (= (:a (->Baz :a 42)) 42))
- (is (= (:b (->Baz :b 108)) 108))
- (is (= (:a (->Baz :a 42 :b 108)) 42))
- (is (= (:b (->Baz :a 42 :b 108)) 108))
- (is (= (:a (->Baz :a 42 :b 108 :c 36)) 42))
- (is (= (:b (->Baz :a 42 :b 108 :c 36)) 108))
- (is (= (:c (->Baz :a 42 :b 108 :c 36)) 36))
- (is (thrown? Error (->Baz :a :b)))
- (is (thrown? Error (->Baz :a 42 :b nil))))
+ (is (= (:a (->Buzz 42 108)) 42))
+ (is (= (:b (->Buzz 42 108)) 108))
+ (is (thrown? ArityException (->Buzz)))
+ (is (thrown? ArityException (->Buzz 12))))
+
+; map->* factory
+
+(deftest test-map-factory-for-defconstrainedrecord
+ (is (= (:a (map->Buzz {:a 1 :b 2})) 1))
+ (is (= (:b (map->Buzz {:a 1 :b 2})) 2))
+ (is (= (:c (map->Buzz {:a 1 :b 2 :c "a"})) "a"))
+ (is (thrown? Error (map->Buzz {:a nil})) "a"))
Something went wrong with that request. Please try again.