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

First JavaScript steps, based on HOWITWORKS.md

This commit is contained in:
Tony Garnock-Jones 2018-10-21 00:58:40 +01:00
parent a178ec5ddf
commit 836bae0e27
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
syndicate/skeleton.rkt
View File

@ -185,7 +185,7 @@
[other (values #f other)])))
(define (extend-skeleton! sk desc)
(define (walk-node! path sk pop-count index desc)
(define (walk-node! rev-path sk pop-count index desc)
(match desc
[(list class-desc pieces ...)
(define class
@ -203,23 +203,23 @@
(define (make-skeleton-node-with-cache)
(define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
(define filtered (make-hash))
(define path (reverse rev-path))
(hash-for-each unfiltered
(lambda (a _)
(when (subterm-matches-class? a path class)
(hash-set! filtered a #t))))
(make-empty-skeleton/cache filtered))
(define next (hash-ref! table class make-skeleton-node-with-cache))
(walk-edge! (append path '(0)) next 0 0 pieces)]
(walk-edge! (cons 0 rev-path) next 0 0 pieces)]
[_
(values pop-count sk)]))
(define (walk-edge! path sk pop-count index pieces)
(define (walk-edge! rev-path sk pop-count index pieces)
(match pieces
['()
(values (+ pop-count 1) sk)]
[(cons p pieces)
(let-values (((pop-count sk) (walk-node! path sk pop-count index p)))
(define next-path (append (drop-right path 1) (list (+ index 1))))
(walk-edge! next-path sk pop-count (+ index 1) pieces))]))
(let-values (((pop-count sk) (walk-node! rev-path sk pop-count index p)))
(walk-edge! (cons (+ index 1) (cdr rev-path)) sk pop-count (+ index 1) pieces))]))
(let-values (((_pop-count sk) (walk-node! '() sk 0 0 desc)))
sk))