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