#lang racket
(require "semantics/structures.rkt")
(require 2htdp/image)
(require "utilities.rkt")
(provide pyret-print pyret-print-to-string pyret-print-to-string-for-error)
(define (pyret-print v)
(cond
[(eof-object? v) (void)]
[(void? v) (void)]
[else
(my-print-value v)
(newline)]))
(define (pyret-print-to-string-for-error v)
(let ([ret (pyret-print-to-string v)])
(if ret
ret
(something-else v))))
(define (struct->string s)
(define (struct-fields->string str)
(let ([fields (struct-field-id-list str)])
(cond
[(empty? fields)
""]
[else
(let loop ([fl fields]
[s ""])
(let ([f (first fl)])
(let ([this-s
(format "~a = ~a" f (pyret-print-to-string
(pyret-struct-lookup str f (syntax->vector #'dummy))))])
(if (= (length fl) 1)
(string-append s this-s)
(loop (rest fl) (string-append s this-s ", "))))))])))
(format
(string-append
"struct: ~a ("
(struct-fields->string s)
")")
(struct-name s)))
(define (pyret-print-to-string v)
(cond
[(number? v)
(if (inexact? v)
(string-append "0nx" (number->string v))
(number->string v))]
[(symbol? v) (symbol->string v)]
[(empty? v) "empty"]
[(boolean? v)
(if v
"True"
"False")]
[(string? v) v]
[(list? v)
(let ([f (string-append "[" (pyret-print-to-string (car v)))])
(let ([internal
(let loop ([l (cdr v)])
(if (empty? l)
"]"
(string-append ", "
(pyret-print-to-string (car l))
(loop (cdr l)))))])
(string-append f internal)))]
[(procedure? v)
(let ([n (object-name v)])
(if (symbol? n)
(symbol->string n)
#f))]
[(pyret-struct-instance? v)
(struct->string v)]
[else
#f]))
(define (my-print-value v)
(cond
[(number? v)
(display (format "~a" (pyret-print-to-string v)))]
[(empty? v)
(display "empty")]
[(boolean? v)
(if v
(display "True")
(display "False"))]
[(image? v)
(display v)]
[(string? v)
(print v)]
[(list? v)
(display "[")
(print (car v))
(for-each (lambda (v)
(display ", ")
(print v))
(cdr v))
(display "]")]
[(cons? v)
(display "cons(")
(write (car v))
(display ", ")
(write (cdr v))
(display ")")]
[(pyret-struct-instance? v)
(display (struct->string v))]
[else
(error 'pyret-print "~e" v)
(void)]))