From e45bc88bfb028146d0e9182ec1e445cfe009794f Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Mon, 14 Jun 2010 11:54:05 -0400 Subject: [PATCH] Moved some indexing functions' type signatures. original commit: 9959f050542aba1faee00202ce5b6b1f3cbf07cc --- .../private/base-env-indexing-abs.rkt | 41 ++++++++++++++++--- collects/typed-scheme/private/base-env.rkt | 31 +------------- 2 files changed, 38 insertions(+), 34 deletions(-) diff --git a/collects/typed-scheme/private/base-env-indexing-abs.rkt b/collects/typed-scheme/private/base-env-indexing-abs.rkt index c27598b6..02c04b1c 100644 --- a/collects/typed-scheme/private/base-env-indexing-abs.rkt +++ b/collects/typed-scheme/private/base-env-indexing-abs.rkt @@ -1,19 +1,18 @@ -#lang scheme +#lang racket (require "../utils/utils.rkt" - scheme/tcp - scheme/unsafe/ops + racket/tcp (only-in rnrs/lists-6 fold-left) '#%paramz "extra-procs.rkt" (utils tc-utils ) (types union convenience) (only-in '#%kernel [apply kernel:apply]) - scheme/promise scheme/system + racket/promise racket/system (only-in string-constants/private/only-once maybe-print-message) (only-in racket/match/runtime match:error matchable? match-equality-test) - (for-template scheme) + (for-template racket racket/unsafe/ops) (rename-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym] [-Nat -Nat*])) (provide indexing) @@ -28,6 +27,36 @@ [substring (->opt -String -Nat [-Nat] -String)] [make-string (cl-> [(-Nat) -String] [(-Nat -Char) -String])] [string-set! (-String -Nat -Char . -> . -Void)] + [string-copy! (-String -Nat -String [-Nat -Nat] . ->opt . -Void)] + + [read-string (-Nat [-Input-Port] . ->opt . (Un -String (-val eof)))] + [read-string! (-String [-Input-Port -Nat -Nat] . ->opt . (Un -Nat* (-val eof)))] + [read-bytes (-Nat [-Input-Port] . ->opt . (Un -Bytes (-val eof)))] + + [write-byte (cl-> [(-Nat) -Void] + [(-Nat -Output-Port) -Void])] + [write-string (cl-> [(-String) -Nat*] + [(-String -Output-Port) -Nat*] + [(-String -Output-Port -Nat) -Nat*] + [(-String -Output-Port -Nat -Nat) -Nat*])] + [write-bytes (cl-> [(-Bytes) -Nat*] + [(-Bytes -Output-Port) -Nat*] + [(-Bytes -Output-Port -Nat) -Nat*] + [(-Bytes -Output-Port -Nat -Nat) -Nat*])] + [write-bytes-avail (cl-> [(-Bytes) -Nat*] + [(-Bytes -Output-Port) -Nat*] + [(-Bytes -Output-Port -Nat) -Nat*] + [(-Bytes -Output-Port -Nat -Nat) -Nat*])] + [write-bytes-avail* (cl-> [(-Bytes) (-opt -Nat*)] + [(-Bytes -Output-Port) (-opt -Nat*)] + [(-Bytes -Output-Port -Nat) (-opt -Nat*)] + [(-Bytes -Output-Port -Nat -Nat) (-opt -Nat*)])] + [write-bytes-avail/enable-break (cl-> [(-Bytes) -Nat*] + [(-Bytes -Output-Port) -Nat*] + [(-Bytes -Output-Port -Nat) -Nat*] + [(-Bytes -Output-Port -Nat -Nat) -Nat*])] + + [list-ref (-poly (a) ((-lst a) -Nat . -> . a))] [list-tail (-poly (a) ((-lst a) -Nat . -> . (-lst a)))] @@ -101,6 +130,8 @@ (-poly (a) ((list (-lst a)) -Nat . ->* . (-values (list (-lst a) (-lst a)))))] [vector-ref (-poly (a) ((-vec a) -Nat . -> . a))] + [unsafe-vector-ref (-poly (a) ((-vec a) -Nat . -> . a))] + [unsafe-vector*-ref (-poly (a) ((-vec a) -Nat . -> . a))] [build-vector (-poly (a) (-Nat (-Nat . -> . a) . -> . (-vec a)))] [vector-set! (-poly (a) (-> (-vec a) -Nat a -Void))] [vector-copy! (-poly (a) ((-vec a) -Nat (-vec a) [-Nat -Nat] . ->opt . -Void))] diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt index c23347ef..32d55e2a 100644 --- a/collects/typed-scheme/private/base-env.rkt +++ b/collects/typed-scheme/private/base-env.rkt @@ -181,7 +181,6 @@ (-> (Un a (-val #f)) a)))] [gensym (->opt [Sym] Sym)] [string-append (->* null -String -String)] -[string-copy! (->opt -String -Nat -String [-Nat -Nat] -Void)] [open-input-string (-> -String -Input-Port)] [open-output-file (->key -Pathlike @@ -602,9 +601,6 @@ [read-byte (cl->* [-> (Un -Byte (-val eof))] [-Input-Port . -> . (Un -Byte (-val eof))])] -[read-string (-Nat [-Input-Port] . ->opt . (Un -String (-val eof)))] -[read-string! (-String [-Input-Port -Nat -Nat] . ->opt . (Un -Nat (-val eof)))] -[read-bytes (-Nat [-Input-Port] . ->opt . (Un -Bytes (-val eof)))] [make-pipe (cl->* [->opt [N] (-values (list -Input-Port -Output-Port))])] [open-output-bytes @@ -754,7 +750,7 @@ [tcp-close (-TCP-Listener . -> . -Void )] [tcp-connect (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))] [tcp-connect/enable-break (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))] -[tcp-listen (-Nat [-Nat Univ (-opt -String)] . ->opt . -TCP-Listener)] +[tcp-listen (-Integer [-Integer Univ (-opt -String)] . ->opt . -TCP-Listener)] ;; scheme/bool [boolean=? (B B . -> . B)] @@ -814,8 +810,6 @@ ;; unsafe -[unsafe-vector-ref (-poly (a) ((-vec a) -Nat . -> . a))] -[unsafe-vector*-ref (-poly (a) ((-vec a) -Nat . -> . a))] [unsafe-vector-length (-poly (a) ((-vec a) . -> . -Nat))] [unsafe-vector*-length (-poly (a) ((-vec a) . -> . -Nat))] [unsafe-car (-poly (a b) @@ -875,32 +869,11 @@ [system*/exit-code ((list -Pathlike) -String . ->* . -Integer)] ;; Byte and String Output (Section 12.3 of the Reference) +;; some are now in base-env-indexing-abs.rkt [write-char (cl-> [(-Char) -Void] [(-Char -Output-Port) -Void])] -[write-byte (cl-> [(-Nat) -Void] - [(-Nat -Output-Port) -Void])] [newline (cl-> [() -Void] [(-Output-Port) -Void])] -[write-string (cl-> [(-String) -Nat] - [(-String -Output-Port) -Nat] - [(-String -Output-Port -Nat) -Nat] - [(-String -Output-Port -Nat -Nat) -Nat])] -[write-bytes (cl-> [(-Bytes) -Nat] - [(-Bytes -Output-Port) -Nat] - [(-Bytes -Output-Port -Nat) -Nat] - [(-Bytes -Output-Port -Nat -Nat) -Nat])] -[write-bytes-avail (cl-> [(-Bytes) -Nat] - [(-Bytes -Output-Port) -Nat] - [(-Bytes -Output-Port -Nat) -Nat] - [(-Bytes -Output-Port -Nat -Nat) -Nat])] -[write-bytes-avail* (cl-> [(-Bytes) (-opt -Nat)] - [(-Bytes -Output-Port) (-opt -Nat)] - [(-Bytes -Output-Port -Nat) (-opt -Nat)] - [(-Bytes -Output-Port -Nat -Nat) (-opt -Nat)])] -[write-bytes-avail/enable-break (cl-> [(-Bytes) -Nat] - [(-Bytes -Output-Port) -Nat] - [(-Bytes -Output-Port -Nat) -Nat] - [(-Bytes -Output-Port -Nat -Nat) -Nat])] [write-special (cl-> [(Univ) -Boolean] [(Univ -Output-Port) -Boolean])] ;; Need event type before we can include these