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

Add in-* annotations to for loops

This commit is contained in:
Tony Garnock-Jones 2018-04-30 09:14:00 +01:00
parent a6811f2ba5
commit eb3a93e32b
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
syndicate/skeleton.rkt
View File

@ -117,7 +117,7 @@
(define (skcont-add! c i)
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
(define (make-matched-constant)
(skeleton-matched-constant (for/mutable-set [(a (skeleton-continuation-cache c))
(skeleton-matched-constant (for/mutable-set [(a (in-set (skeleton-continuation-cache c)))
#:when (equal? (apply-projection a cs) cv)]
a)
(make-hash)))
@ -125,7 +125,7 @@
(define sc (hash-ref! cvt cv make-matched-constant))
(define (make-accumulator)
(define cache (make-bag))
(for [(a (skeleton-matched-constant-cache sc))]
(for [(a (in-set (skeleton-matched-constant-cache sc)))]
(define vars (apply-projection a vs))
(bag-change! cache vars 1))
(skeleton-accumulator cache (mutable-seteq)))
@ -181,7 +181,7 @@
(define (make-skeleton-node-with-cache)
(define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
(make-empty-skeleton/cache
(for/mutable-set [(a unfiltered) #:when (subterm-matches-class? a path class)] a)))
(for/mutable-set [(a (in-set unfiltered)) #:when (subterm-matches-class? a path class)] a)))
(define next (hash-ref! table class make-skeleton-node-with-cache))
(walk-edge! (update-path path pop-count 0) next 0 0 pieces)]
[_
@ -218,7 +218,7 @@
(define variables (apply-projection term0 variable-proj))
(modify-skacc! acc variables term0))))
(for [(edge edges)]
(for [(edge (in-list edges))]
(match-define (cons (skeleton-selector pop-count index) table) edge)
(define popped-stack (drop term-stack pop-count))
(define pieces (car popped-stack))
@ -243,7 +243,7 @@
(define (add-term-to-skacc! skacc vars _term)
(match (bag-change! (skeleton-accumulator-cache skacc) vars 1)
['absent->present
(for [(handler (skeleton-accumulator-handlers skacc))]
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
(apply handler '+ vars))]
;; 'present->absent and 'absent->absent absurd
['present->present
@ -265,7 +265,7 @@
(if (bag-member? cache vars)
(match (bag-change! cache vars -1)
['present->absent
(for [(handler (skeleton-accumulator-handlers skacc))]
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
(apply handler '- vars))]
;; 'absent->absent and 'absent->present absurd
['present->present
@ -285,16 +285,16 @@
void
void
(lambda (skacc vars _term)
(for [(handler (skeleton-accumulator-handlers skacc))]
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
(apply handler '! vars)))))
;; TODO: avoid repeated descent into `term` by factoring out prefixes of paths in `proj`
(define (apply-projection term proj)
(for/list [(path proj)]
(for/list [(path (in-list proj))]
(apply-projection-path term path)))
(define (apply-projection-path term path)
(for/fold [(term (list term))] [(index path)]
(for/fold [(term (list term))] [(index (in-list path))]
(cond [(list? term) (list-ref term index)]
[(non-object-struct? term) (vector-ref (struct->vector term) (+ index 1))]
[else (error 'apply-projection "Term representation not supported: ~v" term)])))