yiyunliu/core-in-racket
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor instantiate to allow pre-allocation of nodes

Browse source
This commit is contained in:
Yiyun Liu 2025-06-07 00:27:37 -04:00
parent 6655004082
commit 4a63f28a63
1 changed files with 19 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

33
semantics.rkt
View file

@ -132,25 +132,31 @@
(if (null? stack) (if (null? stack)
(error "Not enough arguments to apply the supercombinator") (error "Not enough arguments to apply the supercombinator")
(values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))] (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))]
[(heap node) (instantiate-body body new-env heap)] [(heap addr) (instantiate-and-allocate body new-env heap)])
[(heap addr) (allocate-node heap node)])
(let ([new-stack (cons addr new-stack)]) (let ([new-stack (cons addr new-stack)])
(struct-copy State state [stack new-stack] [heap heap]))))) (struct-copy State state [stack new-stack] [heap heap])))))
(: instantiate-body (-> CoreExpr Globals Heap (∪ Addr (-> Addr Heap)))) (: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr)))
(define (instantiate-body e env heap) (define (instantiate-and-allocate e env heap)
(let ([res (instantiate e env heap)])
(cond
[(number? res)
(values heap res)]
[else
(allocate-node (car res) (cdr res))])))
(: instantiate (-> CoreExpr Globals Heap (∪ Addr (Pair Heap Node))))
(define (instantiate e env heap)
(match e (match e
[(? integer?) (λ (x : Addr) (update-heap-undef heap x e))] [(? integer?) (cons heap e)]
[(list f a) [(list f a)
(let*-values ([(heap node0) (instantiate-body f env heap)] (let*-values ([(heap addr-f) (instantiate-and-allocate f env heap)]
[(heap node1) (instantiate-body a env heap)] [(heap addr-a) (instantiate-and-allocate a env heap)])
[(heap addr-f) (allocate-node heap node0)] (cons heap (list addr-f addr-a)))]
[(heap addr-a) (allocate-node heap node1)]) [(? symbol?) (lookup-globals env e)]
(allocate-node heap (list addr-f addr-a)))]
[(? symbol?) (values heap (lookup-globals env e))]
[(list 'let binds e) [(list 'let binds e)
(let-values ([(env heap) (instantiate-binds binds env heap)]) (let-values ([(env heap) (instantiate-binds binds env heap)])
(instantiate-body e env heap))] (instantiate e env heap))]
[_ (error "unimplemented")])) [_ (error "unimplemented")]))
(: instantiate-binds (-> CoreBinds Globals Heap (Values Globals Heap))) (: instantiate-binds (-> CoreBinds Globals Heap (Values Globals Heap)))
@ -165,8 +171,7 @@
(define (instantiate-bind bind old-env new-env heap) (define (instantiate-bind bind old-env new-env heap)
(let ([x (first bind)] (let ([x (first bind)]
[e (second bind)]) [e (second bind)])
(let*-values ([(heap node) (instantiate-body e old-env heap)] (let*-values ([(heap addr) (instantiate-and-allocate e old-env heap)])
[(heap addr) (allocate-node heap node)])
(values (update-globals new-env x addr) heap)))) (values (update-globals new-env x addr) heap))))