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

Update the implementation of step-sc so it errors when unsaturated

Browse source
This commit is contained in:
Yiyun Liu 2025-06-04 23:33:02 -04:00
parent 7f457c1bbd
commit 13c730f9d8
1 changed files with 16 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

36
semantics.rkt
View file

@ -90,33 +90,29 @@
(let ([stack (State-stack state)])
(match stack
[(cons addr rstack)
(step-node state (lookup-node (State-heap state) addr))]
(step-node rstack state (lookup-node (State-heap state) addr))]
['() (error "Invalid state")])))
(: step-node (-> State Node State))
(define (step-node st n)
(: step-node (-> Stack State Node State))
(define (step-node rstack st n)
(match n
[(? integer?) (error "A number cannot be stepped any further!")]
[(list a _) (update-stack (λ (x) (cons a x)) st)]
[(list 'define (list name args ...) body)
(step-sc st args body)]))
(step-sc rstack st args body)]))
(: step-sc (-> State (Listof Name) CoreExpr State))
(define (step-sc state arg-names body)
(let* ([stack (State-stack state)]
[heap (State-heap state)]
[new-env : Globals
(for/fold ([globals : Globals (State-globals state)])
([arg-name : Name arg-names]
[addr : Addr (if (null? stack)
(error "impossible")
(cdr stack))])
(update-globals globals arg-name addr))]
;; [new-stack : Stack
;; (drop stack (add1 (length arg-names)))]
)
(let-values ([(new-heap addr) (instantiate-body body new-env heap)])
(let ([new-stack (cons addr (drop stack (add1 (length arg-names))))])
(: step-sc (-> Stack State (Listof Name) CoreExpr State))
(define (step-sc rstack state arg-names body)
(let ([heap (State-heap state)])
(let*-values ([(new-env new-stack)
(for/fold ([globals : Globals (State-globals state)]
[stack : Stack rstack])
([arg-name : Name arg-names])
(if (null? stack)
(error "Not enough arguments to apply the supercombinator")
(values (update-globals globals arg-name (car stack)) (cdr stack))))]
[(new-heap addr) (instantiate-body body new-env heap)])
(let ([new-stack (cons addr new-stack)])
(struct-copy State state [stack new-stack] [heap new-heap])))))
(: instantiate-body (-> CoreExpr Globals Heap (Values Heap Addr)))