more stuff compiles

svn: r13952

original commit: 37aa9746ea98b683b8b4d90193f20d6e51e9a5af

collects/typed-scheme/private/base-env.ss

@@ -46,7 +46,7 @@
 [null (-val null)]
 [number? (make-pred-ty N)]
 [char? (make-pred-ty -Char)]
-[integer? (Univ . -> . B : (list (make-Latent-Restrict-Effect N)) (list (make-Latent-Remove-Effect -Integer)))]
+[integer? (Univ . -> . B : (-LFS (list (-filter N)) (list (-not-filter -Integer))))]
 [exact-integer? (make-pred-ty -Integer)]
 [boolean? (make-pred-ty B)]
 [add1 (cl->* (-> -Integer -Integer)
@@ -106,10 +106,7 @@
               [((a b c . -> . c) c (-lst a) (-lst b)) c]))]
 [foldr  (-poly (a b c) ((a b . -> . b) b (-lst a) . -> . b))]
 [filter (-poly (a b) (cl->*
-                      ((a . -> . B
-                          :
-                          (list (make-Latent-Restrict-Effect b))
-                          (list (make-Latent-Remove-Effect b)))
+                      ((make-pred-ty a B b)
                        (-lst a)
                        . -> .
                        (-lst b))

collects/typed-scheme/private/env-lang.ss

@@ -31,6 +31,6 @@
 (provide #%module-begin
          require
          (all-from-out scheme/base)
-         (for-syntax
-          (types convenience union)
+         (for-syntax          
+          (types-out convenience union)
           (all-from-out scheme/base)))

collects/typed-scheme/types/abbrev.ss

@@ -198,6 +198,11 @@
       [(Function: as) as]))
   (make-Function (apply append (map funty-arities args))))
 
+(define-syntax cl->
+  (syntax-parser
+   [(_ [(dom ...) rng] ...)
+    #'(cl->* (dom ... . -> . rng) ...)]))
+
 (define-syntax (->key stx)  
   (syntax-parse stx
                 [(_ ty:expr ... (~or (k:keyword kty:expr opt:boolean)) ... rng)
@@ -213,11 +218,17 @@
 (define (-struct name parent flds [proc #f] [poly #f] [pred #'dummy] [cert values])
   (make-Struct name parent flds proc poly pred cert))
 
+(define (-filter t [p null] [i 0])
+  (make-LTypeFilter t p i))
+
+(define (-not-filter t [p null] [i 0])
+  (make-LNotTypeFilter t p i))
+
 
 (define make-pred-ty
   (case-lambda 
     [(in out t)
-     (->* in out : (-LFS (list (make-LTypeFilter t null 0)) (list (make-LNotTypeFilter t null 0))))]
+     (->* in out : (-LFS (list (-filter t)) (list (-not-filter t))))]
     [(t) (make-pred-ty (list Univ) B t)]))
 
 

collects/typed-scheme/types/convenience.ss

@@ -1,7 +1,7 @@
 #lang scheme/base  
 (require "../utils/utils.ss")
 
-(require (rep type-rep)
+(require (rep type-rep filter-rep object-rep)
          (utils tc-utils)
          "abbrev.ss"
 	 (types comparison printer union subtype utils)
@@ -15,7 +15,8 @@
 (provide (all-defined-out)
          (all-from-out "abbrev.ss")
          ;; these should all eventually go away
-         make-Name make-ValuesDots make-Function)
+         make-Name make-ValuesDots make-Function
+         (rep-out filter-rep object-rep))
 
 (define (one-of/c . args)
   (apply Un (map -val args)))