printer.ml

   1 open Types;;
   2 open Format;;
   3
   4 module Printer = struct
   5   let rec display ff obj =
   6     let print_int = fprintf ff "%d" in
   7     let print_string = fprintf ff "%s" in
   8     let rec print_separated = function
   9         [] -> print_string ""
  10       | [x] -> display ff x
  11       | x::y -> (display ff x); print_string " "; (print_separated y)
  12     in
  13     match obj with
  14         Int (i) -> print_int i
  15       | String (s) -> print_string ("\""^s^"\"")
  16       | Symbol (s) -> print_string s
  17       | Null -> print_string "()"
  18       | True -> print_string "#t"
  19       | False -> print_string "#f"
  20       | Closure (_, _, _) -> print_string "#<closure>"
  21       | Continuation (_) -> print_string "#<continuation>"
  22       | Quotation x -> display ff x
  23       | ProperList (l) ->
  24         open_hovbox 1;
  25         print_string "("; print_separated l; print_string ")"; close_box()
  26       | _ -> print_string "#<unknown>"
  27
  28   let rec write ff obj =
  29     let print_int = fprintf ff "%d" in
  30     let print_string = fprintf ff "%s" in
  31     let rec print_separated = function
  32         [] -> print_string ""
  33       | [x] -> write ff x
  34       | x::y -> (display ff x); print_string " "; (print_separated y)
  35     in
  36     match obj with
  37         Int (i) -> print_int i
  38       | String (s)
  39       | Symbol (s) -> print_string s
  40       | Null -> print_string "()"
  41       | True -> print_string "#t"
  42       | False -> print_string "#f"
  43       | Closure (_, _, _) -> print_string "#<closure>"
  44       | Continuation (_) -> print_string "#<continuation>"
  45       | Quotation x -> display ff x
  46       | ProperList (l) ->
  47         open_hovbox 1;
  48         print_string "("; print_separated l; print_string ")"; close_box()
  49       | _ -> print_string "#<unknown>"
  50
  51
  52 end