Permalink
Browse files

Change syntax for datatype/protocol anns. Better errors.

  • Loading branch information...
1 parent aa6396d commit 1e7946d242004c62b0c471b87803e030e836b00c @frenchy64 committed Dec 5, 2012
View
@@ -18,6 +18,15 @@ Leiningen (Clojars):
# Changelog
+0.1.5-SNAPSHOT
+- Better errors for Java methods and polymorphic function applications, borrow error messages from Typed Racket
+- Change `ann-datatype`, `ann-protocol`, `ann-pprotocol` syntax to be flatter
+ (ann-protocol pname
+ method-name method-type ...)
+ (ann-dataype dname
+ [field-name :- field-type ...])
+- Add `defprotocol>`
+
0.1.4
- Support Clojure 1.4.0+
- Better errors, print macro-expanded form from AST
View
@@ -1,6 +1,6 @@
-(defproject typed "0.1.4"
+(defproject typed "0.1.5-SNAPSHOT"
:description "Gradual typing for Clojure"
- :dependencies [[analyze "0.2.3"]
+ :dependencies [[analyze "0.2.4-SNAPSHOT"]
[net.intensivesystems/arrows "1.3.0"
:exclusions [org.clojure/clojure]] ;for testing conduit, lein test wants it here?
[trammel "0.7.0"
@@ -10,7 +10,7 @@
[org.clojure/clojurescript "0.0-1450"]
[org.clojure/tools.trace "0.7.3"
:exclusions [org.clojure/clojure]]
- [org.clojure/clojure "1.4.0"]
+ [org.clojure/clojure "1.5.0-beta1"]
]
:dev-dependencies [[org.clojure/tools.macro "0.1.0"] ;for algo.monads
])
View
@@ -603,6 +603,46 @@
(TApp? etype) (recur (resolve-TApp etype) seen)
:else etype)))))
+(declare Method->symbol)
+
+(defn app-type-error [fexpr args fin arg-ret-types expected poly?]
+ {:pre [(FnIntersection? fin)]}
+ (let [static-method? (= :static-method (:op fexpr))
+ instance-method? (= :instance-method (:op fexpr))
+ method-sym (when (or static-method? instance-method?)
+ (Method->symbol (:method fexpr)))]
+ (error-msg
+ (if poly?
+ (str "Polymorphic "
+ (cond static-method? "static method "
+ instance-method? "instance method "
+ :else "function "))
+ (cond static-method? "Static method "
+ instance-method? "Instance method "
+ :else "Function "))
+ (if (or static-method?
+ instance-method?)
+ method-sym
+ (ana-frm/map->form fexpr))
+ " could not be applied to arguments:\n"
+ "Domains: \n\t"
+ (clojure.string/join "\n\t" (map (partial apply pr-str) (map (comp #(map unparse-type %) :dom) (.types fin))))
+ "\n\n"
+ "Arguments:\n\t" (apply prn-str (mapv (comp unparse-type ret-t) arg-ret-types)) "\n"
+ "in: " (if (or static-method? instance-method?)
+ (ana-frm/map->form fexpr)
+ (list* (ana-frm/map->form fexpr)
+ (map ana-frm/map->form args))))))
+
+(defn polyapp-type-error [fexpr args fexpr-type arg-ret-types expected]
+ {:pre [(Poly? fexpr-type)]}
+ (let [fin (Poly-body* (Poly-free-names* fexpr-type) fexpr-type)]
+ (app-type-error fexpr args fin arg-ret-types expected true)))
+
+(defn plainapp-type-error [fexpr args fexpr-type arg-ret-types expected]
+ {:pre [(FnIntersection? fexpr-type)]}
+ (app-type-error fexpr args fexpr-type arg-ret-types expected false))
+
; TCResult TCResult^n (U nil TCResult) -> TCResult
(defn check-funapp [fexpr args fexpr-ret-type arg-ret-types expected]
{:pre [(TCResult? fexpr-ret-type)
@@ -630,9 +670,7 @@
ftypes))]
(if success-ret-type
success-ret-type
- (throw (Exception. (error-msg "funapp: Arguments did not match function: "
- (unparse-type fexpr-type)
- (mapv unparse-type arg-types))))))
+ (throw (Exception. (plainapp-type-error fexpr args fexpr-type arg-ret-types expected)))))
;ordinary polymorphic function without dotted rest
(and (Poly? fexpr-type)
@@ -641,10 +679,10 @@
(every? (complement :drest) (.types body)))))
(let [fs-names (repeatedly (.nbound fexpr-type) gensym)
_ (assert (every? symbol? fs-names))
- body (Poly-body* fs-names fexpr-type)
+ fin (Poly-body* fs-names fexpr-type)
bbnds (Poly-bbnds* fs-names fexpr-type)
- _ (assert (FnIntersection? body))
- ret-type (loop [[{:keys [dom rng rest drest kws] :as ftype} & ftypes] (.types body)]
+ _ (assert (FnIntersection? fin))
+ ret-type (loop [[{:keys [dom rng rest drest kws] :as ftype} & ftypes] (.types fin)]
(when ftype
#_(prn "infer poly fn" (unparse-type ftype) (map unparse-type arg-types)
(count dom) (count arg-types))
@@ -667,12 +705,7 @@
(recur ftypes)))))]
(if ret-type
ret-type
- (throw (Exception. (error-msg "Could not infer result to polymorphic function: "
- (unparse-type fexpr-type) " with arguments "
- (mapv unparse-type arg-types)
- (when expected
- (str " with expected type " (unparse-type (ret-t expected))))
- " Requires more type annotations.")))))
+ (throw (Exception. (polyapp-type-error fexpr args fexpr-type arg-ret-types expected)))))
:else ;; any kind of dotted polymorphic function without mandatory keyword args
(if-let [[pbody fixed-vars fixed-bnds dotted-var dotted-bnd]
View
@@ -142,6 +142,11 @@
(let [{:keys [fn parsed-methods]} (parse-fn> false forms)]
`(fn>-ann ~fn '~parsed-methods)))
+(defmacro defprotocol> [& body]
+ "Define a typed protocol"
+ `(tc-ignore
+ (defprotocol ~@body)))
+
(defmacro loop>
"Define a typed loop"
[bndings* & forms]
@@ -349,7 +354,7 @@
;_# (prn "local-name" local-name#)
s# (symbol (str munged-ns-str# \. local-name#))
fs# (apply array-map (apply concat (with-frees (mapv make-F '~args)
- (mapv parse-field '~fields))))
+ (mapv parse-field (partition 3 '~fields)))))
as# (set (with-frees (mapv make-F '~args)
(mapv parse-type '~ancests)))
_# (add-datatype-ancestors s# as#)
@@ -419,19 +424,19 @@
(add-var-type kq# mt#)))
[s# (unparse-type t#)]))))
-(defmacro ann-protocol [local-varsym & {mths :methods}]
+(defmacro ann-protocol [local-varsym & {:as mth}]
(assert (not (or (namespace local-varsym)
(some #{\.} (str local-varsym))))
(str "Must provide local var name for protocol: " local-varsym))
`(tc-ignore
- ~(gen-protocol* local-varsym nil nil mths)))
+ ~(gen-protocol* local-varsym nil nil mth)))
-(defmacro ann-pprotocol [local-varsym vbnd & {mths :methods}]
+(defmacro ann-pprotocol [local-varsym vbnd & {:as mth}]
(assert (not (or (namespace local-varsym)
(some #{\.} (str local-varsym))))
(str "Must provide local var name for protocol: " local-varsym))
`(tc-ignore
- ~(gen-protocol* local-varsym (mapv second vbnd) (mapv first vbnd) mths)))
+ ~(gen-protocol* local-varsym (mapv second vbnd) (mapv first vbnd) mth)))
(defmacro override-constructor [ctorsym typesyn]
`(tc-ignore
@@ -650,7 +655,7 @@
(check-ns 'typed.test.macro)
(check-ns 'typed.test.conduit)
- (check-ns 'typed.test.deftype)
+ (check-ns 'typed.test.person)
(check-ns 'typed.test.core-logic)
(check-ns 'typed.test.ckanren)
Oops, something went wrong.

0 comments on commit 1e7946d

Please sign in to comment.