Avoid a few gratuitous conversions during `skeleton-modify!`.
This commit is contained in:
parent
b511e640bd
commit
a5d147e277
|
@ -259,22 +259,21 @@
|
||||||
(for [(edge (in-list edges))]
|
(for [(edge (in-list edges))]
|
||||||
(match-define (cons (skeleton-selector pop-count index) table) edge)
|
(match-define (cons (skeleton-selector pop-count index) table) edge)
|
||||||
(define popped-stack (drop term-stack pop-count))
|
(define popped-stack (drop term-stack pop-count))
|
||||||
(define pieces (car popped-stack))
|
(define old-top (car popped-stack))
|
||||||
(define term (vector-ref pieces (+ index 1))) ;; adjust for struct identifier at beginning
|
(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
|
(define entry (hash-ref table
|
||||||
(cond [(non-object-struct? term) (struct->struct-type term)]
|
(cond [(non-object-struct? new-top) (struct->struct-type new-top)]
|
||||||
[(list? term) (list-type (length term))]
|
[(list? new-top) (list-type (length new-top))]
|
||||||
[(vector? term) (vector-type (vector-length term))]
|
[(vector? new-top) (vector-type (vector-length new-top))]
|
||||||
[else #f])
|
[else #f])
|
||||||
#f))
|
#f))
|
||||||
(when entry
|
(when entry (walk-node! entry (cons new-top popped-stack)))))
|
||||||
(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)))))
|
|
||||||
|
|
||||||
(walk-node! sk (list (vector 'list term0-term))))
|
(walk-node! sk (list (list term0-term))))
|
||||||
|
|
||||||
(define (add-term-to-skcont! skcont term)
|
(define (add-term-to-skcont! skcont term)
|
||||||
(hash-set! (skeleton-continuation-cache skcont) term #t))
|
(hash-set! (skeleton-continuation-cache skcont) term #t))
|
||||||
|
|
Loading…
Reference in New Issue