From dcb5f5cfb1a17fa652cee73fd95a4acdaf9b57ca Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sat, 7 Nov 2009 07:11:00 +0000 Subject: [PATCH] Types for all functions documented in reference/vector.scrbl Fix docs for vector-arg{min,max}. svn: r16602 --- collects/scribblings/reference/vectors.scrbl | 36 +++++-- collects/typed-scheme/private/base-env.ss | 108 +++++++++++++++---- 2 files changed, 115 insertions(+), 29 deletions(-) diff --git a/collects/scribblings/reference/vectors.scrbl b/collects/scribblings/reference/vectors.scrbl index a29aba8b9d..1d48029aba 100644 --- a/collects/scribblings/reference/vectors.scrbl +++ b/collects/scribblings/reference/vectors.scrbl @@ -274,7 +274,7 @@ Returns a fresh vector with the elements of @scheme[vec] for which applied to each element from first to last. @mz-examples[#:eval vec-eval - (vector-filter even? '(1 2 3 4 5 6)) + (vector-filter even? #(1 2 3 4 5 6)) ]} @defproc[(vector-filter-not [pred procedure?] [vec vector?]) vector?]{ @@ -284,7 +284,7 @@ is reversed: the result is a vector of all items for which @scheme[pred] returns @scheme[#f]. @mz-examples[#:eval vec-eval - (vector-filter-not even? '(1 2 3 4 5 6)) + (vector-filter-not even? #(1 2 3 4 5 6)) ]} @@ -292,8 +292,32 @@ returns @scheme[#f]. list?]{ Returns @scheme[(vector-length (vector-filter proc lst ...))], but -without building the intermediate list.} +without building the intermediate list. -vector-count -vector-argmin -vector-argmax \ No newline at end of file +@mz-examples[#:eval vec-eval +(vector-count even? #(1 2 3 4 5)) +(vector-count = #(1 2 3 4 5) #(5 4 3 2 1))] +} + + +@defproc[(vector-argmin [proc (-> any/c real?)] [vec vector?]) any/c]{ + +This returns the first element in the non-empty vector @scheme[vec] that minimizes +the result of @scheme[proc]. + +@mz-examples[#:eval vec-eval +(vector-argmin car #((3 pears) (1 banana) (2 apples))) +(vector-argmin car #((1 banana) (1 orange))) +] +} + +@defproc[(vector-argmax [proc (-> any/c real?)] [vec vector?]) any/c]{ + +This returns the first element in the non-empty vector @scheme[vec] that maximizes +the result of @scheme[proc]. + +@mz-examples[#:eval vec-eval +(vector-argmax car #((3 pears) (1 banana) (2 apples))) +(vector-argmax car #((3 pears) (3 oranges))) +] +} diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index 058f6e357c..6716261e54 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -1,7 +1,6 @@ #lang s-exp "env-lang.ss" (require - scheme/list scheme/tcp scheme scheme/unsafe/ops @@ -130,15 +129,8 @@ . -> . (-lst b)) ((a . -> . Univ) (-lst a) . -> . (-lst a))))] -[filter-map (-polydots (c a b) - ((list - ((list a) (b b) . ->... . (-opt c)) - (-lst a)) - ((-lst b) b) . ->... . (-lst c)))] -[take (-poly (a) ((-lst a) -Integer . -> . (-lst a)))] -[drop (-poly (a) ((-lst a) -Integer . -> . (-lst a)))] -[last (-poly (a) ((-lst a) . -> . a))] -[add-between (-poly (a b) ((-lst a) b . -> . (-lst (Un a b))))] +[filter-not (-poly (a b) (cl->* + ((a . -> . Univ) (-lst a) . -> . (-lst a))))] [remove (-poly (a) (a (-lst a) . -> . (-lst a)))] [remq (-poly (a) (a (-lst a) . -> . (-lst a)))] [remv (-poly (a) (a (-lst a) . -> . (-lst a)))] @@ -189,9 +181,6 @@ (->* (list N) N N))] [min (cl->* (->* (list -Integer) -Integer -Integer) (->* (list N) N N))] -[vector? (make-pred-ty (-vec Univ))] -[vector-ref (-poly (a) ((-vec a) N . -> . a))] -[build-vector (-poly (a) (-Integer (-Integer . -> . a) . -> . (-vec a)))] [build-list (-poly (a) (-Integer (-Integer . -> . a) . -> . (-lst a)))] [reverse (-poly (a) (-> (-lst a) (-lst a)))] [append (-poly (a) (->* (list) (-lst a) (-lst a)))] @@ -406,11 +395,6 @@ ;; this is a hack [match:error ((list) Univ . ->* . (Un))] - -[vector-set! (-poly (a) (-> (-vec a) N a -Void))] - -[vector->list (-poly (a) (-> (-vec a) (-lst a)))] -[list->vector (-poly (a) (-> (-lst a) (-vec a)))] [exact? (N . -> . B)] [inexact? (N . -> . B)] [exact->inexact (N . -> . N)] @@ -450,22 +434,42 @@ [bitwise-not (null -Integer . ->* . -Integer)] [bitwise-xor (null -Integer . ->* . -Integer)] -[vector (-poly (a) (->* (list) a (-vec a)))] [make-string (cl-> [(-Integer) -String] [(-Integer -Char) -String])] [abs (N . -> . N)] [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)] [string->keyword (-String . -> . -Keyword)] [keyword->string (-Keyword . -> . -String)] + +;; vectors +[vector? (make-pred-ty (-vec Univ))] +[vector-ref (-poly (a) ((-vec a) N . -> . a))] +[build-vector (-poly (a) (-Integer (-Integer . -> . a) . -> . (-vec a)))] + +[vector-set! (-poly (a) (-> (-vec a) N a -Void))] + +[vector->list (-poly (a) (-> (-vec a) (-lst a)))] +[list->vector (-poly (a) (-> (-lst a) (-vec a)))] [vector-length (-poly (a) ((-vec a) . -> . -Integer))] +[make-vector (-poly (a) (cl-> [(-Integer) (-vec -Integer)] + [(-Integer a) (-vec a)]))] +[vector (-poly (a) (->* (list) a (-vec a)))] +[vector-immutable (-poly (a) (->* (list) a (-vec a)))] +[vector->vector-immutable (-poly (a) (-> (-vec a) (-vec a)))] +[vector-fill! (-poly (a) (-> (-vec a) a -Void))] +[vector-copy! (-poly (a) + (cl->* ((-vec a) -Integer (-vec a) . -> . -Void) + ((-vec a) -Integer (-vec a) -Integer . -> . -Void) + ((-vec a) -Integer (-vec a) -Integer -Integer . -> . -Void)))] +;; [vector->values no good type here] + + [call-with-input-file (-poly (a) (-String (-Input-Port . -> . a) #:mode (Un (-val 'binary) (-val 'text)) #f . ->key . a))] [call-with-output-file (-poly (a) (-String (-Output-Port . -> . a) @@ -663,6 +667,29 @@ . -> . b))))] ;; scheme/list +[count (-polydots (a b) + ((list + ((list a) (b b) . ->... . Univ) + (-lst a)) + ((-lst b) b) + . ->... . + -Integer))] +[filter-map (-polydots (c a b) + ((list + ((list a) (b b) . ->... . (-opt c)) + (-lst a)) + ((-lst b) b) . ->... . (-lst c)))] +[take (-poly (a) ((-lst a) -Integer . -> . (-lst a)))] +[drop (-poly (a) ((-lst a) -Integer . -> . (-lst a)))] +[take-right (-poly (a) ((-lst a) -Integer . -> . (-lst a)))] +[drop-right (-poly (a) ((-lst a) -Integer . -> . (-lst a)))] +[split-at + (-poly (a) ((list (-lst a)) -Integer . ->* . (-values (list (-lst a) (-lst a)))))] +[split-at-right + (-poly (a) ((list (-lst a)) -Integer . ->* . (-values (list (-lst a) (-lst a)))))] +[last (-poly (a) ((-lst a) . -> . a))] +[add-between (-poly (a b) ((-lst a) b . -> . (-lst (Un a b))))] + [last-pair (-poly (a) ((-mu x (Un a (-val '()) (-pair a x))) . -> . (Un (-pair a a) (-pair a (-val '())))))] @@ -674,8 +701,6 @@ [append-map (-polydots (c a b) ((list ((list a) (b b) . ->... . (-lst c)) (-lst a)) ((-lst b) b) . ->... .(-lst c)))] -[split-at - (-poly (a) ((list (-lst a)) -Integer . ->* . (-values (list (-lst a) (-lst a)))))] [append* (-poly (a) ((-lst (-lst a)) . -> . (-lst a)))] @@ -765,3 +790,40 @@ [unsafe-cdr (-poly (a b) (cl->* (->acc (list (-pair a b)) b (list -cdr))))] + +;; scheme/vector +[vector-count (-polydots (a b) + ((list + ((list a) (b b) . ->... . Univ) + (-vec a)) + ((-vec b) b) + . ->... . + -Integer))] +[vector-filter (-poly (a b) (cl->* + ((make-pred-ty (list a) Univ b) + (-vec a) + . -> . + (-vec b)) + ((a . -> . Univ) (-vec a) . -> . (-vec a))))] + +[vector-filter-not + (-poly (a b) (cl->* ((a . -> . Univ) (-vec a) . -> . (-vec a))))] +[vector-copy + (-poly (a) + (cl->* ((-vec a) . -> . (-vec a)) + ((-vec a) -Integer . -> . (-vec a)) + ((-vec a) -Integer -Integer . -> . (-vec a))))] +[vector-map (-polydots (c a b) ((list ((list a) (b b) . ->... . c) (-vec a)) + ((-vec b) b) . ->... .(-vec c)))] +[vector-map! (-polydots (a b) ((list ((list a) (b b) . ->... . a) (-vec a)) + ((-vec b) b) . ->... .(-vec a)))] +[vector-append (-poly (a) (->* (list) (-vec a) (-vec a)))] +[vector-take (-poly (a) ((-vec a) -Integer . -> . (-vec a)))] +[vector-drop (-poly (a) ((-vec a) -Integer . -> . (-vec a)))] +[vector-take-right (-poly (a) ((-vec a) -Integer . -> . (-vec a)))] +[vector-drop-right (-poly (a) ((-vec a) -Integer . -> . (-vec a)))] +[vector-split-at + (-poly (a) ((list (-vec a)) -Integer . ->* . (-values (list (-vec a) (-vec a)))))] +[vector-split-at-right + (-poly (a) ((list (-vec a)) -Integer . ->* . (-values (list (-vec a) (-vec a)))))] +