From d950cce57bc0325b1204a47d8c9980d1b4260759 Mon Sep 17 00:00:00 2001 From: Yiyun Liu Date: Sat, 7 Jun 2025 16:47:06 -0400 Subject: [PATCH] Fix letrec --- semantics.rkt | 34 +++++++++++++++++----------------- tests/eval.rkt | 2 +- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/semantics.rkt b/semantics.rkt index 14bd278..650bfd6 100644 --- a/semantics.rkt +++ b/semantics.rkt @@ -163,7 +163,7 @@ (let-values ([(args body) (match-sc n)]) (step-sc rstack st args body))] [(indirect-node? n) - (update-stack (λ (stack) (push-addr stack (indirect-addr n))) st)])) + (update-stack (λ (_) (push-addr rstack (indirect-addr n))) st)])) (: get-arg (-> Heap Addr Addr)) (define (get-arg heap addr) @@ -187,39 +187,36 @@ (: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr))) (define (instantiate-and-allocate e env heap) - (let ([res (instantiate-expr e env heap)]) + (let-values ([(heap addr-or-node) (instantiate-expr e env heap)]) (cond - [(number? res) - (values heap res)] + [(allocated-addr? addr-or-node) + (values heap addr-or-node)] [else - (allocate-node (car res) (cdr res))]))) + (allocate-node heap (unallocated-node-get addr-or-node))]))) (: instantiate-and-assign (-> CoreExpr Globals Heap Addr Heap)) (define (instantiate-and-assign e env heap addr) - (let ([res (instantiate-expr e env heap)]) + (let-values ([(heap addr-or-node) (instantiate-expr e env heap)]) (cond - [(number? res) - (update-heap heap addr (list 'Indirect res))] + [(allocated-addr? addr-or-node) + (update-heap heap addr (indirect-node addr-or-node))] [else - (let ([heap (car res)] - [node (cdr res)]) - (update-heap heap addr node))]))) + (update-heap heap addr (unallocated-node-get addr-or-node))]))) -(: instantiate-expr (-> CoreExpr Globals Heap (∪ Addr (Pair Heap Node)))) +(: instantiate-expr (-> CoreExpr Globals Heap (Values Heap (∪ Addr Unallocated-Node)))) (define (instantiate-expr e env heap) (match e - [(? integer?) (cons heap e)] + [(? integer?) (values heap (unallocated-node e))] [(list f a) (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)] + (values heap (unallocated-node (list addr-f addr-a))))] + [(? symbol?) (values heap (lookup-globals env e))] [(list 'let binds e) (let-values ([(env heap) (instantiate-binds binds env heap)]) (instantiate-expr e env heap))] [(list 'letrec binds e) (let-values ([(env heap) (instantiate-rec-binds binds env heap)]) - (print heap) (instantiate-expr e env heap))] [_ (error "unimplemented")])) @@ -272,9 +269,12 @@ (define (unallocated-node? a) (pair? a)) +(: allocated-addr? (-> (∪ Addr Unallocated-Node) Boolean : Addr)) +(define (allocated-addr? a) + (number? a)) + (: unallocated-node (-> Node Unallocated-Node)) (define (unallocated-node a) (cons 'Unallocated a)) - (provide (all-defined-out)) diff --git a/tests/eval.rkt b/tests/eval.rkt index a8ed083..8e9ac3b 100644 --- a/tests/eval.rkt +++ b/tests/eval.rkt @@ -31,4 +31,4 @@ (check-equal? (exp-final-node (ap-exp 'K 100 99)) 100) (check-equal? (exp-final-node `(let ((x ,(ap-exp 'S 'K 'K 3)) (y 5)) ,(ap-exp 'K 'x 'x))) 3) (check-equal? (exp-final-node `(let ((x ,(ap-exp 'S 'K 'K 3)) (y 5)) ,(ap-exp 'K 'y 'x))) 5) -;; (check-equal? (exp-final-node `(letrec ((y x) (x ,(ap-exp 'S 'K 'K 3))) ,(ap-exp 'K 'y 'x))) 5) +(check-equal? (exp-final-node `(letrec ((y x) (x ,(ap-exp 'S 'K 'K 3))) ,(ap-exp 'K 'y 'x))) 3)