Allow other kinds of for clauses in for/hash:

Closes PR 14306
This commit is contained in:
Asumu Takikawa 2014-01-23 11:36:44 -05:00
parent 6484eed468
commit 120ce62bbb
2 changed files with 21 additions and 4 deletions

View File

@ -1057,12 +1057,12 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx (syntax-parse stx
#:literals (:) #:literals (:)
((_ (~seq : return-annotation:expr) ((_ (~seq : return-annotation:expr)
(bind:optionally-annotated-binding ...) clause:for-clauses
body ...) ; body is not always an expression, can be a break-clause body ...) ; body is not always an expression, can be a break-clause
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold: : return-annotation (for/fold: : return-annotation
((return-hash : return-annotation (ann (#,hash-maker null) return-annotation))) ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))
(bind ...) (clause.expand ... ...)
(let-values (((key val) (let () body ...))) (let-values (((key val) (let () body ...)))
(hash-set return-hash key val)))))))) (hash-set return-hash key val))))))))
@ -1075,12 +1075,12 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx (syntax-parse stx
#:literals (:) #:literals (:)
((_ (~seq : return-annotation:expr) ((_ (~seq : return-annotation:expr)
(bind:optionally-annotated-binding ...) clause:for-clauses
body ...) ; body is not always an expression, can be a break-clause body ...) ; body is not always an expression, can be a break-clause
(quasisyntax/loc stx (quasisyntax/loc stx
(for*/fold: : return-annotation (for*/fold: : return-annotation
((return-hash : return-annotation (ann (#,hash-maker null) return-annotation))) ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))
(bind ...) (clause.expand* ... ...)
(let-values (((key val) (let () body ...))) (let-values (((key val) (let () body ...)))
(hash-set return-hash key val)))))))) (hash-set return-hash key val))))))))

View File

@ -1918,6 +1918,23 @@
(call-with-values (lambda () (eval #'(+ 1 2))) (inst list Any)) (call-with-values (lambda () (eval #'(+ 1 2))) (inst list Any))
(-lst Univ)] (-lst Univ)]
;; for/hash, for*/hash - PR 14306
[tc-e (for/hash: : (HashTable Symbol String)
([x (in-list '(x y z))]
[y (in-list '("a" "b" "c"))]
#:when (eq? x 'x))
(values x y))
#:ret (ret (-HT -Symbol -String)
(-FS -top -top)
(make-NoObject))]
[tc-e (for*/hash: : (HashTable Symbol String)
([k (in-list '(x y z))]
[v (in-list '("a" "b"))]
#:when (eq? k 'x))
(values k v))
#:ret (ret (-HT -Symbol -String)
(-FS -top -top)
(make-NoObject))]
) )
(test-suite (test-suite
"tc-literal tests" "tc-literal tests"