Allow other kinds of for clauses in for/hash:
Closes PR 14306
This commit is contained in:
parent
6484eed468
commit
120ce62bbb
|
@ -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))))))))
|
||||||
|
|
||||||
|
|
|
@ -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"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user