Handle top-arr in infer. Add convenience binding for function top.

svn: r12745

collects/typed-scheme/infer/infer-unit.ss

@@ -385,6 +385,9 @@
           ;; parameters are just like one-arg functions
           [((Param: in1 out1) (Param: in2 out2))
            (cset-meet (cg in2 in1) (cg out1 out2))]
+          [((Function: _)
+            (Function: (list (top-arr:))))
+           empty]
           [((Function: (list t-arr ...))
             (Function: (list s-arr ...)))
            (=> unmatch)
@@ -488,4 +491,4 @@
 (define (i s t r)
   (infer/simple (list s) (list t) r))
 
-;(trace cgen/arr #;cgen #;cgen/list)
+;(trace cgen)

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

@@ -90,7 +90,7 @@
 [symbol? (make-pred-ty Sym)]
 [list? (make-pred-ty (-lst Univ))]
 [list (-poly (a) (->* '() a (-lst a)))]
-[procedure? (make-pred-ty (make-Function (list (make-top-arr))))]
+[procedure? (make-pred-ty top-func)]
 [map (-polydots (c a b) ((list ((list a) (b b) . ->... . c) (-lst a))
                          ((-lst b) b) . ->... .(-lst c)))]
 [for-each (-polydots (c a b) ((list ((list a) (b b) . ->... . Univ) (-lst a))

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

@@ -27,5 +27,5 @@
 [Boxof (-poly (a) (make-Box a))]
 [Syntax Any-Syntax]
 [Identifier Ident]
-[Procedure (make-Function (list (make-top-arr)))]
+[Procedure top-func]
 

collects/typed-scheme/private/type-effect-convenience.ss

@@ -17,11 +17,13 @@
 
 (provide (all-defined-out) 
          ;; these should all eventually go away
-         make-Name make-ValuesDots make-Function make-top-arr make-Latent-Restrict-Effect make-Latent-Remove-Effect)
+         make-Name make-ValuesDots make-Function make-Latent-Restrict-Effect make-Latent-Remove-Effect)
 
 (define (one-of/c . args)
   (apply Un (map -val args)))
 
+(define top-func (make-Function (list (make-top-arr))))
+
 (define (-vet id) (make-Var-True-Effect id))
 (define (-vef id) (make-Var-False-Effect id))