ref: 120a0cb0fd9df6a5da5d0ba480d6eb9b8b6d66a8
dir: /printer.ml/
module T = Types.Types
let meta obj =
match obj with
| T.List { T.meta } -> meta
| T.Proc { T.meta } -> meta
| T.Symbol { T.meta } -> meta
| T.Vector { T.meta } -> meta
| T.Record { T.meta } -> meta
| _ -> T.Nil
;;
let rec print obj readable =
let r = readable in
match obj with
| T.Bool true -> "#t"
| T.Bool false -> "#f"
| T.Char c -> "#\\" ^ Char.escaped c
| T.Nil -> "nil"
| T.Map { T.value = xs } ->
"{" ^ (Types.M9map.fold (fun k v s -> s ^ (if s = "" then "" else " ") ^ (print k r)
^ " " ^ (print v r)) xs "")
^ "}"
| T.Comment ->
"" (* TODO: this leaves a space in the output for block comments *)
(* | T.Pair ({ T.value = one }, { T.value = two }) -> "(" ^ (print one readable) ^ " . " ^ (print two readable) ^ ")" *)
| T.Proc p -> "#<proc>"
| T.Symbol { T.value = s } -> s
| T.Bytevector bv -> "<bytevector unsupported>"
| T.Eof_object -> "<eof>"
| T.Number n ->
if Types.is_float n.value
then string_of_float n.value
else string_of_int (int_of_float n.value)
| T.Port p -> "<port unsupported>"
| T.String s ->
if r
then
"\""
^ Reader.gsub
(Str.regexp "\\([\"\\\n]\\)")
(function
| "\n" -> "\\n"
| x -> "\\" ^ x)
s
^ "\""
else s
| T.List { T.value = xs } ->
"(" ^ String.concat " " (List.map (fun s -> print s r) xs) ^ ")"
| T.Vector { T.value = v } ->
"#(" ^ String.concat " " (List.map (fun s -> print s r) v) ^ ")"
| T.Record r -> "<record supported>"
;;
let dump obj = String.concat " " (List.map (fun s -> print s true) obj)