#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 (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))] [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) (print-struct v)] [else (error 'pyret-print "~e" v) (void)]))