From 4a64bbfeaa64e3eed84958571626a5c0e661c8aa Mon Sep 17 00:00:00 2001 From: Chongkai Zhu Date: Sun, 4 Feb 2007 00:17:04 +0000 Subject: [PATCH] update svn: r5549 --- collects/srfi/43/constructors.ss | 20 ++--- collects/srfi/43/conversion.ss | 43 +++++---- collects/srfi/43/mutators.ss | 90 ++++++++----------- collects/srfi/43/util.ss | 80 +++++++++-------- .../simplified-chinese-string-constants.ss | 8 +- 5 files changed, 113 insertions(+), 128 deletions(-) diff --git a/collects/srfi/43/constructors.ss b/collects/srfi/43/constructors.ss index 1da8408a58..53c5c6a58a 100644 --- a/collects/srfi/43/constructors.ss +++ b/collects/srfi/43/constructors.ss @@ -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 ;;; 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 ;;; Append VECTOR ... into a newly allocated vector and return that diff --git a/collects/srfi/43/conversion.ss b/collects/srfi/43/conversion.ss index 146c3f1593..cf756e08bc 100644 --- a/collects/srfi/43/conversion.ss +++ b/collects/srfi/43/conversion.ss @@ -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 [ ]) -> 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 -> vector ;;; Produce a vector containing the elements in LIST in reverse order. diff --git a/collects/srfi/43/mutators.ss b/collects/srfi/43/mutators.ss index 7bf86ee40f..2dcc88df03 100644 --- a/collects/srfi/43/mutators.ss +++ b/collects/srfi/43/mutators.ss @@ -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! [ ]) ;;; -> 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! [ ]) (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)))) diff --git a/collects/srfi/43/util.ss b/collects/srfi/43/util.ss index 60f2eaf1e0..b9000af8ab 100644 --- a/collects/srfi/43/util.ss +++ b/collects/srfi/43/util.ss @@ -58,37 +58,29 @@ callee index vec) (current-continuation-marks))))) - - ;;; (CHECK-START ) -> - ;;; 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 ) -> - ;;; 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! ) ;;; 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! ) ;;; Copy elements from SSTART to SEND from SOURCE to TARGET, in the diff --git a/collects/string-constants/simplified-chinese-string-constants.ss b/collects/string-constants/simplified-chinese-string-constants.ss index ecdf97574a..97306b449a 100644 --- a/collects/string-constants/simplified-chinese-string-constants.ss +++ b/collects/string-constants/simplified-chinese-string-constants.ss @@ -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 "调试")