├── runtime ├── .merlin ├── ocaml │ ├── cheerios_runtime.mllib │ ├── META │ ├── bit_vector.mli │ ├── serializer_primitives.mli │ ├── bit_vector.ml │ └── serializer_primitives.ml ├── test │ ├── positive_bench.ml │ ├── tree.gpi │ ├── positive.gpi │ ├── tree_bench.ml │ ├── bool_pair_test.ml │ ├── bit_vector_tests.ml │ ├── bool_pair.mli │ ├── tree_test.ml │ ├── positive_test.ml │ ├── test_utils.ml │ └── bool_pair.ml ├── coq │ ├── ExtractPositiveSerializerDeps.v │ ├── ExtractTreeSerializerDeps.v │ ├── ExtractPositiveSerializer.v │ └── ExtractTreeSerializer.v ├── .gitignore ├── script │ └── remove_module.pl └── Makefile ├── dune-project ├── theories ├── dune ├── Extraction │ ├── ExtrOcamlCheeriosString.v │ ├── ExtrOcamlCheeriosNatInt.v │ ├── ExtrOcamlCheeriosFinInt.v │ └── ExtrOcamlCheeriosBasic.v └── Core │ ├── Cheerios.v │ ├── Tactics.v │ ├── DeserializerMonad.v │ ├── Types.v │ ├── Core.v │ ├── Combinators.v │ ├── ByteDecidable.v │ ├── BasicSerializers.v │ └── Tree.v ├── Makefile.ml-files ├── .gitignore ├── Makefile.coq.local ├── cheerios-runtime.install ├── _CoqProject ├── Makefile ├── cheerios-runtime.opam ├── coq-cheerios.opam ├── LICENSE ├── .github └── workflows │ └── docker-action.yml ├── README.md ├── doc └── NOTES.md └── meta.yml /runtime/.merlin: -------------------------------------------------------------------------------- 1 | S ocaml 2 | S test 3 | B _build/** 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.5) 2 | (using coq 0.6) 3 | (name cheerios) 4 | -------------------------------------------------------------------------------- /runtime/ocaml/cheerios_runtime.mllib: -------------------------------------------------------------------------------- 1 | Bit_vector 2 | Serializer_primitives 3 | -------------------------------------------------------------------------------- /runtime/test/positive_bench.ml: -------------------------------------------------------------------------------- 1 | open Positive_test 2 | 3 | let _ = space_main () 4 | -------------------------------------------------------------------------------- /runtime/coq/ExtractPositiveSerializerDeps.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Export Cheerios. 2 | From Cheerios Require Export ExtrOcamlCheeriosBasic. 3 | -------------------------------------------------------------------------------- /theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name Cheerios) 3 | (package coq-cheerios) 4 | (synopsis "Coq library for verified serialization")) 5 | 6 | (include_subdirs qualified) 7 | -------------------------------------------------------------------------------- /runtime/coq/ExtractTreeSerializerDeps.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Export Cheerios. 2 | From Cheerios Require Export Tree. 3 | From Cheerios Require Export ExtrOcamlCheeriosBasic. 4 | -------------------------------------------------------------------------------- /Makefile.ml-files: -------------------------------------------------------------------------------- 1 | MLPOSITIVE = runtime/test/positive_serializer.ml runtime/test/positive_serializer.mli 2 | MLTREE = runtime/test/tree_serializer.ml runtime/test/tree_serializer.mli 3 | -------------------------------------------------------------------------------- /runtime/.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.native 3 | *.dat 4 | *.pdf 5 | test/positive_serializer.ml 6 | test/positive_serializer.mli 7 | test/tree_serializer.ml 8 | test/tree_serializer.mli 9 | test/test_file -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *#* 2 | *.v.d 3 | *.glob 4 | *.vo 5 | *.vio 6 | *.aux 7 | *.vos 8 | *.vok 9 | Makefile.coq 10 | Makefile.coq.conf 11 | Makefile.coq.bak 12 | .Makefile.coq.d 13 | .coqdeps.d 14 | *~ 15 | .lia.cache 16 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlCheeriosString.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import Cheerios. 2 | From Coq Require Extraction. 3 | 4 | Extract Inlined Constant ascii_serialize => "Serializer_primitives.putByte". 5 | Extract Inlined Constant ascii_deserialize => "Serializer_primitives.getByte". 6 | -------------------------------------------------------------------------------- /theories/Core/Cheerios.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Export Core. 2 | From Cheerios Require Export DeserializerMonad. 3 | From Cheerios Require Export Tactics. 4 | From Cheerios Require Export BasicSerializers. 5 | From Cheerios Require Export Combinators. 6 | From Cheerios Require Export Tactics. 7 | From Cheerios Require Export Types. 8 | -------------------------------------------------------------------------------- /runtime/test/tree.gpi: -------------------------------------------------------------------------------- 1 | set terminal pdf 2 | set title "Space Usage For Trees Using Cheerios and Marshal" 3 | set xlabel "Tree Height" 4 | set ylabel "Space (bytes)" 5 | set yrange [0:80000000] 6 | plot "test/tree_bench.dat" using 1:2 title "Cheerios" with linespoints , \ 7 | "test/tree_bench.dat" using 1:3 title "Marshal" with linespoints -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlCheeriosNatInt.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import Cheerios. 2 | From Coq Require Extraction. 3 | 4 | Extract Inlined Constant nat_serialize => "(fun i -> Serializer_primitives.putInt (Int32.of_int i))". 5 | Extract Inlined Constant nat_deserialize => "(Serializer_primitives.map Int32.to_int Serializer_primitives.getInt)". 6 | -------------------------------------------------------------------------------- /runtime/ocaml/META: -------------------------------------------------------------------------------- 1 | version = "%%VERSION%%" 2 | description = "Cheerios framework runtime library" 3 | requires = "bytes" 4 | archive(byte) = "cheerios_runtime.cma" 5 | archive(byte, plugin) = "cheerios_runtime.cma" 6 | archive(native) = "cheerios_runtime.cmxa" 7 | archive(native, plugin) = "cheerios_runtime.cmxs" 8 | exists_if = "cheerios_runtime.cma" 9 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlCheeriosFinInt.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import Cheerios. 2 | From Coq Require Extraction. 3 | 4 | Extract Inlined Constant fin_serialize => "(fun _ i -> Serializer_primitives.putInt (Int32.of_int i))". 5 | Extract Inlined Constant fin_deserialize => "(fun _ -> Serializer_primitives.map Int32.to_int Serializer_primitives.getInt)". 6 | -------------------------------------------------------------------------------- /runtime/test/positive.gpi: -------------------------------------------------------------------------------- 1 | set terminal pdf 2 | set title "Space Usage For Positives Using Cheerios and Marshal" 3 | set xlabel "Length (# constructors)" 4 | set ylabel "Space (bytes)" 5 | set xtic 50000 6 | set yrange [0:230000] 7 | plot "test/positive_bench.dat" using 1:2 title "Cheerios" with linespoints , \ 8 | "test/positive_bench.dat" using 1:3 title "Marshal" with linespoints -------------------------------------------------------------------------------- /runtime/ocaml/bit_vector.mli: -------------------------------------------------------------------------------- 1 | type writer 2 | type reader 3 | 4 | exception Out_of_bounds 5 | 6 | val makeWriter : unit -> writer 7 | 8 | val pushBack : writer -> char -> unit 9 | val pop : reader -> char 10 | val hasNext : reader -> bool 11 | 12 | val writerToBytes : writer -> bytes 13 | val bytesToReader : bytes -> reader 14 | 15 | (* for testing *) 16 | val numBytes : writer -> int 17 | -------------------------------------------------------------------------------- /runtime/test/tree_bench.ml: -------------------------------------------------------------------------------- 1 | open Test_utils 2 | open Tree_serializer 3 | open Tree_test 4 | 5 | let space_main () = 6 | let max_height = 16 in 7 | let rec loop i = 8 | if i < max_height 9 | then (compare_cheerios_marshal_space (fun n -> make false n 3) (tree_serialize_top) i; 10 | loop (i + 1)) 11 | in 12 | Printf.printf "height cheerios marshal\n"; 13 | loop 0 14 | 15 | let _ = space_main () 16 | -------------------------------------------------------------------------------- /Makefile.coq.local: -------------------------------------------------------------------------------- 1 | include Makefile.ml-files 2 | 3 | $(MLPOSITIVE): runtime/coq/ExtractPositiveSerializer.v runtime/coq/ExtractPositiveSerializerDeps.vo 4 | $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) runtime/coq/ExtractPositiveSerializer.v 5 | 6 | $(MLTREE): runtime/coq/ExtractTreeSerializer.v runtime/coq/ExtractTreeSerializerDeps.vo 7 | $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) runtime/coq/ExtractTreeSerializer.v 8 | 9 | clean:: 10 | rm -f $(MLPOSITIVE) \ 11 | $(MLTREE) 12 | -------------------------------------------------------------------------------- /runtime/test/bool_pair_test.ml: -------------------------------------------------------------------------------- 1 | let test_pair (x, y) = 2 | let w = Bit_vector.makeWriter () in 3 | let _ = Bool_pair_extracted.serialize_bool_pair (x, y) w in 4 | let r = Bit_vector.writerToReader w in 5 | let (x', y') = Bool_pair_extracted.deserialize_bool_pair r in 6 | let true = x = x' && y = y' in 7 | () 8 | 9 | let _ = test_pair (false, false) 10 | let _ = test_pair (false, true) 11 | let _ = test_pair (true, false) 12 | let _ = test_pair (true, true) 13 | -------------------------------------------------------------------------------- /theories/Core/Tactics.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | From Cheerios Require Import Core. 3 | From Cheerios Require Import DeserializerMonad. 4 | From Cheerios Require Import Types. 5 | 6 | Ltac cheerios_crush := intros; autorewrite with cheerios; auto. 7 | 8 | #[global] 9 | Hint Rewrite <- app_assoc : cheerios. 10 | #[global] 11 | Hint Rewrite 12 | IOStreamWriter.empty_unwrap IOStreamWriter.putByte_unwrap 13 | IOStreamWriter.append_unwrap 14 | ByteListReader.getByte_unwrap ByteListReader.bind_unwrap ByteListReader.ret_unwrap 15 | ByteListReader.map_unwrap @ByteListReader.fold_unwrap : cheerios. 16 | -------------------------------------------------------------------------------- /cheerios-runtime.install: -------------------------------------------------------------------------------- 1 | # cheerios-runtime 2 | 3 | doc: [ 4 | "README.md" {"README.md"} 5 | ] 6 | lib: [ 7 | "cheerios-runtime.opam" {"opam"} 8 | "runtime/ocaml/META" {"META"} 9 | "runtime/_build/ocaml/bit_vector.cmi" {"bit_vector.cmi"} 10 | "runtime/_build/ocaml/serializer_primitives.cmi" {"serializer_primitives.cmi"} 11 | "runtime/_build/ocaml/cheerios_runtime.a" {"cheerios_runtime.a"} 12 | "runtime/_build/ocaml/cheerios_runtime.cma" {"cheerios_runtime.cma"} 13 | "runtime/_build/ocaml/cheerios_runtime.cmxa" {"cheerios_runtime.cmxa"} 14 | "runtime/_build/ocaml/cheerios_runtime.cmxs" {"cheerios_runtime.cmxs"} 15 | ] 16 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q theories Cheerios 2 | -Q runtime/coq Cheerios 3 | 4 | theories/Core/Types.v 5 | theories/Core/Tree.v 6 | theories/Core/ByteDecidable.v 7 | theories/Core/BasicSerializers.v 8 | theories/Core/Core.v 9 | theories/Core/Cheerios.v 10 | theories/Core/Tactics.v 11 | theories/Core/DeserializerMonad.v 12 | theories/Core/Combinators.v 13 | 14 | theories/Extraction/ExtrOcamlCheeriosFinInt.v 15 | theories/Extraction/ExtrOcamlCheeriosString.v 16 | theories/Extraction/ExtrOcamlCheeriosBasic.v 17 | theories/Extraction/ExtrOcamlCheeriosNatInt.v 18 | 19 | runtime/coq/ExtractPositiveSerializer.v 20 | runtime/coq/ExtractPositiveSerializerDeps.v 21 | runtime/coq/ExtractTreeSerializer.v 22 | runtime/coq/ExtractTreeSerializerDeps.v 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include Makefile.ml-files 2 | 3 | default: Makefile.coq 4 | $(MAKE) -f Makefile.coq 5 | 6 | quick: Makefile.coq 7 | $(MAKE) -f Makefile.coq quick 8 | 9 | Makefile.coq: _CoqProject 10 | coq_makefile -f _CoqProject -o Makefile.coq 11 | 12 | $(MLPOSITIVE) $(MLTREE): Makefile.coq 13 | $(MAKE) -f Makefile.coq $@ 14 | 15 | install: Makefile.coq 16 | $(MAKE) -f Makefile.coq install 17 | 18 | clean: Makefile.coq 19 | $(MAKE) -f Makefile.coq cleanall 20 | rm -f Makefile.coq Makefile.coq.conf 21 | $(MAKE) -C runtime clean 22 | 23 | distclean: clean 24 | rm -f _CoqProject 25 | 26 | .PHONY: default clean install distclean quick 27 | .PHONY: $(MLPOSITIVE) $(MLTREE) 28 | 29 | .NOTPARALLEL: $(MLPOSITIVE) 30 | .NOTPARALLEL: $(MLTREE) 31 | -------------------------------------------------------------------------------- /cheerios-runtime.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/uwplse/cheerios" 6 | dev-repo: "git+https://github.com/uwplse/cheerios.git" 7 | bug-reports: "https://github.com/uwplse/cheerios/issues" 8 | license: "BSD-2-Clause" 9 | synopsis: "Cheerios serialization framework runtime library" 10 | description: """ 11 | OCaml support library for the Coq library Cheerios, 12 | enabling running extracted verified serialization code. 13 | """ 14 | 15 | build: [make "-j%{jobs}%" "-C" "runtime"] 16 | depends: [ 17 | "ocaml" {>= "4.02.3"} 18 | "ocamlbuild" {build} 19 | ] 20 | 21 | authors: [ 22 | "Justin Adsuara" 23 | "Karl Palmskog" 24 | "Keith Simmons" 25 | "James R. Wilcox" 26 | "Doug Woos" 27 | ] 28 | -------------------------------------------------------------------------------- /runtime/coq/ExtractPositiveSerializer.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import ExtractPositiveSerializerDeps. 2 | From Coq Require Import ZArith. 3 | From Coq Require Import ExtrOcamlBasic. 4 | From Coq Require Import ExtrOcamlString. 5 | 6 | Definition positive_serialize : positive -> IOStreamWriter.t := serialize. 7 | 8 | Definition positive_deserialize : ByteListReader.t positive := deserialize. 9 | 10 | Definition positive_serialize_top : positive -> IOStreamWriter.wire := 11 | fun p => serialize_top (serialize p). 12 | 13 | Definition positive_deserialize_top : IOStreamWriter.wire -> option positive := 14 | deserialize_top deserialize. 15 | 16 | Extraction "runtime/test/positive_serializer.ml" positive_serialize positive_deserialize positive_serialize_top positive_deserialize_top. 17 | 18 | 19 | -------------------------------------------------------------------------------- /runtime/coq/ExtractTreeSerializer.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import ExtractTreeSerializerDeps. 2 | From Cheerios Require Import BasicSerializers. 3 | From Coq Require Import ZArith. 4 | From Coq Require Import ExtrOcamlBasic. 5 | From Coq Require Import ExtrOcamlString. 6 | 7 | Definition tree_serialize : tree bool -> IOStreamWriter.t := serialize. 8 | 9 | Definition tree_deserialize : ByteListReader.t (tree bool) := deserialize. 10 | 11 | Definition tree_serialize_top : tree bool -> IOStreamWriter.wire := 12 | fun t => serialize_top (serialize t). 13 | 14 | Definition tree_deserialize_top : IOStreamWriter.wire -> option (tree bool) := 15 | deserialize_top deserialize. 16 | 17 | Extraction "runtime/test/tree_serializer.ml" tree_serialize tree_deserialize tree_serialize_top tree_deserialize_top. 18 | 19 | -------------------------------------------------------------------------------- /runtime/script/remove_module.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | # https://perlmaven.com/how-to-replace-a-string-in-a-file-with-perl 7 | 8 | my $serializer_name = $ARGV[0]; 9 | my $mli_name = $serializer_name . '.mli'; 10 | 11 | my $mli = read_file($mli_name); 12 | $mli =~ s/module.*\n WRITER//g; 13 | $mli =~ s/module.*\n READER//g; 14 | write_file($mli_name, $mli); 15 | exit; 16 | 17 | sub read_file { 18 | my ($filename) = @_; 19 | 20 | open my $in, '<:encoding(UTF-8)', $filename or die "Could not open '$filename' for reading $!"; 21 | local $/ = undef; 22 | my $all = <$in>; 23 | close $in; 24 | 25 | return $all; 26 | } 27 | 28 | sub write_file { 29 | my ($filename, $content) = @_; 30 | 31 | open my $out, '>:encoding(UTF-8)', $filename or die "Could not open '$filename' for writing $!";; 32 | print $out $content; 33 | close $out; 34 | 35 | return; 36 | } 37 | -------------------------------------------------------------------------------- /coq-cheerios.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "palmskog@gmail.com" 3 | version: "dev" 4 | 5 | homepage: "https://github.com/uwplse/cheerios" 6 | dev-repo: "git+https://github.com/uwplse/cheerios.git" 7 | bug-reports: "https://github.com/uwplse/cheerios/issues" 8 | license: "BSD-2-Clause" 9 | 10 | synopsis: "Coq library for verified serialization" 11 | description: """ 12 | A formally verified serialization library for Coq 13 | which defines a typeclass for serializable types and instances 14 | for many standard library types.""" 15 | 16 | build: [make "-j%{jobs}%"] 17 | install: [make "install"] 18 | depends: [ 19 | "coq" {>= "8.14"} 20 | "coq-struct-tact" {= "dev"} 21 | ] 22 | 23 | tags: [ 24 | "category:Computer Science/Data Types and Data Structures" 25 | "keyword:serialization" 26 | "keyword:deserialization" 27 | "logpath:Cheerios" 28 | ] 29 | authors: [ 30 | "Justin Adsuara" 31 | "Karl Palmskog" 32 | "Keith Simmons" 33 | "James R. Wilcox" 34 | "Doug Woos" 35 | ] 36 | -------------------------------------------------------------------------------- /runtime/ocaml/serializer_primitives.mli: -------------------------------------------------------------------------------- 1 | type serializer 2 | type 'a deserializer 3 | type wire = bytes 4 | 5 | type ('s, 'a) fold_state = 6 | | Done of 'a 7 | | More of 's 8 | | Error 9 | 10 | (* serializer *) 11 | val empty : serializer 12 | val putByte : char -> serializer 13 | val append : (unit -> serializer) -> (unit -> serializer) -> serializer 14 | val putInt : int32 -> serializer 15 | val putChars : char list -> serializer 16 | val putBytes : bytes -> serializer 17 | 18 | (* deserializer *) 19 | val getByte : char deserializer 20 | val getInt : int32 deserializer 21 | val bind : 'a deserializer -> ('a -> 'b deserializer) -> 'b deserializer 22 | val ret : 'a -> 'a deserializer 23 | val fail : 'a deserializer 24 | val map : ('a -> 'b) -> 'a deserializer -> 'b deserializer 25 | val fold : (char -> 's -> ('s, 'a) fold_state) -> 's -> 'a deserializer 26 | val getChars : int -> (char list) deserializer 27 | val getBytes : bytes deserializer 28 | 29 | (* wire *) 30 | val wire_wrap : serializer -> wire 31 | val size : wire -> int 32 | val dump : wire -> unit 33 | val deserialize_top : 'a deserializer -> wire -> 'a option 34 | 35 | (* channel *) 36 | val to_channel : serializer -> out_channel -> unit 37 | val from_channel : 'a deserializer -> in_channel -> 'a option 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014-2020, Verdi Team 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 16 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 17 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 18 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 19 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 21 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /.github/workflows/docker-action.yml: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | name: Docker CI 4 | 5 | on: 6 | push: 7 | branches: 8 | - master 9 | pull_request: 10 | branches: 11 | - '**' 12 | 13 | jobs: 14 | build: 15 | # the OS must be GNU/Linux to be able to use the docker-coq-action 16 | runs-on: ubuntu-latest 17 | strategy: 18 | matrix: 19 | image: 20 | - 'coqorg/coq:dev' 21 | - 'coqorg/coq:8.18' 22 | - 'coqorg/coq:8.17' 23 | - 'coqorg/coq:8.16' 24 | - 'coqorg/coq:8.15' 25 | - 'coqorg/coq:8.14' 26 | fail-fast: false 27 | steps: 28 | - uses: actions/checkout@v3 29 | - uses: coq-community/docker-coq-action@v1 30 | with: 31 | opam_file: 'coq-cheerios.opam' 32 | custom_image: ${{ matrix.image }} 33 | before_install: | 34 | startGroup "Setup and print opam config" 35 | opam repo -a --set-default add coq-extra-dev https://coq.inria.fr/opam/extra-dev 36 | opam config list; opam repo list; opam list 37 | endGroup 38 | 39 | 40 | # See also: 41 | # https://github.com/coq-community/docker-coq-action#readme 42 | # https://github.com/erikmd/docker-coq-github-action-demo 43 | -------------------------------------------------------------------------------- /runtime/test/bit_vector_tests.ml: -------------------------------------------------------------------------------- 1 | open Test_utils 2 | 3 | let test_byte_vector (n : int) (f : int -> char) = 4 | let rec loop_write i = 5 | if (i = n) 6 | then Serializer_primitives.empty 7 | else (Serializer_primitives.append 8 | (Serializer_primitives.putByte (f i)) 9 | (loop_write (i + 1))) in 10 | let rec loop_read bytes i = 11 | if not (i = n) 12 | then (assert (Bytes.get bytes i = f i); 13 | loop_read bytes (i + 1)) in 14 | let w = Serializer_primitives.wire_wrap (loop_write 0) in 15 | loop_read w 0 16 | 17 | let main n = 18 | let rec loop i = 19 | if not (i = n) 20 | then (Printf.printf "Writing %d bytes...\n" i; 21 | test_byte_vector i (fun n -> Char.chr (n mod 256)); 22 | loop (i + 1)) in 23 | loop 0 24 | 25 | let test_int n = 26 | let rec loop i = 27 | if i < n 28 | then (test_serialize_deserialize 29 | (Int32.of_int i) 30 | (fun i -> Serializer_primitives.wire_wrap (Serializer_primitives.putInt i)) 31 | (fun w -> match Serializer_primitives.deserialize_top 32 | Serializer_primitives.getInt w with 33 | | Some i -> i 34 | | None -> failwith "Deserialization failed") 35 | (fun _ -> Printf.printf "%d" i); 36 | loop (i + 1)) in 37 | loop 0 38 | 39 | let _ = main 10000; 40 | test_int 10000 41 | -------------------------------------------------------------------------------- /runtime/test/bool_pair.mli: -------------------------------------------------------------------------------- 1 | type __ = Obj.t 2 | 3 | module type SERIALIZER = 4 | sig 5 | type t 6 | 7 | val empty : t 8 | 9 | val append : t -> t -> t 10 | 11 | val putBit : bool -> t 12 | 13 | val unwrap : t -> bool list 14 | end 15 | 16 | module Serializer : 17 | SERIALIZER 18 | 19 | module type DESERIALIZER = 20 | sig 21 | type 'x t 22 | 23 | val getBit : bool t 24 | 25 | val unwrap : 'a1 t -> bool list -> ('a1 * bool list) option 26 | 27 | val bind : 'a1 t -> ('a1 -> 'a2 t) -> 'a2 t 28 | 29 | val ret : 'a1 -> 'a1 t 30 | 31 | val map : ('a1 -> 'a2) -> 'a1 t -> 'a2 t 32 | 33 | val fold : (bool -> 'a1 -> ('a1, 'a2) Serializer_primitives.fold_state) -> 'a1 -> 'a2 t 34 | end 35 | 36 | module Deserializer : 37 | DESERIALIZER 38 | 39 | type 'a serializer = { serialize : ('a -> Serializer.t); deserialize : 'a Deserializer.t } 40 | 41 | val serialize : 'a1 serializer -> 'a1 -> Serializer.t 42 | 43 | val deserialize : 'a1 serializer -> 'a1 Deserializer.t 44 | 45 | val bool_Serializer : bool serializer 46 | 47 | val pair_serialize : 'a1 serializer -> 'a2 serializer -> ('a1 * 'a2) -> Serializer.t 48 | 49 | val pair_deserialize : 'a1 serializer -> 'a2 serializer -> ('a1 * 'a2) Deserializer.t 50 | 51 | val pair_Serializer : 'a1 serializer -> 'a2 serializer -> ('a1 * 'a2) serializer 52 | 53 | val serialize_bool_pair : (bool * bool) -> Serializer.t 54 | 55 | val deserialize_bool_pair : (bool * bool) Deserializer.t 56 | -------------------------------------------------------------------------------- /theories/Core/DeserializerMonad.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import Core Types. 2 | From Coq Require Import List. 3 | Import ListNotations. 4 | 5 | Definition sequence {A B} (df : ByteListReader.t (A -> B)) 6 | (da : ByteListReader.t A) : ByteListReader.t B := 7 | ByteListReader.bind df 8 | (fun f => 9 | (ByteListReader.bind da 10 | (fun a => ByteListReader.ret (f a)))). 11 | 12 | Lemma sequence_rewrite : forall {A B : Type} 13 | (df : ByteListReader.t (A -> B)) 14 | (da : ByteListReader.t A), 15 | sequence df da = 16 | ByteListReader.bind df 17 | (fun f => 18 | (ByteListReader.bind da 19 | (fun a => ByteListReader.ret (f a)))). 20 | Proof. 21 | reflexivity. 22 | Qed. 23 | #[global] 24 | Hint Rewrite @sequence_rewrite : cheerios. 25 | 26 | Module DeserializerNotations. 27 | Notation "m >>= f" := (@ByteListReader.bind _ _ m f) (at level 42, left associativity). 28 | 29 | Notation "x <- c1 ;; c2" := (c1 >>= (fun x => c2)) 30 | (at level 100, c1 at next level, right associativity). 31 | Notation "e1 ;; e2" := (_ <- e1 ;; e2) 32 | (at level 100, right associativity). 33 | 34 | Notation "f <$> x" := (@ByteListReader.map _ _ f x) (at level 42, left associativity). 35 | 36 | Notation "f <*> x" := (@sequence _ _ f x) (at level 42, left associativity). 37 | End DeserializerNotations. 38 | 39 | -------------------------------------------------------------------------------- /runtime/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLBUILD = ocamlbuild -tags safe_string -I ocaml -cflag -g -lflag -g 2 | OCAMLBUILDTEST = $(OCAMLBUILD) -pkg oUnit -I test/tree -I test 3 | 4 | MLPOSITIVE = test/positive_serializer.ml test/positive_serializer.mli 5 | MLTREE = test/tree_serializer.ml test/tree_serializer.mli 6 | 7 | MLFILES = ocaml/bit_vector.ml ocaml/bit_vector.mli ocaml/serializer_primitives.ml ocaml/serializer_primitives.mli 8 | 9 | default: cheerios-runtime 10 | 11 | $(MLPOSITIVE) $(MLTREE): 12 | +$(MAKE) -C .. runtime/$@ 13 | 14 | 15 | # positive 16 | positive_test.native: $(MLPOSITIVE) $(MLFILES) script/remove_module.pl test/positive_test.ml 17 | perl script/remove_module.pl test/positive_serializer 18 | $(OCAMLBUILDTEST) positive_test.native 19 | 20 | positive_bench.native: test/positive_test.ml test/positive_bench.ml 21 | $(OCAMLBUILDTEST) positive_bench.native 22 | 23 | test/positive_bench.dat: positive_bench.native 24 | ./positive_bench.native > test/positive_bench.dat 25 | 26 | positive_bench.pdf: test/positive_bench.dat test/positive.gpi 27 | gnuplot test/positive.gpi > positive_bench.pdf 28 | 29 | # tree 30 | tree_test.native: $(MLTREE) $(MLFILES) script/remove_module.pl test/tree_test.ml 31 | perl script/remove_module.pl test/tree_serializer 32 | $(OCAMLBUILDTEST) tree_test.native 33 | 34 | tree_bench.native: test/tree_test.ml test/tree_bench.ml 35 | $(OCAMLBUILDTEST) tree_bench.native 36 | 37 | test/tree_bench.dat: tree_bench.native 38 | ./tree_bench.native > test/tree_bench.dat 39 | 40 | tree_bench.pdf: test/tree_bench.dat test/tree.gpi 41 | gnuplot test/tree.gpi > tree_bench.pdf 42 | 43 | # misc 44 | 45 | cheerios-runtime: $(MLFILES) ocaml/cheerios_runtime.mllib 46 | $(OCAMLBUILD) cheerios_runtime.cma cheerios_runtime.cmxa cheerios_runtime.cmxs 47 | 48 | test: positive_test.native tree_test.native 49 | ./positive_test.native 50 | ./tree_test.native 51 | 52 | .PHONY: default test clean cheerios-runtime $(MLPOSITIVE) $(MLTREE) 53 | 54 | clean: 55 | ocamlbuild -clean 56 | rm -f *.pdf test/*.dat 57 | 58 | .NOTPARALLEL: $(MLPOSITIVE) 59 | .NOTPARALLEL: $(MLTREE) 60 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Cheerios 2 | 3 | [![Docker CI][docker-action-shield]][docker-action-link] 4 | 5 | [docker-action-shield]: https://github.com/uwplse/cheerios/workflows/Docker%20CI/badge.svg?branch=master 6 | [docker-action-link]: https://github.com/uwplse/cheerios/actions?query=workflow:"Docker%20CI" 7 | 8 | 9 | 10 | 11 | A formally verified serialization library for Coq 12 | which defines a typeclass for serializable types and instances 13 | for many standard library types. 14 | 15 | ## Meta 16 | 17 | - Author(s): 18 | - Justin Adsuara 19 | - Karl Palmskog 20 | - Keith Simmons (initial) 21 | - James R. Wilcox (initial) 22 | - Doug Woos (initial) 23 | - License: [BSD 2-Clause "Simplified" license](LICENSE) 24 | - Compatible Coq versions: 8.14 or later 25 | - Additional dependencies: 26 | - [StructTact](https://github.com/uwplse/StructTact) 27 | - Coq namespace: `Cheerios` 28 | - Related publication(s): none 29 | 30 | ## Building and installation instructions 31 | 32 | The easiest way to build and install the Cheerios Coq library is via [opam](http://opam.ocaml.org/doc/Install.html): 33 | ```shell 34 | opam repo add coq-extra-dev https://coq.inria.fr/opam/extra-dev 35 | opam install coq-cheerios 36 | ``` 37 | 38 | To instead build and install manually, do: 39 | ```shell 40 | git clone https://github.com/uwplse/cheerios.git 41 | cd cheerios 42 | make # or make -j 43 | make install 44 | ``` 45 | 46 | To use serializable types in executable programs, code must be extracted 47 | to OCaml and linked with the Cheerios runtime library. The connection between 48 | the Coq definitions and the runtime library primitives is established in 49 | `ExtractOCamlCheeriosBasic.v` in the `extraction` directory, which must be 50 | imported before extraction of serializable types. 51 | 52 | To build and install the OCaml runtime library: 53 | ```shell 54 | opam pin add cheerios-runtime -k git https://github.com/uwplse/cheerios.git 55 | ``` 56 | 57 | To compile the runtime library manually, go to the `runtime` directory 58 | and run `make` (requires [OCamlbuild](https://github.com/ocaml/ocamlbuild)). 59 | 60 | 61 | -------------------------------------------------------------------------------- /doc/NOTES.md: -------------------------------------------------------------------------------- 1 | Applications of Cheerios 2 | ======================== 3 | 4 | Verdi integration for packet serialization 5 | ------------------------------------------ 6 | 7 | - VST for applying serializers to a Verdi system to produce a serialized system with equivalent guarantees 8 | 9 | - Verified serialization and extraction for the following systems: 10 | 11 | * verdi-lockserv 12 | * verdi-raft 13 | * verdi-aggregation 14 | * ... 15 | 16 | - figure out a way to integrate input/output serialization and communication with clients (via explicit binary interface definitions?) 17 | 18 | * cheerios has a json serializer that should work well with yojson's json type. 19 | * not sure what using another language for clients with verified input/output serialization would look like 20 | * using json/input and json/output conversion functions should work best. 21 | 22 | 23 | - instead of serializing messages to an explicit buffer, instead serialize directly to a TCP socket? 24 | 25 | * avoids having to send the length of the buffer over the socket in the shim 26 | * requires rethinking the interface between Verdi systems and network shims 27 | 28 | File serialization and filesystem interaction 29 | --------------------------------------------- 30 | 31 | - use Cheerios to write data types to persistent storage 32 | 33 | - lift guarantees from POSIX filesystems (http://www.tom-ridge.com/resources/doc/sosp_draft.pdf) or FSCQ (http://css.csail.mit.edu/fscq/) to Cheerios? 34 | 35 | - There are various issues with file consistency in real-world filesystems (https://danluu.com/file-consistency/) 36 | 37 | Verdi network semantics with a persistent store 38 | ----------------------------------------------- 39 | 40 | - develop a Verdi network semantics that captures writing to/from persistent storage 41 | 42 | - integrate Cheerios with system using new network semantics 43 | 44 | - previous work on TransActors may be relevant (http://digitool.rpi.edu:8881/dtl_publish/37/12193.html) 45 | 46 | - Current plan: extend handlers to also capture writes to disk (also requires changes to reboot function?). First, snapshot on every handler call. Then, log message receives/sends. More possibilities: disk reads, omit certain events from log. 47 | -------------------------------------------------------------------------------- /runtime/ocaml/bit_vector.ml: -------------------------------------------------------------------------------- 1 | (* serialize -> truncate unused bytes, add one byte to indicate how many bits of the last byte are padding *) 2 | type node = {bytes : bytes; 3 | mutable next : node option} 4 | 5 | type iterator = {head : node; 6 | mutable node : node; 7 | mutable i : int; 8 | mutable count : int} 9 | 10 | type writer = iterator 11 | type reader = iterator 12 | 13 | exception Out_of_bounds 14 | 15 | let byte_length = 8 16 | 17 | let makeNode n = 18 | {bytes = Bytes.make n (Char.chr 0); 19 | next = None} 20 | 21 | let makeIter node = 22 | {head = node; 23 | node = node; 24 | i = 0; 25 | count = 0} 26 | 27 | let initialLength = 100 28 | 29 | let makeWriter () = 30 | makeIter (makeNode initialLength) 31 | 32 | let insert iter c = 33 | let length = Bytes.length iter.node.bytes in 34 | (if iter.i = length 35 | then (let node' = (makeNode (length * 2)) 36 | in iter.node.next <- Some (node'); 37 | iter.node <- node'; 38 | iter.i <- 0)); 39 | Bytes.set iter.node.bytes iter.i c; 40 | iter.i <- iter.i + 1; 41 | iter.count <- iter.count + 1 42 | 43 | let read iter = 44 | let length = Bytes.length iter.node.bytes 45 | in (if iter.i = length 46 | then match iter.node.next with 47 | | Some node' -> (iter.node <- node'; 48 | iter.i <- 0) 49 | | None -> raise Out_of_bounds); 50 | let c = Bytes.get iter.node.bytes iter.i 51 | in (iter.i <- iter.i + 1; 52 | c) 53 | 54 | let hasNext iter = 55 | iter.i < iter.count 56 | 57 | let pushBack = insert 58 | 59 | let writerToReader (iter : iterator) : reader = 60 | makeIter (iter.head) 61 | 62 | let pop : reader -> char = 63 | read 64 | 65 | let numBytes (w : writer) : int = 66 | w.count 67 | 68 | let writerToBytes (w : writer) = 69 | let iter = makeIter w.head in 70 | let bytes = Bytes.make w.count (Char.chr 0) in 71 | let rec loop i = 72 | if i < w.count 73 | then (Bytes.set bytes i (read iter); 74 | loop (i + 1)) in 75 | loop 0; 76 | bytes 77 | 78 | let bytesToReader (b : bytes) : reader = 79 | makeIter {bytes = b; next = None} 80 | -------------------------------------------------------------------------------- /runtime/test/tree_test.ml: -------------------------------------------------------------------------------- 1 | open Tree_serializer 2 | open Test_utils 3 | 4 | let rec make elem height width = 5 | if height = 0 6 | then Atom elem 7 | else let rec loop n acc = 8 | if n = 0 9 | then acc 10 | else loop (n - 1) (make elem (height - 1) width :: acc) in 11 | Node (loop width []) 12 | 13 | let test_width_top max_height width = 14 | let rec loop i = 15 | if i < max_height 16 | then (test_serialize_deserialize (make false i width) 17 | tree_serialize_top 18 | (fun w -> match tree_deserialize_top w with 19 | | Some p -> p 20 | | None -> failwith "Deserialization failed") 21 | (fun _ -> Printf.printf "height %d, width %d%!" 22 | i width); 23 | loop (i + 1)) in 24 | loop 0 25 | 26 | let test_width_channel max_height width = 27 | let rec loop i = 28 | let out_chan = open_out test_file_path in 29 | let write_out t = 30 | (try Serializer_primitives.to_channel (tree_serialize0 t) out_chan 31 | with Sys_error _ -> failwith "Failed serializing!"); 32 | flush out_chan; close_out out_chan; 33 | open_in test_file_path in 34 | let read_in (in_chan : in_channel) = 35 | let res = Serializer_primitives.from_channel tree_deserialize0 in_chan in 36 | close_in in_chan; 37 | Printf.printf("Closed! "); 38 | match res with 39 | | Some t -> t 40 | | None -> failwith "Deserialization failed" in 41 | if i < max_height 42 | then (test_serialize_deserialize (make false i width) 43 | write_out 44 | read_in 45 | (fun _ -> Printf.printf "height %d, width %d%!" 46 | i width); 47 | loop (i + 1)) in 48 | loop 0 49 | 50 | (* main functions *) 51 | let test_main () = 52 | test_width_channel 15 2; 53 | test_width_channel 10 3; 54 | test_width_channel 10 4; 55 | test_width_channel 8 5 56 | 57 | 58 | 59 | 60 | let bench_main () = 61 | compare_time_loop (fun n -> make false n 2) 62 | 20 1 10 63 | tree_serialize_top 64 | (fun w -> match tree_deserialize_top w with 65 | | Some p -> p 66 | | None -> failwith "Deserialization failed") 67 | 68 | 69 | let avg_time_height (f : 'a tree -> 'b) (h : int) = 70 | let num_tries = 10 in 71 | avg (time_loop (fun n -> make false n 2) h num_tries f) 72 | 73 | let main () = test_main (); 74 | bench_main () 75 | 76 | -------------------------------------------------------------------------------- /runtime/test/positive_test.ml: -------------------------------------------------------------------------------- 1 | open Positive_serializer 2 | open Test_utils 3 | 4 | let rec print_positive p = 5 | match p with 6 | | XI p -> Printf.printf "XI "; print_positive p 7 | | XO p -> Printf.printf "XO "; print_positive p 8 | | XH -> Printf.printf "XH" 9 | 10 | let make_positive n = 11 | let rec aux n flag k = 12 | if n = 0 13 | then k XH 14 | else aux (n - 1) (not flag) (if flag 15 | then fun p -> XI (k p) 16 | else fun p -> XO (k p)) in 17 | aux n true (fun p -> p) 18 | 19 | let test_cheerios_top p print = 20 | test_serialize_deserialize p 21 | positive_serialize_top 22 | (fun w -> match positive_deserialize_top w with 23 | | Some p -> p 24 | | None -> failwith "Deserialization failed") 25 | print 26 | 27 | let test_cheerios_channel p print = 28 | let out_chan = open_out test_file_path in 29 | let write_out (p : positive) : in_channel = 30 | Serializer_primitives.to_channel (positive_serialize p) out_chan; 31 | flush out_chan; close_out out_chan; 32 | open_in test_file_path in 33 | let read_in (in_chan : in_channel) : positive = 34 | let res = Serializer_primitives.from_channel positive_deserialize in_chan in 35 | close_in in_chan; 36 | match res with 37 | | Some p -> p 38 | | None -> failwith "Deserialization failed" in 39 | test_serialize_deserialize p 40 | write_out 41 | read_in 42 | print 43 | 44 | let test_top max = 45 | let rec loop n = 46 | if n < max 47 | then (test_cheerios_top (make_positive n) 48 | (fun _ -> Printf.printf "make_positive %d (vector)%!" n); 49 | loop (n + 1)) 50 | in loop 0 51 | 52 | let test_channel max = 53 | let rec loop n = 54 | if n < max 55 | then (test_cheerios_channel (make_positive n) 56 | (fun _ -> Printf.printf "make_positive %d (file)%!" n); 57 | loop (n + 1)) 58 | in loop 0 59 | 60 | 61 | (* benchmarking *) 62 | let bench_main () = 63 | compare_time_loop make_positive 64 | 200000 20000 100 65 | positive_serialize_top 66 | (fun w -> match positive_deserialize_top w with 67 | | Some p -> p 68 | | None -> failwith "Deserialization failed") 69 | 70 | let space_main () = 71 | let max_length = 200000 in 72 | let rec loop i = 73 | if i < max_length 74 | then (compare_cheerios_marshal_space make_positive (positive_serialize_top) i; 75 | loop (i + 10000)) 76 | in 77 | Printf.printf "height cheerios marshal\n"; 78 | loop 0 79 | -------------------------------------------------------------------------------- /meta.yml: -------------------------------------------------------------------------------- 1 | --- 2 | fullname: Cheerios 3 | shortname: cheerios 4 | opam_name: coq-cheerios 5 | organization: uwplse 6 | community: false 7 | action: true 8 | dune: false 9 | coqdoc: false 10 | 11 | synopsis: Coq library for verified serialization 12 | 13 | description: |- 14 | A formally verified serialization library for Coq 15 | which defines a typeclass for serializable types and instances 16 | for many standard library types. 17 | 18 | authors: 19 | - name: Justin Adsuara 20 | initial: false 21 | - name: Karl Palmskog 22 | initial: false 23 | - name: Keith Simmons 24 | initial: true 25 | - name: James R. Wilcox 26 | initial: true 27 | - name: Doug Woos 28 | initial: true 29 | 30 | maintainers: 31 | - name: Karl Palmskog 32 | nickname: palmskog 33 | 34 | opam-file-maintainer: palmskog@gmail.com 35 | 36 | opam-file-version: dev 37 | 38 | license: 39 | fullname: BSD 2-Clause "Simplified" license 40 | identifier: BSD-2-Clause 41 | 42 | supported_coq_versions: 43 | text: 8.14 or later 44 | opam: '{>= "8.14"}' 45 | 46 | tested_coq_opam_versions: 47 | - version: dev 48 | - version: '8.18' 49 | - version: '8.17' 50 | - version: '8.16' 51 | - version: '8.15' 52 | - version: '8.14' 53 | 54 | dependencies: 55 | - opam: 56 | name: coq-struct-tact 57 | version: '{= "dev"}' 58 | description: |- 59 | [StructTact](https://github.com/uwplse/StructTact) 60 | 61 | ci_extra_dev: true 62 | 63 | namespace: Cheerios 64 | 65 | keywords: 66 | - name: serialization 67 | - name: deserialization 68 | 69 | categories: 70 | - name: Computer Science/Data Types and Data Structures 71 | 72 | build: |- 73 | ## Building and installation instructions 74 | 75 | The easiest way to build and install the Cheerios Coq library is via [opam](http://opam.ocaml.org/doc/Install.html): 76 | ```shell 77 | opam repo add coq-extra-dev https://coq.inria.fr/opam/extra-dev 78 | opam install coq-cheerios 79 | ``` 80 | 81 | To instead build and install manually, do: 82 | ```shell 83 | git clone https://github.com/uwplse/cheerios.git 84 | cd cheerios 85 | make # or make -j 86 | make install 87 | ``` 88 | 89 | To use serializable types in executable programs, code must be extracted 90 | to OCaml and linked with the Cheerios runtime library. The connection between 91 | the Coq definitions and the runtime library primitives is established in 92 | `ExtractOCamlCheeriosBasic.v` in the `extraction` directory, which must be 93 | imported before extraction of serializable types. 94 | 95 | To build and install the OCaml runtime library: 96 | ```shell 97 | opam pin add cheerios-runtime -k git https://github.com/uwplse/cheerios.git 98 | ``` 99 | 100 | To compile the runtime library manually, go to the `runtime` directory 101 | and run `make` (requires [OCamlbuild](https://github.com/ocaml/ocamlbuild)). 102 | --- 103 | -------------------------------------------------------------------------------- /runtime/test/test_utils.ml: -------------------------------------------------------------------------------- 1 | let test_serialize_deserialize (v : 'a) 2 | (serialize : 'a -> 'b) 3 | (deserialize : 'b -> 'a) 4 | (print : 'a -> unit) = 5 | let _ = Printf.printf "Serializing/deserializing "; 6 | print v; 7 | Printf.printf "... " in 8 | let serialized = serialize v in 9 | let v' = deserialize serialized in 10 | (assert (v = v')); Printf.printf "success\n" 11 | 12 | (* benchmarking *) 13 | 14 | let time (f : 'a -> 'b) (a : 'a) : 'b * float = 15 | let start = Sys.time () in 16 | let b = f a in 17 | let stop = Sys.time () 18 | in (b, stop -. start) 19 | 20 | let time_f_g (a : 'a) 21 | (f : 'a -> 'b) 22 | (g: 'b -> 'a) : float * float = 23 | let (b, time_f) = time f a in 24 | let (_, time_g) = time g b in 25 | (time_f, time_g) 26 | 27 | let rec time_loop make size n f = 28 | let rec loop i acc = 29 | if i = n 30 | then acc 31 | else match time f (make size) with 32 | | (_, t) -> (t :: acc) in 33 | loop 0 [] 34 | 35 | let rec time_serialize_deserialize_loop make size n 36 | serialize deserialize = 37 | let rec loop i acc = 38 | if i = n 39 | then acc 40 | else loop (i + 1) 41 | (time_f_g (make size) 42 | serialize 43 | deserialize :: acc) 44 | in loop 0 [] 45 | 46 | let avg l = 47 | (List.fold_left (+.) 0.0 l) /. (float_of_int (List.length l)) 48 | 49 | let marshal_test make n = 50 | let rec loop i = 51 | if i < n 52 | then let bytes = Marshal.to_bytes (make i) [] in 53 | let p = Marshal.from_bytes bytes 0 in 54 | (Printf.printf "testing marshal on make %d...\n" i; 55 | assert (p = make i); 56 | loop (i + 1)) in 57 | loop 0 58 | 59 | let compare_cheerios_marshal_time make size n 60 | serialize deserialize = 61 | let cheerios_results : (float * float) list = 62 | time_serialize_deserialize_loop 63 | make size n 64 | serialize deserialize 65 | in 66 | let marshal_results : (float * float) list = 67 | time_serialize_deserialize_loop 68 | make size n 69 | (fun p -> Marshal.to_bytes p []) 70 | (fun b -> (Marshal.from_bytes b 0)) 71 | in 72 | let cheerios_serialize_avg = avg (List.map fst cheerios_results) in 73 | let marshal_serialize_avg = avg (List.map fst marshal_results) in 74 | let cheerios_deserialize_avg = avg (List.map snd cheerios_results) in 75 | let marshal_deserialize_avg = avg (List.map snd marshal_results) in 76 | Printf.printf "size %d - serialize: cheerios %f, marshal %f" 77 | size cheerios_serialize_avg marshal_serialize_avg; 78 | Printf.printf " || deserialize: cheerios %f, marshal %f\n" 79 | cheerios_deserialize_avg marshal_deserialize_avg 80 | 81 | (* outputs *) 82 | let compare_cheerios_marshal_space make serialize_top size = 83 | let v = make size in 84 | let cheerios_size = 85 | Serializer_primitives.size (serialize_top v) in 86 | let marshal_size = Marshal.total_size (Marshal.to_bytes v []) 0 87 | in Printf.printf "%d %d %d\n" 88 | size cheerios_size marshal_size 89 | 90 | let compare_time_loop make max interval num_tries serialize deserialize = 91 | let rec loop n = 92 | if n < max 93 | then (compare_cheerios_marshal_time 94 | make n num_tries 95 | serialize 96 | deserialize; 97 | loop (n + interval)) in 98 | loop 0 99 | 100 | let test_file_path = "test/test_file" 101 | -------------------------------------------------------------------------------- /runtime/test/bool_pair.ml: -------------------------------------------------------------------------------- 1 | type __ = Obj.t 2 | let __ = let rec f _ = Obj.repr f in Obj.repr f 3 | 4 | module type SERIALIZER = 5 | sig 6 | type t 7 | 8 | val empty : t 9 | 10 | val append : t -> t -> t 11 | 12 | val putBit : bool -> t 13 | 14 | val unwrap : t -> bool list 15 | end 16 | 17 | module Serializer = 18 | struct 19 | type t = Serializer_primitives.serializer 20 | 21 | (** val empty : t **) 22 | 23 | let empty = Serializer_primitives.empty 24 | 25 | (** val putBit : bool -> t **) 26 | 27 | let putBit = Serializer_primitives.putBit 28 | 29 | (** val append : t -> t -> t **) 30 | 31 | let append = Serializer_primitives.append 32 | 33 | (** val unwrap : t -> bool list **) 34 | 35 | let unwrap = Obj.magic 36 | 37 | (** val empty_unwrap : __ **) 38 | 39 | let empty_unwrap = 40 | __ 41 | 42 | (** val putBit_unwrap : __ **) 43 | 44 | let putBit_unwrap = 45 | __ 46 | 47 | (** val append_unwrap : __ **) 48 | 49 | let append_unwrap = 50 | __ 51 | end 52 | 53 | module type DESERIALIZER = 54 | sig 55 | type 'x t 56 | 57 | val getBit : bool t 58 | 59 | val unwrap : 'a1 t -> bool list -> ('a1 * bool list) option 60 | 61 | val bind : 'a1 t -> ('a1 -> 'a2 t) -> 'a2 t 62 | 63 | val ret : 'a1 -> 'a1 t 64 | 65 | val map : ('a1 -> 'a2) -> 'a1 t -> 'a2 t 66 | 67 | val fold : (bool -> 'a1 -> ('a1, 'a2) Serializer_primitives.fold_state) -> 'a1 -> 'a2 t 68 | end 69 | 70 | module Deserializer = 71 | struct 72 | type 'a t = 'a Serializer_primitives.deserializer 73 | 74 | (** val unwrap : 'a1 t -> 'a1 t **) 75 | 76 | let unwrap = Obj.magic 77 | 78 | (** val getBit : bool list -> (bool * bool list) option **) 79 | 80 | let getBit = Serializer_primitives.getBit 81 | 82 | (** val bind : 'a1 t -> ('a1 -> 'a2 t) -> 'a2 t **) 83 | 84 | let bind = Serializer_primitives.bind 85 | 86 | (** val ret : 'a1 -> 'a1 t **) 87 | 88 | let ret = Serializer_primitives.ret 89 | 90 | (** val map : ('a1 -> 'a2) -> 'a1 t -> 'a2 t **) 91 | 92 | let map f d = 93 | bind d (fun a -> ret (f a)) 94 | 95 | (** val getBit_unwrap : __ **) 96 | 97 | let getBit_unwrap = 98 | __ 99 | 100 | (** val bind_unwrap : __ **) 101 | 102 | let bind_unwrap = 103 | __ 104 | 105 | (** val fold : 106 | (bool -> 'a1 -> ('a1, 'a2) Serializer_primitives.fold_state) -> 'a1 -> bool list -> 107 | ('a2 * bool list) option **) 108 | 109 | let rec fold = Serializer_primitives.fold 110 | 111 | (** val ret_unwrap : __ **) 112 | 113 | let ret_unwrap = 114 | __ 115 | 116 | (** val map_unwrap : __ **) 117 | 118 | let map_unwrap = 119 | __ 120 | 121 | (** val fold_unwrap : __ **) 122 | 123 | let fold_unwrap = 124 | __ 125 | end 126 | 127 | type 'a serializer = { serialize : ('a -> Serializer.t); deserialize : 'a Deserializer.t } 128 | 129 | (** val serialize : 'a1 serializer -> 'a1 -> Serializer.t **) 130 | 131 | let serialize x = x.serialize 132 | 133 | (** val deserialize : 'a1 serializer -> 'a1 Deserializer.t **) 134 | 135 | let deserialize x = x.deserialize 136 | 137 | (** val bool_Serializer : bool serializer **) 138 | 139 | let bool_Serializer = 140 | { serialize = Serializer.putBit; deserialize = Deserializer.getBit } 141 | 142 | (** val pair_serialize : 143 | 'a1 serializer -> 'a2 serializer -> ('a1 * 'a2) -> Serializer.t **) 144 | 145 | let pair_serialize sA sB = function 146 | | (a, b) -> Serializer.append (sA.serialize a) (sB.serialize b) 147 | 148 | (** val pair_deserialize : 149 | 'a1 serializer -> 'a2 serializer -> ('a1 * 'a2) Deserializer.t **) 150 | 151 | let pair_deserialize sA sB = 152 | Deserializer.bind sA.deserialize (fun a -> 153 | Deserializer.bind sB.deserialize (fun b -> Deserializer.ret (a, b))) 154 | 155 | (** val pair_Serializer : 'a1 serializer -> 'a2 serializer -> ('a1 * 'a2) serializer **) 156 | 157 | let pair_Serializer sA sB = 158 | { serialize = (pair_serialize sA sB); deserialize = (pair_deserialize sA sB) } 159 | 160 | (** val serialize_bool_pair : (bool * bool) -> Serializer.t **) 161 | 162 | let serialize_bool_pair = 163 | (pair_Serializer bool_Serializer bool_Serializer).serialize 164 | 165 | (** val deserialize_bool_pair : (bool * bool) Deserializer.t **) 166 | 167 | let deserialize_bool_pair = 168 | (pair_Serializer bool_Serializer bool_Serializer).deserialize 169 | -------------------------------------------------------------------------------- /theories/Core/Types.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | Import ListNotations. 3 | 4 | Inductive fold_state S A := 5 | | Done (a : A) 6 | | More (s : S) 7 | | Error. 8 | Arguments Done {_} {_} _. 9 | Arguments More {_} {_} _. 10 | Arguments Error {_} {_}. 11 | 12 | Inductive byte := 13 | | x00 | x01 | x02 | x03 | x04 | x05 | x06 | x07 | x08 | x09 | x0a | x0b | x0c 14 | | x0d | x0e | x0f | x10 | x11 | x12 | x13 | x14 | x15 | x16 | x17 | x18 | x19 15 | | x1a | x1b | x1c | x1d | x1e | x1f | x20 | x21 | x22 | x23 | x24 | x25 | x26 16 | | x27 | x28 | x29 | x2a | x2b | x2c | x2d | x2e | x2f | x30 | x31 | x32 | x33 17 | | x34 | x35 | x36 | x37 | x38 | x39 | x3a | x3b | x3c | x3d | x3e | x3f | x40 18 | | x41 | x42 | x43 | x44 | x45 | x46 | x47 | x48 | x49 | x4a | x4b | x4c | x4d 19 | | x4e | x4f | x50 | x51 | x52 | x53 | x54 | x55 | x56 | x57 | x58 | x59 | x5a 20 | | x5b | x5c | x5d | x5e | x5f | x60 | x61 | x62 | x63 | x64 | x65 | x66 | x67 21 | | x68 | x69 | x6a | x6b | x6c | x6d | x6e | x6f | x70 | x71 | x72 | x73 | x74 22 | | x75 | x76 | x77 | x78 | x79 | x7a | x7b | x7c | x7d | x7e | x7f | x80 | x81 23 | | x82 | x83 | x84 | x85 | x86 | x87 | x88 | x89 | x8a | x8b | x8c | x8d | x8e 24 | | x8f | x90 | x91 | x92 | x93 | x94 | x95 | x96 | x97 | x98 | x99 | x9a | x9b 25 | | x9c | x9d | x9e | x9f | xa0 | xa1 | xa2 | xa3 | xa4 | xa5 | xa6 | xa7 | xa8 26 | | xa9 | xaa | xab | xac | xad | xae | xaf | xb0 | xb1 | xb2 | xb3 | xb4 | xb5 27 | | xb6 | xb7 | xb8 | xb9 | xba | xbb | xbc | xbd | xbe | xbf | xc0 | xc1 | xc2 28 | | xc3 | xc4 | xc5 | xc6 | xc7 | xc8 | xc9 | xca | xcb | xcc | xcd | xce | xcf 29 | | xd0 | xd1 | xd2 | xd3 | xd4 | xd5 | xd6 | xd7 | xd8 | xd9 | xda | xdb | xdc 30 | | xdd | xde | xdf | xe0 | xe1 | xe2 | xe3 | xe4 | xe5 | xe6 | xe7 | xe8 | xe9 31 | | xea | xeb | xec | xed | xee | xef | xf0 | xf1 | xf2 | xf3 | xf4 | xf5 | xf6 32 | | xf7 | xf8 | xf9 | xfa | xfb | xfc | xfd | xfe | xff. 33 | 34 | Module Type WRITER. 35 | Parameter t : Type. 36 | Parameter wire : Type. 37 | Parameter wire_eq_dec : forall w w' : wire, {w = w'}+{w <> w'}. 38 | Parameter out_channel : Type. 39 | Parameter in_channel : Type. 40 | 41 | Parameter empty : t. 42 | Parameter append : (unit -> t) -> (unit -> t) -> t. 43 | Parameter putByte : byte -> t. 44 | 45 | (* For proof only! Do not call from serializers. *) 46 | Parameter unwrap : t -> list byte. 47 | Parameter wire_wrap : t -> wire. 48 | Parameter wire_unwrap : wire -> list byte. 49 | 50 | Parameter out_channel_wrap : t -> out_channel. 51 | Parameter channel_send : out_channel -> in_channel. 52 | Parameter in_channel_unwrap : in_channel -> list byte. 53 | Parameter channel_wrap_unwrap : forall x, 54 | in_channel_unwrap (channel_send (out_channel_wrap x)) = unwrap x. 55 | 56 | Parameter empty_unwrap : unwrap empty = []. 57 | Parameter append_unwrap : 58 | forall x y : unit -> t, 59 | unwrap (append x y) = unwrap (x tt) ++ unwrap (y tt). 60 | Parameter putByte_unwrap : forall (a : byte), unwrap (putByte a) = [a]. 61 | Parameter wire_wrap_unwrap : forall x, wire_unwrap (wire_wrap x) = unwrap x. 62 | End WRITER. 63 | 64 | Module Type READER. 65 | Parameter t : Type -> Type. 66 | 67 | Parameter getByte : t byte. 68 | Parameter unwrap : forall {A}, t A -> list byte -> option (A * list byte). 69 | 70 | Parameter getByte_unwrap : forall l, 71 | unwrap getByte l = match l with 72 | | [] => None 73 | | a :: l => Some (a, l) 74 | end. 75 | 76 | Parameter bind : forall {A B}, t A -> (A -> t B) -> t B. 77 | Parameter ret : forall {A}, A -> t A. 78 | Parameter map : forall {A B}, (A -> B) -> t A -> t B. 79 | Parameter error : forall {A}, t A. 80 | 81 | Parameter fold : forall {S A}, 82 | (byte -> S -> fold_state S A) -> S -> t A. 83 | 84 | Parameter bind_unwrap : forall A B (m : t A) 85 | (f : A -> t B) bytes, 86 | unwrap (bind m f) bytes = match unwrap m bytes with 87 | | None => None 88 | | Some (v, bytes) => unwrap (f v) bytes 89 | end. 90 | Parameter ret_unwrap : forall A (x: A) bytes, unwrap (ret x) bytes = Some (x, bytes). 91 | 92 | Parameter map_unwrap: forall A B (f: A -> B) (d: t A) bin, 93 | unwrap (map f d) bin = 94 | match (unwrap d bin) with 95 | | None => None 96 | | Some (v, bin) => Some (f v, bin) 97 | end. 98 | 99 | Parameter fold_unwrap : forall {S A : Type} 100 | (f : byte -> S -> fold_state S A) (s : S) l, 101 | unwrap (fold f s) l = 102 | match l with 103 | | [] => None 104 | | b :: l => match f b s with 105 | | Done a => Some (a, l) 106 | | More s => unwrap (fold f s) l 107 | | Error => None 108 | end 109 | end. 110 | End READER. 111 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlCheeriosBasic.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import Cheerios. 2 | From Coq Require Extraction. 3 | 4 | Extract Constant ByteListReader.t "'a" => "Serializer_primitives.deserializer". 5 | Extraction Inline ByteListReader.t. 6 | 7 | Extract Inductive fold_state => "Serializer_primitives.fold_state" 8 | ["Serializer_primitives.Done" 9 | "Serializer_primitives.More" 10 | "Serializer_primitives.Error"]. 11 | 12 | Extract Inductive byte => 13 | "char" 14 | ["'\000'" "'\001'" "'\002'" "'\003'" "'\004'" "'\005'" "'\006'" "'\007'" "'\008'" "'\009'" "'\010'" "'\011'" "'\012'" "'\013'" "'\014'" "'\015'" "'\016'" "'\017'" "'\018'" "'\019'" "'\020'" "'\021'" "'\022'" "'\023'" "'\024'" "'\025'" "'\026'" "'\027'" "'\028'" "'\029'" "'\030'" "'\031'" "'\032'" "'\033'" "'\034'" "'\035'" "'\036'" "'\037'" "'\038'" "'\039'" "'\040'" "'\041'" "'\042'" "'\043'" "'\044'" "'\045'" "'\046'" "'\047'" "'\048'" "'\049'" "'\050'" "'\051'" "'\052'" "'\053'" "'\054'" "'\055'" "'\056'" "'\057'" "'\058'" "'\059'" "'\060'" "'\061'" "'\062'" "'\063'" "'\064'" "'\065'" "'\066'" "'\067'" "'\068'" "'\069'" "'\070'" "'\071'" "'\072'" "'\073'" "'\074'" "'\075'" "'\076'" "'\077'" "'\078'" "'\079'" "'\080'" "'\081'" "'\082'" "'\083'" "'\084'" "'\085'" "'\086'" "'\087'" "'\088'" "'\089'" "'\090'" "'\091'" "'\092'" "'\093'" "'\094'" "'\095'" "'\096'" "'\097'" "'\098'" "'\099'" "'\100'" "'\101'" "'\102'" "'\103'" "'\104'" "'\105'" "'\106'" "'\107'" "'\108'" "'\109'" "'\110'" "'\111'" "'\112'" "'\113'" "'\114'" "'\115'" "'\116'" "'\117'" "'\118'" "'\119'" "'\120'" "'\121'" "'\122'" "'\123'" "'\124'" "'\125'" "'\126'" "'\127'" "'\128'" "'\129'" "'\130'" "'\131'" "'\132'" "'\133'" "'\134'" "'\135'" "'\136'" "'\137'" "'\138'" "'\139'" "'\140'" "'\141'" "'\142'" "'\143'" "'\144'" "'\145'" "'\146'" "'\147'" "'\148'" "'\149'" "'\150'" "'\151'" "'\152'" "'\153'" "'\154'" "'\155'" "'\156'" "'\157'" "'\158'" "'\159'" "'\160'" "'\161'" "'\162'" "'\163'" "'\164'" "'\165'" "'\166'" "'\167'" "'\168'" "'\169'" "'\170'" "'\171'" "'\172'" "'\173'" "'\174'" "'\175'" "'\176'" "'\177'" "'\178'" "'\179'" "'\180'" "'\181'" "'\182'" "'\183'" "'\184'" "'\185'" "'\186'" "'\187'" "'\188'" "'\189'" "'\190'" "'\191'" "'\192'" "'\193'" "'\194'" "'\195'" "'\196'" "'\197'" "'\198'" "'\199'" "'\200'" "'\201'" "'\202'" "'\203'" "'\204'" "'\205'" "'\206'" "'\207'" "'\208'" "'\209'" "'\210'" "'\211'" "'\212'" "'\213'" "'\214'" "'\215'" "'\216'" "'\217'" "'\218'" "'\219'" "'\220'" "'\221'" "'\222'" "'\223'" "'\224'" "'\225'" "'\226'" "'\227'" "'\228'" "'\229'" "'\230'" "'\231'" "'\232'" "'\233'" "'\234'" "'\235'" "'\236'" "'\237'" "'\238'" "'\239'" "'\240'" "'\241'" "'\242'" "'\243'" "'\244'" "'\245'" "'\246'" "'\247'" "'\248'" "'\249'" "'\250'" "'\251'" "'\252'" "'\253'" "'\254'" "'\255'" ]. 15 | 16 | (* IOStreamWriter *) 17 | Extract Inlined Constant IOStreamWriter.t => "Serializer_primitives.serializer". 18 | Extract Inlined Constant IOStreamWriter.wire => "Serializer_primitives.wire". 19 | 20 | Extract Inlined Constant IOStreamWriter.putByte => "Serializer_primitives.putByte". 21 | Extract Inlined Constant IOStreamWriter.empty => "Serializer_primitives.empty". 22 | Extract Inlined Constant IOStreamWriter.append => "Serializer_primitives.append". 23 | Extract Inlined Constant IOStreamWriter.wire_wrap => "Serializer_primitives.wire_wrap". 24 | Extract Inlined Constant IOStreamWriter.wire_eq_dec => "(=)". 25 | 26 | Extract Inlined Constant IOStreamWriter.empty_unwrap => "__". 27 | Extract Inlined Constant IOStreamWriter.putByte_unwrap => "__". 28 | Extract Inlined Constant IOStreamWriter.append_unwrap => "__". 29 | Extract Inlined Constant IOStreamWriter.wire_wrap_unwrap => "__". 30 | 31 | Extract Inlined Constant IOStreamWriter.unwrap => "Obj.magic". 32 | Extract Inlined Constant IOStreamWriter.wire_unwrap => "Obj.magic". 33 | 34 | Extract Inlined Constant IOStreamWriter.in_channel => "in_channel". 35 | 36 | (* ByteListReader *) 37 | Extract Inlined Constant ByteListReader.getByte => "Serializer_primitives.getByte". 38 | Extract Inlined Constant ByteListReader.bind => "Serializer_primitives.bind". 39 | Extract Inlined Constant ByteListReader.error => "Serializer_primitives.fail". 40 | Extract Inlined Constant ByteListReader.map => "Serializer_primitives.map". 41 | Extract Inlined Constant ByteListReader.ret => "Serializer_primitives.ret". 42 | Extract Inlined Constant ByteListReader.fold => "Serializer_primitives.fold". 43 | 44 | Extract Inlined Constant ByteListReader.getByte_unwrap => "__". 45 | Extract Inlined Constant ByteListReader.bind_unwrap => "__". 46 | Extract Inlined Constant ByteListReader.ret_unwrap => "__". 47 | Extract Inlined Constant ByteListReader.map_unwrap => "__". 48 | Extract Inlined Constant ByteListReader.fold_unwrap => "__". 49 | 50 | Extract Inlined Constant ByteListReader.unwrap => "Obj.magic". 51 | 52 | Extract Inlined Constant wire_serialize => "Serializer_primitives.putBytes". 53 | Extract Inlined Constant wire_deserialize => "Serializer_primitives.getBytes". 54 | Extract Inlined Constant deserialize_top => "Serializer_primitives.deserialize_top". 55 | 56 | Extract Inlined Constant to_channel => "Serializer_primitives.from_channel". 57 | Extract Inlined Constant from_channel => "Serializer_primitives.from_channel". 58 | -------------------------------------------------------------------------------- /runtime/ocaml/serializer_primitives.ml: -------------------------------------------------------------------------------- 1 | type iostream = 2 | | Empty 3 | | WriteByte of char 4 | | Seq of (unit -> iostream) * (unit -> iostream) 5 | 6 | type byte_source = 7 | | Vector of Bit_vector.reader 8 | | Channel of in_channel 9 | 10 | type serializer = iostream 11 | type 'a deserializer = byte_source -> 'a 12 | 13 | type wire = bytes 14 | 15 | exception Serialization_error of string 16 | 17 | (* serializer *) 18 | 19 | let empty : serializer = 20 | Empty 21 | 22 | let putByte (b : char) : serializer = 23 | WriteByte b 24 | 25 | let append (s1 : unit -> serializer) (s2 : unit -> serializer) : serializer = 26 | Seq (s1, s2) 27 | 28 | let putInt (i : int32) : serializer = 29 | let aux n = putByte (Char.chr ((Int32.to_int i lsr n) land 0xff)) 30 | in append (fun () -> (aux 24)) 31 | (fun () -> (append (fun () -> (aux 16)) 32 | (fun () -> (append (fun () -> (aux 8)) 33 | (fun () -> (aux 0)))))) 34 | 35 | let putFloat (f : float) = 36 | putInt (Int32.bits_of_float f) 37 | 38 | let rec putChars (s : char list) : serializer = 39 | match s with 40 | | [] -> empty 41 | | c :: s -> append (fun () -> putByte c) (fun () -> putChars s) 42 | 43 | let rec putBytes (b : bytes) : serializer = 44 | let b = Bytes.copy b in 45 | let rec aux n = 46 | if n = Bytes.length b 47 | then empty 48 | else append (fun () -> putByte (Bytes.get b n)) 49 | (fun () -> aux (n + 1)) in 50 | append (fun () -> putInt (Int32.of_int (Bytes.length b))) 51 | (fun () -> aux 0) 52 | 53 | (* deserializer *) 54 | 55 | let getByte : char deserializer = 56 | fun src -> match src with 57 | | Vector r -> 58 | (try Bit_vector.pop r 59 | with Bit_vector.Out_of_bounds -> raise (Serialization_error "end of vector")) 60 | | Channel channel -> 61 | (try input_char channel 62 | with End_of_file -> raise (Serialization_error "end of file")) 63 | 64 | let bind (d : 'a deserializer) (f : 'a -> 'b deserializer) : 'b deserializer = 65 | fun r -> let v = d r in (f v) r 66 | 67 | let ret (v : 'a) : 'a deserializer = 68 | fun r -> v 69 | 70 | let getInt : int32 deserializer = 71 | let aux b n = Char.code b lsl n in 72 | bind getByte (fun b1 -> 73 | bind getByte (fun b2 -> 74 | bind getByte (fun b3 -> 75 | bind getByte (fun b4 -> 76 | let i = (aux b1 24) lor 77 | (aux b2 16) lor 78 | (aux b3 8) lor 79 | (aux b4 0) in 80 | ret (Int32.of_int i))))) 81 | 82 | let fail : 'a deserializer = 83 | fun r -> raise (Serialization_error "deserialization failed") 84 | 85 | type ('s, 'a) fold_state = 86 | | Done of 'a 87 | | More of 's 88 | | Error 89 | 90 | let map (f : 'a -> 'b) (d : 'a deserializer) : 'b deserializer = 91 | bind d (fun a -> ret (f a)) 92 | 93 | let rec fold (f : char -> 's -> ('s, 'a) fold_state) 94 | (s : 's) : 'a deserializer = 95 | fun r -> let b = getByte r 96 | in match f b s with 97 | | Done a -> a 98 | | More s -> fold f s r 99 | | Error -> raise (Serialization_error "fold deserialization error") 100 | 101 | let getFloat = 102 | map Int32.float_of_bits getInt 103 | 104 | let getChars (n : int) : (char list) deserializer = 105 | if n = 0 106 | then ret [] 107 | else let step c (n, acc) = 108 | let acc' = c :: acc 109 | in if n = 0 110 | then Done (List.rev acc') 111 | else More (n - 1, acc') 112 | in fold step (n - 1, []) 113 | 114 | let getBytes : bytes deserializer = 115 | bind getInt 116 | (fun i -> let i = Int32.to_int i in 117 | if i = 0 118 | then ret Bytes.empty 119 | else let buf = Bytes.make i (Char.chr 0) in 120 | let step b n = 121 | Bytes.set buf n b; 122 | if n + 1 = i 123 | then Done buf 124 | else More (n + 1) in 125 | fold step 0) 126 | 127 | (* wire *) 128 | 129 | let rec to_vector (s : serializer) = 130 | fun w -> match s with 131 | | Empty -> () 132 | | WriteByte b -> Bit_vector.pushBack w b 133 | | Seq (t1, t2) -> (to_vector (t1 ()) w; 134 | to_vector (t2 ()) w) 135 | 136 | let wire_wrap (s : serializer) : wire = 137 | let w = Bit_vector.makeWriter () in 138 | (to_vector s w; 139 | Bit_vector.writerToBytes w) 140 | 141 | let size : wire -> int = 142 | Bytes.length 143 | 144 | let deserialize_top (d : 'a deserializer) (w : wire) : 'a option = 145 | try let r = Bit_vector.bytesToReader w in 146 | let v = d (Vector r) in 147 | if Bit_vector.hasNext r 148 | then None 149 | else Some v 150 | with Serialization_error _ -> None 151 | 152 | (* channel *) 153 | 154 | let rec to_channel (s : serializer) = 155 | fun out -> match s with 156 | | Empty -> () 157 | | WriteByte b -> output_char out b 158 | | Seq (t1, t2) -> (to_channel (t1 ()) out; 159 | to_channel (t2 ()) out) 160 | 161 | let from_channel (d : 'a deserializer) : in_channel -> 'a option = 162 | fun channel -> try Some (d (Channel channel)) 163 | with Serialization_error _ -> None 164 | 165 | (* debug *) 166 | let dump (w : wire) : unit = 167 | let rec loop i = 168 | if i < Bytes.length w 169 | then (Printf.printf "%x %!" (Char.code (Bytes.get w i)); 170 | loop (i + 1)) in 171 | loop 0; Printf.printf "\n%!" 172 | -------------------------------------------------------------------------------- /theories/Core/Core.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import Ascii List ZArith. 2 | From Cheerios Require Import Types. 3 | From Cheerios Require Import ByteDecidable. 4 | 5 | Import ListNotations. 6 | 7 | Set Implicit Arguments. 8 | 9 | Module IOStreamWriter : WRITER. 10 | Inductive iostream := 11 | | Empty : iostream 12 | | WriteByte : byte -> iostream 13 | | Seq : iostream -> (unit -> iostream) -> iostream. 14 | 15 | Definition t := iostream. 16 | 17 | Fixpoint iostreamDenote (i : iostream) : list byte := 18 | match i with 19 | | Empty => [] 20 | | WriteByte b => [b] 21 | | Seq i1 i2 => iostreamDenote i1 ++ iostreamDenote (i2 tt) 22 | end. 23 | 24 | Definition unwrap := iostreamDenote. 25 | 26 | (* serializers *) 27 | Definition empty : iostream := Empty. 28 | 29 | Definition putByte : byte -> iostream := 30 | WriteByte. 31 | 32 | Definition append : (unit -> iostream) -> (unit -> iostream) -> iostream := 33 | fun t1 t2 => Seq (t1 tt) t2. 34 | 35 | Lemma empty_unwrap : unwrap empty = []. 36 | Proof. reflexivity. Qed. 37 | 38 | Lemma append_unwrap : 39 | forall x y : unit -> t, unwrap (append x y) = unwrap (x tt) ++ unwrap (y tt). 40 | Proof. reflexivity. Qed. 41 | 42 | Lemma putByte_unwrap : forall (a : byte), unwrap (putByte a) = [a]. 43 | Proof. reflexivity. Qed. 44 | 45 | (* wire *) 46 | Definition wire := list byte. 47 | 48 | Definition wire_eq_dec := list_eq_dec byte_eq_dec. 49 | 50 | Definition wire_wrap := unwrap. 51 | 52 | Definition wire_unwrap (x : wire) := x. 53 | 54 | Lemma wire_wrap_unwrap : forall x, wire_unwrap (wire_wrap x) = unwrap x. 55 | Proof. reflexivity. Qed. 56 | 57 | (* channel *) 58 | Definition out_channel := list byte. 59 | Definition in_channel := list byte. 60 | 61 | Definition out_channel_wrap s := unwrap s. 62 | Definition channel_send (o : out_channel) : in_channel := o. 63 | Definition in_channel_unwrap (i : in_channel) : list byte := i. 64 | 65 | Theorem channel_wrap_unwrap : forall x, 66 | in_channel_unwrap (channel_send (out_channel_wrap x)) = unwrap x. 67 | Proof. 68 | reflexivity. 69 | Qed. 70 | End IOStreamWriter. 71 | 72 | Notation "a +$+ b" := (IOStreamWriter.append (fun _ => a) (fun _ => b)) 73 | (at level 60, right associativity). 74 | 75 | (* This is the monad used to write deserializers. It is a state monad with 76 | failure, where the state is the serialized bits. *) 77 | 78 | Module ByteListReader : READER. 79 | Definition t (A : Type) := list byte -> option (A * list byte). 80 | Definition unwrap {A} (x : t A) := x. 81 | 82 | Definition getByte (l : list byte) := 83 | match l with 84 | | [] => None 85 | | b :: l => Some (b, l) 86 | end. 87 | 88 | Definition ret {A} (a : A) : t A := fun s => Some (a, s). 89 | 90 | Definition bind {A B} (m : t A) (f : A -> t B) : t B := 91 | fun s => match m s with None => None 92 | | Some (a, s') => f a s' 93 | end. 94 | 95 | Definition map {A B} (f : A -> B) (d : t A) : t B := 96 | bind d (fun a => ret (f a)). 97 | 98 | Definition error {A} : t A := 99 | fun l => None. 100 | 101 | Lemma getByte_unwrap : forall l, 102 | unwrap getByte l = match l with 103 | | [] => None 104 | | b :: l => Some (b, l) 105 | end. 106 | Proof. reflexivity. Qed. 107 | 108 | Lemma bind_unwrap : forall A B (m : t A) 109 | (f : A -> t B) bytes, 110 | unwrap (bind m f) bytes = match unwrap m bytes with 111 | | None => None 112 | | Some (v, bytes) => unwrap (f v) bytes 113 | end. 114 | Proof. 115 | unfold bind. 116 | intros. 117 | reflexivity. 118 | Qed. 119 | 120 | Fixpoint fold {S A} 121 | (f : byte -> S -> fold_state S A) (s : S) (l : list byte) := 122 | match l with 123 | | [] => None 124 | | b :: l => match f b s with 125 | | Done a => Some (a, l) 126 | | More s => fold f s l 127 | | Error => None 128 | end 129 | end. 130 | 131 | Lemma ret_unwrap : forall {A} (x: A) bytes, unwrap (ret x) bytes = Some (x, bytes). 132 | Proof. reflexivity. Qed. 133 | 134 | Lemma map_unwrap: forall A B (f: A -> B) (d: t A) bytes, 135 | unwrap (map f d) bytes = 136 | match (unwrap d bytes) with 137 | | None => None 138 | | Some (v, bytes) => Some (f v, bytes) 139 | end. 140 | Proof. reflexivity. Qed. 141 | 142 | Lemma fold_unwrap : forall {S A : Type} 143 | (f : byte -> S -> fold_state S A) (s : S) l, 144 | unwrap (fold f s) l = 145 | match l with 146 | | [] => None 147 | | b :: l => match f b s with 148 | | Done a => Some (a, l) 149 | | More s => unwrap (fold f s) l 150 | | Error => None 151 | end 152 | end. 153 | Proof. 154 | intros. 155 | simpl. destruct l; reflexivity. 156 | Qed. 157 | End ByteListReader. 158 | Arguments ByteListReader.error {_}. 159 | 160 | Notation serialize_deserialize_id_spec s d := 161 | (forall a bytes, 162 | ByteListReader.unwrap d (IOStreamWriter.unwrap (s a) ++ bytes) = Some(a, bytes)). 163 | 164 | (* This is the class of serializable types, which is the main entrypoint to 165 | Cheerios. Instances are required to show that `deserialize` can correctly 166 | recognize a piece of `serialize`d data at the prefix of an arbitrary 167 | bitstream. *) 168 | Class Serializer (A : Type) : Type := 169 | { 170 | serialize : A -> IOStreamWriter.t; 171 | deserialize : ByteListReader.t A; 172 | serialize_deserialize_id : serialize_deserialize_id_spec serialize deserialize 173 | }. 174 | #[global] 175 | Hint Rewrite @serialize_deserialize_id : cheerios. 176 | 177 | (* In particular, if there is nothing else in the bitsream, then deserialize and 178 | serialize are inverses. *) 179 | Lemma serialize_deserialize_id_nil : 180 | forall A (sA : Serializer A) a, 181 | ByteListReader.unwrap deserialize (IOStreamWriter.unwrap (serialize a)) = Some (a, []). 182 | Proof. 183 | intros. 184 | pose proof serialize_deserialize_id a []. 185 | now rewrite app_nil_r in *. 186 | Qed. 187 | 188 | (* top-level interface for wire type *) 189 | 190 | Definition serialize_top (s : IOStreamWriter.t) : IOStreamWriter.wire := 191 | IOStreamWriter.wire_wrap s. 192 | 193 | Definition deserialize_top {A: Type} 194 | (d : ByteListReader.t A) (w : IOStreamWriter.wire) : option A := 195 | match ByteListReader.unwrap d (IOStreamWriter.wire_unwrap w) with 196 | | Some (a, []) => Some a 197 | | _ => None 198 | end. 199 | 200 | Lemma serialize_deserialize_top_id' : forall {A} (d : ByteListReader.t A) s v, 201 | ByteListReader.unwrap d (IOStreamWriter.unwrap s) = Some (v, []) -> 202 | deserialize_top d (serialize_top s) = Some v. 203 | Proof. 204 | intros. 205 | unfold serialize_top, deserialize_top. 206 | rewrite IOStreamWriter.wire_wrap_unwrap, H. 207 | reflexivity. 208 | Qed. 209 | 210 | Lemma serialize_deserialize_top_invert : forall {A} (d : ByteListReader.t A) s v, 211 | deserialize_top d (serialize_top s) = Some v -> 212 | ByteListReader.unwrap d (IOStreamWriter.unwrap s) = Some (v, []). 213 | 214 | Proof. 215 | intros. 216 | unfold serialize_top, deserialize_top. 217 | rewrite <-IOStreamWriter.wire_wrap_unwrap. 218 | unfold deserialize_top, serialize_top in H. 219 | destruct (ByteListReader.unwrap d (IOStreamWriter.wire_unwrap (IOStreamWriter.wire_wrap s))). 220 | - destruct p. 221 | destruct l; 222 | inversion H. 223 | reflexivity. 224 | - inversion H. 225 | Qed. 226 | 227 | Theorem serialize_deserialize_top_id : forall {A : Type} {sA: Serializer A} a, 228 | deserialize_top deserialize (serialize_top (serialize a)) = Some a. 229 | Proof. 230 | intros. 231 | apply serialize_deserialize_top_id'. 232 | apply serialize_deserialize_id_nil. 233 | Qed. 234 | 235 | Axiom wire_serialize : IOStreamWriter.wire -> IOStreamWriter.t. 236 | Axiom wire_deserialize : ByteListReader.t IOStreamWriter.wire. 237 | Axiom wire_serialize_deserialize_id : 238 | serialize_deserialize_id_spec wire_serialize wire_deserialize. 239 | 240 | #[global] 241 | Instance wire_Serializer : Serializer IOStreamWriter.wire. 242 | Proof. 243 | exact {| serialize := wire_serialize; 244 | deserialize := wire_deserialize; 245 | serialize_deserialize_id := wire_serialize_deserialize_id |}. 246 | Qed. 247 | 248 | (* top-level interface for output and input channels *) 249 | 250 | Definition to_channel : IOStreamWriter.t -> IOStreamWriter.out_channel := 251 | IOStreamWriter.out_channel_wrap. 252 | 253 | Definition from_channel {A} (d : ByteListReader.t A) (i : IOStreamWriter.in_channel) := 254 | match ByteListReader.unwrap d (IOStreamWriter.in_channel_unwrap i) with 255 | | Some (a, []) => Some a 256 | | _ => None 257 | end. 258 | 259 | Theorem serialize_deserialize_channel_id : forall {A} {sA : Serializer A} a, 260 | from_channel deserialize (IOStreamWriter.channel_send (to_channel (serialize a))) = Some a. 261 | Proof. 262 | intros. 263 | unfold to_channel, from_channel. 264 | rewrite IOStreamWriter.channel_wrap_unwrap. 265 | rewrite serialize_deserialize_id_nil. 266 | reflexivity. 267 | Qed. 268 | -------------------------------------------------------------------------------- /theories/Core/Combinators.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | From Coq Require Vector String. 3 | From Cheerios Require Import BasicSerializers. 4 | From Cheerios Require Import Core. 5 | From Cheerios Require Import DeserializerMonad. 6 | From Cheerios Require Import Tactics. 7 | From Cheerios Require Import Types. 8 | From StructTact Require Import StructTactics. 9 | 10 | Import ListNotations. 11 | Import DeserializerNotations. 12 | 13 | (* These functions are either missing obvious implicits, or have 14 | implicit arguments that are not marked "maximally inserted", which 15 | means they cannot easily be used with map or fmap. *) 16 | Arguments Some {_} _. 17 | Arguments cons {_} _ _. 18 | Arguments option_map {_ _} _ _. 19 | Arguments Vector.nil {_}. 20 | Arguments Vector.cons {_} _ {_} _. 21 | 22 | (* This section gives instances for various type constructors, including pairs 23 | and lists. *) 24 | 25 | Section BasicCombinators. 26 | Variables A B : Type. 27 | Variable sA : Serializer A. 28 | Variable sB : Serializer B. 29 | 30 | Definition option_serialize (x : option A) : IOStreamWriter.t := 31 | match x with 32 | | Some a => IOStreamWriter.append (fun _ => serialize true) 33 | (fun _ => serialize a) 34 | | None => serialize false 35 | end. 36 | 37 | Definition option_deserialize : ByteListReader.t (option A) := 38 | b <- deserialize ;; 39 | match b with 40 | | true => Some <$> deserialize 41 | | false => ByteListReader.ret None 42 | end. 43 | 44 | Lemma option_serialize_deserialize_id : 45 | serialize_deserialize_id_spec option_serialize option_deserialize. 46 | Proof using. 47 | intros. 48 | unfold option_serialize, option_deserialize. 49 | destruct a; 50 | repeat (cheerios_crush; simpl). 51 | Qed. 52 | 53 | Global Instance option_Serializer : Serializer (option A). 54 | Proof. 55 | exact {| serialize := option_serialize; 56 | deserialize := option_deserialize; 57 | serialize_deserialize_id := option_serialize_deserialize_id |}. 58 | Qed. 59 | 60 | 61 | Definition pair_serialize (x : A * B) : IOStreamWriter.t := 62 | let (a, b) := x in IOStreamWriter.append (fun _ => serialize a) 63 | (fun _ => serialize b). 64 | 65 | Definition pair_deserialize : ByteListReader.t (A * B) := 66 | a <- deserialize ;; 67 | b <- deserialize ;; 68 | ByteListReader.ret (a, b). 69 | 70 | Lemma pair_serialize_deserialize_id : 71 | serialize_deserialize_id_spec pair_serialize pair_deserialize. 72 | Proof using. 73 | intros. 74 | unfold pair_serialize, pair_deserialize. 75 | destruct a. 76 | cheerios_crush. 77 | Qed. 78 | 79 | Global Instance pair_Serializer : Serializer (A * B). 80 | Proof. 81 | exact {| serialize := pair_serialize; 82 | deserialize := pair_deserialize; 83 | serialize_deserialize_id := pair_serialize_deserialize_id |}. 84 | Qed. 85 | 86 | Definition sum_serialize (x : A + B) : IOStreamWriter.t := 87 | match x with 88 | | inl a => IOStreamWriter.append (fun _ => serialize true) 89 | (fun _ => serialize a) 90 | | inr b => IOStreamWriter.append (fun _ => serialize false) 91 | (fun _ => serialize b) 92 | end. 93 | 94 | Definition sum_deserialize : ByteListReader.t (A + B) := 95 | b <- deserialize ;; 96 | match b with 97 | | true => inl <$> deserialize 98 | | false => inr <$> deserialize 99 | end. 100 | 101 | Lemma sum_serialize_deserialize_id : 102 | serialize_deserialize_id_spec sum_serialize sum_deserialize. 103 | Proof using. 104 | unfold sum_serialize, sum_deserialize. 105 | destruct a; cheerios_crush. 106 | Qed. 107 | 108 | Global Instance sum_Serializer : Serializer (A + B). 109 | Proof. 110 | exact {| serialize := sum_serialize; 111 | deserialize := sum_deserialize; 112 | serialize_deserialize_id := sum_serialize_deserialize_id 113 | |}. 114 | Qed. 115 | 116 | Fixpoint list_serialize_rec (l : list A) : IOStreamWriter.t := 117 | match l with 118 | | [] => IOStreamWriter.empty 119 | | a :: l' => IOStreamWriter.append (fun _ => serialize a) 120 | (fun _ => list_serialize_rec l') 121 | end. 122 | 123 | Definition list_serialize (l : list A) : IOStreamWriter.t := 124 | IOStreamWriter.append (fun _ => serialize (length l)) 125 | (fun _ => list_serialize_rec l). 126 | 127 | Fixpoint list_deserialize_rec (n : nat) : ByteListReader.t (list A) := 128 | match n with 129 | | 0 => ByteListReader.ret [] 130 | | S n' => cons <$> deserialize <*> list_deserialize_rec n' 131 | end. 132 | 133 | Definition list_deserialize : ByteListReader.t (list A) := 134 | deserialize >>= list_deserialize_rec. 135 | 136 | Lemma list_serialize_deserialize_id_rec : 137 | forall l bin, ByteListReader.unwrap (list_deserialize_rec (length l)) 138 | (IOStreamWriter.unwrap (list_serialize_rec l) ++ bin) 139 | = Some(l, bin). 140 | Proof using. 141 | intros. 142 | unfold list_serialize_rec. 143 | cheerios_crush. simpl. 144 | induction l. 145 | - simpl. cheerios_crush. 146 | - simpl. 147 | rewrite sequence_rewrite. 148 | rewrite ByteListReader.bind_unwrap. 149 | rewrite ByteListReader.map_unwrap. 150 | rewrite IOStreamWriter.append_unwrap. 151 | rewrite <- app_assoc. 152 | rewrite serialize_deserialize_id. 153 | rewrite ByteListReader.bind_unwrap. 154 | rewrite IHl. 155 | cheerios_crush. 156 | Qed. 157 | 158 | Lemma serialize_snoc : forall (a : A) l, 159 | (IOStreamWriter.unwrap 160 | (list_serialize_rec (l ++ [a]))) = 161 | (IOStreamWriter.unwrap (list_serialize_rec l) ++ IOStreamWriter.unwrap (serialize a)). 162 | Proof using. 163 | intros. 164 | induction l. 165 | - simpl. cheerios_crush. 166 | rewrite app_nil_r. 167 | reflexivity. 168 | - simpl. 169 | cheerios_crush. 170 | rewrite IHl. 171 | reflexivity. 172 | Qed. 173 | 174 | Lemma list_serialize_deserialize_id : 175 | serialize_deserialize_id_spec list_serialize list_deserialize. 176 | Proof using. 177 | unfold list_serialize, list_deserialize. 178 | cheerios_crush. 179 | now rewrite list_serialize_deserialize_id_rec. 180 | Qed. 181 | 182 | Global Instance list_Serializer : Serializer (list A). 183 | Proof. 184 | exact {| serialize := list_serialize; 185 | deserialize := list_deserialize; 186 | serialize_deserialize_id := list_serialize_deserialize_id 187 | |}. 188 | Qed. 189 | 190 | Fixpoint vector_serialize {n} (v : Vector.t A n) : IOStreamWriter.t := 191 | match v with 192 | | Vector.nil => IOStreamWriter.empty 193 | | Vector.cons a v' => IOStreamWriter.append (fun _ => serialize a) 194 | (fun _ => vector_serialize v') 195 | end. 196 | 197 | Fixpoint vector_deserialize {n} : ByteListReader.t (Vector.t A n) := 198 | match n as n0 return ByteListReader.t (Vector.t A n0) with 199 | | 0 => ByteListReader.ret Vector.nil 200 | | S n' => a <- deserialize ;; 201 | v <- vector_deserialize ;; 202 | ByteListReader.ret (Vector.cons a v) 203 | end. 204 | 205 | Lemma vector_serialize_deserialize_id : 206 | forall n, serialize_deserialize_id_spec vector_serialize (@vector_deserialize n). 207 | Proof using. 208 | induction n; intros. 209 | - destruct a using Vector.case0. auto. unfold vector_serialize, vector_deserialize. 210 | cheerios_crush. 211 | - destruct a using Vector.caseS'. 212 | simpl. 213 | cheerios_crush. 214 | rewrite IHn. 215 | cheerios_crush. 216 | Qed. 217 | 218 | Global Instance vector_Serializer n : Serializer (Vector.t A n). 219 | Proof. 220 | exact {| serialize := vector_serialize; 221 | deserialize := vector_deserialize; 222 | serialize_deserialize_id := vector_serialize_deserialize_id n 223 | |}. 224 | Qed. 225 | End BasicCombinators. 226 | 227 | 228 | (* This has to go here because it depends on having a serializer for 229 | lists available. *) 230 | 231 | Fixpoint string_to_list s := 232 | match s with 233 | | String.EmptyString => nil 234 | | String.String c s' => c :: (string_to_list s') 235 | end. 236 | 237 | Fixpoint list_to_string l := 238 | match l with 239 | | nil => String.EmptyString 240 | | h::l' => String.String h (list_to_string l') 241 | end. 242 | 243 | Lemma string_to_list_to_string : 244 | forall s, list_to_string (string_to_list s) = s. 245 | Proof. 246 | induction s; auto; simpl. 247 | now rewrite IHs. 248 | Qed. 249 | 250 | Definition string_serialize (s : String.string) := 251 | serialize (string_to_list s). 252 | 253 | Definition string_deserialize : ByteListReader.t String.string := 254 | list_to_string <$> deserialize. 255 | 256 | Lemma string_serialize_deserialize_id : 257 | serialize_deserialize_id_spec string_serialize string_deserialize. 258 | Proof. 259 | unfold string_deserialize, string_serialize. 260 | cheerios_crush. 261 | now rewrite string_to_list_to_string. 262 | Qed. 263 | 264 | #[global] 265 | Instance string_Serializer : Serializer String.string. 266 | Proof. 267 | exact {| serialize := string_serialize; 268 | deserialize := string_deserialize; 269 | serialize_deserialize_id := string_serialize_deserialize_id 270 | |}. 271 | Qed. 272 | -------------------------------------------------------------------------------- /theories/Core/ByteDecidable.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import Arith. 2 | From Cheerios Require Import Types. 3 | From StructTact Require Import StructTactics. 4 | 5 | Definition byte_to_nat (b : byte) : nat := 6 | match b with 7 | | x00 => 0 8 | | x01 => 1 9 | | x02 => 2 10 | | x03 => 3 11 | | x04 => 4 12 | | x05 => 5 13 | | x06 => 6 14 | | x07 => 7 15 | | x08 => 8 16 | | x09 => 9 17 | | x0a => 10 18 | | x0b => 11 19 | | x0c => 12 20 | | x0d => 13 21 | | x0e => 14 22 | | x0f => 15 23 | | x10 => 16 24 | | x11 => 17 25 | | x12 => 18 26 | | x13 => 19 27 | | x14 => 20 28 | | x15 => 21 29 | | x16 => 22 30 | | x17 => 23 31 | | x18 => 24 32 | | x19 => 25 33 | | x1a => 26 34 | | x1b => 27 35 | | x1c => 28 36 | | x1d => 29 37 | | x1e => 30 38 | | x1f => 31 39 | | x20 => 32 40 | | x21 => 33 41 | | x22 => 34 42 | | x23 => 35 43 | | x24 => 36 44 | | x25 => 37 45 | | x26 => 38 46 | | x27 => 39 47 | | x28 => 40 48 | | x29 => 41 49 | | x2a => 42 50 | | x2b => 43 51 | | x2c => 44 52 | | x2d => 45 53 | | x2e => 46 54 | | x2f => 47 55 | | x30 => 48 56 | | x31 => 49 57 | | x32 => 50 58 | | x33 => 51 59 | | x34 => 52 60 | | x35 => 53 61 | | x36 => 54 62 | | x37 => 55 63 | | x38 => 56 64 | | x39 => 57 65 | | x3a => 58 66 | | x3b => 59 67 | | x3c => 60 68 | | x3d => 61 69 | | x3e => 62 70 | | x3f => 63 71 | | x40 => 64 72 | | x41 => 65 73 | | x42 => 66 74 | | x43 => 67 75 | | x44 => 68 76 | | x45 => 69 77 | | x46 => 70 78 | | x47 => 71 79 | | x48 => 72 80 | | x49 => 73 81 | | x4a => 74 82 | | x4b => 75 83 | | x4c => 76 84 | | x4d => 77 85 | | x4e => 78 86 | | x4f => 79 87 | | x50 => 80 88 | | x51 => 81 89 | | x52 => 82 90 | | x53 => 83 91 | | x54 => 84 92 | | x55 => 85 93 | | x56 => 86 94 | | x57 => 87 95 | | x58 => 88 96 | | x59 => 89 97 | | x5a => 90 98 | | x5b => 91 99 | | x5c => 92 100 | | x5d => 93 101 | | x5e => 94 102 | | x5f => 95 103 | | x60 => 96 104 | | x61 => 97 105 | | x62 => 98 106 | | x63 => 99 107 | | x64 => 100 108 | | x65 => 101 109 | | x66 => 102 110 | | x67 => 103 111 | | x68 => 104 112 | | x69 => 105 113 | | x6a => 106 114 | | x6b => 107 115 | | x6c => 108 116 | | x6d => 109 117 | | x6e => 110 118 | | x6f => 111 119 | | x70 => 112 120 | | x71 => 113 121 | | x72 => 114 122 | | x73 => 115 123 | | x74 => 116 124 | | x75 => 117 125 | | x76 => 118 126 | | x77 => 119 127 | | x78 => 120 128 | | x79 => 121 129 | | x7a => 122 130 | | x7b => 123 131 | | x7c => 124 132 | | x7d => 125 133 | | x7e => 126 134 | | x7f => 127 135 | | x80 => 128 136 | | x81 => 129 137 | | x82 => 130 138 | | x83 => 131 139 | | x84 => 132 140 | | x85 => 133 141 | | x86 => 134 142 | | x87 => 135 143 | | x88 => 136 144 | | x89 => 137 145 | | x8a => 138 146 | | x8b => 139 147 | | x8c => 140 148 | | x8d => 141 149 | | x8e => 142 150 | | x8f => 143 151 | | x90 => 144 152 | | x91 => 145 153 | | x92 => 146 154 | | x93 => 147 155 | | x94 => 148 156 | | x95 => 149 157 | | x96 => 150 158 | | x97 => 151 159 | | x98 => 152 160 | | x99 => 153 161 | | x9a => 154 162 | | x9b => 155 163 | | x9c => 156 164 | | x9d => 157 165 | | x9e => 158 166 | | x9f => 159 167 | | xa0 => 160 168 | | xa1 => 161 169 | | xa2 => 162 170 | | xa3 => 163 171 | | xa4 => 164 172 | | xa5 => 165 173 | | xa6 => 166 174 | | xa7 => 167 175 | | xa8 => 168 176 | | xa9 => 169 177 | | xaa => 170 178 | | xab => 171 179 | | xac => 172 180 | | xad => 173 181 | | xae => 174 182 | | xaf => 175 183 | | xb0 => 176 184 | | xb1 => 177 185 | | xb2 => 178 186 | | xb3 => 179 187 | | xb4 => 180 188 | | xb5 => 181 189 | | xb6 => 182 190 | | xb7 => 183 191 | | xb8 => 184 192 | | xb9 => 185 193 | | xba => 186 194 | | xbb => 187 195 | | xbc => 188 196 | | xbd => 189 197 | | xbe => 190 198 | | xbf => 191 199 | | xc0 => 192 200 | | xc1 => 193 201 | | xc2 => 194 202 | | xc3 => 195 203 | | xc4 => 196 204 | | xc5 => 197 205 | | xc6 => 198 206 | | xc7 => 199 207 | | xc8 => 200 208 | | xc9 => 201 209 | | xca => 202 210 | | xcb => 203 211 | | xcc => 204 212 | | xcd => 205 213 | | xce => 206 214 | | xcf => 207 215 | | xd0 => 208 216 | | xd1 => 209 217 | | xd2 => 210 218 | | xd3 => 211 219 | | xd4 => 212 220 | | xd5 => 213 221 | | xd6 => 214 222 | | xd7 => 215 223 | | xd8 => 216 224 | | xd9 => 217 225 | | xda => 218 226 | | xdb => 219 227 | | xdc => 220 228 | | xdd => 221 229 | | xde => 222 230 | | xdf => 223 231 | | xe0 => 224 232 | | xe1 => 225 233 | | xe2 => 226 234 | | xe3 => 227 235 | | xe4 => 228 236 | | xe5 => 229 237 | | xe6 => 230 238 | | xe7 => 231 239 | | xe8 => 232 240 | | xe9 => 233 241 | | xea => 234 242 | | xeb => 235 243 | | xec => 236 244 | | xed => 237 245 | | xee => 238 246 | | xef => 239 247 | | xf0 => 240 248 | | xf1 => 241 249 | | xf2 => 242 250 | | xf3 => 243 251 | | xf4 => 244 252 | | xf5 => 245 253 | | xf6 => 246 254 | | xf7 => 247 255 | | xf8 => 248 256 | | xf9 => 249 257 | | xfa => 250 258 | | xfb => 251 259 | | xfc => 252 260 | | xfd => 253 261 | | xfe => 254 262 | | xff => 255 263 | end. 264 | 265 | Definition nat_to_byte (n : nat) : option byte := 266 | match n with 267 | | 0 => Some x00 268 | | 1 => Some x01 269 | | 2 => Some x02 270 | | 3 => Some x03 271 | | 4 => Some x04 272 | | 5 => Some x05 273 | | 6 => Some x06 274 | | 7 => Some x07 275 | | 8 => Some x08 276 | | 9 => Some x09 277 | | 10 => Some x0a 278 | | 11 => Some x0b 279 | | 12 => Some x0c 280 | | 13 => Some x0d 281 | | 14 => Some x0e 282 | | 15 => Some x0f 283 | | 16 => Some x10 284 | | 17 => Some x11 285 | | 18 => Some x12 286 | | 19 => Some x13 287 | | 20 => Some x14 288 | | 21 => Some x15 289 | | 22 => Some x16 290 | | 23 => Some x17 291 | | 24 => Some x18 292 | | 25 => Some x19 293 | | 26 => Some x1a 294 | | 27 => Some x1b 295 | | 28 => Some x1c 296 | | 29 => Some x1d 297 | | 30 => Some x1e 298 | | 31 => Some x1f 299 | | 32 => Some x20 300 | | 33 => Some x21 301 | | 34 => Some x22 302 | | 35 => Some x23 303 | | 36 => Some x24 304 | | 37 => Some x25 305 | | 38 => Some x26 306 | | 39 => Some x27 307 | | 40 => Some x28 308 | | 41 => Some x29 309 | | 42 => Some x2a 310 | | 43 => Some x2b 311 | | 44 => Some x2c 312 | | 45 => Some x2d 313 | | 46 => Some x2e 314 | | 47 => Some x2f 315 | | 48 => Some x30 316 | | 49 => Some x31 317 | | 50 => Some x32 318 | | 51 => Some x33 319 | | 52 => Some x34 320 | | 53 => Some x35 321 | | 54 => Some x36 322 | | 55 => Some x37 323 | | 56 => Some x38 324 | | 57 => Some x39 325 | | 58 => Some x3a 326 | | 59 => Some x3b 327 | | 60 => Some x3c 328 | | 61 => Some x3d 329 | | 62 => Some x3e 330 | | 63 => Some x3f 331 | | 64 => Some x40 332 | | 65 => Some x41 333 | | 66 => Some x42 334 | | 67 => Some x43 335 | | 68 => Some x44 336 | | 69 => Some x45 337 | | 70 => Some x46 338 | | 71 => Some x47 339 | | 72 => Some x48 340 | | 73 => Some x49 341 | | 74 => Some x4a 342 | | 75 => Some x4b 343 | | 76 => Some x4c 344 | | 77 => Some x4d 345 | | 78 => Some x4e 346 | | 79 => Some x4f 347 | | 80 => Some x50 348 | | 81 => Some x51 349 | | 82 => Some x52 350 | | 83 => Some x53 351 | | 84 => Some x54 352 | | 85 => Some x55 353 | | 86 => Some x56 354 | | 87 => Some x57 355 | | 88 => Some x58 356 | | 89 => Some x59 357 | | 90 => Some x5a 358 | | 91 => Some x5b 359 | | 92 => Some x5c 360 | | 93 => Some x5d 361 | | 94 => Some x5e 362 | | 95 => Some x5f 363 | | 96 => Some x60 364 | | 97 => Some x61 365 | | 98 => Some x62 366 | | 99 => Some x63 367 | | 100 => Some x64 368 | | 101 => Some x65 369 | | 102 => Some x66 370 | | 103 => Some x67 371 | | 104 => Some x68 372 | | 105 => Some x69 373 | | 106 => Some x6a 374 | | 107 => Some x6b 375 | | 108 => Some x6c 376 | | 109 => Some x6d 377 | | 110 => Some x6e 378 | | 111 => Some x6f 379 | | 112 => Some x70 380 | | 113 => Some x71 381 | | 114 => Some x72 382 | | 115 => Some x73 383 | | 116 => Some x74 384 | | 117 => Some x75 385 | | 118 => Some x76 386 | | 119 => Some x77 387 | | 120 => Some x78 388 | | 121 => Some x79 389 | | 122 => Some x7a 390 | | 123 => Some x7b 391 | | 124 => Some x7c 392 | | 125 => Some x7d 393 | | 126 => Some x7e 394 | | 127 => Some x7f 395 | | 128 => Some x80 396 | | 129 => Some x81 397 | | 130 => Some x82 398 | | 131 => Some x83 399 | | 132 => Some x84 400 | | 133 => Some x85 401 | | 134 => Some x86 402 | | 135 => Some x87 403 | | 136 => Some x88 404 | | 137 => Some x89 405 | | 138 => Some x8a 406 | | 139 => Some x8b 407 | | 140 => Some x8c 408 | | 141 => Some x8d 409 | | 142 => Some x8e 410 | | 143 => Some x8f 411 | | 144 => Some x90 412 | | 145 => Some x91 413 | | 146 => Some x92 414 | | 147 => Some x93 415 | | 148 => Some x94 416 | | 149 => Some x95 417 | | 150 => Some x96 418 | | 151 => Some x97 419 | | 152 => Some x98 420 | | 153 => Some x99 421 | | 154 => Some x9a 422 | | 155 => Some x9b 423 | | 156 => Some x9c 424 | | 157 => Some x9d 425 | | 158 => Some x9e 426 | | 159 => Some x9f 427 | | 160 => Some xa0 428 | | 161 => Some xa1 429 | | 162 => Some xa2 430 | | 163 => Some xa3 431 | | 164 => Some xa4 432 | | 165 => Some xa5 433 | | 166 => Some xa6 434 | | 167 => Some xa7 435 | | 168 => Some xa8 436 | | 169 => Some xa9 437 | | 170 => Some xaa 438 | | 171 => Some xab 439 | | 172 => Some xac 440 | | 173 => Some xad 441 | | 174 => Some xae 442 | | 175 => Some xaf 443 | | 176 => Some xb0 444 | | 177 => Some xb1 445 | | 178 => Some xb2 446 | | 179 => Some xb3 447 | | 180 => Some xb4 448 | | 181 => Some xb5 449 | | 182 => Some xb6 450 | | 183 => Some xb7 451 | | 184 => Some xb8 452 | | 185 => Some xb9 453 | | 186 => Some xba 454 | | 187 => Some xbb 455 | | 188 => Some xbc 456 | | 189 => Some xbd 457 | | 190 => Some xbe 458 | | 191 => Some xbf 459 | | 192 => Some xc0 460 | | 193 => Some xc1 461 | | 194 => Some xc2 462 | | 195 => Some xc3 463 | | 196 => Some xc4 464 | | 197 => Some xc5 465 | | 198 => Some xc6 466 | | 199 => Some xc7 467 | | 200 => Some xc8 468 | | 201 => Some xc9 469 | | 202 => Some xca 470 | | 203 => Some xcb 471 | | 204 => Some xcc 472 | | 205 => Some xcd 473 | | 206 => Some xce 474 | | 207 => Some xcf 475 | | 208 => Some xd0 476 | | 209 => Some xd1 477 | | 210 => Some xd2 478 | | 211 => Some xd3 479 | | 212 => Some xd4 480 | | 213 => Some xd5 481 | | 214 => Some xd6 482 | | 215 => Some xd7 483 | | 216 => Some xd8 484 | | 217 => Some xd9 485 | | 218 => Some xda 486 | | 219 => Some xdb 487 | | 220 => Some xdc 488 | | 221 => Some xdd 489 | | 222 => Some xde 490 | | 223 => Some xdf 491 | | 224 => Some xe0 492 | | 225 => Some xe1 493 | | 226 => Some xe2 494 | | 227 => Some xe3 495 | | 228 => Some xe4 496 | | 229 => Some xe5 497 | | 230 => Some xe6 498 | | 231 => Some xe7 499 | | 232 => Some xe8 500 | | 233 => Some xe9 501 | | 234 => Some xea 502 | | 235 => Some xeb 503 | | 236 => Some xec 504 | | 237 => Some xed 505 | | 238 => Some xee 506 | | 239 => Some xef 507 | | 240 => Some xf0 508 | | 241 => Some xf1 509 | | 242 => Some xf2 510 | | 243 => Some xf3 511 | | 244 => Some xf4 512 | | 245 => Some xf5 513 | | 246 => Some xf6 514 | | 247 => Some xf7 515 | | 248 => Some xf8 516 | | 249 => Some xf9 517 | | 250 => Some xfa 518 | | 251 => Some xfb 519 | | 252 => Some xfc 520 | | 253 => Some xfd 521 | | 254 => Some xfe 522 | | 255 => Some xff 523 | | _ => None 524 | end. 525 | 526 | Lemma pcancel_byte_nat : forall b : byte, nat_to_byte (byte_to_nat b) = Some b. 527 | Proof. 528 | destruct b; auto. 529 | Qed. 530 | 531 | Definition byte_eq_dec : forall (a b : byte), {a = b} + {a <> b}. 532 | refine 533 | (fun a b => 534 | match Nat.eq_dec (byte_to_nat a) (byte_to_nat b) with 535 | | left H_dec => left _ 536 | | right H_dec => right _ 537 | end). 538 | - pose proof (pcancel_byte_nat a) as H_a. 539 | pose proof (pcancel_byte_nat b) as H_b. 540 | rewrite H_dec in H_a. 541 | rewrite H_a in H_b. 542 | find_injection. 543 | reflexivity. 544 | - intro H_eq. 545 | rewrite H_eq in H_dec. 546 | auto. 547 | Defined. 548 | -------------------------------------------------------------------------------- /theories/Core/BasicSerializers.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List ZArith. 2 | From StructTact Require Import StructTactics Fin. 3 | From Coq Require Fin Ascii. 4 | 5 | From Cheerios Require Import Core. 6 | From Cheerios Require Import DeserializerMonad. 7 | From Cheerios Require Import Tactics. 8 | From Cheerios Require Import Types. 9 | 10 | Import ListNotations. 11 | Import DeserializerNotations. 12 | 13 | Lemma byte_serialize_deserialize_id : 14 | serialize_deserialize_id_spec IOStreamWriter.putByte ByteListReader.getByte. 15 | Proof. cheerios_crush. Qed. 16 | 17 | #[global] 18 | Instance byte_Serializer : Serializer byte := 19 | {| serialize := IOStreamWriter.putByte; 20 | deserialize := ByteListReader.getByte; 21 | serialize_deserialize_id := byte_serialize_deserialize_id |}. 22 | 23 | Lemma byte_unwrap : forall b, IOStreamWriter.unwrap (serialize b) = [b]. 24 | Proof. 25 | cheerios_crush. 26 | Qed. 27 | 28 | #[global] 29 | Hint Rewrite byte_unwrap : cheerios. 30 | 31 | Definition bool_serialize (b : bool) : IOStreamWriter.t := 32 | if b then serialize x01 else serialize x00. 33 | 34 | Definition bool_deserialize := 35 | b <- deserialize ;; 36 | match b with 37 | | x00 => ByteListReader.ret false 38 | | x01 => ByteListReader.ret true 39 | | _ => ByteListReader.error 40 | end. 41 | 42 | Lemma bool_serialize_deserialize_id : 43 | serialize_deserialize_id_spec bool_serialize bool_deserialize. 44 | Proof. 45 | intros. 46 | unfold bool_serialize, bool_deserialize. 47 | destruct a; 48 | cheerios_crush; simpl; cheerios_crush. 49 | Qed. 50 | 51 | #[global] 52 | Instance bool_Serializer : Serializer bool. 53 | Proof. 54 | exact {| serialize := bool_serialize; 55 | deserialize := bool_deserialize; 56 | serialize_deserialize_id := bool_serialize_deserialize_id |}. 57 | Qed. 58 | 59 | (* this needs to go here because we need the bool_Serializer instance *) 60 | Lemma fold_append_unwrap : 61 | forall {S A : Type} 62 | (f : byte -> S -> fold_state S A) (s : S) 63 | (b : byte) (tail : IOStreamWriter.t) (bin : list byte), 64 | ByteListReader.unwrap (ByteListReader.fold f s) 65 | (IOStreamWriter.unwrap (IOStreamWriter.append 66 | (fun _ => (serialize b)) 67 | (fun _ => tail)) ++ bin) = 68 | match f b s with 69 | | Done a => Some(a, IOStreamWriter.unwrap tail ++ bin) 70 | | More s => ByteListReader.unwrap (ByteListReader.fold f s) 71 | (IOStreamWriter.unwrap tail ++ bin) 72 | | Error => None 73 | end. 74 | Proof. 75 | cheerios_crush. 76 | Qed. 77 | 78 | Lemma fold_append_unwrap' : 79 | forall {S A : Type} 80 | (f : byte -> S -> fold_state S A) (s : S) 81 | (b : byte) (tail : IOStreamWriter.t) (bin : list byte), 82 | ByteListReader.unwrap (ByteListReader.fold f s) 83 | (IOStreamWriter.unwrap (IOStreamWriter.append 84 | (fun _ => IOStreamWriter.putByte b) 85 | (fun _ => tail)) ++ bin) = 86 | match f b s with 87 | | Done a => Some(a, IOStreamWriter.unwrap tail ++ bin) 88 | | More s => ByteListReader.unwrap (ByteListReader.fold f s) 89 | (IOStreamWriter.unwrap tail ++ bin) 90 | | Error => None 91 | end. 92 | Proof. 93 | cheerios_crush. 94 | Qed. 95 | #[global] 96 | Hint Rewrite @fold_append_unwrap @fold_append_unwrap' : cheerios. 97 | 98 | 99 | Inductive le_pos (p : positive) : positive -> Prop := 100 | | le_p : le_pos p p 101 | | le_xI : forall p2, le_pos p p2 -> le_pos p (xI p2) 102 | | le_xO : forall p2, le_pos p p2 -> le_pos p (xO p2). 103 | 104 | Section PositiveInductionPrinciple. 105 | Variable P : positive -> Prop. 106 | 107 | Lemma strongind_pos_aux : 108 | P xH -> 109 | (forall q, ((forall p, le_pos p q -> P p) -> P (xI q)) /\ 110 | ((forall p, le_pos p q -> P p) -> P (xO q))) -> 111 | (forall q, (forall p, le_pos p q -> P p)). 112 | Proof using. 113 | induction q; 114 | intros; 115 | inversion H1; 116 | auto; 117 | apply H0; 118 | apply IHq. 119 | Qed. 120 | 121 | Lemma weaken_pos : 122 | (forall q, (forall p, le_pos p q -> P p)) -> forall p, P p. 123 | Proof using. 124 | intros. 125 | apply (H p p). 126 | constructor. 127 | Qed. 128 | 129 | Theorem strongind_pos : 130 | P xH -> 131 | (forall q, ((forall p, le_pos p q -> P p) -> P (xI q)) /\ 132 | ((forall p, le_pos p q -> P p) -> P (xO q))) -> 133 | forall p, P p. 134 | Proof using. 135 | intros. 136 | apply weaken_pos. 137 | now apply strongind_pos_aux. 138 | Qed. 139 | End PositiveInductionPrinciple. 140 | 141 | Local Open Scope char_scope. 142 | 143 | Fixpoint positive_serialize p := 144 | match p with 145 | | xI (xI (xI p)) => IOStreamWriter.append (fun _ => serialize x0e) 146 | (fun _ => positive_serialize p) 147 | | xI (xI (xO p)) => IOStreamWriter.append (fun _ => serialize x0d) 148 | (fun _ => positive_serialize p) 149 | | xI (xO (xI p)) => IOStreamWriter.append (fun _ => serialize x0c) 150 | (fun _ => positive_serialize p) 151 | | xI (xO (xO p)) => IOStreamWriter.append (fun _ => serialize x0b) 152 | (fun _ => positive_serialize p) 153 | | xO (xI (xI p)) => IOStreamWriter.append (fun _ => serialize x0a) 154 | (fun _ => positive_serialize p) 155 | | xO (xI (xO p)) => IOStreamWriter.append (fun _ => serialize x09) 156 | (fun _ => positive_serialize p) 157 | | xO (xO (xI p)) => IOStreamWriter.append (fun _ => serialize x08) 158 | (fun _ => positive_serialize p) 159 | | xO (xO (xO p)) => IOStreamWriter.append (fun _ => serialize x07) 160 | (fun _ => positive_serialize p) 161 | | xI (xI p) => IOStreamWriter.append (fun _ => serialize x06) 162 | (fun _ => positive_serialize p) 163 | | xI (xO p) => IOStreamWriter.append (fun _ => serialize x05) 164 | (fun _ => positive_serialize p) 165 | | xO (xI p) => IOStreamWriter.append (fun _ => serialize x04) 166 | (fun _ => positive_serialize p) 167 | | xO (xO p) => IOStreamWriter.append (fun _ => serialize x03) 168 | (fun _ => positive_serialize p) 169 | | xI p => IOStreamWriter.append (fun _ => serialize x02) 170 | (fun _ => positive_serialize p) 171 | | xO p => IOStreamWriter.append (fun _ => serialize x01) 172 | (fun _ => positive_serialize p) 173 | | xH => serialize x00 174 | end. 175 | 176 | Definition positive_deserialize_step 177 | (b : byte) 178 | (s : positive -> positive) := 179 | match b with 180 | | x0e => More (fun p => s (xI (xI (xI p)))) 181 | | x0d => More (fun p => s (xI (xI (xO p)))) 182 | | x0c => More (fun p => s (xI (xO (xI p)))) 183 | | x0b => More (fun p => s (xI (xO (xO p)))) 184 | | x0a => More (fun p => s (xO (xI (xI p)))) 185 | | x09 => More (fun p => s (xO (xI (xO p)))) 186 | | x08 => More (fun p => s (xO (xO (xI p)))) 187 | | x07 => More (fun p => s (xO (xO (xO p)))) 188 | | x06 => More (fun p => s (xI (xI p))) 189 | | x05 => More (fun p => s (xI (xO p))) 190 | | x04 => More (fun p => s (xO (xI p))) 191 | | x03 => More (fun p => s (xO (xO p))) 192 | | x02 => More (fun p => s (xI p)) 193 | | x01 => More (fun p => s (xO p)) 194 | | x00 => Done (s xH) 195 | | _ => Error 196 | end. 197 | 198 | Definition positive_step_aux p := 199 | forall (k : positive -> positive) (bytes : list byte), 200 | ByteListReader.unwrap (ByteListReader.fold positive_deserialize_step k) 201 | (IOStreamWriter.unwrap (positive_serialize p) ++ bytes) 202 | = Some(k p, bytes). 203 | 204 | Lemma positive_step : 205 | forall (p : positive), positive_step_aux p. 206 | Proof. 207 | apply strongind_pos; unfold positive_step_aux. 208 | - unfold positive_serialize. 209 | cheerios_crush. 210 | - split; 211 | intros; 212 | try destruct q; 213 | try destruct q; 214 | simpl; cheerios_crush; simpl; rewrite H || cheerios_crush; 215 | try reflexivity; 216 | repeat constructor. 217 | Qed. 218 | 219 | Definition positive_deserialize := 220 | ByteListReader.fold positive_deserialize_step (fun p => p). 221 | 222 | Theorem positive_serialize_deserialize_id : 223 | serialize_deserialize_id_spec positive_serialize 224 | positive_deserialize. 225 | Proof. 226 | intros. 227 | unfold positive_deserialize. 228 | apply positive_step. 229 | Qed. 230 | 231 | #[global] 232 | Instance positive_Serializer : Serializer positive. 233 | Proof. 234 | exact ({| serialize := positive_serialize; 235 | deserialize := positive_deserialize; 236 | serialize_deserialize_id := positive_serialize_deserialize_id 237 | |}). 238 | Qed. 239 | 240 | 241 | (* This is the first example of a "typical" serializer: it combines more 242 | primitive serializers (in this case, just for byte and positive) together in 243 | order to serialize a Z. *) 244 | Definition Z_serialize (z : Z) : IOStreamWriter.t := 245 | match z with 246 | | Z0 => serialize x00 247 | | Zpos p => IOStreamWriter.append (fun _ => serialize x01) 248 | (fun _ => serialize p) 249 | | Zneg p => IOStreamWriter.append (fun _ => serialize x02) 250 | (fun _ => serialize p) 251 | end. 252 | 253 | Definition Z_deserialize : ByteListReader.t Z := 254 | tag <- deserialize ;; 255 | match tag with 256 | | x02 => Zneg <$> deserialize 257 | | x01 => Zpos <$> deserialize 258 | | x00 => ByteListReader.ret Z0 259 | | _ => ByteListReader.error 260 | end. 261 | 262 | (* This proof is typical for serializing an algebraic datatype. Unfold the 263 | serializer and deserializer, then do a case analysis and call 264 | serialize_deserialize_id_crush. *) 265 | Lemma Z_serialize_deserialize_id : 266 | serialize_deserialize_id_spec Z_serialize Z_deserialize. 267 | Proof. 268 | intros. 269 | unfold Z_serialize, Z_deserialize. 270 | destruct a; 271 | repeat (cheerios_crush; simpl). 272 | Qed. 273 | 274 | #[global] 275 | Instance Z_Serializer : Serializer Z := 276 | {| serialize := Z_serialize; 277 | deserialize := Z_deserialize; 278 | serialize_deserialize_id := Z_serialize_deserialize_id 279 | |}. 280 | 281 | Definition N_serialize n := 282 | match n with 283 | | N0 => serialize false 284 | | Npos p => IOStreamWriter.append (fun _ => serialize true) 285 | (fun _ => serialize p) 286 | end. 287 | 288 | Definition N_deserialize : ByteListReader.t N := 289 | tag <- deserialize ;; 290 | match tag with 291 | | false => ByteListReader.ret N0 292 | | true => Npos <$> deserialize 293 | end. 294 | 295 | Lemma N_serialize_deserialize_id : 296 | serialize_deserialize_id_spec N_serialize N_deserialize. 297 | Proof. 298 | intros. 299 | unfold N_serialize, N_deserialize. 300 | destruct a; 301 | repeat (cheerios_crush; simpl). 302 | Qed. 303 | 304 | #[global] 305 | Instance N_Serializer : Serializer N. 306 | Proof. 307 | exact {| serialize := N_serialize; 308 | deserialize := N_deserialize; 309 | serialize_deserialize_id := N_serialize_deserialize_id 310 | |}. 311 | Qed. 312 | 313 | (* The other main way to define a serializer is to use an isomorphism to another 314 | type that is already serializable. *) 315 | Definition nat_serialize n : IOStreamWriter.t := serialize (N.of_nat n). 316 | 317 | Definition nat_deserialize : ByteListReader.t nat := N.to_nat <$> deserialize. 318 | 319 | 320 | (* This proof is typical for serializers defined by converting to and from a 321 | type that is already serializable. Unfold the serializer and deserializer, 322 | call serialize_deserialize_id_crush, and then use the proof that the 323 | conversion functions are inverses. *) 324 | Lemma nat_serialize_deserialize_id : 325 | serialize_deserialize_id_spec nat_serialize nat_deserialize. 326 | Proof. 327 | unfold nat_serialize, nat_deserialize. 328 | cheerios_crush. 329 | now rewrite Nnat.Nat2N.id. 330 | Qed. 331 | 332 | #[global] 333 | Instance nat_Serializer : Serializer nat := 334 | {| serialize := nat_serialize; 335 | deserialize := nat_deserialize; 336 | serialize_deserialize_id := nat_serialize_deserialize_id 337 | |}. 338 | 339 | (* Serializer for the standard library's Fin.t based on converting to nat. *) 340 | Definition Fin_serialize {n} (x : Fin.t n) : IOStreamWriter.t := 341 | serialize (proj1_sig (Fin.to_nat x)). 342 | 343 | Definition Fin_deserialize {n} : ByteListReader.t (Fin.t n) := 344 | m <- deserialize ;; 345 | match Fin.of_nat m n with 346 | | inleft x => ByteListReader.ret x 347 | | inright _ => ByteListReader.error 348 | end. 349 | 350 | Lemma Fin_of_nat_to_nat: 351 | forall (n : nat) (a : Fin.t n), Fin.of_nat (proj1_sig (Fin.to_nat a)) n = inleft a. 352 | Proof. 353 | induction a. 354 | - auto. 355 | - simpl. break_let. simpl in *. 356 | now rewrite IHa. 357 | Qed. 358 | 359 | Lemma Fin_serialize_deserialize_id n : 360 | serialize_deserialize_id_spec Fin_serialize (@Fin_deserialize n). 361 | Proof. 362 | unfold Fin_serialize, Fin_deserialize. 363 | cheerios_crush. 364 | rewrite Fin_of_nat_to_nat. 365 | cheerios_crush. 366 | Qed. 367 | 368 | #[global] 369 | Instance Fin_Serializer n : Serializer (Fin.t n). 370 | Proof. 371 | exact {| serialize := Fin_serialize; 372 | deserialize := Fin_deserialize; 373 | serialize_deserialize_id := Fin_serialize_deserialize_id n 374 | |}. 375 | Qed. 376 | 377 | (* Serializer for StructTact's fin based on converting to nat. *) 378 | Definition fin_serialize {n} (x : fin n) : IOStreamWriter.t := 379 | serialize (fin_to_nat x). 380 | 381 | Definition fin_deserialize {n} : ByteListReader.t (fin n) := 382 | m <- deserialize ;; 383 | match fin_of_nat m n with 384 | | inleft x => ByteListReader.ret x 385 | | inright _ => ByteListReader.error 386 | end. 387 | 388 | Lemma fin_serialize_deserialize_id n : 389 | serialize_deserialize_id_spec fin_serialize (@fin_deserialize n). 390 | Proof. 391 | unfold fin_serialize, fin_deserialize. 392 | cheerios_crush. 393 | rewrite fin_of_nat_fin_to_nat. 394 | cheerios_crush. 395 | Qed. 396 | 397 | #[global] 398 | Instance fin_Serializer n : Serializer (fin n). 399 | Proof. 400 | exact {| serialize := fin_serialize; 401 | deserialize := fin_deserialize; 402 | serialize_deserialize_id := fin_serialize_deserialize_id n 403 | |}. 404 | Qed. 405 | 406 | Definition ascii_serialize (a : Ascii.ascii) : IOStreamWriter.t := 407 | serialize (Ascii.nat_of_ascii a). 408 | 409 | Definition ascii_deserialize : ByteListReader.t Ascii.ascii := 410 | Ascii.ascii_of_nat <$> deserialize. 411 | 412 | Lemma ascii_serialize_deserialize_id : 413 | serialize_deserialize_id_spec ascii_serialize ascii_deserialize. 414 | Proof. 415 | unfold ascii_deserialize, ascii_serialize. 416 | cheerios_crush. 417 | now rewrite Ascii.ascii_nat_embedding. 418 | Qed. 419 | 420 | #[global] 421 | Instance ascii_Serializer : Serializer Ascii.ascii. 422 | Proof. 423 | exact {| serialize := ascii_serialize; 424 | deserialize := ascii_deserialize; 425 | serialize_deserialize_id := ascii_serialize_deserialize_id 426 | |}. 427 | Qed. 428 | -------------------------------------------------------------------------------- /theories/Core/Tree.v: -------------------------------------------------------------------------------- 1 | From Cheerios Require Import Combinators Core DeserializerMonad. 2 | From Cheerios Require Import Tactics Types. 3 | From Coq Require Import Arith List FMapPositive. 4 | Import ListNotations. 5 | Import DeserializerNotations. 6 | 7 | Set Implicit Arguments. 8 | 9 | (* 10 | Most user-defined datatypes are tree-like, which are typically nontrivial to 11 | deserialize by structural recursion on the bitstream. This file provides a 12 | generic multi-arity tree type and its serializer/deserializer. Other tree-like 13 | types can be serialized by first converting to a tree and then serializing. 14 | *) 15 | 16 | Section tree. 17 | (* The tree is parametrized on the type of data stored at the leaves. *) 18 | Variable A : Type. 19 | 20 | (* Each node of the tree contains a list of subtrees. 21 | Coq does not generate a useful induction scheme for such types, 22 | so we just tell it not to generate anything, and we'll write our own. *) 23 | Local Unset Elimination Schemes. 24 | 25 | Inductive tree : Type := 26 | | atom : A -> tree 27 | | node : list tree -> tree 28 | . 29 | 30 | (* Here is an actually useful recursion principle for tree, 31 | which requires an additional motive P_list. *) 32 | Section tree_rect. 33 | Variable P : tree -> Type. 34 | Variable P_list : list tree -> Type. 35 | Hypothesis P_nil : P_list []. 36 | Hypothesis P_cons : forall t l, P t -> P_list l -> P_list (t :: l). 37 | Hypothesis P_atom : forall a, P (atom a). 38 | Hypothesis P_node : forall l, P_list l -> P (node l). 39 | 40 | Fixpoint tree_rect (t : tree) : P t := 41 | let fix go_list (l : list tree) : P_list l := 42 | match l with 43 | | [] => P_nil 44 | | t :: l => P_cons (tree_rect t) (go_list l) 45 | end 46 | in 47 | match t with 48 | | atom a => P_atom a 49 | | node l => P_node (go_list l) 50 | end. 51 | End tree_rect. 52 | 53 | (* Setting P_list := List.Forall P is a reasonable default. *) 54 | Section tree_ind. 55 | Variable P : tree -> Prop. 56 | 57 | Hypothesis P_atom : forall a, P (atom a). 58 | Hypothesis P_node : forall l, List.Forall P l -> P (node l). 59 | 60 | Definition tree_ind (t : tree) : P t := 61 | tree_rect P (List.Forall P) 62 | (List.Forall_nil _) 63 | (fun t l Pt Pl => List.Forall_cons _ Pt Pl) P_atom P_node t. 64 | End tree_ind. 65 | End tree. 66 | 67 | 68 | Fixpoint rev_rec {A} (l : list A) (acc : list A) := 69 | match l with 70 | | [] => acc 71 | | a :: l => rev_rec l (a :: acc) 72 | end. 73 | 74 | Lemma rev_rec_spec : forall {A : Type} (l : list A) acc, 75 | rev_rec l acc = rev l ++ acc. 76 | Proof. 77 | intros A l. 78 | induction l. 79 | - reflexivity. 80 | - intros. 81 | simpl. 82 | rewrite <- app_assoc. 83 | now rewrite IHl. 84 | Qed. 85 | 86 | Definition rev' {A} (l : list A) := 87 | rev_rec l []. 88 | 89 | Theorem rev'_spec : forall {A : Type} (l : list A), 90 | rev' l = rev l. 91 | Proof. 92 | intros. unfold rev'. 93 | now rewrite rev_rec_spec, app_nil_r. 94 | Qed. 95 | 96 | 97 | Fixpoint map_rec {A B} (f : A -> B) (l : list A) (acc : list B) := 98 | match l with 99 | | [] => rev' acc 100 | | a :: l => map_rec f l (f a :: acc) 101 | end. 102 | 103 | Lemma map_rec_spec : forall {A B} (f : A -> B) (l : list A) (acc : list B), 104 | map_rec f l acc = rev acc ++ List.map f l. 105 | Proof. 106 | intros A B f l. 107 | induction l. 108 | - intros. 109 | simpl. 110 | unfold rev'. 111 | now rewrite rev_rec_spec. 112 | - intros. 113 | simpl. 114 | rewrite IHl. 115 | simpl. 116 | rewrite <- app_assoc. 117 | reflexivity. 118 | Qed. 119 | 120 | Definition list_map' {A B} (f : A -> B) (l : list A) := 121 | map_rec f l []. 122 | 123 | Theorem map'_spec : forall {A B} (f : A -> B) (l : list A), 124 | List.map f l = list_map' f l. 125 | intros. 126 | unfold list_map'. 127 | now rewrite map_rec_spec. 128 | Qed. 129 | 130 | (* The shape of a tree can be expressed by mapping (fun _ => tt) over it. *) 131 | Fixpoint map {A B} (f : A -> B) (t : tree A) : tree B := 132 | match t with 133 | | atom a => atom (f a) 134 | | node l => node (List.map (map f) l) 135 | end. 136 | 137 | Definition shape {A} (t : tree A) : tree unit := 138 | map (fun _ => tt) t. 139 | 140 | Definition tree_map' {A B} (f : A -> B) (t : tree A) : tree B := 141 | let fix tree_map_loop {A B} (f : A -> B) (l : list (tree A)) acc := 142 | match l with 143 | | [] => rev_rec acc [] 144 | | a :: l => tree_map_loop f l (map f a :: acc) 145 | end in 146 | match t with 147 | | atom a => atom (f a) 148 | | node l => node (tree_map_loop f l []) 149 | end. 150 | 151 | Definition tree_map_loop := 152 | fix tree_map_loop {A B} (f : A -> B) (l : list (tree A)) acc := 153 | match l with 154 | | [] => rev_rec acc [] 155 | | a :: l => tree_map_loop f l (map f a :: acc) 156 | end. 157 | 158 | Lemma tree_map_loop_spec : 159 | forall {A B} (f : A -> B) l acc, 160 | tree_map_loop f l acc = rev acc ++ List.map (map f) l. 161 | Proof. 162 | intros A B f l. 163 | induction l; intros. 164 | - simpl. 165 | now rewrite rev_rec_spec. 166 | - simpl. 167 | rewrite IHl. 168 | simpl. 169 | now rewrite <- app_assoc. 170 | Qed. 171 | 172 | Theorem tree_map'_spec : forall {A B} (f : A -> B) (t : tree A), 173 | tree_map' f t = map f t. 174 | Proof. 175 | intros. 176 | destruct t. 177 | - reflexivity. 178 | - simpl. 179 | now rewrite tree_map_loop_spec. 180 | Qed. 181 | 182 | (* Fill out a tree using a list of elements given in preorder traversal order. *) 183 | Fixpoint fill' {A B} (x : tree A) (bs : list B) : option (tree B * list B) := 184 | let fix fill'_list (l : list (tree A)) (bs : list B) : option (list (tree B) * list B) := 185 | match l with 186 | | [] => Some ([], bs) 187 | | x :: l => match fill' x bs with None => None 188 | | Some (x, bs) => 189 | match fill'_list l bs with None => None 190 | | Some (l, bs) => 191 | Some (x :: l, bs) 192 | end 193 | end 194 | end in 195 | match x with 196 | | atom _ => match bs with 197 | | [] => None 198 | | b :: bs => Some (atom b, bs) 199 | end 200 | | node l => match fill'_list l bs with None => None 201 | | Some (l, bs) => Some (node l, bs) 202 | end 203 | 204 | end. 205 | 206 | (* Copy paste of local definition above. *) 207 | Definition fill'_list {A B} := 208 | fix fill'_list (l : list (tree A)) (bs : list B) : option (list (tree B) * list B) := 209 | match l with 210 | | [] => Some ([], bs) 211 | | x :: l => match fill' x bs with None => None 212 | | Some (x, bs) => 213 | match fill'_list l bs with None => None 214 | | Some (l, bs) => 215 | Some (x :: l, bs) 216 | end 217 | end 218 | end. 219 | 220 | Definition fill {A B} (x : tree A) (bs : list B) : option (tree B) := 221 | match fill' x bs with None => None 222 | | Some (t, _) => Some t 223 | end. 224 | 225 | (* Produce a preorder traversal list of elements *) 226 | Fixpoint preorder {A} (x : tree A) : list A := 227 | let fix preorder_list (l : list (tree A)) : list A := 228 | match l with 229 | | [] => [] 230 | | x :: l => preorder x ++ preorder_list l 231 | end 232 | in 233 | match x with 234 | | atom a => [a] 235 | | node l => preorder_list l 236 | end. 237 | 238 | Definition preorder_list {A} := 239 | fix preorder_list (l : list (tree A)) : list A := 240 | match l with 241 | | [] => [] 242 | | x :: l => preorder x ++ preorder_list l 243 | end. 244 | 245 | Definition preorder' {A} (x : tree A) : list A := 246 | let fix preorder_list (l : list (tree A)) acc : list A := 247 | match l with 248 | | [] => acc 249 | | x :: l => preorder_list l (acc ++ preorder x) 250 | end 251 | in 252 | match x with 253 | | atom a => [a] 254 | | node l => preorder_list l [] 255 | end. 256 | 257 | (* Since the shape is expressed as mapping, we will need the fact that filling 258 | out the a mapped tree with the elements of the original tree gives the 259 | original. 260 | *) 261 | Lemma fill'_preorder : 262 | forall A B (f : B -> A) t (bs : list B), 263 | fill' (map f t) (preorder t ++ bs) = Some (t, bs). 264 | Proof. 265 | intros A B f. 266 | induction t using tree_rect 267 | with (P_list := fun l => 268 | forall bs, 269 | fill'_list (List.map (map f) l) (preorder_list l ++ bs) = Some (l, bs)); intros. 270 | - auto. 271 | - simpl. 272 | rewrite <- app_assoc. rewrite IHt. rewrite IHt0. auto. 273 | - auto. 274 | - simpl. 275 | fold (@preorder_list B). 276 | fold (@fill'_list A B). 277 | now rewrite IHt. 278 | Qed. 279 | 280 | Lemma fill_preorder : 281 | forall A B (f : A -> B) t, 282 | fill (map f t) (preorder t) = Some t. 283 | Proof. 284 | unfold fill. 285 | intros. 286 | rewrite <- app_nil_r with (l := preorder t). 287 | now rewrite fill'_preorder. 288 | Qed. 289 | 290 | Section serializer. 291 | Variables A : Type. 292 | Variable sA :Serializer A. 293 | 294 | (* Now we're ready to serialize trees. First, we serialize their shape. *) 295 | 296 | Fixpoint serialize_tree_shape (t : tree A) : IOStreamWriter.t := 297 | let fix serialize_list_tree_shape (l : list (tree A)) : IOStreamWriter.t := 298 | match l with 299 | | [] => IOStreamWriter.empty 300 | | x :: xs => IOStreamWriter.append (fun _ => serialize_tree_shape x) 301 | (fun _ => serialize_list_tree_shape xs) 302 | end in 303 | match t with 304 | | atom _ => serialize x00 (* ignore the data, since we're just focused on the shape *) 305 | | node l => IOStreamWriter.append (fun _ => serialize x01) 306 | (fun _ => (IOStreamWriter.append 307 | (fun _ => serialize_list_tree_shape l) 308 | (fun _ => serialize x02))) 309 | end. 310 | 311 | Definition serialize_list_tree_shape := 312 | fix serialize_list_tree_shape (l : list (tree A)) : IOStreamWriter.t := 313 | match l with 314 | | [] => IOStreamWriter.empty 315 | | x :: xs => IOStreamWriter.append (fun _ => serialize_tree_shape x) 316 | (fun _ => serialize_list_tree_shape xs) 317 | end. 318 | 319 | Definition deserialize_tree_shape_step (b : byte) (s : list (list (tree unit))) : 320 | fold_state (list (list (tree unit))) (tree unit) := 321 | match b with 322 | | x00 => match s with 323 | | [] => Done (atom tt) 324 | | ts :: s => More ((atom tt :: ts) :: s) 325 | end 326 | | x01 => More ([] :: s) 327 | | x02 => match s with 328 | | [] => Error 329 | | ts :: s => let t := node (rev' ts) in 330 | match s with 331 | | [] => Done t 332 | | ts :: acc => More ((t :: ts) :: acc) 333 | end 334 | end 335 | 336 | | _ => Error 337 | end. 338 | 339 | Lemma shape_aux : 340 | forall t acc bytes, 341 | ByteListReader.unwrap (ByteListReader.fold deserialize_tree_shape_step acc) 342 | (IOStreamWriter.unwrap (serialize_tree_shape t) ++ bytes) = 343 | match acc with 344 | | [] => Some (shape t, bytes) 345 | | j :: js => ByteListReader.unwrap 346 | (ByteListReader.fold deserialize_tree_shape_step 347 | ((shape t :: j) :: js)) bytes 348 | end. 349 | Proof using. 350 | induction t using tree_rect with 351 | (P_list := fun l => 352 | (* We need to extend the statement to a list of subtrees for the mutual induction 353 | hypothesis. 354 | It says that serializing and then deserializing a list of trees `l` is the same 355 | as `List.map (map (fun _ => tt) l)`. 356 | `deserialize_list_tree_shape'` is always called with at least one element on the 357 | accumulator, so there's no need for a match like there was above. 358 | *) 359 | forall ts acc bytes, 360 | ByteListReader.unwrap 361 | (ByteListReader.fold deserialize_tree_shape_step (ts :: acc)) 362 | (IOStreamWriter.unwrap (serialize_list_tree_shape l) ++ bytes) = 363 | ByteListReader.unwrap 364 | (ByteListReader.fold 365 | deserialize_tree_shape_step 366 | ((rev (List.map shape l) ++ ts) :: acc)) bytes); 367 | intros; 368 | try (unfold serialize_list_tree_shape; 369 | rewrite IOStreamWriter.append_unwrap, <- app_assoc, IHt, IHt0; 370 | simpl; 371 | now rewrite <- app_assoc). 372 | (cheerios_crush; simpl; cheerios_crush; simpl). 373 | - destruct acc; 374 | repeat (cheerios_crush; 375 | simpl). 376 | - destruct acc; 377 | simpl; 378 | rewrite IOStreamWriter.append_unwrap, 379 | ByteListReader.fold_unwrap, 380 | IOStreamWriter.append_unwrap, 381 | IOStreamWriter.putByte_unwrap; 382 | simpl; 383 | fold serialize_list_tree_shape; 384 | rewrite <- app_assoc, IHt, ByteListReader.fold_unwrap, 385 | IOStreamWriter.putByte_unwrap; 386 | simpl; 387 | rewrite app_nil_r, rev'_spec, rev_involutive; 388 | reflexivity. 389 | Qed. 390 | 391 | Definition deserialize_tree_shape : ByteListReader.t (tree unit) := 392 | ByteListReader.fold deserialize_tree_shape_step []. 393 | 394 | (* This is the top level statement about serializing and deserializing tree shapes: 395 | it results in `shape` of the original tree. *) 396 | Lemma serialize_deserialize_shape_id : 397 | forall t bytes, 398 | ByteListReader.unwrap deserialize_tree_shape 399 | (IOStreamWriter.unwrap (serialize_tree_shape t) ++ bytes) 400 | = Some (shape t, bytes). 401 | Proof using. 402 | intros. 403 | unfold deserialize_tree_shape. 404 | now rewrite shape_aux. 405 | Qed. 406 | 407 | Fixpoint serialize_tree_elements (t : tree A) : IOStreamWriter.t := 408 | let fix serialize_tree_elements_list (l : list (tree A)) : IOStreamWriter.t := 409 | match l with 410 | | [] => IOStreamWriter.empty 411 | | t :: l' => IOStreamWriter.append (fun _ => serialize_tree_elements t) 412 | (fun _ => serialize_tree_elements_list l') 413 | end 414 | in match t with 415 | | atom a => serialize a 416 | | node l => serialize_tree_elements_list l 417 | end. 418 | 419 | Definition serialize_tree_elements_list := 420 | fix serialize_tree_elements_list (l : list (tree A)) : IOStreamWriter.t := 421 | match l with 422 | | [] => IOStreamWriter.empty 423 | | t :: l' => IOStreamWriter.append (fun _ => serialize_tree_elements t) 424 | (fun _ => serialize_tree_elements_list l') 425 | end. 426 | 427 | Fixpoint deserialize_tree_elements (t : tree unit) : ByteListReader.t (tree A) := 428 | let fix deserialize_tree_elements_list (l : list (tree unit)) := 429 | match l with 430 | | [] => ByteListReader.ret [] 431 | | t :: l' => cons <$> deserialize_tree_elements t 432 | <*> deserialize_tree_elements_list l' 433 | end 434 | in match t with 435 | | atom tt => @atom _ <$> deserialize 436 | | node l => @node _ <$> deserialize_tree_elements_list l 437 | end. 438 | 439 | Definition deserialize_tree_elements_list := 440 | fix deserialize_tree_elements_list (l : list (tree unit)) := 441 | match l with 442 | | [] => ByteListReader.ret [] 443 | | t :: l' => cons <$> deserialize_tree_elements t 444 | <*> deserialize_tree_elements_list l' 445 | end. 446 | 447 | Lemma serialize_deserialize_tree_elements_id : 448 | forall t bytes, 449 | ByteListReader.unwrap (deserialize_tree_elements (shape t)) 450 | (IOStreamWriter.unwrap (serialize_tree_elements t) ++ bytes) = 451 | Some (t, bytes). 452 | Proof using. 453 | induction t using tree_rect with 454 | (P_list := fun l => forall bytes, 455 | ByteListReader.unwrap (deserialize_tree_elements_list (List.map shape l)) 456 | (IOStreamWriter.unwrap (serialize_tree_elements_list l) ++ bytes) = 457 | Some (l, bytes)); 458 | intros; 459 | cbn [shape map List.map 460 | serialize_tree_shape deserialize_tree_shape 461 | serialize_tree_elements deserialize_tree_elements 462 | serialize_tree_elements_list deserialize_tree_elements_list]. 463 | - now cheerios_crush. 464 | - cheerios_crush. 465 | rewrite IHt. 466 | cheerios_crush. 467 | rewrite IHt0. 468 | cheerios_crush. 469 | - now cheerios_crush. 470 | - fold deserialize_tree_elements_list. 471 | fold serialize_tree_elements_list. 472 | cheerios_crush. 473 | now rewrite IHt. 474 | Qed. 475 | 476 | (* Now we serialize the tree itself by first serializing the shape, and then a 477 | preorder traversal of the elements. *) 478 | Definition tree_serialize (t : tree A) : IOStreamWriter.t := 479 | IOStreamWriter.append (fun _ => serialize_tree_shape t) 480 | (fun _ => serialize_tree_elements t). 481 | 482 | (* To deserialize, we deserialize the shape and the elements, and then fill out 483 | the shape with the elements. *) 484 | Definition tree_deserialize : ByteListReader.t (tree A) := 485 | shape <- deserialize_tree_shape ;; 486 | deserialize_tree_elements shape. 487 | 488 | (* To prove this correct, we need to know that serializ-/deserializing the shape of `t` 489 | results in `shape t` (`serialize_deserialize_shape_id`), and that 490 | filling out a `map f t` with the elements of `preorder t` results in `t` 491 | (`fill_preorder`). 492 | *) 493 | Lemma tree_serialize_deserialize_id : 494 | serialize_deserialize_id_spec tree_serialize tree_deserialize. 495 | Proof using. 496 | unfold tree_serialize, tree_deserialize. cheerios_crush. 497 | rewrite serialize_deserialize_shape_id. 498 | now rewrite serialize_deserialize_tree_elements_id. 499 | Qed. 500 | 501 | Global Instance tree_Serializer : Serializer (tree A) := 502 | {| serialize := tree_serialize; 503 | deserialize := tree_deserialize; 504 | serialize_deserialize_id := tree_serialize_deserialize_id 505 | |}. 506 | End serializer. 507 | 508 | Module sexp. 509 | Import String. 510 | 511 | Definition sexp := tree string. 512 | 513 | Module examples. 514 | (* 515 | (define (id x) x) 516 | *) 517 | Definition id : sexp := 518 | node [atom "define"; node [atom "id"; atom "x"]; atom "x"]%string. 519 | 520 | Lemma foo: 521 | ByteListReader.unwrap deserialize 522 | (IOStreamWriter.unwrap (serialize id)) = Some (id, []). 523 | Proof using. 524 | now rewrite serialize_deserialize_id_nil. 525 | Qed. 526 | (* 527 | (define (Y f) ((lambda (x) (f (x x))) 528 | (lambda (x) (f (x x))))) 529 | *) 530 | Definition Y : sexp := 531 | node [atom "define"; node [atom "Y"; atom "f"]; 532 | node [node [atom "lambda"; node [atom "x"]; node [atom "f"; node [atom "x"; atom "x"]]]; 533 | node [atom "lambda"; node [atom "x"]; node [atom "f"; node [atom "x"; atom "x"]]]]] 534 | %string. 535 | 536 | Lemma foo' : ByteListReader.unwrap deserialize (IOStreamWriter.unwrap (serialize Y)) = Some (Y, []). 537 | Proof using. 538 | now rewrite serialize_deserialize_id_nil. 539 | Qed. 540 | End examples. 541 | End sexp. 542 | 543 | Module JSON. 544 | Module json. 545 | Inductive t := 546 | | Null : t 547 | | Bool : bool -> t 548 | | Num : nat -> t 549 | | String : String.string -> t 550 | | Arr : list t -> t 551 | | Obj : list (String.string * t) -> t. 552 | 553 | Section json_rect. 554 | Variable P : t -> Type. 555 | 556 | Variable P_list : list t -> Type. 557 | Variable P_list' : list (String.string * t) -> Type. 558 | 559 | Hypothesis P_nil : P_list []. 560 | Hypothesis P_cons : forall j l, P j -> P_list l -> P_list (j :: l). 561 | 562 | Hypothesis P_nil' : P_list' []. 563 | Hypothesis P_cons' : forall s j l, P j -> P_list' l -> P_list' ((s, j) :: l). 564 | 565 | Hypothesis P_null : P Null. 566 | Hypothesis P_bool : forall b, P (Bool b). 567 | Hypothesis P_num : forall n, P (Num n). 568 | Hypothesis P_string : forall s, P (String s). 569 | 570 | Hypothesis P_arr : forall l, P_list l -> P (Arr l). 571 | Hypothesis P_obj : forall l, P_list' l -> P (Obj l). 572 | 573 | Fixpoint json_rect (j : t) : P j := 574 | let fix go_list (l : list t) : P_list l := 575 | match l with 576 | | [] => P_nil 577 | | j :: l => P_cons (json_rect j) (go_list l) 578 | end in 579 | let fix go_list' (l : list (String.string * t)) : P_list' l := 580 | match l with 581 | | [] => P_nil' 582 | | (s, j) :: l => P_cons' s (json_rect j) (go_list' l) 583 | end in 584 | match j with 585 | | Null => P_null 586 | | Bool b => P_bool b 587 | | Num n => P_num n 588 | | String s => P_string s 589 | | Arr l => P_arr (go_list l) 590 | | Obj l => P_obj (go_list' l) 591 | end. 592 | End json_rect. 593 | 594 | (* Setting P_list := List.Forall P is a reasonable default. *) 595 | Section json_ind. 596 | Variable P : t -> Prop. 597 | 598 | Hypothesis P_null : P Null. 599 | Hypothesis P_bool : forall b, P (Bool b). 600 | Hypothesis P_num : forall n, P (Num n). 601 | Hypothesis P_string : forall s, P (String s). 602 | Hypothesis P_arr : forall l, List.Forall P l -> P (Arr l). 603 | Hypothesis P_obj : forall l, List.Forall (fun s => P (snd s)) l -> P (Obj l). 604 | 605 | Definition json_ind (j : t) : P j := 606 | json_rect P (List.Forall P) 607 | (List.Forall (fun s => P (snd s))) 608 | (List.Forall_nil _) (fun j l Pt Pl => List.Forall_cons j Pt Pl) 609 | (List.Forall_nil _) 610 | (fun s j l Pj Pt => List.Forall_cons (s, j) Pj Pt) 611 | P_null 612 | P_bool 613 | P_num 614 | P_string 615 | P_arr 616 | P_obj 617 | j. 618 | End json_ind. 619 | End json. 620 | 621 | Module tag. 622 | Inductive t := 623 | | Null : t 624 | | Bool : bool -> t 625 | | Num : nat -> t 626 | | Str : String.string -> t 627 | | Arr : t 628 | | Obj : t. 629 | 630 | (* tag serializer *) 631 | Definition tag_serialize (t : t) : IOStreamWriter.t := 632 | match t with 633 | | Null => serialize x00 634 | | Bool b => IOStreamWriter.append (fun _ => serialize x01) 635 | (fun _ => serialize b) 636 | | Num n => IOStreamWriter.append (fun _ => serialize x02) 637 | (fun _ => serialize n) 638 | | Str s => IOStreamWriter.append (fun _ => serialize x03) 639 | (fun _ => serialize s) 640 | | Arr => serialize x04 641 | | Obj => serialize x05 642 | end. 643 | 644 | Definition tag_deserialize : ByteListReader.t t := 645 | tag <- deserialize ;; 646 | match tag with 647 | | x00 => ByteListReader.ret Null 648 | | x01 => Bool <$> deserialize 649 | | x02 => Num <$> deserialize 650 | | x03 => Str <$> deserialize 651 | | x04 => ByteListReader.ret Arr 652 | | x05 => ByteListReader.ret Obj 653 | | _ => ByteListReader.error 654 | end. 655 | 656 | Lemma tag_serialize_deserialize_id : 657 | serialize_deserialize_id_spec tag_serialize tag_deserialize. 658 | Proof using. 659 | intros. 660 | destruct a; 661 | unfold tag_serialize, tag_deserialize; 662 | cheerios_crush; 663 | unfold app; 664 | cheerios_crush. 665 | Qed. 666 | 667 | #[global] 668 | Instance tag_Serializer : Serializer t. 669 | Proof. 670 | exact {| serialize := tag_serialize; 671 | deserialize := tag_deserialize; 672 | serialize_deserialize_id := tag_serialize_deserialize_id |}. 673 | Qed. 674 | (* json <-> tree tag conversion *) 675 | 676 | Fixpoint json_treeify (j : json.t) : tree tag.t := 677 | let fix obj_list_to_tree_list (l : list (String.string * json.t)) := 678 | match l with 679 | | [] => [] 680 | | (s, j) :: l => atom (tag.Str s) 681 | :: json_treeify j 682 | :: obj_list_to_tree_list l 683 | end 684 | in 685 | match j with 686 | | json.Null => atom tag.Null 687 | | json.Bool b => atom (tag.Bool b) 688 | | json.Num n => atom (tag.Num n) 689 | | json.String s => atom (tag.Str s) 690 | | json.Arr l => node (atom tag.Arr :: List.map json_treeify l) 691 | | json.Obj l => node (atom tag.Obj :: obj_list_to_tree_list l) 692 | end. 693 | 694 | Definition obj_list_to_tree_list := 695 | fix obj_list_to_tree_list (l : list (String.string * json.t)) : 696 | list (tree tag.t) := 697 | match l with 698 | | [] => [] 699 | | (s, j) :: l => atom (tag.Str s) :: json_treeify j :: obj_list_to_tree_list l 700 | end. 701 | 702 | Fixpoint json_untreeify (t : tree tag.t) : option json.t := 703 | let fix untreeify_list (l : list (tree tag.t)) : option (list json.t) := 704 | match l with 705 | | [] => Some [] 706 | | x :: l => match json_untreeify x with 707 | | None => None 708 | | Some y => match untreeify_list l with 709 | | None => None 710 | | Some l => Some (y :: l) 711 | end 712 | end 713 | end in 714 | let fix untreeify_obj_list (l : list (tree tag.t)) : 715 | option (list (String.string * json.t)) := 716 | match l with 717 | | [] => Some [] 718 | | atom (tag.Str s) :: t :: l => 719 | match json_untreeify t with 720 | | None => None 721 | | Some j => match untreeify_obj_list l with 722 | | None => None 723 | | Some l => Some ((s, j) :: l) 724 | end 725 | end 726 | | _ => None 727 | end in 728 | match t with 729 | | atom (tag.Num n) => Some (json.Num n) 730 | | atom (tag.Bool b) => Some (json.Bool b) 731 | | atom (tag.Str s) => Some (json.String s) 732 | | node (atom tag.Arr :: l) => match untreeify_list l with 733 | | None => None 734 | | Some l => Some (json.Arr l) 735 | end 736 | | atom (tag.Null) => Some (json.Null) 737 | | node (atom tag.Obj :: l) => match untreeify_obj_list l with 738 | | None => None 739 | | Some l => Some (json.Obj l) 740 | end 741 | | _ => None 742 | end. 743 | 744 | Definition untreeify_obj_list := 745 | fix untreeify_obj_list (l : list (tree tag.t)) : 746 | option (list (String.string * json.t)) := 747 | match l with 748 | | [] => Some [] 749 | | atom (tag.Str s) :: t :: l => 750 | match json_untreeify t with 751 | | None => None 752 | | Some j => match untreeify_obj_list l with 753 | | None => None 754 | | Some l => Some ((s, j) :: l) 755 | end 756 | end 757 | | _ => None 758 | end. 759 | 760 | Definition untreeify_list := 761 | fix untreeify_list l : option (list json.t) := 762 | match l with 763 | | [] => Some [] 764 | | x :: l => match json_untreeify x with 765 | | None => None 766 | | Some y => match untreeify_list l with 767 | | None => None 768 | | Some l => Some (y :: l) 769 | end 770 | end 771 | end. 772 | 773 | Definition treeify_untreeify_aux (j : json.t) := 774 | json_untreeify (json_treeify j) = Some j. 775 | 776 | Lemma treeify_untreeify_id : forall j : json.t, 777 | treeify_untreeify_aux j. 778 | Proof using. 779 | induction j using json.json_rect with 780 | (P_list := fun l => untreeify_list (List.map json_treeify l) = Some l) 781 | (P_list' := fun l => untreeify_obj_list (obj_list_to_tree_list l) = Some l); 782 | unfold treeify_untreeify_aux; 783 | auto; 784 | simpl; 785 | try (fold untreeify_list); 786 | try (fold untreeify_obj_list); 787 | try (fold obj_list_to_tree_list); 788 | try (rewrite IHj); 789 | try (rewrite IHj0); 790 | auto. 791 | Qed. 792 | 793 | Definition json_serialize (j : json.t) : IOStreamWriter.t := 794 | serialize (json_treeify j). 795 | 796 | Definition json_deserialize : ByteListReader.t json.t := 797 | j <- deserialize;; 798 | match json_untreeify j with 799 | | Some j => ByteListReader.ret j 800 | | None => ByteListReader.error 801 | end. 802 | 803 | Lemma json_serialize_deserialize_id : 804 | serialize_deserialize_id_spec json_serialize json_deserialize. 805 | Proof using. 806 | intros. 807 | unfold json_serialize, json_deserialize. 808 | cheerios_crush. 809 | rewrite treeify_untreeify_id. 810 | cheerios_crush. 811 | Qed. 812 | 813 | #[global] 814 | Instance json_Serializer : Serializer json.t. 815 | Proof. 816 | exact {| serialize := json_serialize; 817 | deserialize := json_deserialize; 818 | serialize_deserialize_id := json_serialize_deserialize_id |}. 819 | Qed. 820 | End tag. 821 | 822 | Definition string_eqb s s' := 823 | if (String.string_dec s s') then true else false. 824 | 825 | Lemma string_eqb_true : forall s s', string_eqb s s' = true -> s = s'. 826 | Proof using. 827 | intros. 828 | unfold string_eqb in H. 829 | destruct (String.string_dec s s'). 830 | + assumption. 831 | + congruence. 832 | Qed. 833 | 834 | Lemma string_eqb_refl : forall s, string_eqb s s = true. 835 | Proof using. 836 | intros. 837 | unfold string_eqb. 838 | destruct (String.string_dec s s); congruence. 839 | Qed. 840 | 841 | Fixpoint json_eqb (j j' : json.t) : bool := 842 | let fix loop_arr (l l': list json.t) : bool := 843 | match (l, l') with 844 | | ([], []) => true 845 | | (j :: l, j' :: l') => andb (json_eqb j j') (loop_arr l l') 846 | | (_, _) => false 847 | end in 848 | let fix loop_obj (l l' : list (String.string * json.t)) : bool := 849 | match (l, l') with 850 | | ([], []) => true 851 | | ((s, j) :: l, (s', j') :: l') => andb (string_eqb s s') 852 | (andb (json_eqb j j') 853 | (loop_obj l l')) 854 | | (_, _) => false 855 | end in 856 | match (j, j') with 857 | | (json.Null, json.Null) => true 858 | | (json.Bool b, json.Bool b') => Bool.eqb b b' 859 | | (json.Num n, json.Num n') => Nat.eqb n n' 860 | | (json.String s, json.String s') => string_eqb s s' 861 | | (json.Arr l, json.Arr l') => loop_arr l l' 862 | | (json.Obj l, json.Obj l') => loop_obj l l' 863 | | _ => false 864 | end. 865 | Definition loop_arr := 866 | fix loop_arr (l l': list json.t) : bool := 867 | match (l, l') with 868 | | ([], []) => true 869 | | (j :: l, j' :: l') => andb (json_eqb j j') (loop_arr l l') 870 | | (_, _) => false 871 | end. 872 | Definition loop_obj := 873 | fix loop_obj (l l' : list (String.string * json.t)) : bool := 874 | match (l, l') with 875 | | ([], []) => true 876 | | ((s, j) :: l, (s', j') :: l') => andb (string_eqb s s') 877 | (andb (json_eqb j j') (loop_obj l l')) 878 | | (_, _) => false 879 | end. 880 | 881 | Lemma json_eqb_eq : forall j j', json_eqb j j' = true -> j = j'. 882 | Proof using. 883 | induction j using json.json_rect with (P_list := fun l => 884 | forall l', loop_arr l l' = true -> l = l') 885 | (P_list' := fun l => 886 | forall l', loop_obj l l' = true -> l = l'); 887 | unfold json_eqb. 888 | - intros. 889 | destruct l'. 890 | + reflexivity. 891 | + simpl in H. congruence. 892 | - intros. 893 | destruct l'. 894 | + simpl in H. congruence. 895 | + simpl in H. 896 | apply Bool.andb_true_iff in H. 897 | assert (j = t). 898 | * apply IHj. apply H. 899 | * assert (l = l'). 900 | -- apply IHj0. apply H. 901 | -- now rewrite H0, H1. 902 | - intros. 903 | destruct l'. 904 | * reflexivity. 905 | * simpl in H. congruence. 906 | - intros. 907 | destruct l'; simpl in H. 908 | + congruence. 909 | + destruct p. 910 | apply Bool.andb_true_iff in H. destruct H. 911 | apply Bool.andb_true_iff in H0. destruct H0. 912 | assert (s = s0). now apply string_eqb_true in H. 913 | assert (j = t). apply (IHj t H0). 914 | assert (l = l'). apply (IHj0 _ H1). 915 | now rewrite H2, H3, H4. 916 | - destruct j'; try congruence. 917 | - destruct j'; try congruence. 918 | intros. 919 | apply Bool.eqb_prop in H. 920 | now rewrite H. 921 | - destruct j'; try congruence. 922 | intros. 923 | apply Nat.eqb_eq in H. 924 | now rewrite H. 925 | - destruct j'; try congruence. 926 | intros. 927 | apply string_eqb_true in H. 928 | now rewrite H. 929 | - fold json_eqb. 930 | fold loop_arr. 931 | destruct j'; try congruence. 932 | intros. 933 | apply IHj in H. 934 | now rewrite H. 935 | - fold json_eqb. 936 | fold loop_obj. 937 | destruct j'; try congruence. 938 | intros. 939 | apply IHj in H. 940 | now rewrite H. 941 | Qed. 942 | 943 | Lemma json_eq_eqb : forall j j', j = j' -> json_eqb j j' = true. 944 | Proof using. 945 | induction j using json.json_rect with (P_list := fun l => loop_arr l l = true) 946 | (P_list' := fun l => loop_obj l l = true). 947 | - reflexivity. 948 | - simpl. 949 | specialize IHj with j. 950 | rewrite IHj0. 951 | rewrite IHj; reflexivity. 952 | - reflexivity. 953 | - simpl. 954 | rewrite string_eqb_refl, IHj0. 955 | rewrite IHj; auto. 956 | - intros. now rewrite <- H. 957 | - intros. rewrite <- H. simpl. 958 | apply Bool.eqb_reflx. 959 | - intros. rewrite <- H. simpl. 960 | apply Nat.eqb_refl. 961 | - intros. 962 | rewrite <- H. 963 | simpl. 964 | apply string_eqb_refl. 965 | - intros. 966 | rewrite <- H. 967 | simpl. 968 | assumption. 969 | - intros. 970 | rewrite <- H. 971 | simpl. 972 | assumption. 973 | Qed. 974 | 975 | Lemma json_eq_dec : forall j j' : json.t, {j = j'} + {j <> j'}. 976 | Proof using. 977 | intros. 978 | destruct (json_eqb j j') eqn:H. 979 | + left. now apply json_eqb_eq. 980 | + right. intuition. 981 | rewrite json_eq_eqb in H; 982 | congruence. 983 | Qed. 984 | End JSON. 985 | 986 | Section Ptree. 987 | Context {A : Type} {sA : Serializer A}. 988 | 989 | Fixpoint tree_of_ptree (t : PositiveMap.t A) : tree (option A) := 990 | match t with 991 | | PositiveMap.Leaf _ => atom None 992 | | PositiveMap.Node t1 v t2 => 993 | node [tree_of_ptree t1; atom v; tree_of_ptree t2] 994 | end. 995 | 996 | Fixpoint ptree_of_tree (t : tree (option A)) : option (PositiveMap.t A) := 997 | match t with 998 | | atom None => Some (PositiveMap.Leaf A) 999 | | node [t1; atom v; t2] => 1000 | match ptree_of_tree t1, ptree_of_tree t2 with 1001 | | Some pt1, Some pt2 => 1002 | Some (PositiveMap.Node pt1 v pt2) 1003 | | _, _ => None 1004 | end 1005 | | _ => None 1006 | end. 1007 | 1008 | Lemma tree_of_ptree_ptree_of_tree : 1009 | forall t, ptree_of_tree (tree_of_ptree t) = Some t. 1010 | Proof using. 1011 | induction t using PositiveMap.tree_ind; auto. 1012 | simpl. 1013 | rewrite IHt1. 1014 | rewrite IHt2. 1015 | reflexivity. 1016 | Qed. 1017 | 1018 | Definition ptree_serialize (t : PositiveMap.t A) : IOStreamWriter.t := 1019 | serialize (tree_of_ptree t). 1020 | 1021 | Definition ptree_deserialize : ByteListReader.t (PositiveMap.t A) := 1022 | t <- deserialize;; 1023 | match ptree_of_tree t with 1024 | | Some pt => ByteListReader.ret pt 1025 | | None => ByteListReader.error 1026 | end. 1027 | 1028 | Lemma ptree_serialize_deserialize_id : 1029 | serialize_deserialize_id_spec ptree_serialize ptree_deserialize. 1030 | Proof using. 1031 | unfold ptree_serialize, ptree_deserialize. cheerios_crush. 1032 | rewrite tree_of_ptree_ptree_of_tree. 1033 | cheerios_crush. 1034 | Qed. 1035 | 1036 | Global Instance ptree_Serializer : Serializer (PositiveMap.t A) := 1037 | {| serialize := ptree_serialize; 1038 | deserialize := ptree_deserialize; 1039 | serialize_deserialize_id := ptree_serialize_deserialize_id 1040 | |}. 1041 | End Ptree. 1042 | --------------------------------------------------------------------------------