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

svn: r4689

Browse Source
This commit is contained in:
Chongkai Zhu 2006-10-26 12:32:12 +00:00
parent c9ca7f148a
commit aae3e1eac1
2 changed files with 19 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
collects/srfi/69/hash.ss
View File

@ -1,6 +1,7 @@
; SRFI 69 ; SRFI 69
; Chongkai Zhu mrmathematica@yahoo.com ; Chongkai Zhu czhu@cs.utah.edu
; 01-Nov-2005 ; Original 01-Nov-2005
; Revised 23-Oct-2006
(module hash mzscheme (module hash mzscheme
@ -27,7 +28,7 @@
(rename my-hash-table-copy s:hash-table-copy) (rename my-hash-table-copy s:hash-table-copy)
hash-table-merge! hash-table-merge!
hash hash
string-hash (rename hash string-hash)
string-ci-hash string-ci-hash
hash-by-identity) hash-by-identity)
@ -36,14 +37,7 @@
((obj) (equal-hash-code obj)) ((obj) (equal-hash-code obj))
((obj bound) (modulo (equal-hash-code obj) bound)))) ((obj bound) (modulo (equal-hash-code obj) bound))))
(define (string-hash . args)
(unless (string? (car args))
(raise-type-error 'string-hash "string" 1 args))
(apply hash args))
(define (string-ci-hash s . maybe-bound) (define (string-ci-hash s . maybe-bound)
(unless (string? s)
(raise-type-error 'string-hash "string" s))
(apply hash (string-downcase s) maybe-bound)) (apply hash (string-downcase s) maybe-bound))
(define hash-by-identity (define hash-by-identity
@ -57,7 +51,6 @@
(define (appropriate-hash-function-for comparison) (define (appropriate-hash-function-for comparison)
(cond ((eq? comparison eq?) hash-by-identity) (cond ((eq? comparison eq?) hash-by-identity)
((eq? comparison string=?) string-hash)
((eq? comparison string-ci=?) string-ci-hash) ((eq? comparison string-ci=?) string-ci-hash)
(else hash))) (else hash)))
@ -128,10 +121,8 @@
(raise-mismatch-error 'hash-table-ref "no value associated with " key)) (raise-mismatch-error 'hash-table-ref "no value associated with " key))
(else ((car maybe-default))))) (else ((car maybe-default)))))
(define-syntax hash-table-ref/default (define (hash-table-ref/default hash-table key default)
(syntax-rules () (hash-table-ref hash-table key (lambda () default)))
((_ hash-table key default)
(hash-table-ref hash-table key (lambda () default)))))
(define (hash-table-set! hash-table key value) (define (hash-table-set! hash-table key value)
(let ((hash (%hash-table-hash hash-table key)) (let ((hash (%hash-table-hash hash-table key))
@ -161,10 +152,8 @@
(+ 1 (my-hash-table-size hash-table))) (+ 1 (my-hash-table-size hash-table)))
(%hash-table-maybe-resize! hash-table))))) (%hash-table-maybe-resize! hash-table)))))
(define-syntax hash-table-update!/default (define (hash-table-update!/default hash-table key function default)
(syntax-rules () (hash-table-update! hash-table key function (lambda () default)))
((_ hash-table key function default)
(hash-table-update! hash-table key function (lambda () default)))))
(define (hash-table-delete! hash-table key) (define (hash-table-delete! hash-table key)
(if (%hash-table-delete! (my-hash-table-entries hash-table) (if (%hash-table-delete! (my-hash-table-entries hash-table)
@ -191,12 +180,12 @@
(opt-lambda (alist (opt-lambda (alist
[comparison equal?] [comparison equal?]
[hash (appropriate-hash-function-for comparison)] [hash (appropriate-hash-function-for comparison)]
[size (max *default-table-size* (* 2 (length alist)))] [size (max *default-table-size* (* 2 (length alist)))])
[hash-table (my-make-hash-table comparison hash size)]) (let ([hash-table (my-make-hash-table comparison hash size)])
(for-each (lambda (elem) (for-each (lambda (elem)
(hash-table-set! hash-table (car elem) (cdr elem))) (hash-table-set! hash-table (car elem) (cdr elem)))
alist) alist)
hash-table)) hash-table)))
(define (hash-table->alist hash-table) (define (hash-table->alist hash-table)
(hash-table-fold hash-table (hash-table-fold hash-table
@ -206,7 +195,8 @@
(let ((new (my-make-hash-table (my-hash-table-equivalence-function hash-table) (let ((new (my-make-hash-table (my-hash-table-equivalence-function hash-table)
(my-hash-table-hash-function hash-table) (my-hash-table-hash-function hash-table)
(max *default-table-size* (max *default-table-size*
(* 2 (my-hash-table-size hash-table)))))) (* 2 (my-hash-table-size hash-table)))
(my-hash-table-association-function hash-table))))
(hash-table-walk hash-table (hash-table-walk hash-table
(lambda (key value) (hash-table-set! new key value))) (lambda (key value) (hash-table-set! new key value)))
new)) new))

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

@ -374,6 +374,9 @@
(x-keyword "~a关键字") (x-keyword "~a关键字")
(x-like-keywords "~a类型的关键字") (x-like-keywords "~a类型的关键字")
; used in Square bracket panel
(skip-subexpressions "出现在中括号前的表达式数量")
(expected-a-symbol "需要一个符号，得到a") (expected-a-symbol "需要一个符号，得到a")
(already-used-keyword "“~a”已经是缩进关键字了") (already-used-keyword "“~a”已经是缩进关键字了")
(add-keyword "添加") (add-keyword "添加")