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

Fix letrec

Browse source
This commit is contained in:
Yiyun Liu 2025-06-07 16:47:06 -04:00
parent ba13ba5dbd
commit d950cce57b
2 changed files with 18 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

34
semantics.rkt
View file

@ -163,7 +163,7 @@
(let-values ([(args body) (match-sc n)]) (let-values ([(args body) (match-sc n)])
(step-sc rstack st args body))] (step-sc rstack st args body))]
[(indirect-node? n) [(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)) (: get-arg (-> Heap Addr Addr))
(define (get-arg heap addr) (define (get-arg heap addr)
@ -187,39 +187,36 @@
(: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr))) (: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr)))
(define (instantiate-and-allocate e env heap) (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 (cond
[(number? res) [(allocated-addr? addr-or-node)
(values heap res)] (values heap addr-or-node)]
[else [else
(allocate-node (car res) (cdr res))]))) (allocate-node heap (unallocated-node-get addr-or-node))])))
(: instantiate-and-assign (-> CoreExpr Globals Heap Addr Heap)) (: instantiate-and-assign (-> CoreExpr Globals Heap Addr Heap))
(define (instantiate-and-assign e env heap addr) (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 (cond
[(number? res) [(allocated-addr? addr-or-node)
(update-heap heap addr (list 'Indirect res))] (update-heap heap addr (indirect-node addr-or-node))]
[else [else
(let ([heap (car res)] (update-heap heap addr (unallocated-node-get addr-or-node))])))
[node (cdr res)])
(update-heap heap addr 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) (define (instantiate-expr e env heap)
(match e (match e
[(? integer?) (cons heap e)] [(? integer?) (values heap (unallocated-node e))]
[(list f a) [(list f a)
(let*-values ([(heap addr-f) (instantiate-and-allocate f env heap)] (let*-values ([(heap addr-f) (instantiate-and-allocate f env heap)]
[(heap addr-a) (instantiate-and-allocate a env heap)]) [(heap addr-a) (instantiate-and-allocate a env heap)])
(cons heap (list addr-f addr-a)))] (values heap (unallocated-node (list addr-f addr-a))))]
[(? symbol?) (lookup-globals env e)] [(? 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-expr e env heap))] (instantiate-expr e env heap))]
[(list 'letrec binds e) [(list 'letrec binds e)
(let-values ([(env heap) (instantiate-rec-binds binds env heap)]) (let-values ([(env heap) (instantiate-rec-binds binds env heap)])
(print heap)
(instantiate-expr e env heap))] (instantiate-expr e env heap))]
[_ (error "unimplemented")])) [_ (error "unimplemented")]))
@ -272,9 +269,12 @@
(define (unallocated-node? a) (define (unallocated-node? a)
(pair? a)) (pair? a))
(: allocated-addr? (-> (∪ Addr Unallocated-Node) Boolean : Addr))
(define (allocated-addr? a)
(number? a))
(: unallocated-node (-> Node Unallocated-Node)) (: unallocated-node (-> Node Unallocated-Node))
(define (unallocated-node a) (define (unallocated-node a)
(cons 'Unallocated a)) (cons 'Unallocated a))
(provide (all-defined-out)) (provide (all-defined-out))

2
tests/eval.rkt
View file

@ -31,4 +31,4 @@
(check-equal? (exp-final-node (ap-exp 'K 100 99)) 100) (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 '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 `(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)