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

update

Browse Source 
svn: r5549
This commit is contained in:
Chongkai Zhu 2007-02-04 00:17:04 +00:00
parent 126ff2a91a
commit 4a64bbfeaa
5 changed files with 113 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/srfi/43/constructors.ss
View File

@ -142,8 +142,8 @@
(unless (vector? vec)
(raise-type-error 'vector-copy "vector" vec))
(apply
(opt-lambda (vec (start 0) (end (vector-length vec)) . fill)
(check-start vec start 'vector-copy)
(opt-lambda ((start 0) (end (vector-length vec)) (fill 0))
(check-index vec start 'vector-copy)
(unless (nonneg-int? end)
(raise-type-error 'vector-copy "non-negative exact integer" end))
(unless (<= start end)
@ -153,12 +153,12 @@
'vector-copy start end vec)
(current-continuation-marks))))
(let ((new-vector
(apply make-vector (cons (- end start) fill))))
(make-vector (- end start) fill)))
(%vector-copy! new-vector 0
vec start
(min end (vector-length vec)))
new-vector))
vec arg))
arg))
;;; (VECTOR-REVERSE-COPY <vector> [<start> <end>]) -> vector
;;; Create a newly allocated vector whose elements are the reversed
@ -167,13 +167,11 @@
(define (vector-reverse-copy vec . arg)
(unless (vector? vec)
(raise-type-error 'vector-reverse-copy "vector" vec))
(apply
(opt-lambda (vec (start 0) (end (vector-length vec)))
(check-indices vec start end 'vector-reverse-copy)
(let ((new (make-vector (- end start))))
(%vector-reverse-copy! new 0 vec start end)
new))
vec arg))
(let-values (((start end)
(check-indices vec arg 'vector-reverse-copy)))
(let ((new (make-vector (- end start))))
(%vector-reverse-copy! new 0 vec start end)
new)))
;;; (VECTOR-APPEND <vector> ...) -> vector
;;; Append VECTOR ... into a newly allocated vector and return that

43
collects/srfi/43/conversion.ss
View File

@ -37,8 +37,7 @@
(module conversion mzscheme
(require "util.ss"
(lib "etc.ss"))
(require "util.ss")
(provide (rename my-vector->list vector->list)
reverse-vector->list
@ -55,17 +54,16 @@
vec maybe-start+end))
(if (null? maybe-start+end)
(vector->list vec) ;+++
(apply (opt-lambda (vec (start 0) (end (vector-length vec)))
(check-indices vec start end 'vector->list)
;(unfold (lambda (i) ; No SRFI 1.
; (< i start))
; (lambda (i) (vector-ref vec i))
; (lambda (i) (sub1 i))
; (sub1 end))
(do ((i (sub1 end) (sub1 i))
(result '() (cons (vector-ref vec i) result)))
((< i start) result)))
vec maybe-start+end)))
(let-values (((start end)
(check-indices vec maybe-start+end 'vector->list)))
;(unfold (lambda (i) ; No SRFI 1.
; (< i start))
; (lambda (i) (vector-ref vec i))
; (lambda (i) (sub1 i))
; (sub1 end))
(do ((i (sub1 end) (sub1 i))
(result '() (cons (vector-ref vec i) result)))
((< i start) result)))))
;;; (REVERSE-VECTOR->LIST <vector> [<start> <end>]) -> list
;;; Produce a list containing the elements in the locations between
@ -76,16 +74,15 @@
(apply raise-type-error
'reverse-vector->list "vector" 0
vec maybe-start+end))
(apply (opt-lambda (vec (start 0) (end (vector-length vec)))
(check-indices vec start end 'reverse-vector->list)
;(unfold (lambda (i) (= i end)) ; No SRFI 1.
; (lambda (i) (vector-ref vec i))
; (lambda (i) (add1 i))
; start)
(do ((i start (add1 i))
(result '() (cons (vector-ref vec i) result)))
((= i end) result)))
vec maybe-start+end))
(let-values (((start end)
(check-indices vec maybe-start+end 'reverse-vector->list)))
;(unfold (lambda (i) (= i end)) ; No SRFI 1.
; (lambda (i) (vector-ref vec i))
; (lambda (i) (add1 i))
; start)
(do ((i start (add1 i))
(result '() (cons (vector-ref vec i) result)))
((= i end) result))))
;;; (REVERSE-LIST->VECTOR <list> -> vector
;;; Produce a vector containing the elements in LIST in reverse order.

90
collects/srfi/43/mutators.ss
View File

@ -37,8 +37,7 @@
(module mutators mzscheme
(require "util.ss"
(lib "etc.ss"))
(require "util.ss")
(provide vector-swap!
(rename my-vector-fill! vector-fill!)
@ -74,13 +73,12 @@
'vector-fill! "vector" 0
vec value maybe-start+end))
(else
(apply (opt-lambda (vec value (start 0) (end (vector-length vec)))
(check-indices vec start end 'vector-fill!)
(do ((i start (add1 i)))
((= i end))
(vector-set! vec i value))
vec)
vec value maybe-start+end))))
(let-values (((start end)
(check-indices vec maybe-start+end 'vector-fill!)))
(do ((i start (add1 i)))
((= i end))
(vector-set! vec i value))
vec))))
(define %vector-reverse!
(letrec ((loop (lambda (vec i j)
@ -99,10 +97,9 @@
(apply raise-type-error
'vector-reverse! "vector" 0
vec maybe-start+end))
(apply (opt-lambda (vec (start 0) (end (vector-length vec)))
(check-indices vec start end 'vector-reverse!)
(%vector-reverse! vec start end))
vec maybe-start+end))
(let-values (((start end)
(check-indices vec maybe-start+end 'vector-reverse!)))
(%vector-reverse! vec start end)))
;;; (VECTOR-COPY! <target> <tstart> <source> [<sstart> <send>])
;;; -> unspecified
@ -113,23 +110,18 @@
(apply raise-type-error
'vector-copy! "vector" 0
target tstart source maybe-sstart+send))
(check-start target tstart 'vector-copy!)
(check-index target tstart 'vector-copy!)
(unless (vector? source)
(apply raise-type-error
'vector-copy! "vector" 2
target tstart source maybe-sstart+send))
(apply (opt-lambda (target
tstart
source
(sstart 0)
(send (vector-length source)))
(check-indices source sstart send 'vector-copy!)
(if (< (- (vector-length target) tstart)
(- send sstart))
(error 'vector-copy!
"target vector not long enough to copy"))
(%vector-copy! target tstart source sstart send))
target tstart source maybe-sstart+send))
(let-values (((sstart send)
(check-indices source maybe-sstart+send 'vector-copy!)))
(if (< (- (vector-length target) tstart)
(- send sstart))
(error 'vector-copy!
"target vector not long enough to copy"))
(%vector-copy! target tstart source sstart send)))
;;; (VECTOR-REVERSE-COPY! <target> <tstart> <source> [<sstart> <send>])
(define (vector-reverse-copy! target tstart source . maybe-sstart+send)
@ -137,35 +129,31 @@
(apply raise-type-error
'vector-reverse-copy! "vector" 0
target tstart source maybe-sstart+send))
(check-start target tstart 'vector-reverse-copy!)
(check-index target tstart 'vector-reverse-copy!)
(unless (vector? source)
(apply raise-type-error
'vector-reverse-copy! "vector" 2
target tstart source maybe-sstart+send))
(apply (opt-lambda (target
tstart
source
(sstart 0)
(send (vector-length source)))
(check-indices source sstart send 'vector-reverse-copy!)
(cond ((< (- (vector-length target) tstart)
(- send sstart))
(error 'vector-reverse-copy!
"target vector not long enough to copy"))
((and (eq? target source)
(= sstart tstart))
(%vector-reverse! target tstart send))
((and (eq? target source)
(or (between? sstart tstart send)
(between? tstart sstart
(+ tstart (- send sstart)))))
;an error in the reference implement here
(error 'vector-reverse-copy!
"Vector range for self-copying overlaps"))
(else
(%vector-reverse-copy! target tstart
source sstart send))))
target tstart source maybe-sstart+send))
(let-values (((sstart send)
(check-indices source maybe-sstart+send 'vector-reverse-copy!)))
(cond ((< (- (vector-length target) tstart)
(- send sstart))
(error 'vector-reverse-copy!
"target vector not long enough to copy"))
((and (eq? target source)
(= sstart tstart))
(%vector-reverse! target tstart send))
((and (eq? target source)
(or (between? sstart tstart send)
(between? tstart sstart
(+ tstart (- send sstart)))))
;an error in the reference implement here
(error 'vector-reverse-copy!
"Vector range for self-copying overlaps"))
(else
(%vector-reverse-copy! target tstart
source sstart send)))))
(define (between? x y z)
(and (< x y)
(<= y z))))

80
collects/srfi/43/util.ss
View File

@ -58,37 +58,29 @@
callee index vec)
(current-continuation-marks)))))
;;; (CHECK-START <vector> <index> <callee>) ->
;;; Ensure that INDEX is a valid bound of VECTOR; if not, signal an
;;; error stating that it is not and that this happened in a call to
;;; CALLEE. (Note that this does NOT check that VECTOR is indeed a
;;; vector.)
(define (check-start vec index callee)
(unless (nonneg-int? index)
(raise-type-error callee "non-negative exact integer" index))
(unless (<= 0 index (vector-length vec))
(raise
(make-exn:fail:contract
(format "~a: index ~a out of range for vector: ~a"
callee index vec)
(current-continuation-marks)))))
;;; (CHECK-INDICES <vector> <start> <end> <caller>) ->
;;; Ensure that START and END are valid bounds of a range within
;;; VECTOR; if not, signal an error stating that they are not
;;; while calling CALLEE.
(define (check-indices vec start end callee)
(unless (nonneg-int? start)
(raise-type-error callee "non-negative exact integer" start))
(unless (nonneg-int? end)
(raise-type-error callee "non-negative exact integer" end))
(unless (<= 0 start end (vector-length vec))
(raise
(make-exn:fail:contract
(format "~a: indices (~a, ~a) out of range for vector: ~a"
callee start end vec)
(current-continuation-marks)))))
(define (check-indices vec maybe-start+end callee)
(if (null? maybe-start+end)
(values 0 (vector-length vec))
(let ((start (car maybe-start+end)))
(unless (nonneg-int? start)
(raise-type-error callee "non-negative exact integer" start))
(unless (<= 0 start (vector-length vec))
(raise
(make-exn:fail:contract
(format "~a: index ~a out of range for vector: ~a"
callee start vec)
(current-continuation-marks))))
(if (null? (cdr maybe-start+end))
(values start (vector-length vec))
(let ((end (cadr maybe-start+end)))
(unless (nonneg-int? end)
(raise-type-error callee "non-negative exact integer" end))
(unless (<= start end (vector-length vec))
(raise
(make-exn:fail:contract
(format "~a: indices (~a, ~a) out of range for vector: ~a"
callee start end vec))))
(values start end))))))
(define (nonneg-int? x)
(and (integer? x)
@ -98,13 +90,25 @@
;;; (%VECTOR-COPY! <target> <tstart> <source> <sstart> <send>)
;;; Copy elements at locations SSTART to SEND from SOURCE to TARGET,
;;; starting at TSTART in TARGET.
(define (%vector-copy! target tstart source sstart send)
(let loop ((i sstart)
(j tstart))
(cond ((< i send)
(vector-set! target j
(vector-ref source i))
(loop (add1 i) (add1 j))))))
(define %vector-copy!
(letrec ((loop/l->r (lambda (target source send i j)
(cond ((< i send)
(vector-set! target j
(vector-ref source i))
(loop/l->r target source send
(add1 i) (add1 j))))))
(loop/r->l (lambda (target source sstart i j)
(cond ((>= i sstart)
(vector-set! target j
(vector-ref source i))
(loop/r->l target source sstart
(sub1 i) (sub1 j)))))))
(lambda (target tstart source sstart send)
(if (> sstart tstart) ; Make sure we don't copy over
; ourselves.
(loop/l->r target source send sstart tstart)
(loop/r->l target source sstart (sub1 send)
(+ -1 tstart send (- sstart)))))))
;;; (%VECTOR-REVERSE-COPY! <target> <tstart> <source> <sstart> <send>)
;;; Copy elements from SSTART to SEND from SOURCE to TARGET, in the

8
collects/string-constants/simplified-chinese-string-constants.ss
View File

@ -507,13 +507,10 @@
(save-as-info "输入新的文件名,保存当前文件")
(save-as-menu-item "另存为(&A)...")
(page-setup-info "设置打印参数")
(page-setup-menu-item "页面设置")
(print-info "打印当前文件")
(print-menu-item "打印(&P)...")
(page-setup-info "设置页面")
(page-setup-info "设置打印参数")
(page-setup-menu-item "页面设置...")
(close-info "关闭当前文件")
@ -1048,15 +1045,16 @@
(stepper-program-has-changed "注意：程序已改变。")
(stepper-program-window-closed "注意：程序窗口已关闭。")
(stepper-home "还原")
(stepper-name "单步执行器")
(stepper-language-level-message
"您选择的语言是“~a”。目前，单步执行只支持“~a”和“~a”之间的语言。")
(stepper-button-label "单步执行")
(stepper-home "源程序")
(stepper-previous-application "|< 调用")
(stepper-previous "< 上一步")
(stepper-next "下一步 >")
(stepper-next-application "调用 >|")
(stepper-jump-to-end "最终运行结果")
(debug-tool-button-name "调试")