s.ml

type t =
  | Leaf of int * string
  | Concat of int * t * t

let length = function
  | Leaf (i, _) -> i
  | Concat (i, _, _) -> i

let leaf s =
  Leaf (String.length s, s)

let empty = leaf ""

let (^) t1 t2 =
  Concat (length t1 + length t2, t1, t2)

let (@+) s t =
  leaf s ^ t

let (+@) t s =
  t ^ leaf s

let to_string t =
  let buf = Buffer.create @@ length t in
  let rec loop = function
    | Leaf (_, s) -> Buffer.add_string buf s
    | Concat (_, t1, t2) ->
      loop t1;
      loop t2
  in
  loop t;
  Buffer.to_bytes buf |> Bytes.to_string

(* tail-recursive *)
let to_string' t =
  let buf = Buffer.create @@ length t in
  let rec loop rest = function
    | Leaf (_, s) ->
      Buffer.add_string buf s;
      begin match rest with
      | r::rs ->
        loop rs r
      | [] ->
        Buffer.to_bytes buf |> Bytes.to_string
      end
    | Concat (_, t1, t2) ->
      loop (t2::rest) t1
  in loop [] t

let () =
  ("1" @+ empty) +@ "2" |> to_string' |> print_endline;
  "1" @+ (empty +@ "2") |> to_string' |> print_endline;
  "1" @+ (empty +@ "2" +@ "3") |> to_string' |> print_endline;
  ("1" @+ empty +@ "2") +@ "3" |> to_string' |> print_endline;
  empty +@ "1" +@ "2" +@ "3" +@ "4" |> to_string' |> print_endline;
  let x = leaf "xy" in
  let x = "{" @+ "(" @+ x +@ ")" +@ "}" in
  x |> to_string' |> print_endline;
  ()