suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix contracts for exact

Browse Source 
svn: r6014
This commit is contained in:
Chongkai Zhu 2007-04-22 02:20:48 +00:00
parent 6f2bd461d6
commit bc9c424249
1 changed files with 33 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
collects/srfi/43/vector-lib.ss
View File

@ -8,17 +8,20 @@
(define mutable-vector/c (define mutable-vector/c
(and/c vector? (not/c immutable?))) (and/c vector? (not/c immutable?)))
(define index/c
(and/c natural-number/c
exact?))
(define (vec-start-end-contract vector?) (define (vec-start-end-contract vector?)
(case-> (case->
(-> vector? any) (-> vector? any)
(->r ((vec vector?) (->r ((vec vector?)
(start (and/c natural-number/c (start (and/c index/c
(<=/c (vector-length vec))))) (<=/c (vector-length vec)))))
any) any)
(->pp ((vec vector?) (->pp ((vec vector?)
(start natural-number/c) (start index/c)
(end natural-number/c)) (end index/c))
(<= start end (vector-length vec)) (<= start end (vector-length vec))
any))) any)))
@ -50,7 +53,7 @@
(->r ((f (lambda (f) (->r ((f (lambda (f)
(and (procedure? f) (and (procedure? f)
(procedure-arity-includes? f (add1 (length seeds)))))) (procedure-arity-includes? f (add1 (length seeds))))))
(len natural-number/c)) (len index/c))
seeds list? seeds list?
any)) any))
@ -58,19 +61,19 @@
(case-> (case->
(-> vector? any) (-> vector? any)
(->r ((vec vector?) (->r ((vec vector?)
(start (and/c natural-number/c (start (and/c index/c
(<=/c (vector-length vec))))) (<=/c (vector-length vec)))))
any) any)
(->r ((vec vector?) (->r ((vec vector?)
(start (and/c natural-number/c (start (and/c index/c
(<=/c (vector-length vec)))) (<=/c (vector-length vec))))
(end (and/c natural-number/c (end (and/c index/c
(>=/c start)))) (>=/c start))))
any) any)
(->r ((vec vector?) (->r ((vec vector?)
(start (and/c natural-number/c (start (and/c index/c
(<=/c (vector-length vec)))) (<=/c (vector-length vec))))
(end (and/c natural-number/c (end (and/c index/c
(>=/c start))) (>=/c start)))
(fill any/c)) (fill any/c))
any))) any)))
@ -489,7 +492,7 @@
;;; reached, return #F. ;;; reached, return #F.
(define vector-index (define vector-index
(letrec ((loop1 (lambda (pred? vec len i) (letrec ((loop1 (lambda (pred? vec len i)
(cond ((>= i len) #f) (cond ((= i len) #f)
((pred? (vector-ref vec i)) i) ((pred? (vector-ref vec i)) i)
(else (loop1 pred? vec len (add1 i)))))) (else (loop1 pred? vec len (add1 i))))))
(loop2+ (lambda (pred? vectors len i) (loop2+ (lambda (pred? vectors len i)
@ -657,35 +660,35 @@
(define copy!-contract (define copy!-contract
(case-> (case->
(->r ((target mutable-vector/c) (->r ((target mutable-vector/c)
(tstart (and/c natural-number/c (tstart (and/c index/c
(<=/c (- (vector-length target) (<=/c (- (vector-length target)
(vector-length source))))) (vector-length source)))))
(source vector?)) (source vector?))
any) any)
(->r ((target mutable-vector/c) (->r ((target mutable-vector/c)
(tstart (and/c natural-number/c (tstart (and/c index/c
(<=/c (- (vector-length target) (<=/c (- (vector-length target)
(- (vector-length source) (- (vector-length source)
sstart))))) sstart)))))
(source vector?) (source vector?)
(sstart (and/c natural-number/c (sstart (and/c index/c
(<=/c (vector-length source))))) (<=/c (vector-length source)))))
any) any)
(->pp ((target mutable-vector/c) (->pp ((target mutable-vector/c)
(tstart (and/c natural-number/c (tstart (and/c index/c
(<=/c (- (vector-length target) (<=/c (- (vector-length target)
(- send sstart))))) (- send sstart)))))
(source vector?) (source vector?)
(sstart natural-number/c) (sstart index/c)
(send natural-number/c)) (send index/c))
(<= sstart send (vector-length source)) (<= sstart send (vector-length source))
any))) any)))
(provide/contract (vector-swap! (provide/contract (vector-swap!
(->r ((vec mutable-vector/c) (->r ((vec mutable-vector/c)
(i (and/c natural-number/c (i (and/c index/c
(</c (vector-length vec)))) (</c (vector-length vec))))
(j (and/c natural-number/c (j (and/c index/c
(</c (vector-length vec))))) (</c (vector-length vec)))))
any)) any))
(rename my-vector-fill! s:vector-fill! (rename my-vector-fill! s:vector-fill!
@ -693,13 +696,13 @@
(-> vector? any/c any) (-> vector? any/c any)
(->r ((vec vector?) (->r ((vec vector?)
(fill any/c) (fill any/c)
(start (and/c natural-number/c (start (and/c index/c
(<=/c (vector-length vec))))) (<=/c (vector-length vec)))))
any) any)
(->pp ((vec vector?) (->pp ((vec vector?)
(fill any/c) (fill any/c)
(start natural-number/c) (start index/c)
(end natural-number/c)) (end index/c))
(<= start end (vector-length vec)) (<= start end (vector-length vec))
any))) any)))
(vector-reverse! (vec-start-end-contract mutable-vector/c)) (vector-reverse! (vec-start-end-contract mutable-vector/c))
@ -804,15 +807,15 @@
;;; between START, whose default is 0, and END, whose default is the ;;; between START, whose default is 0, and END, whose default is the
;;; length of VECTOR, from VECTOR. ;;; length of VECTOR, from VECTOR.
(define my-vector->list (define my-vector->list
(opt-lambda (vec (start 0) (end (vector-length vec))) (case-lambda
;(unfold (lambda (i) ; No SRFI 1. ((vec)
; (< i start)) (vector->list vec)) ;+++
; (lambda (i) (vector-ref vec i)) ((vec start)
; (lambda (i) (sub1 i)) (my-vector->list start (vector-length vec)))
; (sub1 end)) ((vec start end)
(do ((i (sub1 end) (sub1 i)) (do ((i (sub1 end) (sub1 i))
(result '() (cons (vector-ref vec i) result))) (result '() (cons (vector-ref vec i) result)))
((< i start) result)))) ((< i start) result)))))
;;; (REVERSE-VECTOR->LIST <vector> [<start> <end>]) -> list ;;; (REVERSE-VECTOR->LIST <vector> [<start> <end>]) -> list
;;; Produce a list containing the elements in the locations between ;;; Produce a list containing the elements in the locations between