New contracts for hashtables, vectors, boxes

svn: r15646

original commit: 1ea71ea94b86f9454825bebbc86215b73ede3f19

collects/tests/typed-scheme/succeed/hash-ref.ss

@@ -0,0 +1,13 @@
+#lang scheme/load
+
+(module m typed-scheme
+  (define x ({inst make-hash Symbol Number}))
+  (hash-ref! x 'key (lambda () 1))
+  (hash-ref x 'key 7)
+  (provide x))
+
+(module n scheme
+  (require 'm)
+  (hash-ref x 'key))
+
+(require 'n)

collects/tests/typed-scheme/xfail/rec-contract.ss

@@ -0,0 +1,13 @@
+#lang scheme/load
+
+(module m typed-scheme
+  (: f (Rec X (Number -> X)))
+  (define (f n) f )
+  (provide f)
+  )
+
+(module mm scheme
+  (require 'm)
+  (f 1))
+
+(require 'mm)

collects/typed-scheme/private/prims.ss

@@ -79,9 +79,10 @@ This file defines two sorts of primitives. All of them are provided into any mod
              #:with opt #'(#:name-exists)))
   (syntax-parse stx
     [(_ lib (~or [sc:simple-clause] [strc:struct-clause] [oc:opaque-clause]) ...)
-     #'(begin (require/typed sc.nm sc.ty lib) ... 
-              (require-typed-struct strc.nm (strc.body ...) lib) ...
-              (require/opaque-type oc.ty oc.pred lib . oc.opt) ...)]
+     #'(begin 
+	 (require/opaque-type oc.ty oc.pred lib . oc.opt) ...
+	 (require/typed sc.nm sc.ty lib) ... 
+	 (require-typed-struct strc.nm (strc.body ...) lib) ...)]
     [(_ nm:opt-rename ty lib (~or [#:struct-maker parent] #:opt) ...)
      (with-syntax ([cnt* (generate-temporary #'nm.nm)]
 		   [sm (if #'parent

collects/typed-scheme/private/type-contract.ss

@@ -93,9 +93,9 @@
 	     [(list e) e]
 	     [l #`(case-> #,@l)]))]
         [(Vector: t)
-         #`(vector-immutableof #,(t->c t))]
+         #`(vectorof #,(t->c t))]
         [(Box: t)
-         #`(box-immutable/c #,(t->c t))]
+         #`(box/c #,(t->c t))]
         [(Pair: t1 t2)
          #`(cons/c #,(t->c t1) #,(t->c t2))]
         [(Opaque: p? cert)
@@ -127,7 +127,7 @@
         [(Syntax: t) #`(syntax/c #,(t->c t))]
         [(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))]
         [(Param: in out) #`(parameter/c #,(t->c out))]
-	[(Hashtable: k v) #`hash?]
+	[(Hashtable: k v) #`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care)]
         [else          
          (exit (fail))]))))