Make syntax of #{} less accepting of errors.

original commit: 91fefa055ea0b0fda8ae8bffb993bc163e4160af

collects/tests/typed-scheme/succeed/basic-tests.rkt

@@ -17,7 +17,7 @@
 
 #;(define: match-test : number
 (match 3
-       [(? number? #{x number}) (+ 17 x)]
+       [(? number? #{x : number}) (+ 17 x)]
        [_ 12]))
 
 
@@ -45,7 +45,7 @@
 
 #;(define: (pt-add/match [v : top]) : number
 (match v
-       [($ pt #{x number} #{y number}) (+ x y)]
+       [($ pt #{x : number} #{y : number}) (+ x y)]
        [_ 0]))
 
 #;(pt-add/match x-struct)
@@ -77,9 +77,9 @@
 
 (define: (f [x : number] [y : number]) : number (+ x y))
 (define: (g [x : number] [y : number]) : boolean
-  (let+ (#;[val #{z number} #f]
-	 [val #{x1 number} (* x x)]
-	 [rec #{y1 number} (* y y)])
+  (let+ (#;[val #{z : number} #f]
+	 [val #{x1 : number} (* x x)]
+	 [rec #{y1 : number} (* y y)])
 	#|(define-syntax foo
 	(syntax-rules ()
 	[(foo) (= x1 y1)]))

collects/tests/typed-scheme/succeed/match-expander-problem.rkt

@@ -14,7 +14,7 @@
 
 (define: (pt-add/match/blah [v : Any]) : Number
   (match v
-	 [(blah pt #{x Number} #{y Number}) (+ x y)]
+	 [(blah pt #{x : Number} #{y : Number}) (+ x y)]
 	 [_ 0]))
 
 

collects/tests/typed-scheme/succeed/stream.rkt

@@ -0,0 +1,66 @@
+#lang typed/racket
+#:optimize
+
+(provide Stream stream-cons stream-car stream-cdr empty-stream?)
+
+(define-type Stream
+  (All (A)
+    (Rec S
+      (U Null (Boxof (U (-> (Pair A S))
+                        (Pair A S)))))))
+
+(: empty-stream? : (All (A) ((Stream A) -> Boolean)))
+(define (empty-stream? stream) (null? stream))
+
+(define-syntax-rule (stream-cons x stream)
+  (box (lambda () (cons x stream))))
+
+(: stream-car : (All (A) ((Stream A) -> A)))
+(define (stream-car stream)
+  (if (null? stream)
+    (error 'stream-car "empty stream: ~e" stream)
+    (let ([p (unbox stream)])
+      (if (procedure? p)
+        (let ([pair (p)])
+          (set-box! stream pair)
+          (car pair))
+        (car p)))))
+
+(: stream-cdr : (All (A) ((Stream A) -> (Stream A))))
+(define (stream-cdr stream)
+  (if (null? stream)
+    (error 'stream-cdr "empty stream: ~e" stream)
+    (let ([p (unbox stream)])
+      (if (procedure? p)
+        (let ([pair (p)])
+          (set-box! stream pair)
+          (cdr pair))
+        (cdr p)))))
+
+(: stream : (All (A) (A * -> (Stream A))))
+(define (stream . xs)
+  (: loop : (All (A) ((Listof A) -> (Stream A))))
+  (define (loop xs)
+    (if (null? xs)
+      '()
+      (box (cons (car xs) (loop (cdr xs))))))
+  (loop xs))
+
+(: stream->list : (All (A) ((Stream A) -> (Listof A))))
+(define (stream->list stream)
+  (if (null? stream)
+    '()
+    (cons (stream-car stream) (stream->list (stream-cdr stream)))))
+
+(: rotate : (All (A) ((Stream A) (Listof A) (Stream A) -> (Stream A))))
+(define (rotate frnt rer accum)
+  (let ([carrer (car rer)])   
+    ;; Manually expanded `stream-cons', and added type annotations
+    (if (empty-stream? frnt)
+        (stream-cons carrer accum)
+        (stream-cons
+         (stream-car frnt)
+         ((inst rotate A)
+          (stream-cdr frnt) 
+          (cdr rer)
+          (box (lambda () (cons carrer accum))))))))

collects/typed-scheme/private/type-annotation.rkt

@@ -30,7 +30,7 @@
                (printf/log "Annotation Sexp Pair \n")
                (print-size #'a)
                (print-size #'b))]      
-    [_ (printf/log "Annotation Sexp \n" )]))
+    [_ (printf/log "Annotation Sexp \n")]))
 
 ;; get the type annotation of this syntax
 ;; syntax -> Maybe[Type]
@@ -62,7 +62,6 @@
 
 (define (type-ascription stx)
   (define (pt prop)
-    #;(print-size prop)
     (if (syntax? prop)
         (parse-tc-results prop)
         (parse-tc-results/id stx prop)))
@@ -72,7 +71,7 @@
      (lambda (prop)
        (if (pair? prop)
            (pt (car prop))
-           (pt prop)))]
+           (pt prop)))]    
     [else #f]))
 
 (define (remove-ascription stx)

collects/typed-scheme/typed-reader.rkt

@@ -51,11 +51,13 @@
                          (let* ([prop-name (syntax-e (read-one))])   
                            (skip-whitespace port)
                            (syntax-property name prop-name (read-one)))]
-                 ;; type annotation
-                 [else (syntax-property name 'type-label (syntax->datum next))])))
+                 ;; otherwise error
+                 [else 
+                  (let-values ([(l c p) (port-next-location port)])
+                    (raise-read-error (format "typed expression ~a must be followed by :, ::, or @"
+                                              (syntax->datum name)) src l c p 1))])))
       (skip-whitespace port)
       (let ([c (read-char port)])
-        #;(printf "char: ~a" c)
         (unless (equal? #\} c)
           (let-values ([(l c p) (port-next-location port)])
             (raise-read-error (format "typed expression ~a not properly terminated" (syntax->datum name)) src l c p 1)))))))