Add pretty printer for states

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)])

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))