Add instantiation function
This commit is contained in:
parent
c0be56ee21
commit
7f457c1bbd
1 changed files with 30 additions and 5 deletions
|
@ -89,7 +89,7 @@
|
|||
(define (step state)
|
||||
(let ([stack (State-stack state)])
|
||||
(match stack
|
||||
[(cons addr _)
|
||||
[(cons addr rstack)
|
||||
(step-node state (lookup-node (State-heap state) addr))]
|
||||
['() (error "Invalid state")])))
|
||||
|
||||
|
@ -99,8 +99,33 @@
|
|||
[(? 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 name args body)]))
|
||||
(step-sc st args body)]))
|
||||
|
||||
(: step-sc (-> State Name (Listof Name) CoreExpr State))
|
||||
(define (step-sc state sc args body)
|
||||
(error "to be implemented"))
|
||||
(: 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))))])
|
||||
(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")]))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue