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

hash-map and hash-for-each

Browse Source
This commit is contained in:
Danny Yoo 2011-11-09 11:31:19 -05:00
parent 588ff1644b
commit 86e584b983
2 changed files with 31 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lang/base.rkt
View File

@ -14,10 +14,12 @@
(all-from-out "private/list.rkt")
(all-from-out "list.rkt")
(all-from-out "private/map.rkt")
(all-from-out "private/hash.rkt")
quasiquote)
(require "private/list.rkt"
"private/map.rkt"
"private/hash.rkt"
"list.rkt"
(only-in "private/qq-and-or.rkt" quasiquote))

29
lang/private/hash.rkt Normal file
View File

@ -0,0 +1,29 @@
#lang s-exp "../kernel.rkt"
(provide hash-map hash-for-each)
(define (hash-map a-hash f)
(unless (hash? a-hash)
(raise-type-error 'hash-map "hash" a-hash))
(unless (and (procedure? f) (procedure-arity-includes? f 2))
(raise-type-error 'hash-map "procedure (arity 2)" f))
(let loop ([keys (hash-keys a-hash)])
(if (null? keys)
'()
(cons (f (car keys) (hash-ref a-hash (car keys)))
(loop (rest keys))))))
(define (hash-for-each a-hash f)
(unless (hash? a-hash)
(raise-type-error 'hash-for-each "hash" a-hash))
(unless (and (procedure? f) (procedure-arity-includes? f 2))
(raise-type-error 'hash-for-each "procedure (arity 2)" f))
(let loop ([keys (hash-keys a-hash)])
(if (null? keys)
(void)
(begin
(f (car keys) (hash-ref a-hash (car keys)))
(loop (rest keys))))))