From d324fdd5d7f40aa0b991fbe4b668933933c0f138 Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Thu, 5 Jun 2025 23:46:41 -0400
Subject: [PATCH 1/2] Add pretty printer for states

---
 printer.rkt   | 44 ++++++++++++++++++++++++++++++++++++++++++++
 semantics.rkt |  2 ++
 2 files changed, 46 insertions(+)

diff --git a/printer.rkt b/printer.rkt
index 80052fb..408f620 100644
--- a/printer.rkt
+++ b/printer.rkt
@@ -1,5 +1,6 @@
 #lang typed/racket
 (require "ast.rkt")
+(require "semantics.rkt")
 
 (define-type IndentLevel Integer)
 
@@ -101,6 +102,49 @@
       (ppr-expr a)
       (iseq-append "(" (ppr-expr a) ")")))
 
+(: ppr-addr (-> Addr String))
+(define (ppr-addr a)
+  (number->string a))
+
+(: ppr-fwaddr (-> Addr ISeq))
+(define (ppr-fwaddr a)
+  (let ([s (ppr-addr a)])
+    (iseq-append (make-string (- 4 (string-length s)) #\ ) s)))
+
+(: ppr-node (-> Node ISeq))
+(define (ppr-node a)
+  (cond
+    [(integer? a)
+     (iseq-append "NNum" (number->string a))]
+    [(not (eq? (car a) 'define))
+     (let ([fun (first a)]
+           [arg (second a)])
+       (iseq-append "NAp " (ppr-addr fun) " " (ppr-addr arg)))]
+    [else (iseq-append "NSupercomb " (symbol->string (caadr a)))]))
+
+(: ppr-stack-node (-> Heap Node ISeq))
+(define (ppr-stack-node heap node)
+  (if (and (pair? node) (not (symbol? (car node))))
+      (let ([fun : Addr (first node)]
+            [arg : Addr (second node)])
+        (iseq-append-with-sep
+         " " "NAp" (ppr-fwaddr fun) (ppr-fwaddr arg) "(" (ppr-node (lookup-node heap arg)) ")"))
+      (ppr-node node)))
+
+(: ppr-stack (-> Heap Stack ISeq))
+(define (ppr-stack heap stack)
+  (let ([ppr-stack-item
+         : (-> Addr ISeq)
+         (λ (addr) (iseq-append (ppr-fwaddr addr) ": " (ppr-stack-node heap (lookup-node heap addr))))])
+    (iseq-append "Stk [" (list 'Hang -1 (ppr-list ppr-stack-item 'Newline stack)))))
+
+(: ppr-state (-> State ISeq))
+(define (ppr-state st)
+  (let ([stack (State-stack st)]
+        [heap (State-heap st)])
+    (iseq-append (ppr-stack heap stack) 'Newline)))
+
+
 (: iseq->string (-> IndentLevel ISeq String))
 (define (iseq->string l a)
   (let ([s (open-output-string)])
diff --git a/semantics.rkt b/semantics.rkt
index 1300666..e25fed8 100644
--- a/semantics.rkt
+++ b/semantics.rkt
@@ -134,3 +134,5 @@
        (allocate-node heap1 (list addr-f addr-a)))]
     [(? symbol?) (values heap (lookup-globals env e))]
     [_ (error "unimplemented")]))
+
+(provide (all-defined-out))

From 1a39377ca158fe9ae286c66d70426c563d81a5b8 Mon Sep 17 00:00:00 2001
From: Yiyun Liu <liuyiyun@seas.upenn.edu>
Date: Fri, 6 Jun 2025 00:17:27 -0400
Subject: [PATCH 2/2] Fix the add-node function

---
 printer.rkt   | 6 ++++--
 semantics.rkt | 5 +++--
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/printer.rkt b/printer.rkt
index 408f620..72ab6ff 100644
--- a/printer.rkt
+++ b/printer.rkt
@@ -115,7 +115,7 @@
 (define (ppr-node a)
   (cond
     [(integer? a)
-     (iseq-append "NNum" (number->string a))]
+     (iseq-append "NNum " (number->string a))]
     [(not (eq? (car a) 'define))
      (let ([fun (first a)]
            [arg (second a)])
@@ -136,7 +136,7 @@
   (let ([ppr-stack-item
          : (-> Addr ISeq)
          (λ (addr) (iseq-append (ppr-fwaddr addr) ": " (ppr-stack-node heap (lookup-node heap addr))))])
-    (iseq-append "Stk [" (list 'Hang -1 (ppr-list ppr-stack-item 'Newline stack)))))
+    (iseq-append "Stk [" (list 'Hang 0 (ppr-list ppr-stack-item 'Newline stack)) "]")))
 
 (: ppr-state (-> State ISeq))
 (define (ppr-state st)
@@ -170,3 +170,5 @@
                      [(? string?) (display i s)]))])
       (go l a)
       (get-output-string s))))
+
+(provide (all-defined-out))
diff --git a/semantics.rkt b/semantics.rkt
index e25fed8..15b4f47 100644
--- a/semantics.rkt
+++ b/semantics.rkt
@@ -48,8 +48,9 @@
 
 (: allocate-node (-> Heap Node (Values Heap Addr)))
 (define (allocate-node heap node)
-  (let ([heap (treelist-add heap node)])
-    (values heap (treelist-length heap))))
+  (let ([addr (treelist-length heap)]
+        [heap (treelist-add heap node)])
+    (values heap addr)))
 
 (: lookup-node (-> Heap Addr Node))
 (define lookup-node treelist-ref)