Section serializer.
Variables A : Type.
Variable sA :Serializer A.
(* Now we're ready to serialize trees. First, we serialize their shape. *)
Fixpoint serialize_tree_shape (t : tree A) : IOStreamWriter.t :=
let fix serialize_list_tree_shape (l : list (tree A)) : IOStreamWriter.t :=
match l with
| [] => IOStreamWriter.empty
| x :: xs => IOStreamWriter.append (fun _ => serialize_tree_shape x)
(fun _ => serialize_list_tree_shape xs)
end in
match t with
| atom _ => serialize x00 (* ignore the data, since we're just focused on the shape *)
| node l => IOStreamWriter.append (fun _ => serialize x01)
(fun _ => (IOStreamWriter.append
(fun _ => serialize_list_tree_shape l)
(fun _ => serialize x02)))
end.
Definition serialize_list_tree_shape :=
fix serialize_list_tree_shape (l : list (tree A)) : IOStreamWriter.t :=
match l with
| [] => IOStreamWriter.empty
| x :: xs => IOStreamWriter.append (fun _ => serialize_tree_shape x)
(fun _ => serialize_list_tree_shape xs)
end.
Definition deserialize_tree_shape_step (b : byte) (s : list (list (tree unit))) :
fold_state (list (list (tree unit))) (tree unit) :=
match b with
| x00 => match s with
| [] => Done (atom tt)
| ts :: s => More ((atom tt :: ts) :: s)
end
| x01 => More ([] :: s)
| x02 => match s with
| [] => Error
| ts :: s => let t := node (rev' ts) in
match s with
| [] => Done t
| ts :: acc => More ((t :: ts) :: acc)
end
end
| _ => Error
end.
Proof using.
induction t using tree_rect with
(P_list := fun l =>
(* We need to extend the statement to a list of subtrees for the mutual induction hypothesis. It says that serializing and then deserializing a list of trees `l` is the same as `List.map (map (fun _ => tt) l)`. `deserialize_list_tree_shape'` is always called with at least one element on the accumulator, so there's no need for a match like there was above. *)
forall ts acc bytes,
ByteListReader.unwrap
(ByteListReader.fold deserialize_tree_shape_step (ts :: acc))
(IOStreamWriter.unwrap (serialize_list_tree_shape l) ++ bytes) =
ByteListReader.unwrap
(ByteListReader.fold
deserialize_tree_shape_step
((rev (List.map shape l) ++ ts) :: acc)) bytes);
intros;
try (unfold serialize_list_tree_shape;
rewrite IOStreamWriter.append_unwrap, app_ass, IHt, IHt0;
simpl;
now rewrite app_ass).
(cheerios_crush; simpl; cheerios_crush; simpl).
-  destruct acc;
repeat (cheerios_crush;
simpl).
- destruct acc;
simpl;
rewrite IOStreamWriter.append_unwrap,
ByteListReader.fold_unwrap,
IOStreamWriter.append_unwrap,
IOStreamWriter.putByte_unwrap;
simpl;
fold serialize_list_tree_shape;
rewrite app_ass, IHt, ByteListReader.fold_unwrap,
IOStreamWriter.putByte_unwrap;
simpl;
rewrite app_nil_r, rev'_spec, rev_involutive;
reflexivity.
Qed.
Definition deserialize_tree_shape : ByteListReader.t (tree unit) :=
ByteListReader.fold deserialize_tree_shape_step [].
Proof using.
intros.
unfold deserialize_tree_shape.
now rewrite shape_aux.
Qed.
Fixpoint serialize_tree_elements (t : tree A) : IOStreamWriter.t :=
let fix serialize_tree_elements_list (l : list (tree A)) : IOStreamWriter.t :=
match l with
| [] => IOStreamWriter.empty
| t :: l' => IOStreamWriter.append (fun _ => serialize_tree_elements t)
(fun _ => serialize_tree_elements_list l')
end
in match t with
| atom a => serialize a
| node l => serialize_tree_elements_list l
end.
Definition serialize_tree_elements_list :=
fix serialize_tree_elements_list (l : list (tree A)) : IOStreamWriter.t :=
match l with
| [] => IOStreamWriter.empty
| t :: l' => IOStreamWriter.append (fun _ => serialize_tree_elements t)
(fun _ => serialize_tree_elements_list l')
end.
Fixpoint deserialize_tree_elements (t : tree unit) : ByteListReader.t (tree A) :=
let fix deserialize_tree_elements_list (l : list (tree unit)) :=
match l with
| [] => ByteListReader.ret []
| t :: l' => cons <$> deserialize_tree_elements t
<*> deserialize_tree_elements_list l'
end
in match t with
| atom tt => @atom _ <$> deserialize
| node l => @node _ <$> deserialize_tree_elements_list l
end.
Definition deserialize_tree_elements_list :=
fix deserialize_tree_elements_list (l : list (tree unit)) :=
match l with
| [] => ByteListReader.ret []
| t :: l' => cons <$> deserialize_tree_elements t
<*> deserialize_tree_elements_list l'
end.
Proof using.
induction t using tree_rect with
(P_list := fun l => forall bytes,
ByteListReader.unwrap (deserialize_tree_elements_list (List.map shape l))
(IOStreamWriter.unwrap (serialize_tree_elements_list l) ++ bytes) =
Some (l, bytes));
intros;
cbn [shape map List.map
serialize_tree_shape deserialize_tree_shape
serialize_tree_elements deserialize_tree_elements
serialize_tree_elements_list deserialize_tree_elements_list].
- now cheerios_crush.
- cheerios_crush.
rewrite IHt.
cheerios_crush.
rewrite IHt0.
cheerios_crush.
- now cheerios_crush.
- fold deserialize_tree_elements_list.
fold serialize_tree_elements_list.
cheerios_crush.
now rewrite IHt.
Qed.
(* Now we serialize the tree itself by first serializing the shape, and then a preorder traversal of the elements. *)
Definition tree_serialize (t : tree A) : IOStreamWriter.t :=
IOStreamWriter.append (fun _ => serialize_tree_shape t)
(fun _ => serialize_tree_elements t).
(* To deserialize, we deserialize the shape and the elements, and then fill out the shape with the elements. *)
Definition tree_deserialize : ByteListReader.t (tree A) :=
shape <- deserialize_tree_shape ;;
deserialize_tree_elements shape.

(* To prove this correct, we need to know that serializ-/deserializing the shape of `t` results in `shape t` (`serialize_deserialize_shape_id`), and that filling out a `map f t` with the elements of `preorder t` results in `t` (`fill_preorder`). *)
Lemma tree_serialize_deserialize_id :
serialize_deserialize_id_spec tree_serialize tree_deserialize.