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

hash quasiquote on hash tables (PR 10266) (merge to 4.2)

Browse Source 
svn: r15003
This commit is contained in:
Matthew Flatt 2009-05-28 13:02:42 +00:00
parent f63d3cc8fb
commit 43a3a326b7
1 changed files with 22 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/scheme/private/qq-and-or.ss
View File

@ -341,7 +341,7 @@
(list (quote-syntax quote)
(prefab-struct-key (syntax-e x)))
l2))))
;; hash or hasheq
;; hash[eq[v]]
(if (if (syntax? x)
(hash? (syntax-e x))
#f)
@ -349,15 +349,29 @@
(((qq-hash-assocs)
(lambda (x level)
(if (null? x)
(quote-syntax ())
x
(let-values
(((pair) (car x)))
(apply-cons
(list (quote-syntax list*)
(list (quote-syntax quote)
(datum->syntax here (car pair)))
(qq (datum->syntax here (cdr pair)) level))
(qq-hash-assocs (cdr x) level)))))))
(let-values ([(val)
(qq (datum->syntax here (cdr pair)) level)]
[(rest)
(qq-hash-assocs (cdr x) level)])
(if (if (eq? val (cdr pair))
(eq? rest (cdr x))
#f)
x
(apply-cons
(list (quote-syntax list*)
(list (quote-syntax quote)
(datum->syntax here (car pair)))
(if (eq? val (cdr pair))
(list (quote-syntax quote)
val)
val))
(if (eq? rest (cdr x))
(list (quote-syntax quote)
rest)
rest)))))))))
(let-values (((l0) (hash-map (syntax-e x) cons)))
(let-values
(((l) (qq-hash-assocs l0 level)))