Compare commits

..

2 commits

Author SHA1 Message Date
1a39377ca1 Fix the add-node function 2025-06-06 00:17:27 -04:00
d324fdd5d7 Add pretty printer for states 2025-06-05 23:46:41 -04:00
2 changed files with 51 additions and 2 deletions

View file

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

View file

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