Fix name of Type/c

Fix fold on Result.
Add comments.
New -struct constructor with opt args.
Fix tests to agree with contracts.

svn: r13934

collects/tests/typed-scheme/unit-tests/test-utils.ss

@@ -8,7 +8,7 @@
          (for-syntax scheme/base))
 
 
-(require (types comparison type-utils)
+(require (types comparison utils)
          (schemeunit))
 
 (provide private typecheck (rename-out [infer r:infer]) utils env rep types)

collects/tests/typed-scheme/unit-tests/type-equal-tests.ss

@@ -2,12 +2,12 @@
 
 (require "test-utils.ss" "planet-requires.ss" (for-syntax scheme/base))
 (require (rep type-rep)
-	 (types comparison type-abbrev)
+	 (types comparison abbrev union)
          (schemeunit))
 
 (provide type-equal-tests)
 
-(define (-base x) (make-Base x #f))
+(define (-base x) (make-Base x #'dummy))
 
 
 (define-syntax (te-tests stx)
@@ -37,14 +37,12 @@
    [(-mu x (Un N Sym x)) (-mu y (Un N Sym y))]     
    ;; found bug
    [FAIL (Un (-mu heap-node 
-                  (-struct 'heap-node #f (list (-base 'comparator) N (-v a) (Un heap-node (-base 'heap-empty))) #f  #f #f values)) 
+                  (-struct 'heap-node #f (list (-base 'comparator) N (-v a) (Un heap-node (-base 'heap-empty))))) 
              (-base 'heap-empty))
          (Un (-mu heap-node 
-                  (-struct 'heap-node #f (list (-base 'comparator) N (-pair N N) (Un heap-node (-base 'heap-empty))) #f #f #f values)) 
+                  (-struct 'heap-node #f (list (-base 'comparator) N (-pair N N) (Un heap-node (-base 'heap-empty))))) 
              (-base 'heap-empty))]))
 
-
-
 (define-go
   type-equal-tests)
 

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

@@ -12,7 +12,7 @@
 
 (define Type/c
   (flat-named-contract
-   "Type"
+   'Type
    (λ (e)
      (and (Type? e)
           (not (Scope? e))
@@ -129,7 +129,7 @@
 
 (dt Result ([t Type/c] [f LFilterSet?] [o LatentObject?])
     [#:frees (λ (frees) (combine-frees (map frees (list t f o))))]
-    [#:fold-rhs (*Result (type-rec-id t) (latentfilter-rec-id f) (latentobject-rec-id f))])
+    [#:fold-rhs (*Result (type-rec-id t) (latentfilter-rec-id f) (latentobject-rec-id o))])
 
 ;; types : Listof[Type]
 (dt Values ([rs (listof Result?)]) 

collects/typed-scheme/types/abbrev.ss

@@ -19,7 +19,6 @@
 
 (define -values make-Values)
 (define -pair make-Pair)
-(define -struct make-Struct)
 (define -val make-Value)
 (define -Param make-Param)
 (define -box make-Box)
@@ -211,6 +210,9 @@
 (define (make-arr-dots dom rng dty dbound)
   (make-arr* dom rng #:drest (cons dty dbound)))
 
+(define (-struct name parent flds [proc #f] [poly #f] [pred #'dummy] [cert values])
+  (make-Struct name parent flds proc poly pred cert))
+
 
 (define make-pred-ty
   (case-lambda 

collects/typed-scheme/utils/tc-utils.ss

@@ -1,4 +1,10 @@
 #lang scheme/base
+
+#|
+This file is for utilities that are only useful for Typed Scheme, but
+don't depend on any other portion of the system
+|#
+
 (provide (all-defined-out))
 (require "syntax-traversal.ss" (for-syntax scheme/base stxclass) scheme/match)
 

collects/typed-scheme/utils/utils.ss

@@ -1,5 +1,10 @@
 #lang scheme/base
 
+#|
+This file is for utilities that are of general interest, 
+at least theoretically.
+|#
+
 (require (for-syntax scheme/base stxclass)
          scheme/contract mzlib/plt-match scheme/require-syntax scheme/provide-syntax
          mzlib/struct scheme/unit
@@ -15,9 +20,7 @@
          in-list-forever
          extend
          debug
-         in-syntax
+         in-syntax)
-	 ;; require macros
-	 rep utils typecheck infer env private types)
 
 (define-syntax (define-requirer stx)
   (syntax-parse stx