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

Avoid a few gratuitous conversions during `skeleton-modify!`.

This commit is contained in:
Tony Garnock-Jones 2018-10-20 21:42:38 +01:00
parent b511e640bd
commit a5d147e277
1 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
syndicate/skeleton.rkt
View File

@ -259,22 +259,21 @@
(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))
(define term (vector-ref pieces (+ index 1))) ;; adjust for struct identifier at beginning
(define old-top (car popped-stack))
(define new-top
(cond [(non-object-struct? old-top) (vector-ref (struct->vector old-top) (+ index 1))]
;; ^ TODO: evaluate unsafe-struct-ref
[(list? old-top) (list-ref old-top index)]
[(vector? old-top) (vector-ref old-top index)]))
(define entry (hash-ref table
(cond [(non-object-struct? term) (struct->struct-type term)]
[(list? term) (list-type (length term))]
[(vector? term) (vector-type (vector-length term))]
(cond [(non-object-struct? new-top) (struct->struct-type new-top)]
[(list? new-top) (list-type (length new-top))]
[(vector? new-top) (vector-type (vector-length new-top))]
[else #f])
#f))
(when entry
(define new-pieces
(cond [(non-object-struct? term) (struct->vector term)]
[(list? term) (list->vector (cons 'list term))]
[(vector? term) (list->vector (cons 'list (vector->list term)))]))
(walk-node! entry (cons new-pieces popped-stack)))))
(when entry (walk-node! entry (cons new-top popped-stack)))))
(walk-node! sk (list (vector 'list term0-term))))
(walk-node! sk (list (list term0-term))))
(define (add-term-to-skcont! skcont term)
(hash-set! (skeleton-continuation-cache skcont) term #t))