Fix the bug of not using the get-arg function

This commit is contained in:
Yiyun Liu 2025-06-05 00:20:52 -04:00
parent 13c730f9d8
commit 784d27d564

View file

@ -76,6 +76,13 @@
(State (list (lookup-globals globals 'main)) empty-dump heap globals empty-stats))) (State (list (lookup-globals globals 'main)) empty-dump heap globals empty-stats)))
(: eval-state (-> State (Pairof State (Listof State))))
(define (eval-state st)
(if (final-state? st)
(list st)
(let ([next-st (update-stats incr-stats (step st))])
(cons st (eval-state next-st)))))
(: data-node? (-> Node Boolean)) (: data-node? (-> Node Boolean))
(define data-node? integer?) (define data-node? integer?)
@ -101,6 +108,12 @@
[(list 'define (list name args ...) body) [(list 'define (list name args ...) body)
(step-sc rstack st args body)])) (step-sc rstack st args body)]))
(: get-arg (-> Heap Addr Addr))
(define (get-arg heap addr)
(match (lookup-node heap addr)
[(list _ a) a]
[_ (error "Not an application node")]))
(: step-sc (-> Stack State (Listof Name) CoreExpr State)) (: step-sc (-> Stack State (Listof Name) CoreExpr State))
(define (step-sc rstack state arg-names body) (define (step-sc rstack state arg-names body)
(let ([heap (State-heap state)]) (let ([heap (State-heap state)])
@ -110,7 +123,7 @@
([arg-name : Name arg-names]) ([arg-name : Name arg-names])
(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 (car stack)) (cdr stack))))] (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))]
[(new-heap addr) (instantiate-body body new-env heap)]) [(new-heap addr) (instantiate-body body new-env heap)])
(let ([new-stack (cons addr new-stack)]) (let ([new-stack (cons addr new-stack)])
(struct-copy State state [stack new-stack] [heap new-heap]))))) (struct-copy State state [stack new-stack] [heap new-heap])))))