Compare commits
2 commits
716c16a4c4
...
1a39377ca1
Author | SHA1 | Date | |
---|---|---|---|
1a39377ca1 | |||
d324fdd5d7 |
2 changed files with 51 additions and 2 deletions
46
printer.rkt
46
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 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)])
|
||||
|
@ -126,3 +170,5 @@
|
|||
[(? string?) (display i s)]))])
|
||||
(go l a)
|
||||
(get-output-string s))))
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
|
|
@ -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)
|
||||
|
@ -134,3 +135,5 @@
|
|||
(allocate-node heap1 (list addr-f addr-a)))]
|
||||
[(? symbol?) (values heap (lookup-globals env e))]
|
||||
[_ (error "unimplemented")]))
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue