Skip to content
This repository
Browse code

Fix major bug with filters & objects being lost during funapps

  • Loading branch information...
commit a5810fe426845365a938859508d1ff8fc477af24 1 parent b7c6570
Ambrose Bonnaire-Sergeant authored November 05, 2012
8  README.md
Source Rendered
@@ -19,8 +19,12 @@ Leiningen (Clojars):
19 19
 # Changelog
20 20
 
21 21
 0.1.2-SNAPSHOT
  22
+- TODO
  23
+  - Add tests for (if (seq a) (first a) 0) filter example.
22 24
 
23  
-- Can annotate datatypes outside current namespace
  25
+- DONE
  26
+  - Fix objects and filters being lost during polymorphic and dotted function applications
  27
+  - Can annotate datatypes outside current namespace
24 28
 
25 29
 0.1.1
26 30
 
@@ -37,7 +41,7 @@ Leiningen (Clojars):
37 41
 
38 42
 `(typed.core/cf t)` type checks the form `t`.
39 43
 
40  
-# Immediate Roadmap
  44
+# Future work
41 45
 
42 46
 * Equality filters for occurrence typing
43 47
 * Type check multimethods
77  src/typed/core.clj
@@ -67,9 +67,14 @@
67 67
 (defn tc-pr-env 
68 68
   "Print the current type environment, and debug-string"
69 69
   [debug-string] nil)
70  
-(defn tc-pr-filters [debug-string frm] frm)
71 70
 
72  
-(defn inst-poly [inst-of types-syn]
  71
+(defn tc-pr-filters 
  72
+  "Print the filter set attached to form, and debug-string"
  73
+  [debug-string frm] 
  74
+  frm)
  75
+
  76
+(defn inst-poly 
  77
+  [inst-of types-syn]
73 78
   inst-of)
74 79
 
75 80
 (defn inst-poly-ctor [inst-of types-syn]
@@ -5962,10 +5967,10 @@
5962 5967
         tcls (symbol->Class (:the-class t))]
5963 5968
     (cond
5964 5969
       (.isPrimitive ^Class scls)
5965  
-      (-> (primitive-coersions scls) :up tcls)
  5970
+      (-> (primitive-coersions scls) :up (get tcls))
5966 5971
 
5967 5972
       (.isPrimitive ^Class tcls)
5968  
-      (-> (primitive-coersions tcls) :down scls))))
  5973
+      (-> (primitive-coersions tcls) :down (get scls)))))
5969 5974
 
5970 5975
 (defmethod subtype* [RClass RClass]
5971 5976
   [{polyl? :poly? :as s}
@@ -7095,6 +7100,12 @@
7095 7100
          (RObject? o)
7096 7101
          ((some-fn nil? Type?) t)]
7097 7102
    :post [(FilterSet? %)]}
  7103
+;  (prn "subst-filter-set")
  7104
+;  (prn "fs" (unparse-filter-set fs))
  7105
+;  (prn "k" k) 
  7106
+;  (prn "o" o)
  7107
+;  (prn "polarity" polarity) 
  7108
+;  (prn "t" (when t (unparse-type t)))
7098 7109
   (let [extra-filter (if t (->TypeFilter t nil k) -top)]
7099 7110
     (letfn [(add-extra-filter [f]
7100 7111
               {:pre [(Filter? f)]
@@ -7104,8 +7115,8 @@
7104 7115
                   f*
7105 7116
                   f)))]
7106 7117
       (cond
7107  
-        (FilterSet? fs) (-FS (subst-filter (add-extra-filter (:then fs)) k o polarity)
7108  
-                             (subst-filter (add-extra-filter (:else fs)) k o polarity))
  7118
+        (FilterSet? fs) (-FS (subst-filter (add-extra-filter (.then fs)) k o polarity)
  7119
+                             (subst-filter (add-extra-filter (.else fs)) k o polarity))
7109 7120
         :else (-FS -top -top)))))
7110 7121
 
7111 7122
 (defn subst-object [t k o polarity]
@@ -7174,6 +7185,27 @@
7174 7185
                 :polarity polarity}}
7175 7186
       t)))
7176 7187
 
  7188
+;; Used to "instantiate" a Result from a function call.
  7189
+;; eg. (let [a (ann-form [1] (U nil (Seqable Number)))]
  7190
+;;       (if (seq a)
  7191
+;;         ...
  7192
+;;
  7193
+;; Here we want to instantiate the result of (seq a).
  7194
+;; objs is each of the arguments' objects, ie. [-empty]
  7195
+;; ts is each of the arugments' types, ie. [(U nil (Seqable Number))]
  7196
+;;
  7197
+;; The latent result:
  7198
+; (Option (ISeq x))
  7199
+; :filters {:then (is (CountRange 1) 0)
  7200
+;           :else (| (is nil 0)
  7201
+;                    (is (ExactCount 0) 0))}]))
  7202
+;; instantiates to 
  7203
+; (Option (ISeq x))
  7204
+; :filters {:then (is (CountRange 1) a)
  7205
+;           :else (| (is nil a)
  7206
+;                    (is (ExactCount 0) a))}]))
  7207
+;;
  7208
+;; Notice the objects are instantiated from 0 -> a
7177 7209
 (defn open-Result 
7178 7210
   "Substitute ids for objs in Result t"
7179 7211
   [{t :t fs :fl old-obj :o :as r} objs & [ts]]
@@ -7184,7 +7216,11 @@
7184 7216
          ((some-fn nil? (every-c? Type?)) ts)]
7185 7217
    :post [((hvector-c? Type? FilterSet? RObject?) %)]}
7186 7218
 ;  (prn "open-result")
7187  
-;  (prn "latent filter set" (unparse-filter-set fs))
  7219
+;  (prn "result type" (unparse-type t))
  7220
+;  (prn "result filterset" (unparse-filter-set fs))
  7221
+;  (prn "result (old) object" old-obj)
  7222
+;  (prn "objs" objs)
  7223
+;  (prn "ts" (mapv unparse-type ts))
7188 7224
   (reduce (fn [[t fs old-obj] [[o k] arg-ty]]
7189 7225
             {:pre [(Type? t)
7190 7226
                    ((some-fn FilterSet? NoFilter?) fs)
@@ -7193,10 +7229,15 @@
7193 7229
                    (RObject? o)
7194 7230
                    ((some-fn false? Type?) arg-ty)]
7195 7231
              :post [((hvector-c? Type? FilterSet? RObject?) %)]}
7196  
-            [(subst-type t k o true)
7197  
-             (subst-filter-set fs k o true arg-ty)
7198  
-             (subst-object old-obj k o true)])
  7232
+            (let [r [(subst-type t k o true)
  7233
+                     (subst-filter-set fs k o true arg-ty)
  7234
+                     (subst-object old-obj k o true)]]
  7235
+;              (prn [(unparse-type t) (unparse-filter-set fs) old-obj])
  7236
+;              (prn "r" r)
  7237
+              r))
7199 7238
           [t fs old-obj]
  7239
+          ; this is just a sequence of pairs of [nat? RObject] and Type?
  7240
+          ; Represents the object and type of each argument, and its position
7200 7241
           (map vector 
7201 7242
                (map-indexed #(vector %2 %1) ;racket's is opposite..
7202 7243
                             objs)
@@ -7214,6 +7255,8 @@
7214 7255
    :post [(TCResult? %)]}
7215 7256
   (assert (not drest) "funapp with drest args NYI")
7216 7257
   (assert (empty? (:mandatory kws)) "funapp with mandatory keyword args NYI")
  7258
+;  (prn "check-funapp1")
  7259
+;  (prn "argtys objects" (map ret-o argtys))
7217 7260
   ;checking
7218 7261
   (when check?
7219 7262
     (when (or (and (not rest) (not (= (count dom) (count argtys))))
@@ -7224,9 +7267,9 @@
7224 7267
       (check-below arg-t dom-t)))
7225 7268
   (let [dom-count (count dom)
7226 7269
         arg-count (+ dom-count (if rest 1 0) (count (:optional kws)))
7227  
-        o-a (map :o argtys)
  7270
+        o-a (map ret-o argtys)
7228 7271
         _ (assert (every? RObject? o-a))
7229  
-        t-a (map :t argtys)
  7272
+        t-a (map ret-t argtys)
7230 7273
         _ (assert (every? Type? t-a))
7231 7274
         [o-a t-a] (let [rs (for [[nm oa ta] (map vector 
7232 7275
                                                  (range arg-count) 
@@ -7257,7 +7300,7 @@
7257 7300
          ((some-fn nil? TCResult?) expected)]
7258 7301
    :post [(TCResult? %)]}
7259 7302
   (let [fexpr-type (resolve-to-ftype (ret-t fexpr-ret-type))
7260  
-        arg-types (doall (map ret-t arg-ret-types))]
  7303
+        arg-types (mapv ret-t arg-ret-types)]
7261 7304
     #_(prn "check-funapp" (unparse-type fexpr-type) (map unparse-type arg-types))
7262 7305
     (cond
7263 7306
       ;ordinary Function, single case, special cased for improved error msgs
@@ -7308,7 +7351,7 @@
7308 7351
                                                    #_(prn e)))]
7309 7352
                            (do #_(prn "subst:" substitution)
7310 7353
                              (check-funapp1 (subst-all substitution ftype)
7311  
-                                            (map ret arg-types) expected :check? false))
  7354
+                                            arg-ret-types expected :check? false))
7312 7355
                            (if (or drest kws)
7313 7356
                              (throw (Exception. "Cannot infer arguments to polymorphic functions with dotted rest or kw types"))
7314 7357
                              (recur ftypes)))))]
@@ -7361,7 +7404,7 @@
7361 7404
                                            ;_ (prn "args" (map unparse-type arg-types))
7362 7405
                                            ]
7363 7406
                                        (or (and substitution
7364  
-                                                (check-funapp1 substituted-type (map ret arg-types) expected :check? false))
  7407
+                                                (check-funapp1 substituted-type arg-ret-types expected :check? false))
7365 7408
                                            (throw (Exception. "Error applying dotted type")))))))]
7366 7409
           ;(prn "inferred-rng"inferred-rng)
7367 7410
           (if inferred-rng
@@ -8264,6 +8307,8 @@
8264 8307
          (every? integer? keys)
8265 8308
          ((some-fn NoFilter? FilterSet?) fs)]
8266 8309
    :post [((some-fn NoFilter? FilterSet?) %)]}
  8310
+;  (prn "abstract filter")
  8311
+;  (prn ids keys fs)
8267 8312
   (cond
8268 8313
     (FilterSet? fs)
8269 8314
     (let [{fs+ :then fs- :else} fs]
@@ -8294,6 +8339,8 @@
8294 8339
          (every? integer? idxs)
8295 8340
          (Filter? f)]
8296 8341
    :post [(Filter? %)]}
  8342
+;  (prn "abo")
  8343
+;  (prn xs idxs f)
8297 8344
   (letfn [(lookup [y]
8298 8345
             {:pre [(symbol? y)]
8299 8346
              :post [((some-fn nil? integer?) %)]}
8  test/typed/test/core.clj
@@ -124,9 +124,11 @@
124 124
   (is (subtype? (constant-type '{:a 1 :b 2 :c 3})
125 125
                 (constant-type '{:a 1 :b 2}))))
126 126
 
127  
-;(deftest subtype-top-Function
128  
-;  (is (subtype? (parse-type '[Integer -> Number])
129  
-;                (In (->TopFunction)))))
  127
+(deftest subtype-top-Function
  128
+  (is (subtype? (parse-type '[Integer -> Number])
  129
+                (parse-type 'AnyFunction)))
  130
+  (is (subtype? (parse-type '[Integer -> Number])
  131
+                (parse-type 'AnyFunction))))
130 132
 
131 133
 (deftest subtype-poly
132 134
   (is (subtype? (parse-type '(All [x] (clojure.lang.ASeq x)))

0 notes on commit a5810fe

Please sign in to comment.
Something went wrong with that request. Please try again.