From 66550040822880e512483dd48f683aa19e08cd34 Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Fri, 6 Jun 2025 16:35:19 -0400
Subject: [PATCH 1/6] Minor

---
 semantics.rkt  | 31 +++++++++++++++++++++++--------
 tests/eval.rkt |  1 +
 2 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/semantics.rkt b/semantics.rkt
index 8e65454..6f4c253 100644
--- a/semantics.rkt
+++ b/semantics.rkt
@@ -34,6 +34,17 @@
 (: incr-stats (-> Stats Stats))
 (define incr-stats add1)
 
+(: update-heap-undef (-> Heap Addr Node Heap))
+(define (update-heap-undef heap addr node)
+  (if (eq? (treelist-ref heap addr) 'Undef)
+      (update-heap heap addr node)
+      (error "Address in heap is not undefined")))
+
+(: update-heap (-> Heap Addr Node Heap))
+(define (update-heap heap addr node)
+  (treelist-set heap addr node))
+
+
 (: update-globals (-> Globals Name Addr Globals))
 (define (update-globals globals name addr)
   (hash-set globals name addr))
@@ -121,18 +132,21 @@
                     (if (null? stack)
                         (error "Not enough arguments to apply the supercombinator")
                         (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))]
-                  [(new-heap addr) (instantiate-body body new-env heap)])
+                  [(heap node) (instantiate-body body new-env heap)]
+                  [(heap addr) (allocate-node heap node)])
       (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 heap])))))
 
-(: instantiate-body (-> CoreExpr Globals Heap (Values Heap Addr)))
+(: instantiate-body (-> CoreExpr Globals Heap (∪ Addr (-> Addr Heap))))
 (define (instantiate-body e env heap)
   (match e
-    [(? integer?) (allocate-node heap e)]
+    [(? integer?) (λ (x : Addr) (update-heap-undef heap x 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)))]
+     (let*-values ([(heap node0) (instantiate-body f env heap)]
+                   [(heap node1) (instantiate-body a env heap)]
+                   [(heap addr-f) (allocate-node heap node0)]
+                   [(heap addr-a) (allocate-node heap node1)])
+       (allocate-node heap (list addr-f addr-a)))]
     [(? symbol?) (values heap (lookup-globals env e))]
     [(list 'let binds e)
      (let-values ([(env heap) (instantiate-binds binds env heap)])
@@ -151,7 +165,8 @@
 (define (instantiate-bind bind old-env new-env heap)
   (let ([x (first bind)]
         [e (second bind)])
-    (let-values ([(heap addr) (instantiate-body e old-env heap)])
+    (let*-values ([(heap node) (instantiate-body e old-env heap)]
+                  [(heap addr) (allocate-node heap node)])
       (values (update-globals new-env x addr) heap))))
 
 
diff --git a/tests/eval.rkt b/tests/eval.rkt
index 4537d4f..5dbf034 100644
--- a/tests/eval.rkt
+++ b/tests/eval.rkt
@@ -1,6 +1,7 @@
 #lang typed/racket
 (require "../semantics.rkt")
 (require "../ast.rkt")
+(require "../printer.rkt")
 (require typed/rackunit)
 
 (: exp->program (-> CoreExpr CoreProgram))

From 4a63f28a63438f850fda40b8caaa0a27fc0fe3dc Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Sat, 7 Jun 2025 00:27:37 -0400
Subject: [PATCH 2/6] Refactor instantiate to allow pre-allocation of nodes

---
 semantics.rkt | 33 +++++++++++++++++++--------------
 1 file changed, 19 insertions(+), 14 deletions(-)

diff --git a/semantics.rkt b/semantics.rkt
index 6f4c253..c635436 100644
--- a/semantics.rkt
+++ b/semantics.rkt
@@ -132,25 +132,31 @@
                     (if (null? stack)
                         (error "Not enough arguments to apply the supercombinator")
                         (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))]
-                  [(heap node) (instantiate-body body new-env heap)]
-                  [(heap addr) (allocate-node heap node)])
+                  [(heap addr) (instantiate-and-allocate body new-env heap)])
       (let ([new-stack (cons addr new-stack)])
         (struct-copy State state [stack new-stack] [heap heap])))))
 
-(: instantiate-body (-> CoreExpr Globals Heap (∪ Addr (-> Addr Heap))))
-(define (instantiate-body e env heap)
+(: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr)))
+(define (instantiate-and-allocate e env heap)
+  (let ([res (instantiate e env heap)])
+    (cond
+      [(number? res)
+       (values heap res)]
+      [else
+       (allocate-node (car res) (cdr res))])))
+
+(: instantiate (-> CoreExpr Globals Heap (∪ Addr (Pair Heap Node))))
+(define (instantiate e env heap)
   (match e
-    [(? integer?) (λ (x : Addr) (update-heap-undef heap x e))]
+    [(? integer?) (cons heap e)]
     [(list f a)
-     (let*-values ([(heap node0) (instantiate-body f env heap)]
-                   [(heap node1) (instantiate-body a env heap)]
-                   [(heap addr-f) (allocate-node heap node0)]
-                   [(heap addr-a) (allocate-node heap node1)])
-       (allocate-node heap (list addr-f addr-a)))]
-    [(? symbol?) (values heap (lookup-globals env e))]
+     (let*-values ([(heap addr-f) (instantiate-and-allocate f env heap)]
+                   [(heap addr-a) (instantiate-and-allocate a env heap)])
+       (cons heap (list addr-f addr-a)))]
+    [(? symbol?) (lookup-globals env e)]
     [(list 'let binds e)
      (let-values ([(env heap) (instantiate-binds binds env heap)])
-       (instantiate-body e env heap))]
+       (instantiate e env heap))]
     [_ (error "unimplemented")]))
 
 (: instantiate-binds (-> CoreBinds Globals Heap (Values Globals Heap)))
@@ -165,8 +171,7 @@
 (define (instantiate-bind bind old-env new-env heap)
   (let ([x (first bind)]
         [e (second bind)])
-    (let*-values ([(heap node) (instantiate-body e old-env heap)]
-                  [(heap addr) (allocate-node heap node)])
+    (let*-values ([(heap addr) (instantiate-and-allocate e old-env heap)])
       (values (update-globals new-env x addr) heap))))
 
 

From ba13ba5dbd6a1a6de581e5365877536a74a9663a Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Sat, 7 Jun 2025 16:34:28 -0400
Subject: [PATCH 3/6] Add unallocated node type

---
 printer.rkt    |  12 +++--
 semantics.rkt  | 121 +++++++++++++++++++++++++++++++++++++++++++++----
 tests/eval.rkt |   1 +
 3 files changed, 119 insertions(+), 15 deletions(-)

diff --git a/printer.rkt b/printer.rkt
index 72ab6ff..74febe1 100644
--- a/printer.rkt
+++ b/printer.rkt
@@ -114,13 +114,15 @@
 (: ppr-node (-> Node ISeq))
 (define (ppr-node a)
   (cond
-    [(integer? a)
+    [(integer-node? a)
      (iseq-append "NNum " (number->string a))]
-    [(not (eq? (car a) 'define))
-     (let ([fun (first a)]
-           [arg (second a)])
+    [(ap-node? a)
+     (let ([fun (ap-fun a)]
+           [arg (ap-arg a)])
        (iseq-append "NAp " (ppr-addr fun) " " (ppr-addr arg)))]
-    [else (iseq-append "NSupercomb " (symbol->string (caadr a)))]))
+    [(sc-node? a) (iseq-append "NSupercomb " (symbol->string (caadr a)))]
+    [(indirect-node? a) (iseq-append "Indirect " (ppr-addr (indirect-addr a)))]
+    [else (error "Impossible: Undefined node encountered")]))
 
 (: ppr-stack-node (-> Heap Node ISeq))
 (define (ppr-stack-node heap node)
diff --git a/semantics.rkt b/semantics.rkt
index c635436..14bd278 100644
--- a/semantics.rkt
+++ b/semantics.rkt
@@ -10,10 +10,51 @@
 (define-type Stack (Listof Addr))
 (define-type Dump Null)
 (define-type Heap (TreeListof Node))
-(define-type Node (∪ (List Addr Addr) CoreScDefn Integer))
+(define-type Node (∪ (List Addr Addr) CoreScDefn Integer (List 'Indirect Addr) 'Undef))
 (define-type Globals (Immutable-HashTable Name Addr))
 (define-type Stats Nonnegative-Integer)
 
+
+(: ap-node? (-> Node Boolean : (List Addr Addr)))
+(define (ap-node? a)
+  (and (pair? a) (number? (car a)) (pair? (cdr a)) (null? (cddr a))))
+
+(: undef-node? (-> Any Boolean : 'Undef))
+(define (undef-node? a)
+  (eqv? a 'Undef))
+
+(: indirect-node? (-> Node Boolean : (List 'Indirect Addr)))
+(define (indirect-node? a)
+  (and (pair? a) (eqv? (car a) 'Indirect)))
+
+(: indirect-node (-> Addr (∩ (List 'Indirect Addr) Node)))
+(define (indirect-node a)
+  (list 'Indirect a))
+
+(: integer-node? (-> Node Boolean : Integer))
+(define (integer-node? a)
+  (integer? a))
+
+(: sc-node? (-> Node Boolean : CoreScDefn))
+(define (sc-node? a)
+  (and (pair? a) (eqv? (car a) 'define)))
+
+(: ap-fun (-> (List Addr Addr) Addr))
+(define (ap-fun a)
+  (first a))
+
+(: ap-arg (-> (List Addr Addr) Addr))
+(define (ap-arg a)
+  (second a))
+
+(: match-sc (-> CoreScDefn (Values (Listof Name) CoreExpr)))
+(define (match-sc scdef)
+  (values (cdadr scdef) (caddr scdef)))
+
+(: indirect-addr (-> (List 'Indirect Addr) Addr))
+(define (indirect-addr a)
+  (second a))
+
 (: empty-heap Heap)
 (define empty-heap
   (treelist))
@@ -31,6 +72,10 @@
 (: empty-stack Stack)
 (define empty-stack '())
 
+(: push-addr (-> Stack Addr (Pairof Addr Stack)))
+(define (push-addr st n)
+  (cons n st))
+
 (: incr-stats (-> Stats Stats))
 (define incr-stats add1)
 
@@ -110,11 +155,15 @@
 
 (: 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 rstack st args body)]))
+  (cond
+    [(integer-node? n) (error "A number cannot be stepped any further!")]
+    [(ap-node? n) (update-stack (λ (stack) (push-addr stack (ap-fun n))) st)]
+    [(undef-node? n) (error "An undefined node is being stepped!")]
+    [(sc-node? n)
+     (let-values ([(args body) (match-sc n)])
+       (step-sc rstack st args body))]
+    [(indirect-node? n)
+     (update-stack (λ (stack) (push-addr stack (indirect-addr n))) st)]))
 
 (: get-arg (-> Heap Addr Addr))
 (define (get-arg heap addr)
@@ -138,15 +187,26 @@
 
 (: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr)))
 (define (instantiate-and-allocate e env heap)
-  (let ([res (instantiate e env heap)])
+  (let ([res (instantiate-expr e env heap)])
     (cond
       [(number? res)
        (values heap res)]
       [else
        (allocate-node (car res) (cdr res))])))
 
-(: instantiate (-> CoreExpr Globals Heap (∪ Addr (Pair Heap Node))))
-(define (instantiate e env heap)
+(: instantiate-and-assign (-> CoreExpr Globals Heap Addr Heap))
+(define (instantiate-and-assign e env heap addr)
+  (let ([res (instantiate-expr e env heap)])
+    (cond
+      [(number? res)
+       (update-heap heap addr (list 'Indirect res))]
+      [else
+       (let ([heap (car res)]
+             [node (cdr res)])
+         (update-heap heap addr node))])))
+
+(: instantiate-expr (-> CoreExpr Globals Heap (∪ Addr (Pair Heap Node))))
+(define (instantiate-expr e env heap)
   (match e
     [(? integer?) (cons heap e)]
     [(list f a)
@@ -156,9 +216,36 @@
     [(? symbol?) (lookup-globals env e)]
     [(list 'let binds e)
      (let-values ([(env heap) (instantiate-binds binds env heap)])
-       (instantiate e env heap))]
+       (instantiate-expr e env heap))]
+    [(list 'letrec binds e)
+     (let-values ([(env heap) (instantiate-rec-binds binds env heap)])
+       (print heap)
+       (instantiate-expr e env heap))]
     [_ (error "unimplemented")]))
 
+(: instantiate-rec-binds (-> CoreBinds Globals Heap (Values Globals Heap)))
+(define (instantiate-rec-binds binds env heap)
+  (let-values ([(addrs env heap)
+                (for/fold
+                    ([addrs : (Listof Addr) '()]
+                     [env : Globals env]
+                     [heap : Heap heap])
+                    ([bind : CoreBind binds])
+                  (let-values ([(heap addr) (allocate-node heap 'Undef)])
+                    (values (cons addr addrs) (update-globals env (first bind) addr) heap)))])
+    (values env (for/fold
+        ([heap : Heap heap])
+        ([bind : CoreBind binds]
+         [addr : Addr (reverse addrs)])
+                  (instantiate-rec-bind addr bind env heap)))))
+
+(: instantiate-rec-bind (-> Addr CoreBind Globals Heap Heap))
+(define (instantiate-rec-bind addr bind env heap)
+  (let ([x (first bind)]
+        [e (second bind)])
+    (let ([heap (instantiate-and-assign e env heap addr)])
+      heap)))
+
 (: instantiate-binds (-> CoreBinds Globals Heap (Values Globals Heap)))
 (define (instantiate-binds binds old-env heap)
   (for/fold
@@ -175,5 +262,19 @@
       (values (update-globals new-env x addr) heap))))
 
 
+(define-type Unallocated-Node (Pair 'Unallocated Node))
+
+(: unallocated-node-get (-> Unallocated-Node Node))
+(define (unallocated-node-get a)
+  (cdr a))
+
+(: unallocated-node? (-> (∪ Addr Unallocated-Node) Boolean : Unallocated-Node))
+(define (unallocated-node? a)
+  (pair? a))
+
+(: unallocated-node (-> Node Unallocated-Node))
+(define (unallocated-node a)
+  (cons 'Unallocated a))
+
 
 (provide (all-defined-out))
diff --git a/tests/eval.rkt b/tests/eval.rkt
index 5dbf034..a8ed083 100644
--- a/tests/eval.rkt
+++ b/tests/eval.rkt
@@ -31,3 +31,4 @@
 (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 'y 'x))) 5)
+;; (check-equal? (exp-final-node `(letrec ((y x) (x ,(ap-exp 'S 'K 'K 3))) ,(ap-exp 'K 'y 'x))) 5)

From d950cce57bc0325b1204a47d8c9980d1b4260759 Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Sat, 7 Jun 2025 16:47:06 -0400
Subject: [PATCH 4/6] Fix letrec

---
 semantics.rkt  | 34 +++++++++++++++++-----------------
 tests/eval.rkt |  2 +-
 2 files changed, 18 insertions(+), 18 deletions(-)

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

From 815fb10e896ff3b18787b059875d72cb972a94ec Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Sat, 7 Jun 2025 17:37:29 -0400
Subject: [PATCH 5/6] Add tests for recursion

---
 tests/eval.rkt   |  9 +++++++++
 typed-parser.rkt | 18 ++++++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/tests/eval.rkt b/tests/eval.rkt
index 8e9ac3b..c142e70 100644
--- a/tests/eval.rkt
+++ b/tests/eval.rkt
@@ -27,8 +27,17 @@
 (define (exp-final-node e)
   (program-final-node (exp->program e)))
 
+(define rec-program
+  '((define (pair x y f) ((f x) y))
+    (define (fst p) (p K))
+    (define (snd p) (p K1))
+    (define (f x y)
+      (letrec ((a ((pair x) b)) (b ((pair y) a))) (fst (snd (snd (snd a))))))
+    (define (main) ((f 3) 4))))
+
 (check-equal? (exp-final-node (ap-exp 'S 'K 'K 3)) 3)
 (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 'y 'x))) 5)
 (check-equal? (exp-final-node `(letrec ((y x) (x ,(ap-exp 'S 'K 'K 3))) ,(ap-exp 'K 'y 'x))) 3)
+(check-equal? (program-final-node rec-program) 4)
diff --git a/typed-parser.rkt b/typed-parser.rkt
index dfc67b3..be60d1f 100644
--- a/typed-parser.rkt
+++ b/typed-parser.rkt
@@ -1,7 +1,25 @@
 #lang typed/racket
 (require "ast.rkt")
+(require racket/cmdline)
 (require/typed "parser.rkt"
   [parse-from-port (-> Input-Port CoreProgram)]
   [parse-from-string (-> String CoreProgram)])
 
+
+
+(module* main #f
+  (: filename Path-String)
+  (define filename
+    (let ([result (command-line
+                   #:program "core-parser"
+                   #:args (filename)
+                   filename)])
+      (if (path-string? result)
+          result
+          (error "Commandline parser returned unexpected results"))))
+
+
+  (pretty-print (parse-from-port
+                 (open-input-file filename))))
+
 (provide parse-from-port parse-from-string)

From d827f9f68355b5d2cac7436c6a9f1acf96dfc82c Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Sat, 7 Jun 2025 19:05:26 -0400
Subject: [PATCH 6/6] Add in-place update

---
 semantics.rkt | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/semantics.rkt b/semantics.rkt
index 650bfd6..4b02bae 100644
--- a/semantics.rkt
+++ b/semantics.rkt
@@ -150,18 +150,18 @@
   (let ([stack (State-stack state)])
     (match stack
       [(cons addr rstack)
-       (step-node rstack state (lookup-node (State-heap state) addr))]
+       (step-node addr rstack state (lookup-node (State-heap state) addr))]
       ['() (error "Invalid state")])))
 
-(: step-node (-> Stack State Node State))
-(define (step-node rstack st n)
+(: step-node (-> Addr Stack State Node State))
+(define (step-node addr rstack st n)
   (cond
     [(integer-node? n) (error "A number cannot be stepped any further!")]
     [(ap-node? n) (update-stack (λ (stack) (push-addr stack (ap-fun n))) st)]
     [(undef-node? n) (error "An undefined node is being stepped!")]
     [(sc-node? n)
      (let-values ([(args body) (match-sc n)])
-       (step-sc rstack st args body))]
+       (step-sc addr rstack st args body))]
     [(indirect-node? n)
      (update-stack (λ (_) (push-addr rstack (indirect-addr n))) st)]))
 
@@ -171,18 +171,19 @@
     [(list _ a) a]
     [_ (error "Not an application node")]))
 
-(: step-sc (-> Stack State (Listof Name) CoreExpr State))
-(define (step-sc rstack state arg-names body)
+(: step-sc (-> Addr Stack State (Listof Name) CoreExpr State))
+(define (step-sc root rstack state arg-names body)
   (let ([heap (State-heap state)])
-    (let*-values ([(new-env new-stack)
+    (let*-values ([(new-env new-stack root)
                   (for/fold ([globals : Globals (State-globals state)]
-                             [stack : Stack rstack])
+                             [stack : Stack rstack]
+                             [root : Addr root])
                             ([arg-name : Name arg-names])
                     (if (null? stack)
                         (error "Not enough arguments to apply the supercombinator")
-                        (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))]
-                  [(heap addr) (instantiate-and-allocate body new-env heap)])
-      (let ([new-stack (cons addr new-stack)])
+                        (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack) (car stack))))])
+      (let* ([heap (instantiate-and-assign body new-env heap root)]
+             [new-stack (cons root new-stack)])
         (struct-copy State state [stack new-stack] [heap heap])))))
 
 (: instantiate-and-allocate (-> CoreExpr Globals Heap (Values Heap Addr)))