Merge pull request #358 from bjh21/bjh21-extra-tests

[jackhill/mal.git] / guile / printer.scm

diff --git a/guile/printer.scm b/guile/printer.scm
index 98ce9c1..c3400cf 100644 (file)
--- a/guile/printer.scm
+++ b/guile/printer.scm
@@ -14,24 +14,47 @@
 ;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 (library (printer)
-  (export pr_str)
-  (import (guile) (types) (ice-9 match) (ice-9 regex)))
+         (export pr_str)
+         (import (guile) (types) (ice-9 match) (ice-9 regex)))
+
+(define (print-hashmap hm p)
+  (call-with-output-string
+   (lambda (port)
+     (display "{" port)
+     (display
+      (string-join
+       (hash-map->list
+        (lambda (k v)
+          (format #f "~a ~a" (p k) (p v)))
+        hm)
+       " ")
+      port)
+     (display "}" port))))
 
 (define (pr_str obj readable?)
+  (define (->str s)
+    (string-sub
+     (string-sub
+      (string-sub s "\\\\" "\\\\")
+      "\"" "\\\"")
+     "\n" "\\n"))
   (define (%pr_str o) (pr_str o readable?))
   (match obj
+    ((? box?) (%pr_str (unbox obj)))
+    ((? is-func?) "#<function>")
+    ((? is-macro?) "#<macro>")
     ((? list?) (format #f "(~{~a~^ ~})" (map %pr_str obj)))
     ((? vector?) (format #f "[~{~a~^ ~}]" (map %pr_str (vector->list obj))))
-    ((? hash-table?) (format #f "{~{~a~^ ~}}" (map %pr_str (hash-map->list list obj))))
+    ((? hash-table?) (print-hashmap obj %pr_str))
     ((? string?)
      (cond
-      ((string-match "^\u029e(.*)" obj)
-       => (lambda (m) (format #f ":~a" (match:substring m 1))))
-      (else (if readable? (format #f "\"~a\"" obj) obj))))
-    ((? number?) obj)
-    ((? symbol?) obj)
-    ((? atom?) (format #f "(atom ~a)" (atom-val obj)))
-    ((? _nil?) nil)
+      ((_keyword? obj)
+       => (lambda (m) (format #f ":~a" (substring obj 1))))
+      (else (if readable? (format #f "\"~a\"" (->str obj)) obj))))
+    ;;((? number?) (format #f "~a" obj))
+    ;;((? symbol?) (format #f "~a" obj))
+    ((? atom?) (format #f "(atom ~a)" (%pr_str (atom-val obj))))
+    ((? _nil?) "nil")
     (#t "true")
     (#f "false")
-    (else (display obj))))
+    (else (format #f "~a" obj))))