[jackhill/mal.git] / scheme / lib / printer.sld

(define-library (lib printer)

(export pr-str)

(import (scheme base))
(import (scheme write))

(import (lib util))
(import (lib types))

(begin

(define (pr-str ast print-readably)
  (cond
   ((procedure? ast)
    "#<fn>")
   ((func? ast)
    "#<func>")
   (else
    (if (procedure? ast)
        "#<fn>"
        (let* ((type (and (mal-object? ast) (mal-type ast)))
               (value (and (mal-object? ast) (mal-value ast))))
          (case type
            ((true) "true")
            ((false) "false")
            ((nil) "nil")
            ((number) (number->string value))
            ((string) (call-with-output-string
                       (lambda (port)
                         (if print-readably
                             (begin
                               (display #\" port)
                               (string-for-each
                                (lambda (char)
                                  (case char
                                    ((#\\) (display "\\\\" port))
                                    ((#\") (display "\\\"" port))
                                    ((#\newline) (display "\\n" port))
                                    (else (display char port))))
                                value)
                               (display #\" port))
                             (display value port)))))
            ((keyword) (string-append ":" (symbol->string value)))
            ((symbol) (symbol->string value))
            ((list) (pr-list value "(" ")" print-readably))
            ((vector) (pr-list (vector->list value) "[" "]" print-readably))
            ((map) (pr-list (alist->list value) "{" "}" print-readably))
            ((atom) (string-append "(atom " (pr-str value print-readably) ")"))
            (else (error "unknown type"))))))))

(define (pr-list items starter ender print-readably)
  (call-with-output-string
   (lambda (port)
     (display starter port)
     (let ((reprs (map (lambda (item) (pr-str item print-readably)) items)))
       (display (string-intersperse reprs " ") port))
     (display ender port))))

)

)
Commit	Line	Data
6ca83567 VS	1	(define-library (lib printer)
	2
	3	(export pr-str)
	4
	5	(import (scheme base))
	6	(import (scheme write))
	7
	8	(import (lib util))
	9	(import (lib types))
	10
	11	(begin
	12
	13	(define (pr-str ast print-readably)
a9385e97 VS	14	(cond
	15	((procedure? ast)
	16	"#<fn>")
	17	((func? ast)
	18	"#<func>")
	19	(else
	20	(if (procedure? ast)
	21	"#<fn>"
	22	(let* ((type (and (mal-object? ast) (mal-type ast)))
	23	(value (and (mal-object? ast) (mal-value ast))))
	24	(case type
	25	((true) "true")
	26	((false) "false")
	27	((nil) "nil")
	28	((number) (number->string value))
	29	((string) (call-with-output-string
	30	(lambda (port)
	31	(if print-readably
	32	(begin
	33	(display #\" port)
	34	(string-for-each
	35	(lambda (char)
	36	(case char
	37	((#\\) (display "\\\\" port))
	38	((#\") (display "\\\"" port))
	39	((#\newline) (display "\\n" port))
	40	(else (display char port))))
	41	value)
	42	(display #\" port))
	43	(display value port)))))
	44	((keyword) (string-append ":" (symbol->string value)))
	45	((symbol) (symbol->string value))
	46	((list) (pr-list value "(" ")" print-readably))
	47	((vector) (pr-list (vector->list value) "[" "]" print-readably))
	48	((map) (pr-list (alist->list value) "{" "}" print-readably))
663059ad	49	((atom) (string-append "(atom " (pr-str value print-readably) ")"))
a9385e97	50	(else (error "unknown type"))))))))
6ca83567 VS	51
	52	(define (pr-list items starter ender print-readably)
	53	(call-with-output-string
	54	(lambda (port)
	55	(display starter port)
	56	(let ((reprs (map (lambda (item) (pr-str item print-readably)) items)))
	57	(display (string-intersperse reprs " ") port))
	58	(display ender port))))
	59
	60	)
	61
	62	)