guile/printer.scm

   1 ;;  Copyright (C) 2015
   2 ;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
   3 ;;  This file is free software: you can redistribute it and/or modify
   4 ;;  it under the terms of the GNU General Public License as published by
   5 ;;  the Free Software Foundation, either version 3 of the License, or
   6 ;;  (at your option) any later version.
   7
   8 ;;  This file is distributed in the hope that it will be useful,
   9 ;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 ;;  GNU General Public License for more details.
  12
  13 ;;  You should have received a copy of the GNU General Public License
  14 ;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 (library (printer)
  17          (export pr_str)
  18          (import (guile) (types) (ice-9 match) (ice-9 regex)))
  19
  20 (define (print-hashmap hm p)
  21   (call-with-output-string
  22    (lambda (port)
  23      (display "{" port)
  24      (display
  25       (string-join
  26        (hash-map->list
  27         (lambda (k v)
  28           (format #f "~a ~a" (p k) (p v)))
  29         hm)
  30        " ")
  31       port)
  32      (display "}" port))))
  33
  34 (define (pr_str obj readable?)
  35   (define (->str s)
  36     (string-sub
  37      (string-sub
  38       (string-sub s "\\\\" "\\\\")
  39       "\"" "\\\"")
  40      "\n" "\\n"))
  41   (define (%pr_str o) (pr_str o readable?))
  42   (match obj
  43     ((? box?) (%pr_str (unbox obj)))
  44     ((? is-func?) "#<function>")
  45     ((? is-macro?) "#<macro>")
  46     ((? list?) (format #f "(~{~a~^ ~})" (map %pr_str obj)))
  47     ((? vector?) (format #f "[~{~a~^ ~}]" (map %pr_str (vector->list obj))))
  48     ((? hash-table?) (print-hashmap obj %pr_str))
  49     ((? string?)
  50      (cond
  51       ((_keyword? obj)
  52        => (lambda (m) (format #f ":~a" (substring obj 1))))
  53       (else (if readable? (format #f "\"~a\"" (->str obj)) obj))))
  54     ;;((? number?) (format #f "~a" obj))
  55     ;;((? symbol?) (format #f "~a" obj))
  56     ((? atom?) (format #f "(atom ~a)" (%pr_str (atom-val obj))))
  57     ((? _nil?) "nil")
  58     (#t "true")
  59     (#f "false")
  60     (else (format #f "~a" obj))))