Permalink
Browse files

Bump to snapshot. Annotate datatypes in other namespaces

  • Loading branch information...
1 parent 8b3885f commit 3be3d063c9e8613b4e77bd43c66d5c849b242ee4 @frenchy64 committed Nov 3, 2012
Showing with 51 additions and 44 deletions.
  1. +4 −0 README.md
  2. +1 −1 project.clj
  3. +46 −43 src/typed/core.clj
View
@@ -18,6 +18,10 @@ Leiningen (Clojars):
# Changelog
+0.1.2-SNAPSHOT
+
+- Can annotate datatypes outside current namespace
+
0.1.1
- Ensure `ann-form` finally checks its expression is of the expected type
View
@@ -1,4 +1,4 @@
-(defproject typed "0.1.1"
+(defproject typed "0.1.2-SNAPSHOT"
:description "Gradual typing for Clojure"
:dependencies [[analyze "0.2"]
[net.intensivesystems/arrows "1.3.0"] ;for testing conduit, lein test wants it here?
View
@@ -2156,53 +2156,56 @@
(defn parse-field [[n _ t]]
[n (parse-type t)])
-(defn gen-datatype* [local-name fields variances args ancests]
- `(let [local-name# '~local-name
- fs# (apply array-map (apply concat (with-frees (mapv make-F '~args)
- (mapv parse-field '~fields))))
- as# (set (with-frees (mapv make-F '~args)
- (mapv parse-type '~ancests)))
- s# (symbol (str (munge (-> *ns* ns-name)) \. local-name#))
- _# (add-datatype-ancestors s# as#)
- pos-ctor-name# (symbol (str (-> *ns* ns-name)) (str "->" local-name#))
- args# '~args
- vs# '~variances
- dt# (if args#
- (Poly* args# (repeat (count args#) no-bounds)
- (->DataType s# vs# (map make-F args#) fs#)
- args#)
- (->DataType s# nil nil fs#))
- pos-ctor# (if args#
- (Poly* args# (repeat (count args#) no-bounds)
- (make-FnIntersection
- (make-Function (vec (vals fs#)) (->DataType s# vs# (map make-F args#) fs#)))
- args#)
- (make-FnIntersection
- (make-Function (vec (vals fs#)) dt#)))]
- (do
- (when vs#
- (let [f# (mapv make-F (repeatedly (count vs#) gensym))]
- (alter-class* s# (RClass* (map :name f#) vs# f# s# {}))))
- (add-datatype s# dt#)
- (add-var-type pos-ctor-name# pos-ctor#)
- [[s# (unparse-type dt#)]
- [pos-ctor-name# (unparse-type pos-ctor#)]])))
-
-(defmacro ann-datatype [local-name fields & {ancests :unchecked-ancestors rplc :replace}]
+(defn gen-datatype* [provided-name fields variances args ancests]
+ `(let [provided-name# '~provided-name
+ local-name# (if (namespace provided-name#)
+ (symbol (apply str (last (partition-by #(= \. %) (str provided-name#)))))
+ provided-name#)
+ s# (if (namespace provided-name#)
+ provided-name#
+ (symbol (str (munge (-> *ns* ns-name)) \. local-name#)))
+ fs# (apply array-map (apply concat (with-frees (mapv make-F '~args)
+ (mapv parse-field '~fields))))
+ as# (set (with-frees (mapv make-F '~args)
+ (mapv parse-type '~ancests)))
+ _# (add-datatype-ancestors s# as#)
+ pos-ctor-name# (symbol (str (-> *ns* ns-name)) (str "->" local-name#))
+ args# '~args
+ vs# '~variances
+ dt# (if args#
+ (Poly* args# (repeat (count args#) no-bounds)
+ (->DataType s# vs# (map make-F args#) fs#)
+ args#)
+ (->DataType s# nil nil fs#))
+ pos-ctor# (if args#
+ (Poly* args# (repeat (count args#) no-bounds)
+ (make-FnIntersection
+ (make-Function (vec (vals fs#)) (->DataType s# vs# (map make-F args#) fs#)))
+ args#)
+ (make-FnIntersection
+ (make-Function (vec (vals fs#)) dt#)))]
+ (do
+ (when vs#
+ (let [f# (mapv make-F (repeatedly (count vs#) gensym))]
+ (alter-class* s# (RClass* (map :name f#) vs# f# s# {}))))
+ (add-datatype s# dt#)
+ (add-var-type pos-ctor-name# pos-ctor#)
+ [[s# (unparse-type dt#)]
+ [pos-ctor-name# (unparse-type pos-ctor#)]])))
+
+(defmacro ann-datatype [dname fields & {ancests :unchecked-ancestors rplc :replace}]
(assert (not rplc) "Replace NYI")
- (assert (not (or (namespace local-name)
- (some #(= \. %) (str local-name))))
- (str "Must provide local name: " local-name))
+ (assert (symbol? dname)
+ (str "Must provide name symbol: " dname))
`(tc-ignore
- ~(gen-datatype* local-name fields nil nil ancests)))
+ ~(gen-datatype* dname fields nil nil ancests)))
-(defmacro ann-pdatatype [local-name vbnd fields & {ancests :unchecked-ancestors rplc :replace}]
+(defmacro ann-pdatatype [dname vbnd fields & {ancests :unchecked-ancestors rplc :replace}]
(assert (not rplc) "Replace NYI")
- (assert (not (or (namespace local-name)
- (some #(= \. %) (str local-name))))
- (str "Must provide local name: " local-name))
+ (assert (symbol? dname)
+ (str "Must provide local symbol: " dname))
`(tc-ignore
- ~(gen-datatype* local-name fields (map second vbnd) (map first vbnd) ancests)))
+ ~(gen-datatype* dname fields (map second vbnd) (map first vbnd) ancests)))
(defn gen-protocol* [local-varsym variances args mths]
`(let [local-vsym# '~local-varsym
@@ -8700,7 +8703,7 @@
(let [cls-stub (symbol (.getName ^Class cls))
clssym (symbol (str/replace-first (str cls-stub) (str COMPILE-STUB-PREFIX ".") ""))
inst-of (or (@DATATYPE-ENV clssym)
- (RClass-of (Class->symbol (Class/forName (str clssym)) nil)))
+ (RClass-of clssym))
cexpr (check the-expr)
expr-tr (expr-type cexpr)]
(assoc expr

0 comments on commit 3be3d06

Please sign in to comment.