new version of abstract-filters that handles multiple values/arguments properly

strengthen contracts
improve match expanders

svn: r14057

collects/typed-scheme/rep/object-rep.ss

@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require scheme/match scheme/contract "rep-utils.ss" "free-variance.ss")
+(require scheme/match scheme/contract "rep-utils.ss" "free-variance.ss" "filter-rep.ss")
 
 (dpe CarPE () [#:fold-rhs #:base])
 (dpe CdrPE () [#:fold-rhs #:base])
@@ -17,6 +17,6 @@
 
 (dlo LEmpty () [#:fold-rhs #:base])
 
-(dlo LPath ([p (listof PathElem?)] [idx natural-number/c])
+(dlo LPath ([p (listof PathElem?)] [idx index/c])
   [#:frees (combine-frees (map free-vars* p)) (combine-frees (map free-idxs* p))]
   [#:fold-rhs (*LPath (map pathelem-rec-id p) idx)])

collects/typed-scheme/typecheck/tc-metafunctions.ss

@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require "../utils/utils.ss")
-(require (rename-in (types subtype convenience remove-intersect union)                   
+(require (rename-in (types subtype convenience remove-intersect union utils)                   
                     [-> -->]
                     [->* -->*]
                     [one-of/c -one-of/c])
@@ -27,22 +27,48 @@
          (make-FilterSet null (list (make-Bot)))]
         [else (make-FilterSet l1 l2)]))
 
-(define/contract (abstract-filter x idx fs)
+(d/c (abstract-filters keys ids results)
-  (-> identifier? index/c FilterSet? LFilterSet?)
+     (-> (listof index/c) (listof identifier?) tc-results? (or/c Values? ValuesDots?))
+     (define (mk l [drest #f])
+       (if drest (make-ValuesDots l (car drest) (cdr drest)) (make-Values l)))
+     (match results
+       [(tc-results: ts fs os dty dbound)
+        (make-ValuesDots 
+         (for/list ([t ts]
+                    [f fs]
+                    [o os])
+           (make-Result t (abstract-filter ids keys f) (abstract-object ids keys o))))]))
+
+(define/contract (abstract-object ids keys o)
+  (-> (listof identifier?) (listof index/c) Object? LatentObject?)
+  (define (lookup y)
+    (for/first ([x ids] [i keys] #:when (free-identifier=? x y)) i))
+  (define-match-expander lookup:
+    (syntax-rules ()
+      [(_ i) (app lookup (? values i))]))
+  (match o    
+    [(Path: p (lookup: idx)) (make-LPath p idx)]
+    [_ (make-LEmpty)]))
+
+(define/contract (abstract-filter ids keys fs)
+  (-> (listof identifier?) (listof index/c) FilterSet? LFilterSet?)
   (match fs
     [(FilterSet: f+ f-)
      (lcombine
-      (apply append (for/list ([f f+]) (abo x idx f)))
+      (apply append (for/list ([f f+]) (abo ids keys f)))
-      (apply append (for/list ([f f-]) (abo x idx f))))]))
+      (apply append (for/list ([f f-]) (abo ids keys f))))]))
 
-(define/contract (abo x idx f)
+(define/contract (abo xs idxs f)
-  (-> identifier? index/c Filter/c (or/c '() (list/c LatentFilter/c)))
+  (-> (listof identifier?) (listof index/c) Filter/c (or/c '() (list/c LatentFilter/c)))
-  (define-match-expander =x
+  (define (lookup y)
-    (lambda (stx) #'(? (lambda (id) (free-identifier=? id x)))))
+    (for/first ([x xs] [i idxs] #:when (free-identifier=? x y)) i)) 
+  (define-match-expander lookup:
+    (syntax-rules ()
+      [(_ i) (app lookup (? values i))]))
   (match f
     [(Bot:) (list (make-LBot))]
-    [(TypeFilter: t p (=x)) (list (make-LTypeFilter t p idx))]
+    [(TypeFilter: t p (lookup: idx)) (list (make-LTypeFilter t p idx))]
-    [(NotTypeFilter: t p (=x)) (list (make-LNotTypeFilter t p idx))]
+    [(NotTypeFilter: t p (lookup: idx)) (list (make-LNotTypeFilter t p idx))]
     [_ null]))
 
 (define/contract (apply-filter lfs t o)

collects/typed-scheme/types/utils.ss

@@ -167,7 +167,7 @@
 
 ;; this structure represents the result of typechecking an expression
 (d-s/c tc-result ([t Type/c] [f FilterSet?] [o Object?]) #:transparent)
-(d-s/c tc-results ([ts (listof tc-result?)] [drest (or/c (cons/c symbol? Type/c) #f)]))
+(d-s/c tc-results ([ts (listof tc-result?)] [drest (or/c (cons/c Type/c symbol?) #f)]) #:transparent)
 
 (define-match-expander tc-result:
   (syntax-parser
@@ -177,9 +177,10 @@
 (define-match-expander tc-results:
   (syntax-parser
    [(_ tp fp op) #'(struct tc-results ((list (struct tc-result (tp fp op)) (... ...)) #f))]
+   [(_ tp fp op dty dbound) #'(struct tc-results ((list (struct tc-result (tp fp op)) (... ...)) (cons dty dbound)))]
    [(_ tp) #'(struct tc-results ((list (struct tc-result (tp _ _)) (... ...)) #f))]))
 
-(provide tc-result: tc-results:)
+(provide tc-result: tc-results: tc-result? tc-results?)
 
 ;; convenience function for returning the result of typechecking an expression
 (define ret