diff --git a/printer.rkt b/printer.rkt index 72ab6ff..80052fb 100644 --- a/printer.rkt +++ b/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)) diff --git a/semantics.rkt b/semantics.rkt index 15b4f47..1300666 100644 --- a/semantics.rkt +++ b/semantics.rkt @@ -48,9 +48,8 @@ (: allocate-node (-> Heap Node (Values Heap Addr))) (define (allocate-node heap node) - (let ([addr (treelist-length heap)] - [heap (treelist-add heap node)]) - (values heap addr))) + (let ([heap (treelist-add heap node)]) + (values heap (treelist-length heap)))) (: 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))