From 4a63f28a63438f850fda40b8caaa0a27fc0fe3dc Mon Sep 17 00:00:00 2001 From: Yiyun Liu Date: Sat, 7 Jun 2025 00:27:37 -0400 Subject: [PATCH] Refactor instantiate to allow pre-allocation of nodes --- semantics.rkt | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/semantics.rkt b/semantics.rkt index 6f4c253..c635436 100644 --- a/semantics.rkt +++ b/semantics.rkt @@ -132,25 +132,31 @@ (if (null? stack) (error "Not enough arguments to apply the supercombinator") (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))] - [(heap node) (instantiate-body body new-env heap)] - [(heap addr) (allocate-node heap node)]) + [(heap addr) (instantiate-and-allocate body new-env heap)]) (let ([new-stack (cons addr new-stack)]) (struct-copy State state [stack new-stack] [heap heap]))))) -(: instantiate-body (-> CoreExpr Globals Heap (∪ Addr (-> Addr Heap)))) -(define (instantiate-body e env heap) +(: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr))) +(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 - [(? integer?) (λ (x : Addr) (update-heap-undef heap x e))] + [(? integer?) (cons heap e)] [(list f a) - (let*-values ([(heap node0) (instantiate-body f env heap)] - [(heap node1) (instantiate-body a env heap)] - [(heap addr-f) (allocate-node heap node0)] - [(heap addr-a) (allocate-node heap node1)]) - (allocate-node heap (list addr-f addr-a)))] - [(? symbol?) (values heap (lookup-globals env e))] + (let*-values ([(heap addr-f) (instantiate-and-allocate f env heap)] + [(heap addr-a) (instantiate-and-allocate a env heap)]) + (cons heap (list addr-f addr-a)))] + [(? symbol?) (lookup-globals env e)] [(list 'let binds e) (let-values ([(env heap) (instantiate-binds binds env heap)]) - (instantiate-body e env heap))] + (instantiate e env heap))] [_ (error "unimplemented")])) (: instantiate-binds (-> CoreBinds Globals Heap (Values Globals Heap))) @@ -165,8 +171,7 @@ (define (instantiate-bind bind old-env new-env heap) (let ([x (first bind)] [e (second bind)]) - (let*-values ([(heap node) (instantiate-body e old-env heap)] - [(heap addr) (allocate-node heap node)]) + (let*-values ([(heap addr) (instantiate-and-allocate e old-env heap)]) (values (update-globals new-env x addr) heap))))