From a7b5d4af4b478e4c29e2cc52cd760fe0f6b7a596 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 27 Oct 2008 15:16:22 +0000
Subject: [PATCH] Add type for Procedure. Fix types to use Integer instead of
 Number where appropriate. add type for maybe-print-message.

svn: r12141
---
 collects/typed-scheme/private/base-env.ss   | 24 ++++++++++++---------
 collects/typed-scheme/private/base-types.ss |  1 +
 2 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index f1452e1303..0a8e44e6fd 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -6,6 +6,7 @@
  '#%paramz
  (only-in '#%kernel [apply kernel:apply])
  scheme/promise
+ (only-in string-constants/private/only-once maybe-print-message)
  (only-in scheme/match/runtime match:error))
 
 [raise (Univ . -> . (Un))]
@@ -344,18 +345,19 @@
 [bitwise-xor (null N . ->* . N)]
 
 [vector (-poly (a) (->* (list) a (-vec a)))]
-[make-string (cl-> [(N) -String] [(N -Char) -String])]
+[make-string (cl-> [(-Integer) -String] [(-Integer -Char) -String])]
 [abs (N . -> . N)]
-[substring (cl-> [(-String N) -String]
-                 [(-String N N) -String])]
-[string-length (-String . -> . N)]
-[string-set! (-String N -Char . -> . -Void)]
-[make-vector (-poly (a) (cl-> [(N) (-vec N)] [(N a) (-vec a)]))]
+[substring (cl-> [(-String -Integer) -String]
+                 [(-String -Integer -Integer) -String])]
+[string-length (-String . -> . -Integer)]
+[string-set! (-String -Integer -Char . -> . -Void)]
+[make-vector (-poly (a) (cl-> [(-Integer) (-vec -Integer)]
+			      [(-Integer a) (-vec a)]))]
 
 [file-exists? (-Pathlike . -> . B)]
 [string->symbol (-String . -> . Sym)]
 [symbol->string (Sym . -> . -String)]
-[vector-length (-poly (a) ((-vec a) . -> . N))]
+[vector-length (-poly (a) ((-vec a) . -> . -Integer))]
 
 [call-with-input-file (-poly (a) (cl-> [(-String (-Port . -> . a))  a]
                                        [(-String (-Port . -> . a) Sym)  a]))]
@@ -365,9 +367,9 @@
 [current-output-port (-Param -Output-Port -Output-Port)]
 [current-error-port (-Param -Output-Port -Output-Port)]
 [current-input-port (-Param -Input-Port -Input-Port)]
-[round (N . -> . N)]
-[seconds->date (N . -> . (make-Name #'date))]
-[current-seconds (-> N)]
+[round (N . -> . -Integer)]
+[seconds->date (-Integer . -> . (make-Name #'date))]
+[current-seconds (-> -Integer)]
 [path->string (-> -Path -String)]
 
 [link-exists? (-> -Pathlike B)]
@@ -477,3 +479,5 @@
 
 [eof (-val eof)]
 [read-accept-reader (-Param B B)]
+
+[maybe-print-message (-String . -> . -Void)]
\ No newline at end of file
diff --git a/collects/typed-scheme/private/base-types.ss b/collects/typed-scheme/private/base-types.ss
index 6058fd4b9c..13226af46a 100644
--- a/collects/typed-scheme/private/base-types.ss
+++ b/collects/typed-scheme/private/base-types.ss
@@ -75,6 +75,7 @@
   [Boxof (-poly (a) (make-Box a))]
   [Syntax Any-Syntax]
   [Identifier Ident]
+  [Procedure (make-Function (list (make-top-arr)))]
   )
 
 (define-other-types