syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Support internal definitions in comprehension macros.

This commit is contained in:
Tony Garnock-Jones 2016-02-29 09:20:21 -05:00
parent 95456a4fd5
commit 7fc1554230
1 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
prospect/comprehensions.rkt
View File

@ -37,7 +37,7 @@
[(_ ([acc-id acc-init] ...) [(_ ([acc-id acc-init] ...)
() ()
body ...) body ...)
#'(begin body ...)] #'(let () body ...)]
[(_ ([acc-id acc-init] ...) [(_ ([acc-id acc-init] ...)
((pat_0 trie_0) ((pat_0 trie_0)
clauses ...) clauses ...)
@ -78,7 +78,7 @@
[(_ (clauses (... ...)) body (... ...)) [(_ (clauses (... ...)) body (... ...))
(with-syntax ([loop #'(for-trie/fold ([acc initial]) (with-syntax ([loop #'(for-trie/fold ([acc initial])
(clauses (... ...)) (clauses (... ...))
(folder (begin body (... ...)) acc))]) (folder (let () body (... ...)) acc))])
(build-fold #'loop stx))]))])) (build-fold #'loop stx))]))]))
(make-fold for-trie/list cons empty) (make-fold for-trie/list cons empty)
@ -99,7 +99,7 @@
[(_ (clauses ...) body ...) [(_ (clauses ...) body ...)
(with-syntax ([loop #'(for-trie/fold ([acc (void)]) (with-syntax ([loop #'(for-trie/fold ([acc (void)])
(clauses ...) (clauses ...)
(begin body ... acc))]) (begin (let () body ...) acc))])
(build-fold #'loop stx))])) (build-fold #'loop stx))]))
(module+ test (module+ test
@ -123,6 +123,14 @@
bar) bar)
(set 1 2 3)) (set 1 2 3))
;; We should support internal definitions.
(check-equal? (for-trie/set ([(foo $bar $zot) (make-trie (foo 1 2)
(foo 3 4)
(foo 5 6))])
(define sum (+ bar zot))
sum)
(set 3 7 11))
(check-equal? (for-trie/list ([$x (make-trie 1 2 3 4)] (check-equal? (for-trie/list ([$x (make-trie 1 2 3 4)]
#:where (even? x)) #:where (even? x))
(+ x 1)) (+ x 1))
@ -213,4 +221,4 @@
(set-add! a-set x)) (set-add! a-set x))
(void)) (void))
;; for-trie runs body for effects ;; for-trie runs body for effects
(check-equal? a-set (mutable-set 1 2 3 4)))) (check-equal? a-set (mutable-set 1 2 3 4))))