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

Add instantiation function

Browse source
This commit is contained in:
Yiyun Liu 2025-06-03 23:15:07 -04:00
parent c0be56ee21
commit 7f457c1bbd
1 changed files with 30 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

35
semantics.rkt
View file

@ -89,7 +89,7 @@
(define (step state) (define (step state)
(let ([stack (State-stack state)]) (let ([stack (State-stack state)])
(match stack (match stack
[(cons addr _) [(cons addr rstack)
(step-node state (lookup-node (State-heap state) addr))] (step-node state (lookup-node (State-heap state) addr))]
['() (error "Invalid state")]))) ['() (error "Invalid state")])))
@ -99,8 +99,33 @@
[(? integer?) (error "A number cannot be stepped any further!")] [(? integer?) (error "A number cannot be stepped any further!")]
[(list a _) (update-stack (λ (x) (cons a x)) st)] [(list a _) (update-stack (λ (x) (cons a x)) st)]
[(list 'define (list name args ...) body) [(list 'define (list name args ...) body)
(step-sc st name args body)])) (step-sc st args body)]))
(: step-sc (-> State Name (Listof Name) CoreExpr State)) (: step-sc (-> State (Listof Name) CoreExpr State))
(define (step-sc state sc args body) (define (step-sc state arg-names body)
(error "to be implemented")) (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))))])
(struct-copy State state [stack new-stack] [heap new-heap])))))
(: instantiate-body (-> CoreExpr Globals Heap (Values Heap Addr)))
(define (instantiate-body e env heap)
(match e
[(? integer?) (allocate-node heap e)]
[(list f a)
(let*-values ([(heap0 addr-f) (instantiate-body f env heap)]
[(heap1 addr-a) (instantiate-body a env heap0)])
(allocate-node heap1 (list addr-f addr-a)))]
[(? symbol?) (values heap (lookup-globals env e))]
[_ (error "unimplemented")]))