Permalink
Browse files

mvn test runs. Failing test for unhelpful filter handling

  • Loading branch information...
1 parent eaf6601 commit 83e913b2cc07bf68a50235ae889ff9e7cb769b0e @frenchy64 frenchy64 committed Mar 25, 2013
View
22 pom.xml
@@ -20,12 +20,34 @@
<version>0.0.26</version>
</parent>
+ <build>
+ <plugins>
+ <plugin>
+ <groupId>com.theoryinpractise</groupId>
+ <artifactId>clojure-maven-plugin</artifactId>
+ <version>1.3.10</version>
+ <configuration>
+ <compileDeclaredNamespaceOnly>true</compileDeclaredNamespaceOnly>
+ <namespaces>
+ <namespace>!.*</namespace>
+ </namespaces>
+ </configuration>
+ </plugin>
+ </plugins>
+ </build>
+
<dependencies>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>jvm.tools.analyzer</artifactId>
<version>0.3.2-20130321.151954-5</version>
</dependency>
+ <!-- for algo.monads -->
+ <dependency>
+ <groupId>org.clojure</groupId>
+ <artifactId>tools.macro</artifactId>
+ <version>0.1.0</version>
+ </dependency>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>core.contracts</artifactId>
View
116 src/main/clojure/clojure/core/typed.clj
@@ -7,7 +7,7 @@
IFn IPersistentStack Associative IPersistentSet IPersistentMap IMapEntry
Keyword Atom PersistentList IMeta PersistentArrayMap Compiler Named
IRef AReference ARef IDeref IReference APersistentSet PersistentHashSet Sorted
- LazySeq APersistentMap))
+ LazySeq APersistentMap Indexed))
(:require [clojure.set :as set]
[clojure.reflect :as reflect]
[clojure.string :as str]
@@ -95,30 +95,85 @@
(defn loop>-ann [loop-of bnding-types]
loop-of)
-(defn doseq>* [the-doseq _]
- the-doseq)
-
-;(ann doseq>-ann [Any Any -> Any])
-(defmacro doseq> [bnd-vec & body]
- (let [bndings (->> bnd-vec
- (partition 2)
- (map first))
- inits (->> bnd-vec
- (partition 2)
- (map second))
- gsyms (repeatedly (count inits) gensym)]
- `(doseq>* (doseq ~bnd-vec ~@body)
- ;in a thunk to macroexpand, but not evaluation
- (fn []
- ;the collection arguments to doseq
- (let ~(vec (interleave gsyms inits))
- (print-env "doseq gsyms")
- (if (and ~@(map (fn [sym] `(seq ~sym)) gsyms))
- (do
- (let ~(vec (interleave bndings (map (fn [sym] `(first ~sym)) gsyms)))
- ~@body)
- nil)
- nil))))))
+(comment
+ (cf
+ (doseq> [[a :- (U nil AnyInteger)] [1 nil 2 3]
+ :when a]
+ (inc a))
+ )
+ )
+
+(defmacro doseq>
+ "Repeatedly executes body (presumably for side-effects) with
+ bindings and filtering as provided by \"for\". Does not retain
+ the head of the sequence. Returns nil."
+ {:added "1.0"}
+ [seq-exprs & body]
+ (@#'clojure.core/assert-args
+ (vector? seq-exprs) "a vector for its binding"
+ (even? (count seq-exprs)) "an even number of forms in binding vector")
+ (let [step (fn step [recform exprs]
+ (if-not exprs
+ [true `(do ~@body)]
+ (let [k (first exprs)
+ v (second exprs)]
+ (if (keyword? k)
+ (let [steppair (step recform (nnext exprs))
+ needrec (steppair 0)
+ subform (steppair 1)]
+ (cond
+ (= k :let) [needrec `(let ~v ~subform)]
+ (= k :while) [false `(when ~v
+ ~subform
+ ~@(when needrec [recform]))]
+ (= k :when) [false `(if ~v
+ (do
+ ~subform
+ ~@(when needrec [recform]))
+ ~recform)]))
+ ;; k is [k :- k-ann]
+ (let [_ (assert (and (vector? k)
+ (#{3} (count k))
+ (#{:-} (second k)))
+ "Binder must be of the form [lhs :- type]")
+ k-ann (nth k 2)
+ k (nth k 0)
+ ; k is the lhs binding
+ seq- (gensym "seq_")
+ chunk- (with-meta (gensym "chunk_")
+ {:tag 'clojure.lang.IChunk})
+ count- (gensym "count_")
+ i- (gensym "i_")
+ recform `(recur (next ~seq-) nil 0 0)
+ steppair (step recform (nnext exprs))
+ needrec (steppair 0)
+ subform (steppair 1)
+ recform-chunk
+ `(recur ~seq- ~chunk- ~count- (unchecked-inc ~i-))
+ steppair-chunk (step recform-chunk (nnext exprs))
+ subform-chunk (steppair-chunk 1)]
+ [true
+ `(loop> [[~seq- :- (~'U nil (~'clojure.lang.Seqable ~k-ann))] (seq ~v),
+ [~chunk- :- (~'U nil (~'clojure.lang.IChunk ~k-ann))] nil
+ [~count- :- ~'clojure.core.typed/AnyInteger] 0,
+ [~i- :- ~'clojure.core.typed/AnyInteger] 0]
+ (print-env "start-loop")
+ (if (and (< ~i- ~count-)
+ ;; core.typed thinks chunk- could be nil here
+ ~chunk-)
+ (let [~'_ (print-env "after if")
+ ~k (.nth ~chunk- ~i-)]
+ ~subform-chunk
+ ~@(when needrec [recform-chunk]))
+ (when-let [~seq- (seq ~seq-)]
+ (if (chunked-seq? ~seq-)
+ (let [c# (chunk-first ~seq-)]
+ (recur (chunk-rest ~seq-) c#
+ (int (count c#)) (int 0)))
+ (let [~k (first ~seq-)]
+ ~subform
+ ~@(when needrec [recform]))))))])))))]
+ (nth (step nil (seq seq-exprs)) 1)))
;(ann parse-fn> [Any (Seqable Any) ->
; '{:poly Any
@@ -390,9 +445,16 @@
(defrecord PropEnv [l props]
"A lexical environment l, props is a list of known propositions"
[(lex-env? l)
+ (set? props)
(every? Filter? props)])
-(declare ^:dynamic *lexical-env*)
+(defn -PropEnv [l props]
+ (->PropEnv l (if (set? props)
+ props
+ (into #{} props))))
+
+(def ^:dynamic *lexical-env* (-PropEnv {} #{}))
+(set-validator! #'*lexical-env* PropEnv?)
(defn print-env [debug-str]
nil)
@@ -407,15 +469,13 @@
:props (map unparse-filter (:props e))})))
(defonce VAR-ANNOTATIONS (atom {}))
-(def ^:dynamic *lexical-env* (->PropEnv {} []))
(defmacro with-lexical-env [env & body]
`(binding [*lexical-env* ~env]
~@body))
(set-validator! VAR-ANNOTATIONS #(and (every? (every-pred symbol? namespace) (keys %))
(every? Type? (vals %))))
-(set-validator! #'*lexical-env* PropEnv?)
(defmacro ann [varsym typesyn]
`(tc-ignore
View
22 src/main/clojure/clojure/core/typed/alter.clj
@@ -35,9 +35,22 @@
{Seqable (Seqable a)
IPersistentCollection (IPersistentCollection a)})
+(alter-class clojure.lang.IChunkedSeq [[a :variance :covariant]]
+ :replace
+ {Seqable (Seqable a)
+ IPersistentCollection (IPersistentCollection a)
+ ISeq (ISeq a)})
+
+(alter-class clojure.lang.Indexed [[a :variance :covariant]])
+
+(alter-class clojure.lang.IChunk [[a :variance :covariant]]
+ :replace
+ {clojure.lang.Indexed (clojure.lang.Indexed a)})
+
(alter-class ILookup [[a :variance :covariant]
[b :variance :covariant]])
+
(alter-class IPersistentSet [[a :variance :covariant]]
:replace
{IPersistentCollection (IPersistentCollection a)
@@ -97,7 +110,8 @@
Seqable (Seqable a)
IPersistentStack (IPersistentStack a)
ILookup (ILookup Number a)
- Associative (Associative Number a)})
+ Associative (Associative Number a)
+ Indexed (Indexed a)})
(alter-class APersistentMap [[a :variance :covariant] [b :variance :covariant]]
:replace
@@ -118,7 +132,8 @@
IFn [Number -> a]
IPersistentStack (IPersistentStack a)
ILookup (ILookup Number a)
- Associative (Associative Number a)})
+ Associative (Associative Number a)
+ Indexed (Indexed a)})
(alter-class PersistentVector [[a :variance :covariant]]
:replace
@@ -130,7 +145,8 @@
IPersistentStack (IPersistentStack a)
ILookup (ILookup Number a)
IMeta (IMeta Any)
- Associative (Associative Number a)})
+ Associative (Associative Number a)
+ Indexed (Indexed a)})
(alter-class Cons [[a :variance :covariant]]
:replace
View
4 src/main/clojure/clojure/core/typed/ann.clj
@@ -574,8 +574,8 @@
(override-method clojure.lang.Indexed/nth
(All [x y]
- (Fn [(Seqable x) AnyInteger -> x]
- [(Seqable x) AnyInteger y -> (U x y)])))
+ (Fn [(Indexed x) AnyInteger -> x]
+ [(Indexed x) AnyInteger y -> (U x y)])))
(non-nil-return clojure.lang.Compiler/munge :all)
View
26 src/main/clojure/clojure/core/typed/check.clj
@@ -2075,7 +2075,7 @@
env (let [env (-> *lexical-env*
;add mm-filter
- (assoc-in [:props] (concat props (when mm-filter [mm-filter])))
+ (assoc-in [:props] (set (concat props (when mm-filter [mm-filter]))))
;add parameters to scope
;IF UNHYGIENIC order important, (fn [a a & a]) prefers rightmost name
(update-in [:l] merge (into {} fixed-entry) (into {} rest-entry)))
@@ -2292,10 +2292,10 @@
#_(prn "invoke method: " (when method (Method->symbol method)) inst?)
(binding [*current-env* env]
(let [msym (MethodExpr->qualsym expr)
- rfin-type (ret (or (when msym
- (@METHOD-OVERRIDE-ENV msym))
- (when method
- (Method->Type method))))
+ rfin-type (or (when msym
+ (@METHOD-OVERRIDE-ENV msym))
+ (when method
+ (Method->Type method)))
_ (assert rfin-type (error-msg "Unresolved " (if inst? "instance" "static")
" method invocation "
(when c
@@ -2305,18 +2305,19 @@
;"\n\nForm:\n\t" (emit-form-fn expr))
))
_ (when inst?
- (let [ctarget (check (:target expr))]
+ (let [ctarget (check (:target expr))
+ target-class (resolve (:declaring-class method))
+ _ (assert target-class)]
; (prn "check target" (unparse-type (ret-t (expr-type ctarget)))
; (unparse-type (RClass-of (Class->symbol (resolve (:declaring-class method))) nil)))
- (when-not (subtype? (ret-t (expr-type ctarget)) (RClass-of (Class->symbol (resolve (:declaring-class method)))
- nil))
+ (when-not (subtype? (ret-t (expr-type ctarget)) (RClass-of-with-unknown-params target-class))
(throw (Exception. (error-msg "Cannot call instance method " (Method->symbol method)
" on type " (pr-str (unparse-type (ret-t (expr-type ctarget))))
"\n\n"
"Form:"
"\n\t" (emit-form-fn expr)))))))
cargs (doall (map check args))
- result-type (check-funapp expr args rfin-type (map expr-type cargs) expected)]
+ result-type (check-funapp expr args (ret rfin-type) (map expr-type cargs) expected)]
(assoc expr
expr-type result-type))))
@@ -2575,8 +2576,9 @@
;update binding type
(assoc-in [:l sym] t)
;update props
- (update-in [:props] #(apply concat
- (combine-props p* % (atom true))))
+ (update-in [:props] #(set
+ (apply concat
+ (combine-props p* % (atom true)))))
(env+ [(if (= -bot flow-f) -top flow-f)] flow-atom))
_ (assert @flow-atom "Applying flow filter resulted in local being bottom")]
new-env)
@@ -2989,7 +2991,7 @@
;(prn "variables are now bottom: " (map key bs))
(reset! flag false))
new-env))
- (assoc env :props (concat atoms props))
+ (assoc env :props (set (concat atoms props)))
(concat atoms props))))
(def object-equal? =)
View
14 src/main/clojure/clojure/core/typed/type_rep.clj
@@ -233,6 +233,7 @@
(Poly? rc) (instantiate-poly rc args)
(RClass? rc) rc
:else (->RClass nil nil sym {} #{})))))
+
(declare Poly* no-bounds)
@@ -403,6 +404,19 @@
(visit-bounds b #(instantiate-many names %)))
(.bbnds poly)))
+(defn RClass-of-with-unknown-params
+ ([sym-or-cls]
+ {:pre [((some-fn class? symbol?) sym-or-cls)]
+ :post [(RClass? %)]}
+ (let [sym (if (class? sym-or-cls)
+ (Class->symbol sym-or-cls)
+ sym-or-cls)
+ rc (@RESTRICTED-CLASS sym)
+ args (when (Poly? rc)
+ ;instantiate with Any, could be more general if respecting variance
+ (repeat (.nbound ^Poly rc) -any))]
+ (RClass-of sym args))))
+
(defrecord PolyDots [nbound bbnds ^Scope scope]
"A polymorphic type containing n-1 bound variables and 1 ... variable"
[(nat? nbound)
View
0 ...lojure/clojure/core/typed/test/logic.cljs → ...t/cljs/clojure/core/typed/test/logic.cljs
File renamed without changes.
View
10 src/test/clojure/clojure/core/typed/test/cljs.clj
@@ -1,10 +0,0 @@
-(ns clojure.core.typed.test.core
- (:refer-clojure :exclude [defrecord])
- (:require [clojure.test :refer :all]
- [clojure.tools.analyzer :refer [ast]]
- [clojure.repl :refer [pst]]
- [clojure.pprint :refer [pprint]]
- [clojure.data :refer [diff]]
- [clojure.core.typed :as tc, :refer :all, :exclude [subtype? check]]
- [clojure.tools.trace :refer [trace-vars untrace-vars
- trace-ns untrace-ns]]))
View
23 src/test/clojure/clojure/core/typed/test/core.clj
@@ -411,32 +411,32 @@
(is (let [props [(-filter (->Value :a) 'a)]
flag (atom true)]
(and (= (let [env {'a -any}
- lenv (->PropEnv env props)]
+ lenv (-PropEnv env props)]
(env+ lenv [] flag))
- (->PropEnv {'a (->Value :a)} props))
+ (-PropEnv {'a (->Value :a)} props))
@flag)))
;test positive KeyPE
;update a from (U (HMap {:op :if}) (HMap {:op :var})) => (HMap {:op :if})
(is (let [props [(-filter (->Value :if) 'a [(->KeyPE :op)])]
flag (atom true)]
(and (= (let [env {'a (Un (-hmap {(->Value :op) (->Value :if)})
(-hmap {(->Value :op) (->Value :var)}))}
- lenv (->PropEnv env props)]
+ lenv (-PropEnv env props)]
(env+ lenv [] flag))
- (->PropEnv {'a (-hmap {(->Value :op) (->Value :if)})} props))
+ (-PropEnv {'a (-hmap {(->Value :op) (->Value :if)})} props))
@flag)))
;test negative KeyPE
(is (let [props [(-not-filter (->Value :if) 'a [(->KeyPE :op)])]
flag (atom true)]
(and (= (let [env {'a (Un (-hmap {(->Value :op) (->Value :if)})
(-hmap {(->Value :op) (->Value :var)}))}
- lenv (->PropEnv env props)]
+ lenv (-PropEnv env props)]
(env+ lenv [] flag))
- (->PropEnv {'a (-hmap {(->Value :op) (->Value :var)})} props))
+ (-PropEnv {'a (-hmap {(->Value :op) (->Value :var)})} props))
@flag)))
;test impfilter
(is (let [{:keys [l props]}
- (env+ (->PropEnv {'a (Un -false -true) 'b (Un -nil -true)}
+ (env+ (-PropEnv {'a (Un -false -true) 'b (Un -nil -true)}
[(->ImpFilter (-not-filter -false 'a)
(-filter -true 'b))])
[(-not-filter (Un -nil -false) 'a)]
@@ -446,7 +446,7 @@
#{(-not-filter (Un -nil -false) 'a)
(-filter -true 'b)}))))
; more complex impfilter
- (is (= (env+ (->PropEnv {'and1 (Un -false -true)
+ (is (= (env+ (-PropEnv {'and1 (Un -false -true)
'tmap (->Name 'clojure.core.typed.test.core/UnionName)}
[(->ImpFilter (-filter (Un -nil -false) 'and1)
(-not-filter (-val :MapStruct1)
@@ -459,7 +459,7 @@
[(-filter (Un -nil -false) 'and1)]
(atom true))))
; refine a subtype
- (is (= (:l (env+ (->PropEnv {'and1 (RClass-of Seqable [-any])} [])
+ (is (= (:l (env+ (-PropEnv {'and1 (RClass-of Seqable [-any])} [])
[(-filter (RClass-of IPersistentVector [-any]) 'and1)]
(atom true)))
{'and1 (RClass-of IPersistentVector [-any])})))
@@ -1213,3 +1213,8 @@
AddProtoc
(adder [_ i] (Accumulator. (+ t i))))))))
;;;;
+
+(deftest let-filter-unscoping-test
+ (is (cf (fn [a]
+ (and (< 1 2) a))
+ [(U nil Number) -> Any :filters {:then (is Number 0)}])))
View
2 src/test/clojure/clojure/core/typed/test/rbt.clj
@@ -138,7 +138,7 @@
(let [fs (read-string "#clojure.core.typed.FilterSet{:then #clojure.core.typed.AndFilter{:fs #{#clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :right} #clojure.core.typed.KeyPE{:val :left} #clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :left} #clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Black}, :path (#clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :right} #clojure.core.typed.KeyPE{:val :tree}), :id tmap}}}, :else #clojure.core.typed.OrFilter{:fs #{#clojure.core.typed.AndFilter{:fs #{#clojure.core.typed.OrFilter{:fs #{#clojure.core.typed.AndFilter{:fs #{#clojure.core.typed.NotTypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :left} #clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Black}, :path (#clojure.core.typed.KeyPE{:val :tree}), :id tmap}}} #clojure.core.typed.AndFilter{:fs #{#clojure.core.typed.OrFilter{:fs #{#clojure.core.typed.AndFilter{:fs #{#clojure.core.typed.NotTypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :right} #clojure.core.typed.KeyPE{:val :left} #clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :left} #clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Black}, :path (#clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :right} #clojure.core.typed.KeyPE{:val :tree}), :id tmap}}} #clojure.core.typed.AndFilter{:fs #{#clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :left} #clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Black}, :path (#clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.NotTypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :right} #clojure.core.typed.KeyPE{:val :tree}), :id tmap}}}}} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Red}, :path (#clojure.core.typed.KeyPE{:val :left} #clojure.core.typed.KeyPE{:val :tree}), :id tmap} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Black}, :path (#clojure.core.typed.KeyPE{:val :tree}), :id tmap}}}}} #clojure.core.typed.TypeFilter{:type #clojure.core.typed.Value{:val :Black}, :path (#clojure.core.typed.KeyPE{:val :tree}), :id tmap}}} #clojure.core.typed.NotTypeFilter{:type #clojure.core.typed.Value{:val :Black}, :path (#clojure.core.typed.KeyPE{:val :tree}), :id tmap}}}}")]
(->
- (env+ (->PropEnv {'tmap (->Name 'typed.test.rbt/badRight)}
+ (env+ (-PropEnv {'tmap (->Name 'typed.test.rbt/badRight)}
[])
[(:else fs)]
(atom true))

0 comments on commit 83e913b

Please sign in to comment.