printer.rkt

@@ -1,6 +1,5 @@
 #lang typed/racket
 (require "ast.rkt")
-(require "semantics.rkt")
 
 (define-type IndentLevel Integer)
 
@@ -102,49 +101,6 @@
       (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 0 (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)])
@@ -170,5 +126,3 @@
                      [(? string?) (display i s)]))])
       (go l a)
       (get-output-string s))))
-
-(provide (all-defined-out))

semantics.rkt

@@ -48,9 +48,8 @@
 
 (: allocate-node (-> Heap Node (Values Heap Addr)))
 (define (allocate-node heap node)
-  (let ([addr (treelist-length heap)]
+  (let ([heap (treelist-add heap node)])
-        [heap (treelist-add heap node)])
+    (values heap (treelist-length heap))))
-    (values heap addr)))
 
 (: lookup-node (-> Heap Addr Node))
 (define lookup-node treelist-ref)
@@ -135,5 +134,3 @@
        (allocate-node heap1 (list addr-f addr-a)))]
     [(? symbol?) (values heap (lookup-globals env e))]
     [_ (error "unimplemented")]))
-
-(provide (all-defined-out))