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

Merge pull request #1208 from stchang/fast-in-hash

Browse Source 
add :do-in fast path for in-hash
This commit is contained in:
Stephen Chang 2016-01-19 10:52:10 -05:00
commit 8331e28c49
1 changed files with 112 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
racket/collects/racket/private/for.rkt
View File

@ -48,10 +48,10 @@
(rename *in-port in-port) (rename *in-port in-port)
(rename *in-lines in-lines) (rename *in-lines in-lines)
(rename *in-bytes-lines in-bytes-lines) (rename *in-bytes-lines in-bytes-lines)
in-hash (rename *in-hash in-hash)
in-hash-keys (rename *in-hash-keys in-hash-keys)
in-hash-values (rename *in-hash-values in-hash-values)
in-hash-pairs (rename *in-hash-pairs in-hash-pairs)
in-directory in-directory
in-sequences in-sequences
@ -664,12 +664,93 @@
(values (hash-iterate-key ht pos) (values (hash-iterate-key ht pos)
(hash-iterate-value ht pos))))) (hash-iterate-value ht pos)))))
(define-sequence-syntax *in-hash
(lambda () #'in-hash)
(lambda (stx)
(syntax-case stx ()
[[(k v) (_ ht-expr)]
(for-clause-syntax-protect
#'[(k v)
(:do-in
;;outer bindings
([(ht) ht-expr])
;; outer check
(unless (hash? ht) (in-hash ht))
;; loop bindings
([i (hash-iterate-first ht)])
;; pos check
i
;; inner bindings
([(k v) (values (hash-iterate-key ht i)
(hash-iterate-value ht i))])
;; pre guard
#t
;; post guard
#t
;; loop args
((hash-iterate-next ht i)))])]
[_ #f])))
(define (in-hash-keys ht) (define (in-hash-keys ht)
(unless (hash? ht) (raise-argument-error 'in-hash-keys "hash?" ht)) (unless (hash? ht) (raise-argument-error 'in-hash-keys "hash?" ht))
(make-do-sequence (lambda () (:hash-gen ht hash-iterate-key)))) (make-do-sequence (lambda () (:hash-gen ht hash-iterate-key))))
(define-sequence-syntax *in-hash-keys
(lambda () #'in-hash-keys)
(lambda (stx)
(syntax-case stx ()
[[(id) (_ ht-expr)]
(for-clause-syntax-protect
#'[(id)
(:do-in
;;outer bindings
([(ht) ht-expr])
;; outer check
(unless (hash? ht) (in-hash-keys ht))
;; loop bindings
([i (hash-iterate-first ht)])
;; pos check
i
;; inner bindings
([(id) (hash-iterate-key ht i)])
;; pre guard
#t
;; post guard
#t
;; loop args
((hash-iterate-next ht i)))])]
[_ #f])))
(define (in-hash-values ht) (define (in-hash-values ht)
(unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht)) (unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht))
(make-do-sequence (lambda () (:hash-gen ht hash-iterate-value)))) (make-do-sequence (lambda () (:hash-gen ht hash-iterate-value))))
(define-sequence-syntax *in-hash-values
(lambda () #'in-hash-values)
(lambda (stx)
(syntax-case stx ()
[[(id) (_ ht-expr)]
(for-clause-syntax-protect
#'[(id)
(:do-in
;;outer bindings
([(ht) ht-expr])
;; outer check
(unless (hash? ht) (in-hash-values ht))
;; loop bindings
([i (hash-iterate-first ht)])
;; pos check
i
;; inner bindings
([(id) (hash-iterate-value ht i)])
;; pre guard
#t
;; post guard
#t
;; loop args
((hash-iterate-next ht i)))])]
[_ #f])))
(define (in-hash-pairs ht) (define (in-hash-pairs ht)
(unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht)) (unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht))
(make-do-sequence (lambda () (make-do-sequence (lambda ()
@ -677,6 +758,33 @@
(cons (hash-iterate-key ht pos) (cons (hash-iterate-key ht pos)
(hash-iterate-value ht pos))))))) (hash-iterate-value ht pos)))))))
(define-sequence-syntax *in-hash-pairs
(lambda () #'in-hash-pairs)
(lambda (stx)
(syntax-case stx ()
[[(id) (_ ht-expr)]
(for-clause-syntax-protect
#'[(id)
(:do-in
;;outer bindings
([(ht) ht-expr])
;; outer check
(unless (hash? ht) (in-hash-pairs ht))
;; loop bindings
([i (hash-iterate-first ht)])
;; pos check
i
;; inner bindings
([(id) (cons (hash-iterate-key ht i)
(hash-iterate-value ht i))])
;; pre guard
#t
;; post guard
#t
;; loop args
((hash-iterate-next ht i)))])]
[_ #f])))
(define (:hash-gen ht sel) (define (:hash-gen ht sel)
(values (lambda (pos) (sel ht pos)) (values (lambda (pos) (sel ht pos))
(lambda (pos) (hash-iterate-next ht pos)) (lambda (pos) (hash-iterate-next ht pos))