Du code brut de fonderie (et un peu brouillon), car un peu au delà des objectifs avoués du TD.

(* Écriture *)
let bit_to_int b = match b with
| Zero -> 0
| Un   -> 1

let get_one_bit l = match l with
| []     -> Zero,[]
| b::rem -> b,rem

let rec get_n_bits n l =
  if n <= 0 then 0,l
  else
    let b,rem = get_one_bit l in
    let r,rem = get_n_bits (n-1) rem in
    2 * r + (bit_to_int b),rem

let rec output_list f l = match l with
| [] -> ()
| _  ->
    let byte,rem = get_n_bits 8 l in
    output_char f (Char.chr byte) ;
    output_list f rem

let ecrire_arbre name a =
  let f = open_out_bin name in
  output_list f (arbre_vers_liste a) ;
  close_out f

(* Lecture *)
let read_byte f =
  try
    let c = input_char f in
    Some (Char.code c)
  with
  | End_of_file -> None

let rec get_n_bits digits n =
  if digits <= 0 then
    []
  else
    let b = match n mod 2 with 0 -> Zero | 1 -> Un | _ -> assert false in
    b::get_n_bits (digits-1) (n/2)

let rec input_list f =  match read_byte f with
| None -> []
| Some n -> get_n_bits 8 n @ input_list f

let lire_arbre name =
  let f = open_in_bin name in
  let a = liste_vers_arbre (input_list f) in
  close_in f ;
  a