src/pretty.ml

   1 exception InvalidUtf8Codepoint of int
   2
   3 let subscripts = "₀₁₂₃₄₅₆₇₈₉"
   4 let superscripts = "⁰¹²³⁴⁵⁶⁷⁸⁹"
   5
   6 let char_length c =
   7   let code = Char.code c in
   8     if code <= 0x7f then 1
   9     else if 0xc2 <= code && code <= 0xdf then 2
  10     else if 0xe0 <= code && code <= 0xef then 3
  11     else if 0xf0 <= code && code <= 0xf4 then 4
  12     else raise (InvalidUtf8Codepoint code)
  13
  14
  15 let next_char s i len =
  16   let n = i + char_length s.[i] in
  17     if n >= len then -1 else n
  18
  19 let str_len s =
  20   let len = String.length s in
  21   let rec loop i acc =
  22     if i == -1 then acc
  23     else loop (next_char s i len) (acc+1)
  24   in
  25     loop 0 0
  26
  27 let length = str_len
  28
  29 let get_char s i =
  30   let len = String.length s in
  31   let rec loop j count =
  32     if count == i then String.sub s j (char_length s.[j])
  33     else loop (next_char s j len) (count+1)
  34   in
  35     loop 0 0
  36
  37
  38 let format_number digits i =
  39   let s = string_of_int i in
  40   let len = String.length s in
  41   let buf = Buffer.create (len*4) in
  42     for i = 0 to len - 1 do
  43       let d = Char.code s.[i] - Char.code '0' in
  44         Buffer.add_string buf (get_char digits d)
  45     done;
  46     Buffer.contents buf
  47
  48 let rev_explode s =
  49   let len = str_len s in
  50   let rec loop i acc =
  51       if i >= len then acc
  52       else
  53         loop (i+1) ((get_char s i) :: acc)
  54   in
  55       loop 0 []
  56
  57
  58 let explode s = List.rev (rev_explode s)
  59
  60 let combine_all comp s =
  61   let l = rev_explode s in
  62   String.concat "" (List.fold_left (fun acc e -> comp::e::acc) [] l)
  63
  64
  65 let subscript = format_number subscripts
  66 let superscript = format_number superscripts
  67 let down_arrow = "↓"
  68 let up_arrow = "↑"
  69 let right_arrow = "→"
  70 let left_arrow =  "←"
  71 let epsilon = "ϵ"
  72 let cap = "∩"
  73 let cup = "∪"
  74 let lnot = "¬"
  75 let wedge = "∧"
  76 let vee = "∨"
  77 let top = "⊤"
  78 let bottom = "⊥"
  79 let dummy = "☠"
  80 let double_right_arrow = "⇒"
  81 let combining_overbar = "\204\133"
  82 let combining_underbar = "\204\178"
  83 let combining_stroke = "\204\182"
  84 let combining_vertical_line = "\226\131\146"
  85
  86
  87 let overline s = combine_all combining_overbar s
  88 let underline s = combine_all combining_underbar s
  89 let strike s = combine_all combining_stroke s
  90
  91 let mk_repeater c =
  92   let mk_str i = String.make i c in
  93   let _table = Array.init 16 mk_str in
  94      fun i -> try
  95       if i < 16 then _table.(i) else mk_str i
  96     with e -> print_int i; print_newline(); raise e
  97 let padding = mk_repeater ' '
  98 let line = mk_repeater '_'
  99
 100
 101
 102
 103 let ppf f fmt s =
 104   Format.fprintf fmt "%s" (f s)
 105
 106 let pp_overline = ppf overline
 107 let pp_underline = ppf underline
 108 let pp_strike = ppf strike
 109 let pp_subscript = ppf subscript
 110 let pp_superscript = ppf superscript
 111
 112 let print_list ?(sep=" ") printer fmt l =
 113   match l with
 114       [] -> ()
 115     | [ e ] -> printer fmt e
 116     | e::es -> printer fmt e; List.iter (fun x -> Format.fprintf fmt "%s%a" sep printer x) es
 117
 118 let print_array ?(sep=" ") printer fmt l =
 119   print_list ~sep:sep printer fmt (Array.to_list l)