diff --git a/piqi-ocaml/CHANGES b/piqi-ocaml/CHANGES new file mode 100644 index 0000000..8f4ad29 --- /dev/null +++ b/piqi-ocaml/CHANGES @@ -0,0 +1,119 @@ +Piqi-ocaml 0.7.8 (Aug 05, 2019) +=============================== + +- Add support for the dune build system and use it from OPAM by default +- Switch CI setup from Travis to GH Actions + + +Piqi-ocaml 0.7.7 (Oct 12, 2019) +=============================== + +- Switch from Pervasives to Stdlib + + +Piqi-ocaml 0.7.6 (Sep 13, 2018) +=============================== + +- Fix sometimes incorrect handling of unknown fields (--gen-preserve-unknown-fields) +- (new) add support for .internal flag for fields that should be defined in OCaml but + skipped during serialization/deserialization + + +Piqi-ocaml 0.7.5 (May 31, 2016) +=============================== + +- Switch to tail-recursive List.map in the piqirun.ml runtime library +- (new feature) Support for overriding ocaml name of an imported module + + +Piqi-ocaml 0.7.4 (Mar 13, 2015) +=============================== + +- Fix build and tests for OCaml < 4.02.0 + + +Piqi-ocaml 0.7.3 (Mar 13, 2015) +=============================== + +- Fix compilation warnings for OCaml >= 4.02 + + +Piqi-ocaml 0.7.2 (May 17, 2014) +=============================== + +New features: + + - Automatically prefix OCaml keywords and user-specified reserved names with + underscores in generated OCaml code (thanks to Petter Urkedal) + + +Piqi-ocaml 0.7.1 (April 17, 2014) +================================= + +Fixes: + + - 'piqic-ocaml --normalize-names' should be true by default + +Other changes: + + - piqic-ocaml: indent generated .ml code instead of relying on camlp4o + + +Piqi-ocaml 0.7.0 (April 7, 2014) +================================ + +The main change of this release is the rewrite of the "piqic-ocaml" code +generator on top of "piqi compile" interfaces. As a result, we were able to move +the piqi-ocaml code from the main Piqi project repository into its own +piqi-ocaml repo. + +Other important changes: + + - "piqic ocaml" becomes "piqic-ocaml" + - "piqic ocaml-ext" turns into "piqic-ocaml --ext" + - "piqirun" becomes a package with two subpackages: piqirun.pb -- for Protobuf + serialization and piqirun.ext -- for multi-format serialization; piqirun.pb + should be now used instead of piqirun package and piqirun.ext -- instead of + piqi.lib + - "--gen-defaults" compiler option is deprecated. "piqic-ocaml" now generates + _piqi.default_X automatically + - Much more cleaner and stable interfaces in the piqilib dependency (those + that piqi-ocaml depends on); this allows us to release piqilib and + piqi-ocaml independently + - Drop support for OCaml <= 3.11 + - Deprecate and remove "pa_openin" camlp4 extension; "pa_labelscope" + extensions is kept for now as a part of the piqilib package so that existing + programs can still use it + - Deprecate and remove "piqic-ocaml -o " command-line option + +Fixes: + + - Fix generation of incorrect code for custom OCaml types + +New features: + + - Preserve unknown Protobuf fields through deserialization-serialization cycle + (new piqic-ocaml --gen-preserve-unknown-fields flag) + - New conversion options: piq_frameless_output, piq_frameless_input, + piq_relaxed_parsing + - Add the ability to specify conversion options for generated + _piqi_ext.print_/prerr_ functions + - Add piqic-ocaml --piqi-version flag for printing piqilib version + - Add piqic-ocaml --runtime option for specifying the name of the + Protobuf serialization runtime module (default = Piqirun) + +Miscellaneous: + + - Rename conversion option: json_omit_null_fields -> json_omit_missing_fields + - Improved piqi-ocaml documentation (available at doc/piqi-ocaml.md) + - Continuous builds via Travis-CI + + +Piqi 0.6.5 (October 27, 2013) +============================= + + Changelog for v0.6.5 and earlier releases is available here (the piqi-ocaml + project used to be a subtree in the piqi repository): + + https://github.com/alavrik/piqi/blob/master/CHANGES + diff --git a/piqi-ocaml/LICENSE b/piqi-ocaml/LICENSE new file mode 100644 index 0000000..e454a52 --- /dev/null +++ b/piqi-ocaml/LICENSE @@ -0,0 +1,178 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + diff --git a/piqi-ocaml/Makefile b/piqi-ocaml/Makefile new file mode 100644 index 0000000..73fbb9f --- /dev/null +++ b/piqi-ocaml/Makefile @@ -0,0 +1,31 @@ +include make/Makefile.dirs + + +DESTDIR ?= /usr/local + + +DIRS = piqirun piqic-ocaml + + +.PHONY: install uninstall clean distclean test + + +install: + $(MAKE) -C piqirun install + -install -d $(DESTDIR)/bin + install piqic-ocaml/piqic-ocaml $(DESTDIR)/bin + + +uninstall: + $(MAKE) -C piqirun uninstall + rm -f $(DESTDIR)/bin/piqic-ocaml + + +test: + $(MAKE) -C tests + + +distclean: + $(MAKE) clean + $(MAKE) -C tests clean + diff --git a/piqi-ocaml/README.md b/piqi-ocaml/README.md new file mode 100644 index 0000000..23a74d0 --- /dev/null +++ b/piqi-ocaml/README.md @@ -0,0 +1,142 @@ +[![build](https://github.com/alavrik/piqi-ocaml/actions/workflows/build.yml/badge.svg)](https://github.com/alavrik/piqi-ocaml/actions/workflows/build.yml) + + +Piqi is a multi-format data serialization system for OCaml. It provides a +uniform interface for serializing OCaml data structures to JSON, XML and +Protocol Buffers formats. + + +A typical Piqi usage scenario involves the following steps: + +**1. Install piqi-ocaml** -- see installation instructions below. + + +**2. Describe data structures using the Piqi data definition language or +Protocol Buffers `.proto` files** + +The [Piqi](http://piqi.org/doc/piqi/) data definition language can describe many +OCaml types, both primitive and user-defined. This includes integers, floats, +booleans, strings, binaries, lists, records and polymorphic variants. + +`.piqi` modules can be converted to and from Protocol Buffers `.proto` files: + + piqi to-proto X.piqi + piqi of-proto X.proto + + +**3. Call the Piqi compiler (piqic-ocaml) to generate OCaml type definitions and +serialization code** + + piqic-ocaml X.piqi + + +**4. Use generated serializes/deserializers in a user's program** -- the desired +serialization format can be specified at runtime. For +[examples](examples/addressbook/io_json_xml_pb.ml): + + + % deserialize a data structure from Protocol Buffers + let buf = Piqirun.init_from_string bytes in + let addressbook = Addressbook_piqi.parse_address_book buf in ... + + % serialize it as JSON + let json = Addressbook_piqi_ext.gen_address_book addressbook `json in ... + + % serialize it as pretty-printed JSON + let json_pretty = Addressbook_piqi_ext.gen_address_book addressbook `json_pretty in ... + + % serialize it as XML + let xml = Addressbook_piqi_ext.gen_address_book addressbook `xml in ... + + +Examples +-------- + +See [examples/addressbook](examples/addressbook/) and other projects in the +[examples](examples/) directory. + + +Installation +------------ + +### Installing using OPAM + +In order to install Piqi using [OPAM](https://opam.ocaml.org/), run the +following command: + + opam install piqi + +This command will install the latest stable version of Piqi that includes `piqi` +and `piqic-ocaml` executables and runtime libraries for OCaml. + +To install the latest development version of Piqi, use opam pinning. + + opam pin add -n --dev-repo piqilib + opam pin add -n --dev-repo piqi + opam install piqi + + +### Installing from source code +------------------------------- + +1. Download and install [piqi and piqilib](http://github.com/alavrik/piqi) + + Follow general build and installation instructions from the INSTALL file. + + After that, build and install the `piqilib` OCaml library by running + + make ocaml + make ocaml-install + + +2. Build and install `piqi-ocaml` + + ``` + make + make install + ``` + +To uninstall: + + make uninstall + + +Documentation +------------- + +Piqi OCaml documentation is available at http://piqi.org/doc/ocaml/ + +The master copy is located in this repository: +[doc/piqi-ocaml.md](doc/piqi-ocaml.md) + + +Bugs +---- + +Please report found problems using [GitHub +issues](http://github.com/alavrik/piqi-ocaml/issues). + + +Mailing list +------------ + +http://groups.google.com/group/piqi + + +Contributing +------------ + +Your contributions are always welcome. Just open a pull request. Check [TODO +list](TODO) for ideas. + + +Some useful commands: + + make test + + +License +------- + +[Apache License Version 2.0](LICENSE) + diff --git a/piqi-ocaml/THANKS b/piqi-ocaml/THANKS new file mode 100644 index 0000000..4f07512 --- /dev/null +++ b/piqi-ocaml/THANKS @@ -0,0 +1,4 @@ +The following people have contributed to piqi-ocaml: + +Koen De Keyser +Petter Urkedal diff --git a/piqi-ocaml/TODO b/piqi-ocaml/TODO new file mode 100644 index 0000000..5eb4743 --- /dev/null +++ b/piqi-ocaml/TODO @@ -0,0 +1,31 @@ +This is a list of ideas of how to improve piqi-ocaml. + +Current issues and feature requests: https://github.com/alavrik/piqi-ocaml/issues + + +New features +------------ + +- optionally, treat Piqi enums as OCaml integers and generate enum constants as + constants instead of polymorphic variants + + +Optimizations +------------- + +- profile and optimize piqirun.ml, e.g. varint encoding, record parsing, GC + behavior, etc. + + +Miscellaneous +------------- + +- add piqi-any example that demonstrates use of embedded JSON/XML (now that we + have piqi_piqi.ml as a part of piqilib); see piqi-erlang/examples/piqi-any for + details + +- more tests + + + +# ex: et sw=4 ts=4 diff --git a/piqi-ocaml/VERSION b/piqi-ocaml/VERSION new file mode 100644 index 0000000..2637de3 --- /dev/null +++ b/piqi-ocaml/VERSION @@ -0,0 +1 @@ +0.7.8-dev diff --git a/piqi-ocaml/doc/piqi-ocaml.md b/piqi-ocaml/doc/piqi-ocaml.md new file mode 100644 index 0000000..69bcfba --- /dev/null +++ b/piqi-ocaml/doc/piqi-ocaml.md @@ -0,0 +1,624 @@ +Overview +-------- + +Piqi includes a data serialization system for OCaml. It can be used for +serializing OCaml values in 4 different formats: Google Protocol Buffers, +[JSON](/doc/encodings/#json), [XML](/doc/encodings/#xml) and [Piq](/doc/piq/). + +A typical Piqi usage scenario involves the following steps: + +**1. Build and install Piqi libraries for OCaml** +: Piqi source code is distributed as a self-contained package with no external + dependencies. Builds have been tested on all major platforms. + + The installation instructions are available + [here](https://github.com/alavrik/piqi-ocaml). + +**2. Describe data structures using the Piqi data definition language** +: The [Piqi](/doc/piqi/) data definition language can describe many OCaml + types, both primitive and user-defined. This includes int, uint32 and + uint64, floats, bools, strings, lists, arrays, records and polymorphic + variants (including sub-variants). + + In addition to types supported by default, Piqi has a mechanism for adding + support for arbitrary monomorphic OCaml types. It can be used, for example, + to add support for OCaml's `nativeint` or `char`. + + Refer to the "Piqi to OCaml mapping" section below for details. + +**3. Call `piqic-ocaml`, the Piqi compiler for OCaml, to generate OCaml type + definitions and serialization code** +: See the next section for the detailed description. + +**4. Use generated serializes/deserializers/printers in a user's program** +: When multi-format serialization mode is used, one can specify a desired + format at runtime. + +**5. Link the user's program with the Piqi runtime library** +: There are two Piqi runtime libraries: `piqirun.pb` and `piqirun.ext`. The + first one is for Protocol Buffers serialization. The second one is used for + multi-format serialization. See the next section for more details. + +The [Examples](#examples) section contains links to several sample OCaml +projects that use Piqi for data serialization and demonstrate usage of steps +2--5. + + +Piqi compiler and generated OCaml code +-------------------------------------- + +`piqic-ocaml`, the Piqi compiler for OCaml, can generate two flavors of OCaml +code. The first one is used only for Protocol Buffers serialization. The second +flavor can be used for serializing multiple formats, including Protobuf, XML, +JSON and Piq. + +Multi-format serialization is an extension of the basic Protocol Buffers +serialization mode. It requires linking with a different runtime library. + + +### Protocol Buffers serialization + +When called without `--multi-format`, `piqic-ocaml` generates OCaml type +definitions and code for Protocol Buffers serialization. + +`piqic-ocaml` command takes a Piqi module `/.piqi` and produces +an output `.ml` file in the current working directory. By default, +`` is a valid OCaml module name equivalent to `_piqi`. + +For each specified, imported or included module `.piqi`, the compiler tries +to load and automatically include `.ocaml.piqi`. This mechanism is called +*Extension Modules*. It is described in detail in the Piqi language +[section](/doc/piqi#extensionmodules). + +Output directory can be overridden using the `-C` command-line option. + +Generated `.ml` file contains OCaml type definitions and functions +for serializing and deserializing OCaml values. + +For each defined data type ``, `piqic-ocaml` produces several +functions: + +- `parse_` -- for deserializing a value + +- `gen_` -- for serializing a value + +- `default_` -- type constructor: returns a minimally serializable + value of this type + +Compiled `.ml` files should be linked with the `piqilib.pb` findlib package. For +example: + + # generate "test_piqi.ml" + piqic-ocaml test.piqi + + # compile and link it with the runtime library using findlib/ocamlfind + ocamlfind ocamlc -linkpkg -package piqilib.pb test_piqi.ml + + +### Customized runtime library for Protocol Buffers serialization + +Under the hood, the `piqilib.pb` package resolves to a single compiled module +named `Piqirun`. This is the module the generated `_piqi.ml` OCaml code uses. + +Sometimes, it may be useful to use a modified version of the `Piqirun` module. +For example, a customized version could have extra optimizations, improve error +handling or implement serialization code for [Custom OCaml +types](#customocamltypes). + +To swap the default runtime for a customized one, call `piqic-ocaml` with +`--runtime ` option, where `` is the name of the +module to use instead of `Piqirun`. + + +### Multi-format serialization + +When `piqic-ocaml` is called with the `--multi-format` flag, it generates an +additional code for serializing values in XML, JSON, Protobuf and Piq formats. + +The additional module generated by this compiler is named +`_piqi_ext.ml`. + +The `parse_` and `gen_` functions from this module take an +additional parameter specifying which serialization format to use: + + type input_format = [ `piq | `json | `xml | `pb | `wire ] + + type output_format = [ input_format | `json_pretty | `xml_pretty ] + +In addition, `piqic-ocaml --multi-format` generates some other functions: + +- `print_` -- for printing a value to `stdout` in Piq format + +Each `parse_` and `gen_` function accepts an optional +`?opts` argument representing a set of serialization options that can be +constructed using `Piqirun_ext.make_options`: + + (* Construct serialization options to be passed as an optional argument to + * gen_ and parse_ functions. Available options: + * + * pretty_print + * + * Pretty-print generated JSON and XML output (default = true) + * + * json_omit_missing_fields + * + * Omit missing optional and empty repeated fields from JSON + * output instead of representing them as {"field_name": null} and + * {"field_name", []} JSON fields (default = true) + * + * use_strict_parsing + * + * Treat unknown and duplicate fields as errors when parsing JSON, + * XML and Piq formats (default = false) + * + * piq_frameless_output + * + * Print a frame (i.e. : []) around a single output Piq object + * (default=false) + * + * piq_frameless_input + * + * Expect a frame around a single input Piq object (default=false) + * + * piq_relaxed_parsing + * + * Parse Piq format using "relaxed" mode (default=false); + * + * For instance, when set to `true`, single-word string literals don't have + * to be quoted + *) + val make_options: + ?pretty_print:bool -> + ?json_omit_missing_fields:bool -> + ?use_strict_parsing:bool -> + ?piq_frameless_output:bool -> + ?piq_frameless_input:bool -> + ?piq_relaxed_parsing:bool -> + unit -> options + + +Compiled `.ml` files should be linked with the `piqirun.ext` findlib package. +For example: + + # generate "test_piqi.ml" and "test_piqi_ext.ml" + piqic-ocaml --multi-format test.piqi + + # compile and link them with the runtime library using findlib/ocamlfind + ocamlfind ocamlc -linkpkg -package piqirun.ext test_piqi.ml test_piqi_ext.ml + + +### Command-line parameters + +`piqic-ocaml` accepts the following command-line parameters. + +- `--multi-format` generate extended OCaml stubs for multi-format + (JSON/XML/Piq/Pb) serialization, i.e. `_piqi_ext.ml`a file + +- `--ext` same as `--multi-format` + +- `--normalize-names true|false` -- convert "CamelCase"-style identifiers from + the original type spec into "camel_case" OCaml names (names will be + capitalized when appropriate). When the argument is `false`, the original + identifiers will be lowercased without performing any additional + transformations, e.g. "CamelCase" turns into "camelCase". The default value + is `true`. + +- `--reserved-name` -- add a reserved name in addition to the standard OCaml + keywords. Can be used several times. Such names will be prefixed with + underscores in the generated OCaml code. + +- `--runtime ` name of the Protobuf serialization runtime module + (default = Piqirun) + +- `-C ` -- specify output directory for the generated `.ml` files. + +- `-I ` -- add directory to the list of imported .piqi search paths + +- `-e ` -- try including extension for all loaded modules (can be + used several times) + +- `--gen-preserve-unknown-fields` -- generate code that preserves unknown + Protobuf fields when they are serialized back. When enabled, unknown + (unrecognized) Protobuf fields are captured during de-serialization in a + special 'piqi_unknown_pb' field and automatically written back when the + record is serialized to Protobuf. + +- `--strict` treat unknown and duplicate fields as errors + +- `--no-warnings` -- don't print warnings + +- `--trace` -- turn on tracing (verbose output) + +- `--version` -- print piqi-ocaml version and exit + +- `--piqi-version` -- print piqi (piqilib) version and exit + +- `-h, --help` -- print command-line options help + + +Piqi to OCaml mapping +--------------------- + +The following sections describe how different Piqi constructs such as modules +and types are mapped to OCaml. + +### Modules + +The name of OCaml module is derived from Piqi module name unless overridden by +`ocaml-module` top-level field. + +If Piqi module name is "example.com/foo/bar", then "Bar" (the last part of the +Piqi module name) will be used as the OCaml module name. It is possible to +override such default name assignment by specifying +`.ocaml-module ""` in the Piqi module. + +#### Includes + +Piqi takes all "include" directives of a Piqi module, resolves them internally +and produces a compound Piqi module which is then mapped to the resulting OCaml +module. + +#### Imports + +Piqi "import" directives are mapped to OCaml modules in the following way. + +Imports that do not specify local module name are used directly as a part of +Ocaml type names for imported types. For example, + + .import [ .module example.com/foo/bar ] + .variant [ + .name v + .option [ + .name o + .type bar/t + ] + ] + +is mapped to: + + type v = [ `o of Bar.t ] + +Imports that do have imported module name result in generation of module alias. +For example, + + .import [ .module example.com/foo/bar .name fum ] + +is mapped to: + + module Fum = Bar + +It is possible to override ocaml names of an imported module by using +`.ocaml-name` and `.ocaml-module` properties in the import statement. For +example, given an import statement like this: + + .import [ + .module m + .ocaml-module "Foo.Bar" + .ocaml-name "Fum" + ] + +`piqic-ocaml` will generate the following statement at the top of the generated +`_piqi.ml`: + + module Fum = Foo.Bar + + +### Primitive types + +The table below represents correspondence between Piqi primitive types and OCaml +types. + +(Mapping between Piqi and Protocol Buffers primitive type is documented +[here](/doc/protobuf/#primitivetypes)). + + Piqi type(s) OCaml type Protobuf type(s) + ---------------------------------------------------------- ------------ ------------------------------------------ + bool bool bool + string string string + binary string bytes + int, uint int sint32, uint32 + int32, uint32, int32-fixed, uint32-fixed, protobuf-int32 int32 sint32, uint32, sfixed32, fixed32, int32 + int64, uint64, int64-fixed, uint64-fixed, protobuf-int64 int64 sint64, uint64, sfixed64, fixed64, int64 + float, float64, float32 float double, float + +If there is a need to add serialization support for other OCaml types, such as +`char`, `nativeint` or `bigint`, refer to [Custom OCaml +types](#customocamltypes) section which describes a method for mapping custom +OCaml types to Piqi types. + +### User-defined types + +- Type names + + Each user-defined type is identified by its name. Piqi type names are + converted to OCaml type name using the following rule. + + By default, Piqi identifiers are normalized and all hyphen characters are + replaced by underscores. Normalization means converting "CamelCase" to + "camel-case". + + If `--normalize false` command-line option is specified, then instead of + full normalization, the first letter of the type name is uncapitalized. + + Sometimes it is necessary to override this rule and specify a custom OCaml + name for a type. For example, when a Piqi type name conflicts with one of + OCaml keywords. In such case, custom OCaml name can be specified using + `.ocaml-name ""` field next to the original `.name ` + entry. (This feature also works for field names, option names, import names + and function names). + + For those Piqi fields or options that do not specify names, OCaml name is + derived from the name of the Piqi type for that field. + +- Records are mapped to OCaml records. + + As a workaround for OCaml's flat namespace for record labels, Piqi puts each + record definition in a separate OCaml module. The module's name is set to + the record's name. + + For example, Piqi record + + .record [ + .name r + .field [ .name a .type int ] + ] + + will be mapped to the following OCaml module: + + module R = + struct + record t = { mutable a : int } + end + + (In fact, the real example would be more verbose, because Piqi uses + recursive modules which require signature definition in addition to module + implementation.) + + To make working with records defined in separate modules easier, you can use + "local opens" introduced in OCaml 3.12. For example, records can be created + as + + R.({ a = 10; b = ... }) + + instead of + + {R.a = 10; b = ...} + + Similarly, if you have a significant portion of code working with some + record's fields, you can `open` the record's module before the code: + + let open R in + ... + + (let open R in ... is a full equivalent of R.( ... )) + + This way, you can refer to record felds as `x.a` instead of `x.R.a`. Note + that this doesn't work with several records simultaneously. + + + **required** Piqi fields are mapped directly to OCaml record fields. + + + **optional** Piqi fields of type `` are mapped to fields with type + ` option`. + + **optional** Piqi fields with specified default values are mapped + to OCaml fields the same way as required fields unless + `.ocaml-optional` flag is specified in which case the field will + have type ` option`. + + If a value of such field is not defined in serialized object, it + will be set to the default value during deserialization. Also, see + [Limitations](#limitations) section below. + + **repeated** Piqi fields of type `` are mapped to fields with type + ` list`. It is possible to use OCaml `array` instead of `list` by + specifying an additional `.ocaml-array` property in the field definition. + + It is possible for some fields to generate OCaml definitions but exclude + them during serialization/deserialization. This is achieved by adding + `.internal` flag under `.field [ ... ]`. + +- Enums and Variants are mapped directly to OCaml polymorphic variants. + + For example, these definitions: + + .enum [ + .name e + .option [ .name a ] + .option [ .name b ] + ] + .varint [ + .name v + .option [ .type e ] + .option [ .name f ] + .option [ .name i .type int ] + ] + + are mapped to: + + type e = [ `a | `b ] + type v = [ e | `f | `i of int ] + +- List type is mapped OCaml list type. + + For example, + + .list [ + .name l + .type x + ] + + is mapped to: + + type l = x list + + It is possible to use OCaml `array` instead of `list` by specifying an + additional `.ocaml-array` property in the field definition, e.g.: + + .list [ + .name l + .type x + .ocaml-array + ] + + is mapped to: + + type l = x array + +- Aliases are mapped to OCaml type definitions. + + For example, + + .alias [ + .name a + .type x + ] + + is mapped to: + + type a = x + +### Custom OCaml types + +Piqi provides a way to define mappings between custom OCaml types and Piqi +types. Such mechanism is useful when there is a need to automatically serialize +an OCaml type using some relevant Piqi type, but there is no way to describe the +desired OCaml type using Piqi. + +Inability to use Piqi to define an OCaml type would mean that the OCaml type is +either a primitive built-in or abstract type (e.g. `char` or `bigint`), or some +higher-order parametric type (e.g. `string Map.Make(String).t`). + +The mapping mechanism works as follows. Suppose we need to add support for +serializing OCaml's `char` type as Piqi `int`. This can be done in a few steps: + +1. First, define Piqi alias for such mapping: + + .alias [ + % the new Piqi type + .name char + + % the original Piqi type + .type int + + % OCaml type (should be point to the namespace with the mapping + % implementation -- see below) + .ocaml-type "Piqirun_custom.char" + + % optionally, define a custom OCaml name for this type + % .ocaml-name "char" + ] + +2. Second, implement runtime functions for mapping the custom OCaml type to the + Piqi type: + + In module `piqirun_custom.ml`: + + type char = Char.t + + let char_of_int: int -> char = Char.chr + let char_to_int: char -> int = Char.code + +After that, the only thing that's left is to compile and link +`piqirun_custom.ml` with your OCaml program. + +More examples of how to map various OCaml types to Piqi types can be found +[here](http://github.com/alavrik/piqi-ocaml/tree/master/examples/custom-types/). + +### Piqi extensions + +There is no direct notion of Piqi extensions in OCaml: Piqi extensions are all +resolved and applied to Piqi types before generating OCaml types from them. + +Examples +-------- + +- The first example is based on the "addressbook" example from Protocol + Buffers source distribution. It contains OCaml implementation of two simple + programs: for adding a record to an addressbook and for listing addressbook + contents. The programs implement the same functionality as programs from the + Protocol Buffers + [examples](https://github.com/google/protobuf/tree/v2.6.1/examples) written + in C++, Java and Python. + + [examples/ocaml](http://github.com/alavrik/piqi-ocaml/tree/master/examples/) + +- Data serialization in XML, JSON and Piq formats using `piqic-ocaml + --multi-format` + + In the same directory, there is the `io_json_xml_pb.ml` OCaml module. It + reads and writes the addressbook data structure from the previous example in + a variety of formats. + +- Piqi implementation itself makes another example + + Piqi is implemented in OCaml but the Piqi language and Piqi internal + representation are defined in a series of Piqi specifications which are + mapped to OCaml types. + + [Piqi self-specifications](http://github.com/alavrik/piqi/tree/master/piqi/) + +- More complicated example demonstrating complex types and module imports + + Piqi compiler for OCaml (`piqic-ocaml`) produces OCaml parsers and + generators from Piqi self-specification + ([piqi.piqi](/self-definition/#piqi_piqi)). After that, an OCaml + program reads (and writes back) Piqi self-specification represented as a + binary object. + + [tests/ocaml\_piqi](http://github.com/alavrik/piqi-ocaml/tree/master/tests/piqi/) + +- Examples of serializing custom OCaml types using Piqi + + [examples/ocaml-custom-types](http://github.com/alavrik/piqi-ocaml/tree/master/examples/custom-types/) + +- Example of using [Piq](/doc/piq) as a config file format + + [examples/ocaml-piq-config](http://github.com/alavrik/piqi-ocaml/tree/master/examples/piq-config/) + +Limitations +----------- + +The way how Piqi records are mapped to OCaml records introduces several +limitations. + +- Limited support for defaults. + + There is no way to tell if the value of an optional field came from the + original serialized object or it is the default value. + + There is no way to skip default values when serializing an optional field + since concrete value for that field must be always present in the OCaml + record. This behavior may be optimized in the future, but at the moment, it + will produce somewhat excessive serialized representation for optional + fields with default values. + +- No other dynamic properties. + + For example, in Protocol Buffers, there is a way to get the count of + repeated fields and access them using field index. (Update: now it is + possible to do that by specifying to use OCaml arrays instead of lists for + repeated fields). + +An alternative method would use OCaml objects for representing records, +providing "setters" and "getters" for object fields. Such method is used, for +example, in Protocol Buffers mappings for C++, Java and Python languages. + +Although it is possible (and even easier) to implement this method for OCaml, +the current method has several advantages: + +- Native syntax for record construction and field access. + +- Pattern matching works with records. + +- No runtime overhead of calling constructors, setters and getters. + +Other limitations: + +- Piqi runtime library hasn't been heavily optimized for performance yet. + +Supported OCaml and Protocol Buffers versions +--------------------------------------------- + +Piqi works with OCaml \>= 3.12 and Protocol Buffers \>= 2.3.0 diff --git a/piqi-ocaml/dune b/piqi-ocaml/dune new file mode 100644 index 0000000..8daec20 --- /dev/null +++ b/piqi-ocaml/dune @@ -0,0 +1 @@ +(env (dev (flags (:standard -warn-error -A)))) diff --git a/piqi-ocaml/dune-project b/piqi-ocaml/dune-project new file mode 100644 index 0000000..53dcc04 --- /dev/null +++ b/piqi-ocaml/dune-project @@ -0,0 +1,5 @@ +(lang dune 2.0) +(name piqi) + +(package (name piqi)) +(package (name piqirun)) diff --git a/piqi-ocaml/examples/addressbook/Makefile b/piqi-ocaml/examples/addressbook/Makefile new file mode 100644 index 0000000..ba31d3e --- /dev/null +++ b/piqi-ocaml/examples/addressbook/Makefile @@ -0,0 +1,30 @@ +.PHONY: all ocaml test ocaml_ext test_ext clean + + +all: ocaml test ocaml_ext test_ext + + +ocaml: + GOAL=add_person $(MAKE) -f Makefile.ocaml + GOAL=list_people $(MAKE) -f Makefile.ocaml + + +test: + ./test + + +ocaml_ext: + rm -f addressbook_piqi.cm? # forcing make to rebuild it + $(MAKE) -f Makefile.ocaml_ext + + +test_ext: ocaml_ext + ./io_json_xml_pb addressbook.piq.pb + + +clean: + GOAL=add_person $(MAKE) -f Makefile.ocaml clean + GOAL=list_people $(MAKE) -f Makefile.ocaml clean + rm -f addressbook.piq.pb addressbook.pb.piq l1 l2 + $(MAKE) -f Makefile.ocaml_ext clean + diff --git a/piqi-ocaml/examples/addressbook/Makefile.ocaml b/piqi-ocaml/examples/addressbook/Makefile.ocaml new file mode 100644 index 0000000..3c3c262 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/Makefile.ocaml @@ -0,0 +1,37 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +SOURCES = addressbook_piqi.ml + + +ifeq ($(GOAL),add_person) +RESULT = add_person +SOURCES += add_person.ml +else +RESULT = list_people +SOURCES += list_people.ml +endif + + +PRE_TARGETS = addressbook_piqi.ml + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +#PIQIC_FLAGS = + + +all: native-code #byte-code + + +addressbook_piqi.ml: addressbook.proto.piqi + $(PIQIC) $(PIQIC_FLAGS) $< + + +clean:: + rm -f *.tmp.ml + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/examples/addressbook/Makefile.ocaml_ext b/piqi-ocaml/examples/addressbook/Makefile.ocaml_ext new file mode 100644 index 0000000..74f19d3 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/Makefile.ocaml_ext @@ -0,0 +1,41 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = io_json_xml_pb + + +SOURCES = \ + $(PIQI_ML_FILES) \ + io_json_xml_pb.ml + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.ext + + +PIQI_FILES = addressbook.proto.piqi +PIQI_ML_FILES = addressbook_piqi.ml addressbook_piqi_ext.ml + + +PRE_TARGETS = $(PIQI_ML_FILES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +PIQIC_FLAGS = --multi-format + + +all: native-code #byte-code debug-code + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + +clean:: + rm -f *.tmp.ml + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/examples/addressbook/README b/piqi-ocaml/examples/addressbook/README new file mode 100644 index 0000000..fd4e563 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/README @@ -0,0 +1,35 @@ +This directory contains an example of an addressbook data structure definition +and two OCaml programs that rely on it to manipulate addressbook data: + + addressbook.proto.piqi -- definition of the addressbook data structure + + add_person.ml -- adds a person to the addressbook + + list_people.ml -- lists the contents of the addressbook + + +The "./test" shell script contains tests for the OCaml programs. + + +This example is based on the Google Protocol Buffers examples: + + http://protobuf.googlecode.com/svn/trunk/examples/ + (See their README.txt file for details) + +The data definition file "addressbook.proto.piqi" is converted from the original +"../addressbook.proto" using the "piqi of-proto" command. + +OCaml-specific extensions to the converted ".proto" specificaion are defined in +"addressbook.ocaml.piqi". + +The OCaml programs implement exactly the same functionality as Python, Java and +C++ programs from the Protobuf examples. The data structure and the binary +encoding of the addressbook data structure is fully compatible as well. As a +result, the OCaml programs can read an addressbook structure created by +Python/C++/Java programs and vice versa. + +This example also contains the "addressbook.piq" file which is a sample +addressbook data structure represented as a Piq file. It can be converted to the +binary Protocol Buffers format (using "piqi convert") and then can be +manipulated by the OCaml programs. + diff --git a/piqi-ocaml/examples/addressbook/add_person.ml b/piqi-ocaml/examples/addressbook/add_person.ml new file mode 100644 index 0000000..1d30150 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/add_person.ml @@ -0,0 +1,105 @@ + +module A = Addressbook_piqi + + +let default_phone_number = A.default_person_phone_number () + + +let read_phone_type () = + print_endline "Is this a mobile, home, or work phone? "; + match read_line () with + | "mobile" -> `mobile + | "home" -> `home + | "work" -> `work + | _ -> + print_endline "Unknown phone type. Using default."; + default_phone_number.A.Person_phone_number.phone_type + + +let read_phone_numbers () = + let rec aux accu = + match read_line () with + | "" -> List.rev accu + | number -> + let phone_type = read_phone_type () in + let res = + A.Person_phone_number.({ + number = number; + phone_type = phone_type; + }) + in aux (res :: accu) + in aux [] + + +(* This function fills in a Person message based on user input. *) +let prompt_for_address address_book = + print_endline "Enter person ID number: "; + let id = Int32.of_string (read_line ()) in + + print_endline "Enter name: "; + let name = read_line () in + + print_endline "Enter email address (blank for none): "; + let email = + match read_line () with + | "" -> None + | x -> Some x + in + + print_endline "Enter a phone number (or leave blank to finish): "; + let phone_numbers = read_phone_numbers () in + let person = + A.Person.({ + id = id; + name = name; + email = email; + phone = phone_numbers; + }) + in + A.Address_book.({ + (* address_book with *) + person = address_book.person @ [person] + }) + + +(* + * Main function: Reads the entire address book from a file, + * adds one person based on user input, then writes it back out to the same + * file. + *) +let _ = + if Array.length Sys.argv <> 2 + then + ( Printf.eprintf "Usage: %s ADDRESS_BOOK_FILE\n" Sys.argv.(0); + exit (-1) + ); + + let address_book = + try + (* Read the existing address book. *) + let ch = open_in_bin Sys.argv.(1) in + let buf = Piqirun.init_from_channel ch in + let res = A.parse_address_book buf in + close_in ch; + res + with + | Sys_error _ -> + Printf.printf "%s: File not found. Creating a new file.\n" Sys.argv.(0); + A.Address_book.({person = []}) + | Piqirun.Error _ -> + Printf.eprintf "Failed to parse address book.\n"; + exit (-1) + in + + (* Add an address. *) + let address_book = prompt_for_address address_book in + + (* Write the new address book back to disk. *) + let och = open_out_bin Sys.argv.(1) in + (* NOTE: specifying -1 as the field code has a special meaning: it tells + * generator not to generate the header (code/tag/len) -- just generate the + * contents *) + let data = A.gen_address_book address_book in + Piqirun.to_channel och data; + close_out och + diff --git a/piqi-ocaml/examples/addressbook/addressbook.ocaml.piqi b/piqi-ocaml/examples/addressbook/addressbook.ocaml.piqi new file mode 100644 index 0000000..0fbb793 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/addressbook.ocaml.piqi @@ -0,0 +1,20 @@ +% This is an extension for addressbook.proto.piqi module. +% +% This file will be automatically included by "piqic-ocaml" when it loads +% addressbook.proto.piqi +% +% After converting addressbook.proto to addressbook.proto.piqi, we need to add +% "ocaml-name" property for field "type" in "person-phone-name" record. This is +% necessary because "type" is a keyword in OCaml. + +.include [ .module addressbook ] + + +.extend [ + .field person-phone-number.type + + .with.ocaml-name "phone_type" +] + + +.custom-field ocaml-name diff --git a/piqi-ocaml/examples/addressbook/addressbook.piq b/piqi-ocaml/examples/addressbook/addressbook.piq new file mode 100644 index 0000000..2616aaf --- /dev/null +++ b/piqi-ocaml/examples/addressbook/addressbook.piq @@ -0,0 +1,54 @@ + +:addressbook/address-book [ + + .person [ + .name "J. Random Hacker" + .id 0 + + .email "j.r.hacker@example.com" + + .phone [ + .number "(111) 123 45 67" % phone is "home" by default + ] + + .phone [ + .number "(222) 123 45 67" + .mobile % NOTE: this is a "shorthand" for .type.mobile + ] + + .phone [ + .number "(333) 123 45 67" + .work + ] + + % this is also valid (but not recormmended) + .phone [ "(444) 123 45 67" .mobile ] + ] + + + % it is possible to omit optional "email" field + % and repeated "phone" field + .person [ + .name "Joe User" + .id 1 + + % it is possible to omit optional "email" field + % and repeated "phone" field + ] + + + % ... or even omit labels for the required fields (not recommended style + % though) + .person [ "Joe User Jr" 2 ] + + + % or even like that + .person [ + "Joe User II" + 3 + "joe.user@example.com" + .phone [ "(444) 123 45 67" ] + .phone [ "(555) 123 45 67" .work ] + ] +] + diff --git a/piqi-ocaml/examples/addressbook/addressbook.proto b/piqi-ocaml/examples/addressbook/addressbook.proto new file mode 100644 index 0000000..d15ef62 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/addressbook.proto @@ -0,0 +1,33 @@ +// This file was taken from Google Protocol Buffers source distribution. It is +// also available here: +// +// http://protobuf.googlecode.com/svn/trunk/examples/addressbook.proto + +package tutorial; + +option java_package = "com.example.tutorial"; +option java_outer_classname = "AddressBookProtos"; + +message Person { + required string name = 1; + required int32 id = 2; // Unique ID number for this person. + optional string email = 3; + + enum PhoneType { + MOBILE = 0; + HOME = 1; + WORK = 2; + } + + message PhoneNumber { + required string number = 1; + optional PhoneType type = 2 [default = HOME]; + } + + repeated PhoneNumber phone = 4; +} + +// Our address book file is just one of these. +message AddressBook { + repeated Person person = 1; +} diff --git a/piqi-ocaml/examples/addressbook/addressbook.proto.piqi b/piqi-ocaml/examples/addressbook/addressbook.proto.piqi new file mode 100644 index 0000000..963f0db --- /dev/null +++ b/piqi-ocaml/examples/addressbook/addressbook.proto.piqi @@ -0,0 +1,77 @@ +% This file was generated from "addressbook.proto" using the following command: +% +% piqi of-proto --normalize addressbook.proto + + +.protobuf-package "tutorial" + +.record [ + .name person + .field [ + .name name + .type string + .code 1 + ] + .field [ + .name id + .type protobuf-int32 + .code 2 + ] + .field [ + .name email + .type string + .optional + .code 3 + ] + .field [ + .name phone + .type person-phone-number + .repeated + .code 4 + ] +] + +.record [ + .name person-phone-number + .field [ + .name number + .type string + .code 1 + ] + .field [ + .name type + .type person-phone-type + .optional + .default.home + .code 2 + ] +] + +.enum [ + .name person-phone-type + .option [ + .name mobile + .code 0 + .protobuf-name "person_mobile" + ] + .option [ + .name home + .code 1 + .protobuf-name "person_home" + ] + .option [ + .name work + .code 2 + .protobuf-name "person_work" + ] +] + +.record [ + .name address-book + .field [ + .name person + .type person + .repeated + .code 1 + ] +] diff --git a/piqi-ocaml/examples/addressbook/io_json_xml_pb.ml b/piqi-ocaml/examples/addressbook/io_json_xml_pb.ml new file mode 100644 index 0000000..e1fc41d --- /dev/null +++ b/piqi-ocaml/examples/addressbook/io_json_xml_pb.ml @@ -0,0 +1,77 @@ + + +module Ab = Addressbook_piqi_ext + + +(* Main function: Reads the entire address book from a file and prints all + * the information inside in various formats *) +let _ = + if Array.length Sys.argv <> 2 + then + ( Printf.eprintf "Usage: %s ADDRESS_BOOK_FILE\n" Sys.argv.(0); + exit (-1) + ); + + (* Read the existing address book in binary Protocol Buffers format *) + let ch = open_in_bin Sys.argv.(1) in + let buf = Piqirun.init_from_channel ch in + let address_book = Addressbook_piqi.parse_address_book buf in + close_in ch; + + (* Serialize addressbook to JSON format *) + let json = Ab.gen_address_book address_book `json in + Printf.printf "\n\nJSON: \n\n%s\n" json; + (* Read back from JSON *) + let address_book' = Ab.parse_address_book json `json in + assert (address_book' = address_book); + + (* Serialize addressbook to pretty-printed JSON format *) + let json = Ab.gen_address_book address_book `json_pretty in + Printf.printf "\n\npretty-printed JSON: \n\n%s\n" json; + (* Read back from JSON *) + let address_book' = Ab.parse_address_book json `json in + assert (address_book' = address_book); + + (* Serialize addressbook to pretty-printed JSON format and include "null" JSON + * fields for missing optional and [] for missing required fields *) + let opts = Piqirun_ext.make_options ~json_omit_missing_fields:false () in + let json = Ab.gen_address_book address_book `json ~opts in + Printf.printf "\n\nJSON with null fields: \n\n%s\n" json; + (* Read back from JSON *) + let address_book' = Ab.parse_address_book json `json in + assert (address_book' = address_book); + + (* Serialize addressbook to XML format *) + let xml = Ab.gen_address_book address_book `xml in + Printf.printf "\n\nXML: \n\n%s\n" xml; + (* Read back from XML *) + let address_book' = Ab.parse_address_book xml `xml in + assert (address_book' = address_book); + + (* Serialize addressbook to pretty-printed XML format *) + let xml = Ab.gen_address_book address_book `xml_pretty in + Printf.printf "\n\npretty-printed XML: \n\n%s\n" xml; + (* Read back from XML *) + let address_book' = Ab.parse_address_book xml `xml in + assert (address_book' = address_book); + + + (* Serialize addressbook to Piq format *) + let piq = Ab.gen_address_book address_book `piq in + Printf.printf "\n\nPiq: \n\n%s\n" piq; + (* Read back from XML *) + let address_book' = Ab.parse_address_book piq `piq in + assert (address_book' = address_book); + + + (* Print addressbook to stdout in Piq format *) + Printf.printf "\n\nPrinting to stdout:\n\n"; + Ab.print_address_book address_book; + + + (* Print addressbook to stderr in Piq format *) + Printf.eprintf "\n\nPrinting to stderr:\n\n"; + Ab.prerr_address_book address_book; + + () + diff --git a/piqi-ocaml/examples/addressbook/list_people.ml b/piqi-ocaml/examples/addressbook/list_people.ml new file mode 100644 index 0000000..3fcb064 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/list_people.ml @@ -0,0 +1,50 @@ + +open Addressbook_piqi + + +let printf = Printf.printf + + +(* Iterates though all people in the AddressBook and prints info about them. *) +let list_people address_book = + let print_email = function + | Some email -> + printf " E-mail address: %s\n" email + | None -> () + in + let print_phone_number x = + (match x.Person_phone_number.phone_type with + | `mobile -> + printf " Mobile phone #: " + | `home -> + printf " Home phone #: " + | `work -> + printf " Work phone #: " + ); + printf "%s\n" x.Person_phone_number.number + in + let list_person x = + printf "Person ID: %ld\n" x.Person.id; + printf " Name: %s\n" x.Person.name; + print_email x.Person.email; + List.iter print_phone_number x.Person.phone + in + List.iter list_person address_book.Address_book.person + + +(* Main function: Reads the entire address book from a file and prints all + * the information inside. *) +let _ = + if Array.length Sys.argv <> 2 + then + ( Printf.eprintf "Usage: %s ADDRESS_BOOK_FILE\n" Sys.argv.(0); + exit (-1) + ); + (* Read the existing address book. *) + let ch = open_in_bin Sys.argv.(1) in + let buf = Piqirun.init_from_channel ch in + let address_book = parse_address_book buf in + close_in ch; + + list_people address_book + diff --git a/piqi-ocaml/examples/addressbook/test b/piqi-ocaml/examples/addressbook/test new file mode 100755 index 0000000..1a9b817 --- /dev/null +++ b/piqi-ocaml/examples/addressbook/test @@ -0,0 +1,63 @@ +#!/bin/sh + +: ${PIQI:=piqi} + + +set -ex + +# create a binary representation of the addressbook by converting it from piq +$PIQI convert -t pb addressbook.piq + +# create another copy of addressbook records using ocaml program +./add_person addressbook.pb < l1 +./list_people addressbook.pb > l2 +cmp l1 l2 + + +# check that the addressbook binary file created by "add_person" is readable by +# "piqi convert" +$PIQI convert --type addressbook/address-book addressbook.pb > addressbook.pb.piq + +rm addressbook.pb + diff --git a/piqi-ocaml/examples/custom-types/Makefile b/piqi-ocaml/examples/custom-types/Makefile new file mode 100644 index 0000000..8fccf00 --- /dev/null +++ b/piqi-ocaml/examples/custom-types/Makefile @@ -0,0 +1,44 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = a.out + + +SOURCES = \ + $(PIQI_ML_FILES1) \ + piqirun_custom.ml \ + $(PIQI_ML_FILES2) \ + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb num + + +PIQI_FILES = example.piqi skvl.piqi +PIQI_ML_FILES1 = skvl_piqi.ml +PIQI_ML_FILES2 = example_piqi.ml +PIQI_ML_FILES = $(PIQI_ML_FILES1) $(PIQI_ML_FILES2) + + +PRE_TARGETS = $(PIQI_ML_FILES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +#PIQIC_FLAGS = + + +all: native-code #byte-code debug-code + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + +clean:: + rm -f *.tmp.ml + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/examples/custom-types/README b/piqi-ocaml/examples/custom-types/README new file mode 100644 index 0000000..39c1cf2 --- /dev/null +++ b/piqi-ocaml/examples/custom-types/README @@ -0,0 +1,6 @@ +This is an example of how to serialize arbitrary monomorphic OCaml types by +mapping them to built-in or previously defined Piqi types. + +This mechanism can be used, for example, for serializing OCaml chars as +integers, bigints as decimal strings, or even "string Map.Make(String).t" as +list of {key, value} records. diff --git a/piqi-ocaml/examples/custom-types/example.piqi b/piqi-ocaml/examples/custom-types/example.piqi new file mode 100644 index 0000000..72c7a6f --- /dev/null +++ b/piqi-ocaml/examples/custom-types/example.piqi @@ -0,0 +1,70 @@ +% +% defining custom OCaml types to be serialized as some Piqi types +% + +% mapping OCaml char to Piqi int +.alias [ + .name char + .type int + .ocaml-type "Piqirun_custom.char" +] + + +% mapping OCaml nativeint to Piqi int +.alias [ + .name ocaml-nativeint + .type int + .ocaml-type "Piqirun_custom.nativeint" +] + + +% mapping OCaml big_int to Piqi string (by representing number as a decimal +% string) +.alias [ + .name ocaml-bigint + .type string + .ocaml-type "Piqirun_custom.bigint" +] + + +% +% mapping OCaml string key-value map (string Map.Make(String) +% to the list of {key, value} records +% + +.import [ .module skvl ] + +.alias [ + .name ocaml-string-key-value-list + .type skvl/string-key-value-list + .ocaml-type "Piqirun_custom.skvl" +] + + +% a record that uses the above definitions +.record [ + .name r + + .field [ + .name c + .type char + ] + + .field [ + .name ni + .type ocaml-nativeint + ] + + .field [ + .name bi + .type ocaml-bigint + ] + + .field [ + .name kvl + .type ocaml-string-key-value-list + ] +] + + +.custom-field ocaml-type diff --git a/piqi-ocaml/examples/custom-types/piqirun_custom.ml b/piqi-ocaml/examples/custom-types/piqirun_custom.ml new file mode 100644 index 0000000..5093c2b --- /dev/null +++ b/piqi-ocaml/examples/custom-types/piqirun_custom.ml @@ -0,0 +1,62 @@ +(* + * runtime support for OCaml custom types defined in example.piqi + *) + +(* mapping OCaml char to Piqi int *) +type char = Char.t + +let char_of_int: int -> char = Char.chr +let char_to_int: char -> int = Char.code + + +(* mapping OCaml nativeint to Piqi int *) +type nativeint = Nativeint.t + +let nativeint_of_int: int -> nativeint = Nativeint.of_int +let nativeint_to_int: nativeint -> int = Nativeint.to_int + + +(* mapping OCaml big_int to Piqi string (by representing number as a decimal + * string) + *) +type bigint = Big_int.big_int + +let bigint_of_string: string -> bigint = Big_int.big_int_of_string +let bigint_to_string: bigint -> string = Big_int.string_of_big_int + + +(* + * mapping string key-value map (string Map.Make(String) + * to the list of {key, value} records + *) + + +module M = Map.Make(String) +type skvl = string M.t + + +let list_of_map map = + let l = M.fold (fun k v accu -> (k,v)::accu) map [] in + List.rev l + +let map_of_list pairs = + List.fold_left (fun accu (k,v) -> M.add k v accu) M.empty pairs + + +open Skvl_piqi.String_key_value + +let skvl_of_string_key_value_list (x: Skvl_piqi.string_key_value_list) :skvl = + (* + M.empty + *) + let pairs = List.map (fun x -> x.key, x.value) x in + map_of_list pairs + + +let skvl_to_string_key_value_list (x :skvl) :Skvl_piqi.string_key_value_list = + (* + Skvl_piqi.default_string_key_value_list () + *) + let pairs = list_of_map x in + List.map (fun (k, v) -> {key = k; value = v}) pairs + diff --git a/piqi-ocaml/examples/custom-types/skvl.piqi b/piqi-ocaml/examples/custom-types/skvl.piqi new file mode 100644 index 0000000..613d249 --- /dev/null +++ b/piqi-ocaml/examples/custom-types/skvl.piqi @@ -0,0 +1,20 @@ + +.record [ + .name string-key-value + + .field [ + .name key + .type string + ] + .field [ + .name value + .type string + ] +] + + +.list [ + .name string-key-value-list + .type string-key-value +] + diff --git a/piqi-ocaml/examples/piq-config/Makefile b/piqi-ocaml/examples/piq-config/Makefile new file mode 100644 index 0000000..dae09f3 --- /dev/null +++ b/piqi-ocaml/examples/piq-config/Makefile @@ -0,0 +1,41 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = config + + +SOURCES = \ + $(PIQI_ML_FILES) \ + config.ml + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.ext + + +PIQI_FILES = config.piqi +PIQI_ML_FILES = config_piqi.ml config_piqi_ext.ml + + +PRE_TARGETS = $(PIQI_ML_FILES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +PIQIC_FLAGS = --multi-format + + +all: native-code #byte-code debug-code + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + +clean:: + rm -f *.tmp.ml + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/examples/piq-config/README b/piqi-ocaml/examples/piq-config/README new file mode 100644 index 0000000..80e33fb --- /dev/null +++ b/piqi-ocaml/examples/piq-config/README @@ -0,0 +1,14 @@ +This is an example of how to use configuration file in Piq format from OCaml +program. + +To build the example, run "make". + +The resulting "./config" executable will read the config data structure from +"config.piq" and print it on stdout. + + +Files: + config.piqi - the definition of the config file format + config.piq - an example config file + config.ml - an OCaml program that reads the "config.piq" file + diff --git a/piqi-ocaml/examples/piq-config/config.ml b/piqi-ocaml/examples/piq-config/config.ml new file mode 100644 index 0000000..d7f9390 --- /dev/null +++ b/piqi-ocaml/examples/piq-config/config.ml @@ -0,0 +1,30 @@ + +let read_file filename = + let ch = open_in_bin filename in + let len = in_channel_length ch in + let buf = Buffer.create len in + Buffer.add_channel buf ch len; + close_in ch; + Buffer.contents buf + + +(* common serialization options *) +let opts = Piqirun_ext.make_options () + ~piq_frameless_input:true + ~piq_frameless_output:true + + +let read_config filename = + let contents = read_file filename in + try + Config_piqi_ext.parse_config contents `piq ~opts + with + Piqi_common.Error ((file, col, line), error) -> + failwith (Printf.sprintf "error at %s:%d:%d: %s" file col line error) + + +(* test *) +let _ = + let config = read_config "config.piq" in + Config_piqi_ext.print_config config ~opts + diff --git a/piqi-ocaml/examples/piq-config/config.piq b/piqi-ocaml/examples/piq-config/config.piq new file mode 100644 index 0000000..4e83b93 --- /dev/null +++ b/piqi-ocaml/examples/piq-config/config.piq @@ -0,0 +1,24 @@ + +% the shortest form +[ "foo" .make ] + +% explicit field name +[ .path "foo" .make ] + +% more explicit field names +[ .path "foo" .generator.make ] + +% alternative notation for representing enums (variants) +[ .path "foo" .generator (.make) ] + +% the longest form +[ + .path "foo" + .generator.make +] + +% testing other enum values +[ "bar" .latexmk ] +[ "fum" .org ] +[ "baz" .tensile ] + diff --git a/piqi-ocaml/examples/piq-config/config.piqi b/piqi-ocaml/examples/piq-config/config.piqi new file mode 100644 index 0000000..2edf94f --- /dev/null +++ b/piqi-ocaml/examples/piq-config/config.piqi @@ -0,0 +1,26 @@ +.module config + +.enum [ + .name generator + .option [ .name make ] + .option [ .name latexmk ] + .option [ .name org ] + .option [ .name tensile ] +] + +.record [ + .name entry + .field [ + .name path + .type string + ] + .field [ + .type generator + ] +] + +.list [ + .name config + .type entry +] + diff --git a/piqi-ocaml/make/Makefile.dirs b/piqi-ocaml/make/Makefile.dirs new file mode 100644 index 0000000..712e1e3 --- /dev/null +++ b/piqi-ocaml/make/Makefile.dirs @@ -0,0 +1,20 @@ +.PHONY: all dirs clean pre_target post_target + +all: pre_target dirs post_target + + +dirs: $(DIRS) + set -e; \ + for dir in $(DIRS); do \ + $(MAKE) -C $$dir $(MAKECMDGOALS); \ + done + + +clean:: dirs + + +pre_target:: +post_target:: + + +# vim:ft=make diff --git a/piqi-ocaml/make/OCamlMakefile b/piqi-ocaml/make/OCamlMakefile new file mode 100644 index 0000000..0e1ef2a --- /dev/null +++ b/piqi-ocaml/make/OCamlMakefile @@ -0,0 +1,1281 @@ +########################################################################### +# OCamlMakefile +# Copyright (C) 1999- Markus Mottl +# +# For updates see: +# http://www.ocaml.info/home/ocaml_sources.html +# +########################################################################### + +# Modified by damien for .glade.ml compilation + +# Set these variables to the names of the sources to be processed and +# the result variable. Order matters during linkage! + +ifndef SOURCES + SOURCES := foo.ml +endif +export SOURCES + +ifndef RES_CLIB_SUF + RES_CLIB_SUF := _stubs +endif +export RES_CLIB_SUF + +ifndef RESULT + RESULT := foo +endif +export RESULT := $(strip $(RESULT)) + +export LIB_PACK_NAME + +ifndef DOC_FILES + DOC_FILES := $(filter %.mli, $(SOURCES)) +endif +export DOC_FILES +FIRST_DOC_FILE := $(firstword $(DOC_FILES)) + +export BCSUFFIX +export NCSUFFIX + +ifndef TOPSUFFIX + TOPSUFFIX := .top +endif +export TOPSUFFIX + +# Eventually set include- and library-paths, libraries to link, +# additional compilation-, link- and ocamlyacc-flags +# Path- and library information needs not be written with "-I" and such... +# Define THREADS if you need it, otherwise leave it unset (same for +# USE_CAMLP4)! + +export THREADS +export VMTHREADS +export ANNOTATE +export USE_CAMLP4 + +export INCDIRS +export DINCDIRS +export LIBDIRS +export EXTLIBDIRS +export RESULTDEPS +export OCAML_DEFAULT_DIRS + +export LIBS +export CLIBS +export CFRAMEWORKS + +export OCAMLFLAGS +export OCAMLNCFLAGS +export OCAMLBCFLAGS + +export OCAMLLDFLAGS +export OCAMLNLDFLAGS +export OCAMLBLDFLAGS + +export OCAMLMKLIB_FLAGS + +ifndef OCAMLCPFLAGS + OCAMLCPFLAGS := a +endif +export OCAMLCPFLAGS + +ifndef DOC_DIR + DOC_DIR := doc +endif +export DOC_DIR + +export PPFLAGS + +export LFLAGS +export YFLAGS +export IDLFLAGS + +export OCAMLDOCFLAGS + +export OCAMLFIND_INSTFLAGS + +export DVIPSFLAGS + +export STATIC + +# Add a list of optional trash files that should be deleted by "make clean" +export TRASH + +ECHO := echo + +ifdef REALLY_QUIET + export REALLY_QUIET + ECHO := true + LFLAGS := $(LFLAGS) -q + YFLAGS := $(YFLAGS) -q +endif + +#################### variables depending on your OCaml-installation + +SYSTEM := $(shell ocamlc -config 2>/dev/null | grep system | sed 's/system: //') + # This may be + # - mingw + # - mingw64 + # - win32 + # - cygwin + # - some other string means Unix + # - empty means ocamlc does not support -config + +ifeq ($(SYSTEM),$(filter $(SYSTEM),mingw mingw64)) + MINGW=1 +endif +ifeq ($(SYSTEM),win32) + MSVC=1 +endif + +ifdef MINGW + export MINGW + WIN32 := 1 + # The OCaml C header files use this flag: + CFLAGS += -D__MINGW32__ +endif +ifdef MSVC + export MSVC + WIN32 := 1 + ifndef STATIC + CPPFLAGS_WIN32 := -DCAML_DLL + endif + CFLAGS_WIN32 += -nologo + EXT_OBJ := obj + EXT_LIB := lib + ifeq ($(CC),gcc) + # work around GNU Make default value + ifdef THREADS + CC := cl -MT + else + CC := cl + endif + endif + ifeq ($(CXX),g++) + # work around GNU Make default value + CXX := $(CC) + endif + CFLAG_O := -Fo +endif +ifdef WIN32 + EXT_CXX := cpp + EXE := .exe +endif + +ifndef EXT_OBJ + EXT_OBJ := o +endif +ifndef EXT_LIB + EXT_LIB := a +endif +ifndef EXT_CXX + EXT_CXX := cc +endif +ifndef EXE + EXE := # empty +endif +ifndef CFLAG_O + CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! +endif + +export CC +export CXX +export CFLAGS +export CXXFLAGS +export LDFLAGS +export CPPFLAGS + +ifndef RPATH_FLAG + ifdef ELF_RPATH_FLAG + RPATH_FLAG := $(ELF_RPATH_FLAG) + else + RPATH_FLAG := -R + endif +endif +export RPATH_FLAG + +ifndef MSVC +ifndef PIC_CFLAGS + PIC_CFLAGS := -fPIC +endif +ifndef PIC_CPPFLAGS + PIC_CPPFLAGS := -DPIC +endif +endif + +export PIC_CFLAGS +export PIC_CPPFLAGS + +BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) +NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) +TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) + +ifndef OCAMLFIND + OCAMLFIND := ocamlfind +endif +export OCAMLFIND + +ifndef OCAMLC + OCAMLC := ocamlc +endif +export OCAMLC + +ifndef OCAMLOPT + OCAMLOPT := ocamlopt +endif +export OCAMLOPT + +ifndef OCAMLMKTOP + OCAMLMKTOP := ocamlmktop +endif +export OCAMLMKTOP + +ifndef OCAMLCP + OCAMLCP := ocamlcp +endif +export OCAMLCP + +ifndef OCAMLDEP + OCAMLDEP := ocamldep +endif +export OCAMLDEP + +ifndef OCAMLLEX + OCAMLLEX := ocamllex +endif +export OCAMLLEX + +ifndef OCAMLYACC + OCAMLYACC := ocamlyacc +endif +export OCAMLYACC + +ifndef OCAMLMKLIB + OCAMLMKLIB := ocamlmklib +endif +export OCAMLMKLIB + +ifndef OCAML_GLADECC + OCAML_GLADECC := lablgladecc2 +endif +export OCAML_GLADECC + +ifndef OCAML_GLADECC_FLAGS + OCAML_GLADECC_FLAGS := +endif +export OCAML_GLADECC_FLAGS + +ifndef CAMELEON_REPORT + CAMELEON_REPORT := report +endif +export CAMELEON_REPORT + +ifndef CAMELEON_REPORT_FLAGS + CAMELEON_REPORT_FLAGS := +endif +export CAMELEON_REPORT_FLAGS + +ifndef CAMELEON_ZOGGY + CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo +endif +export CAMELEON_ZOGGY + +ifndef CAMELEON_ZOGGY_FLAGS + CAMELEON_ZOGGY_FLAGS := +endif +export CAMELEON_ZOGGY_FLAGS + +ifndef OXRIDL + OXRIDL := oxridl +endif +export OXRIDL + +ifndef CAMLIDL + CAMLIDL := camlidl +endif +export CAMLIDL + +ifndef CAMLIDLDLL + CAMLIDLDLL := camlidldll +endif +export CAMLIDLDLL + +ifndef NOIDLHEADER + MAYBE_IDL_HEADER := -header +endif +export NOIDLHEADER + +export NO_CUSTOM + +ifndef CAMLP4 + CAMLP4 := camlp4 +endif +export CAMLP4 + +ifndef REAL_OCAMLFIND + ifdef PACKS + ifndef CREATE_LIB + ifdef THREADS + PACKS += threads + endif + endif + empty := + space := $(empty) $(empty) + comma := , + ifdef PREDS + PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) + PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) + OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) + # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) + OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) + OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) + else + OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) + OCAML_DEP_PACKAGES := + endif + OCAML_FIND_LINKPKG := -linkpkg + REAL_OCAMLFIND := $(OCAMLFIND) + endif +endif + +export OCAML_FIND_PACKAGES +export OCAML_DEP_PACKAGES +export OCAML_FIND_LINKPKG +export REAL_OCAMLFIND + +ifndef OCAMLDOC + OCAMLDOC := ocamldoc +endif +export OCAMLDOC + +ifndef LATEX + LATEX := latex +endif +export LATEX + +ifndef DVIPS + DVIPS := dvips +endif +export DVIPS + +ifndef PS2PDF + PS2PDF := ps2pdf +endif +export PS2PDF + +ifndef OCAMLMAKEFILE + OCAMLMAKEFILE := OCamlMakefile +endif +export OCAMLMAKEFILE + +ifndef OCAMLLIBPATH + OCAMLLIBPATH := \ + $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) +endif +export OCAMLLIBPATH + +ifndef OCAML_LIB_INSTALL + OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib +endif +export OCAML_LIB_INSTALL + +########################################################################### + +#################### change following sections only if +#################### you know what you are doing! + +# delete target files when a build command fails +.PHONY: .DELETE_ON_ERROR +.DELETE_ON_ERROR: + +# for pedants using "--warn-undefined-variables" +export MAYBE_IDL +export REAL_RESULT +export CAMLIDLFLAGS +export THREAD_FLAG +export RES_CLIB +export MAKEDLL +export ANNOT_FLAG +export C_OXRIDL +export SUBPROJS +export CFLAGS_WIN32 +export CPPFLAGS_WIN32 + +INCFLAGS := + +SHELL := /bin/sh + +MLDEPDIR := ._d +BCDIDIR := ._bcdi +NCDIDIR := ._ncdi + +FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.m %.$(EXT_CXX) %.rep %.zog %.glade + +FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) +SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) + +FILTERED_REP := $(filter %.rep, $(FILTERED)) +DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) +AUTO_REP := $(FILTERED_REP:.rep=.ml) + +FILTERED_ZOG := $(filter %.zog, $(FILTERED)) +DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) +AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) + +FILTERED_GLADE := $(filter %.glade, $(FILTERED)) +DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) +AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) + +FILTERED_ML := $(filter %.ml, $(FILTERED)) +DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) + +FILTERED_MLI := $(filter %.mli, $(FILTERED)) +DEP_MLI := $(FILTERED_MLI:.mli=.di) + +FILTERED_MLL := $(filter %.mll, $(FILTERED)) +DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) +AUTO_MLL := $(FILTERED_MLL:.mll=.ml) + +FILTERED_MLY := $(filter %.mly, $(FILTERED)) +DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) +AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) + +FILTERED_IDL := $(filter %.idl, $(FILTERED)) +DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) +C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) +ifndef NOIDLHEADER + C_IDL += $(FILTERED_IDL:.idl=.h) +endif +OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) +AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) + +FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) +DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) +AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) + +FILTERED_C_CXX := $(filter %.c %.m %.$(EXT_CXX), $(FILTERED)) +OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) +OBJ_C_CXX := $(OBJ_C_CXX:.m=.$(EXT_OBJ)) +OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) + +PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) + +ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) + +MLDEPS := $(filter %.d, $(ALL_DEPS)) +MLIDEPS := $(filter %.di, $(ALL_DEPS)) +BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) +NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) + +ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) + +IMPLO_INTF := $(ALLML:%.mli=%.mli.__) +IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ + $(basename $(file)).cmi $(basename $(file)).cmo) +IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) +IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) + +IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) + +INTF := $(filter %.cmi, $(IMPLO_INTF)) +IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) +IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) +IMPL_ASM := $(IMPL_CMO:.cmo=.asm) +IMPL_S := $(IMPL_CMO:.cmo=.s) + +OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) +OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) + +EXECS := $(addsuffix $(EXE), \ + $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) +ifdef WIN32 + EXECS += $(BCRESULT).dll $(NCRESULT).dll +endif + +CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) +ifneq ($(strip $(OBJ_LINK)),) + RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) +endif + +ifdef WIN32 +DLLSONAME := dll$(CLIB_BASE).dll +else +DLLSONAME := dll$(CLIB_BASE).so +endif + +NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ + $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ + $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ + $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ + $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ + $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx \ + $(LIB_PACK_NAME).$(EXT_OBJ) + +ifndef STATIC + NONEXECS += $(DLLSONAME) +endif + +ifndef LIBINSTALL_FILES + LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ + $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + LIBINSTALL_FILES += $(DLLSONAME) + endif + endif +endif + +export LIBINSTALL_FILES + +ifdef WIN32 + # some extra stuff is created while linking DLLs + NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib +endif + +TARGETS := $(EXECS) $(NONEXECS) + +# If there are IDL-files +ifneq ($(strip $(FILTERED_IDL)),) + MAYBE_IDL := -cclib -lcamlidl +endif + +ifdef USE_CAMLP4 + CAMLP4PATH := \ + $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) + INCFLAGS := -I $(CAMLP4PATH) + CINCFLAGS := -I$(CAMLP4PATH) +endif + +INCFLAGS_COMMON := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) +INCFLAGS := $(INCFLAGS_COMMON) $(INCDIRS:%=-I %) +DINCFLAGS := $(INCFLAGS_COMMON) $(DINCDIRS:%=-I %) +CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) + +ifndef MSVC + CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ + $(EXTLIBDIRS:%=-L%) $(OCAML_DEFAULT_DIRS:%=-L%) + + ifeq ($(ELF_RPATH), yes) + CLIBFLAGS += $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) + endif +endif + +ifndef PROFILING + INTF_OCAMLC := $(OCAMLC) +else + ifndef THREADS + INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) + else + # OCaml does not support profiling byte code + # with threads (yet), therefore we force an error. + ifndef REAL_OCAMLC + $(error Profiling of multithreaded byte code not yet supported by OCaml) + endif + INTF_OCAMLC := $(OCAMLC) + endif +endif + +ifndef MSVC + COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ + $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ + $(EXTLIBDIRS:%=-ccopt -Wl $(OCAML_DEFAULT_DIRS:%=-ccopt -L%)) + + ifeq ($(ELF_RPATH),yes) + COMMON_LDFLAGS += $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) + endif +else + COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ + $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ + $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " +endif + +CLIBS_OPTS := $(CLIBS:%=-cclib -l%) $(CFRAMEWORKS:%=-cclib '-framework %') +ifdef MSVC + ifndef STATIC + # MSVC libraries do not have 'lib' prefix + CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) + endif +endif + +ifneq ($(strip $(OBJ_LINK)),) + ifdef CREATE_LIB + OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) + else + OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) + endif +else + OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) +endif + +ifdef LIB_PACK_NAME + FOR_PACK_NAME := $(shell echo $(LIB_PACK_NAME) | awk '{print toupper(substr($$0,1,1))substr($$0,2)}') +endif + +# If we have to make byte-code +ifndef REAL_OCAMLC + BYTE_OCAML := y + + # EXTRADEPS is added dependencies we have to insert for all + # executable files we generate. Ideally it should be all of the + # libraries we use, but it's hard to find the ones that get searched on + # the path since I don't know the paths built into the compiler, so + # just include the ones with slashes in their names. + EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + + + ifndef LIB_PACK_NAME + SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) + else + SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLBCFLAGS) + endif + + REAL_OCAMLC := $(INTF_OCAMLC) + + REAL_IMPL := $(IMPL_CMO) + REAL_IMPL_INTF := $(IMPLO_INTF) + IMPL_SUF := .cmo + + DEPFLAGS := + MAKE_DEPS := $(MLDEPS) $(BCDEPIS) + + ifdef CREATE_LIB + override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) + override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + MAKEDLL := $(DLLSONAME) + ALL_LDFLAGS := -dllib $(DLLSONAME) + endif + endif + endif + + ifndef NO_CUSTOM + ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS) $(CFRAMEWORKS))" "" + ALL_LDFLAGS += -custom + endif + endif + + ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ + $(COMMON_LDFLAGS) $(LIBS:%=%.cma) + CAMLIDLDLLFLAGS := + + ifdef THREADS + ifdef VMTHREADS + THREAD_FLAG := -vmthread + else + THREAD_FLAG := -thread + endif + ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) + ifndef CREATE_LIB + ifndef REAL_OCAMLFIND + ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) + endif + endif + endif + +# we have to make native-code +else + EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + ifndef PROFILING + SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) + PLDFLAGS := + else + SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) + PLDFLAGS := -p + endif + + ifndef LIB_PACK_NAME + SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) + else + SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLNCFLAGS) + endif + REAL_IMPL := $(IMPL_CMX) + REAL_IMPL_INTF := $(IMPLX_INTF) + IMPL_SUF := .cmx + + override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) + + DEPFLAGS := -native + MAKE_DEPS := $(MLDEPS) $(NCDEPIS) + + ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ + $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) + CAMLIDLDLLFLAGS := -opt + + ifndef CREATE_LIB + ALL_LDFLAGS += $(LIBS:%=%.cmxa) + else + override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) + override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) + endif + + ifdef THREADS + THREAD_FLAG := -thread + ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) + ifndef CREATE_LIB + ifndef REAL_OCAMLFIND + ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) + endif + endif + endif +endif + +export MAKE_DEPS + +ifdef ANNOTATE + ANNOT_FLAG := -dtypes +else +endif + +ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ + $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) + +ifdef make_deps + -include $(MAKE_DEPS) + PRE_TARGETS := +endif + +########################################################################### +# USER RULES + +# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. +QUIET=@ + +# generates byte-code (default) +byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bc: byte-code + +byte-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bcnl: byte-code-nolink + +top: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes + +# generates native-code + +native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +nc: native-code + +native-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncnl: native-code-nolink + +# generates byte-code libraries +byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" \ + CREATE_LIB=yes \ + make_deps=yes +bcl: byte-code-library + +# generates native-code libraries +native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +ncl: native-code-library + +ifdef WIN32 +# generates byte-code dll +byte-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).dll \ + REAL_RESULT="$(BCRESULT)" \ + make_deps=yes +bcd: byte-code-dll + +# generates native-code dll +native-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).dll \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncd: native-code-dll +endif + +# generates byte-code with debugging information +debug-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dc: debug-code + +debug-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dcnl: debug-code-nolink + +# generates byte-code with debugging information (native code) +debug-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" make_deps=yes \ + REAL_OCAMLC="$(OCAMLOPT)" \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dnc: debug-native-code + +debug-native-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(NCRESULT)" make_deps=yes \ + REAL_OCAMLC="$(OCAMLOPT)" \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dncnl: debug-native-code-nolink + +# generates byte-code libraries with debugging information +debug-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + CREATE_LIB=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dcl: debug-code-library + +# generates byte-code libraries with debugging information (native code) +debug-native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cma \ + REAL_RESULT="$(NCRESULT)" make_deps=yes \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dncl: debug-native-code-library + +# generates byte-code for profiling +profiling-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + make_deps=yes +pbc: profiling-byte-code + +# generates native-code + +profiling-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PROFILING="y" \ + make_deps=yes +pnc: profiling-native-code + +# generates byte-code libraries +profiling-byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + CREATE_LIB=yes \ + make_deps=yes +pbcl: profiling-byte-code-library + +# generates native-code libraries +profiling-native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" PROFILING="y" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +pncl: profiling-native-code-library + +# packs byte-code objects +pack-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ + REAL_RESULT="$(BCRESULT)" \ + PACK_LIB=yes make_deps=yes +pabc: pack-byte-code + +# packs native-code objects +pack-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(NCRESULT).cmx $(NCRESULT).$(EXT_OBJ) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PACK_LIB=yes make_deps=yes +panc: pack-native-code + +# generates HTML-documentation +htdoc: $(DOC_DIR)/$(RESULT)/html/index.html + +# generates Latex-documentation +ladoc: $(DOC_DIR)/$(RESULT)/latex/doc.tex + +# generates PostScript-documentation +psdoc: $(DOC_DIR)/$(RESULT)/latex/doc.ps + +# generates PDF-documentation +pdfdoc: $(DOC_DIR)/$(RESULT)/latex/doc.pdf + +# generates all supported forms of documentation +doc: htdoc ladoc psdoc pdfdoc + +########################################################################### +# LOW LEVEL RULES + +$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ + $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ + $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) + +nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) + +ifdef WIN32 +$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) + $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ + -o $@ $(REAL_IMPL) +endif + +%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ + $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ + $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) + +.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ + .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .m .$(EXT_CXX) .h .so \ + .rep .zog .glade + +ifndef STATIC +ifdef MINGW +# From OCaml 3.11.0, ocamlmklib is available on windows +OCAMLMLIB_EXISTS = $(shell which $(OCAMLMKLIB)) +ifeq ($(strip $(OCAMLMLIB_EXISTS)),) +$(DLLSONAME): $(OBJ_LINK) + $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ + $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ + '$(OCAMLLIBPATH)/ocamlrun.a' \ + -Wl,--whole-archive \ + -Wl,--export-all-symbols \ + -Wl,--allow-multiple-definition \ + -Wl,--enable-auto-import +else +$(DLLSONAME): $(OBJ_LINK) + $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ + -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ + $(CFRAMEWORKS:%=-framework %) \ + $(OCAMLMKLIB_FLAGS) +endif +else +ifdef MSVC +$(DLLSONAME): $(OBJ_LINK) + link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ + $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ + '$(OCAMLLIBPATH)/ocamlrun.lib' + +else +$(DLLSONAME): $(OBJ_LINK) + $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ + -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) $(CFRAMEWORKS:%=-framework %) \ + $(OCAMLMKLIB_FLAGS) +endif +endif +endif + +ifndef LIB_PACK_NAME +$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(REAL_IMPL) + +$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(REAL_IMPL) +else +# Packing a bytecode library +ifdef BYTE_OCAML +$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(OCAMLLDFLAGS) $(REAL_IMPL) +# Packing into a unit which can be transformed into a library +# Remember the .ml's must have been compiled with -for-pack $(LIB_PACK_NAME) +else +$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) + $(REAL_OCAMLFIND) $(OCAMLOPT) -pack -o $(LIB_PACK_NAME).cmx $(OCAMLLDFLAGS) $(REAL_IMPL) +endif + +$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmo + +$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) + $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(filter-out -custom, $(ALL_LDFLAGS)) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmx +endif + +$(RES_CLIB): $(OBJ_LINK) +ifndef MSVC + ifneq ($(strip $(OBJ_LINK)),) + $(AR) rcs $@ $(OBJ_LINK) + endif +else + ifneq ($(strip $(OBJ_LINK)),) + lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) + endif +endif + +.mli.cmi: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + else \ + pp=`eval echo $$pp`; \ + pp=`echo $$pp | sed -e 's!:\\/!:\\\\!'`; \ + $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + fi + +.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c $(ALL_OCAMLCFLAGS) $<; \ + else \ + pp=`eval echo $$pp`; \ + pp=`echo $$pp | sed -e 's!:\\/!:\\\\!'`; \ + $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ + -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ + fi + +.PRECIOUS: %.ml +%.ml: %.mll + $(OCAMLLEX) $(LFLAGS) $< + +.PRECIOUS: %.ml %.mli +%.ml %.mli: %.mly + $(OCAMLYACC) $(YFLAGS) $< + $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \ + if [ ! -z "$$pp" ]; then \ + mv $*.ml $*.ml.temporary; \ + echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \ + cat $*.ml.temporary >> $*.ml; \ + rm $*.ml.temporary; \ + mv $*.mli $*.mli.temporary; \ + echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \ + cat $*.mli.temporary >> $*.mli; \ + rm $*.mli.temporary; \ + fi + + +.PRECIOUS: %.ml +%.ml: %.rep + $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< + +.PRECIOUS: %.ml +%.ml: %.zog + $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ + +.PRECIOUS: %.ml +%.ml: %.glade + $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ + +.PRECIOUS: %.ml %.mli +%.ml %.mli: %.oxridl + $(OXRIDL) $< + +.PRECIOUS: %.ml %.mli %_stubs.c %.h +%.ml %.mli %_stubs.c %.h: %.idl + $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ + $(CAMLIDLFLAGS) $< + $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi + +.c.$(EXT_OBJ): + $(OCAMLC) -c -ccopt "$(CFLAGS) \ + $(CPPFLAGS) $(CPPFLAGS_WIN32) \ + $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< + +.m.$(EXT_OBJ): + $(CC) -c $(CFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ + -I'$(OCAMLLIBPATH)' \ + $< $(CFLAG_O)$@ + +.$(EXT_CXX).$(EXT_OBJ): + $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ + -I'$(OCAMLLIBPATH)' \ + $< $(CFLAG_O)$@ + +$(MLDEPDIR)/%.d: %.ml + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ + $(DINCFLAGS) $< \> $@; \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ + $(DINCFLAGS) $< > $@; \ + else \ + pp=`eval echo $$pp`; \ + pp=`echo $$pp | sed -e 's!:\\/!:\\\\!'`; \ + $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ + -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ + -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ + fi + +$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< \> $@; \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \ + else \ + $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ + -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \ + $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ + -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ + fi + +$(DOC_DIR)/$(RESULT)/html: + mkdir -p $@ + +$(DOC_DIR)/$(RESULT)/html/index.html: $(DOC_DIR)/$(RESULT)/html $(DOC_FILES) + rm -rf $" +maintainer: "Anton Lavrik " +homepage: "https://github.com/alavrik/piqi-ocaml" +bug-reports: "https://github.com/alavrik/piqi-ocaml/issues" +depends: [ + "ocaml" {>= "4.02.0"} + "dune" {>= "2.0.0"} + "piqilib" + "stdlib-shims" + "num" {with-test} +] +dev-repo: "git://github.com/alavrik/piqi-ocaml" + +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + "piqi,piqirun" + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] + +install: [ + ["dune" "install" "-p" "piqi,piqirun"] +] diff --git a/piqi-ocaml/piqic-ocaml/.gitignore b/piqi-ocaml/piqic-ocaml/.gitignore new file mode 100644 index 0000000..ca4bf99 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/.gitignore @@ -0,0 +1,4 @@ +/piqic-ocaml +/piqic_ocaml_version.ml + +/piqi.piqi diff --git a/piqi-ocaml/piqic-ocaml/Makefile b/piqi-ocaml/piqic-ocaml/Makefile new file mode 100644 index 0000000..33213b4 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/Makefile @@ -0,0 +1,52 @@ +OCAMLMAKEFILE := ../make/OCamlMakefile + + +RESULT = piqic-ocaml + + +SOURCES = \ + piqic_piqi.ml \ + piqic_common.ml \ + \ + piqic_ocaml_types.ml \ + piqic_ocaml_out.ml \ + piqic_ocaml_in.ml \ + piqic_ocaml_defaults.ml \ + piqic_ocaml_ext.ml \ + \ + piqic_ocaml_version.ml \ + piqic_ocaml.ml \ + + +PACKS = piqilib bytes stdlib-shims +INCDIRS = ../piqirun +LIBS = ../piqirun/piqirun + + +PRE_TARGETS = piqic_ocaml_version.ml + + +all: nc + +debug: dc top + + +clean:: + rm -f piqi.piqi + + +# recompile piqi self-spec into piqic_piqi.ml +PIQI ?= piqi +PIQIC = ./$(RESULT) +PIQIC_FLAGS = -e piqi-ocaml --embed-piqi #--trace + +piqi: + $(PIQI) cc -o piqi.piqi + $(PIQIC) $(PIQIC_FLAGS) piqi.piqi + + +piqic_ocaml_version.ml: ../VERSION + echo "let version = \"`head -1 $<`\"" >$@ + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/piqic-ocaml/dune b/piqi-ocaml/piqic-ocaml/dune new file mode 100644 index 0000000..ce6af9b --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/dune @@ -0,0 +1,13 @@ +(executable + (name piqic_ocaml) + (public_name piqic-ocaml) + (package piqi) + (libraries piqilib piqirun bytes stdlib-shims)) + +(rule + (target piqic_ocaml_version.ml) + (deps + (file make_version.sh) + (file ../VERSION)) + (action (with-stdout-to %{target} + (bash ./make_version.sh)))) diff --git a/piqi-ocaml/piqic-ocaml/make_version.sh b/piqi-ocaml/piqic-ocaml/make_version.sh new file mode 100755 index 0000000..dfea812 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/make_version.sh @@ -0,0 +1 @@ +echo "let version = \"$(head -1 ../VERSION)\"" diff --git a/piqi-ocaml/piqic-ocaml/piqi.ocaml.piqi b/piqi-ocaml/piqic-ocaml/piqi.ocaml.piqi new file mode 100644 index 0000000..f3c8271 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqi.ocaml.piqi @@ -0,0 +1,88 @@ +% Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Anton Lavrik +% +% Licensed under the Apache License, Version 2.0 (the "License"); +% you may not use this file except in compliance with the License. +% You may obtain a copy of the License at +% +% http://www.apache.org/licenses/LICENSE-2.0 +% +% Unless required by applicable law or agreed to in writing, software +% distributed under the License is distributed on an "AS IS" BASIS, +% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +% See the License for the specific language governing permissions and +% limitations under the License. + + +.include [ .module piqi ] + + +% +% types +% + +.extend [ + .typedef* [ int uint ] + .with.ocaml-type "int" +] + +.extend [ + .typedef* [ int32 uint32 ] + .with.ocaml-type "int32" +] + +.extend [ + .typedef* [ int64 uint64 ] + .with.ocaml-type "int64" +] + +.extend [ + .typedef* [ float64 float32 ] + .with.ocaml-type "float" +] + + +% +% names +% + +.extend [ + .option typedef.list + + .with.ocaml-name "list" +] + +.extend [ + .typedef type + .field any.type + + .with.ocaml-name "typename" +] + +.extend [ + .typedef list + + .with.ocaml-name "piqi_list" +] + +.extend [ + .field* [ piqi.module import.module ] + + .with.ocaml-name "modname" +] + +.extend [ + .typedef function + + .with.ocaml-name "func" +] + +.extend [ + .typedef piqi-list + + % ocaml-name "piqi-list" is already defined for record "list" + .with.ocaml-name "piqi_bundle" +] + + +.custom-field* [ ocaml-type ocaml-name ] + diff --git a/piqi-ocaml/piqic-ocaml/piqi.piqi-ocaml.piqi b/piqi-ocaml/piqic-ocaml/piqi.piqi-ocaml.piqi new file mode 100644 index 0000000..1d3db4a --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqi.piqi-ocaml.piqi @@ -0,0 +1,81 @@ +% Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Anton Lavrik +% +% Licensed under the Apache License, Version 2.0 (the "License"); +% you may not use this file except in compliance with the License. +% You may obtain a copy of the License at +% +% http://www.apache.org/licenses/LICENSE-2.0 +% +% Unless required by applicable law or agreed to in writing, software +% distributed under the License is distributed on an "AS IS" BASIS, +% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +% See the License for the specific language governing permissions and +% limitations under the License. + +% +% OCaml-specific Piqi extensions +% + +.include [ .module piqi ] + + +% generate piqic_piqi.ml instead of piqi_piqi.ml so that we don't conflict with +% piqi_piqi.ml that comes with the piqilib library +.ocaml-module "Piqic_piqi" +.custom-field ocaml-module + + +.extend [ + .typedef* [ record field variant option enum alias list import function ] + + .with.field [ + .name ocaml-name + .type string + .optional + ] +] + + +.extend [ + .typedef* [ piqi import ] + + .with.field [ + .name ocaml-module + .type string + .optional + ] +] + + +.extend [ + .typedef alias + + .with.field [ + .name ocaml-type + .type string + .optional + ] +] + + +% flag for representing repeated fields and lists as OCaml arrays +.extend [ + .typedef* [ field list ] + + .with.field [ + .name ocaml-array + .optional + ] +] + + +% flag for representing optional fields with defaults as 'a option instead of 'a +.extend [ + .typedef field + + .with.field [ + .name ocaml-optional + .optional + ] +] + diff --git a/piqi-ocaml/piqic-ocaml/piqic_common.ml b/piqi-ocaml/piqic-ocaml/piqic_common.ml new file mode 100644 index 0000000..22082da --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_common.ml @@ -0,0 +1,1080 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2018 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +(* + * This module contain functionality that is used by various parts of + * piqi compilers. + *) + +module T = Piqic_piqi + + +module Record = T.Record +module Field = T.Field +module Variant = T.Variant +module Option = T.Option +module Enum = T.Enum +module Alias = T.Alias + + +module Import = T.Import +module Func = T.Func +module Any = T.Any + + +module R = Record +module F = Field +module V = Variant +module O = Option +module E = Enum +module A = Alias +module L = T.Piqi_list +module P = T.Piqi + + +(* util *) +module Util = + struct + (* the below alternative tail-recursive implementation of stdlib's List.append + * was copied from Core (https://github.com/janestreet/core_kernel) + *) + + let list_slow_append l1 l2 = List.rev_append (List.rev l1) l2 + + + let rec list_count_append l1 l2 count = + match l2 with + | [] -> l1 + | _ -> + match l1 with + | [] -> l2 + | [x1] -> x1 :: l2 + | [x1; x2] -> x1 :: x2 :: l2 + | [x1; x2; x3] -> x1 :: x2 :: x3 :: l2 + | [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2 + | x1 :: x2 :: x3 :: x4 :: x5 :: tl -> + x1 :: x2 :: x3 :: x4 :: x5 :: + (if count > 1000 + then list_slow_append tl l2 + else list_count_append tl l2 (count + 1)) + + let list_append l1 l2 = list_count_append l1 l2 0 + + + module Std = + struct + module List = + struct + include List + + let map = Piqirun.list_map + + let append = list_append + + let concat l = + let rec aux accu = function + | [] -> rev accu + | h::t -> aux (rev_append h accu) t + in + aux [] l + + let flatten = concat + + let fold_right f l accu = + fold_left (fun a b -> f b a) accu (rev l) + + let split l = + let rec aux accu_a accu_b = function + | [] -> + rev accu_a, rev accu_b + | (a,b)::t -> + aux (a::accu_a) (b::accu_b) t + in + aux [] [] l + + let combine l1 l2 = + let rec aux accu l1 l2 = + match l1, l2 with + | [], [] -> rev accu + | (h1::t1), (h2::t2) -> + aux ((h1, h2)::accu) t1 t2 + | (_, _) -> + invalid_arg "List.combine" + in + aux [] l1 l2 + end + + let ( @ ) = List.append + end + + + open Std + + + (* list flatmap *) + let flatmap f l = + let rec aux accu = function + | [] -> List.rev accu + | h::t -> aux (List.rev_append (f h) accu) t + in + aux [] l + + + (* substitute character [x] with [y] in string [s] *) + let string_subst_char s x y = + if not (String.contains s x) + then s + else + (* preserve the original string *) + let s = Bytes.of_string s in + for i = 0 to (Bytes.length s) - 1 + do + if Bytes.get s i = x + then Bytes.set s i y + done; + Bytes.unsafe_to_string s + + + let dashes_to_underscores s = + string_subst_char s '-' '_' + + + let list_of_string s = + let n = String.length s in + let rec aux i = + if i < n + then s.[i] :: (aux (i+1)) + else [] + in aux 0 + + + let string_of_list l = + let s = Bytes.create (List.length l) in + let rec aux i = function + | [] -> () + | h::t -> + Bytes.set s i h; + aux (i+1) t + in + aux 0 l; + Bytes.unsafe_to_string s + + + let string_startswith s prefix = + let len = String.length prefix in + let rec aux i = + if i = len + then true + else + if s.[i] <> prefix.[i] + then false + else aux (i+1) + in + try + aux 0 + with _ -> + false + + + (* NOTE: naive, non-tail recursive. Remove duplicates from the list using + * reference equality, preserves the initial order *) + let rec uniqq = function + | [] -> [] + | h::t -> + let t = uniqq t in + if List.memq h t then t else h :: t + + + (* leave the first of the duplicate elements in the list instead of the last *) + let uniqq l = + List.rev (uniqq (List.rev l)) + + + let rec uniq = function + | [] -> [] + | h::t -> + let t = uniq t in + if List.mem h t then t else h :: t + + + (* leave the first of the duplicate elements in the list instead of the last *) + let uniq l = + List.rev (uniq (List.rev l)) + + + (* analogous to Filename.dirname but with forward slashes only *) + let get_module_name x = + try + let pos = String.rindex x '/' in + let res = String.sub x 0 pos in + Some res + with + Not_found -> None + + + (* analogous to Filename.basename but with forward slashes only *) + let get_local_name x = + try + let pos = String.rindex x '/' in + String.sub x (pos + 1) ((String.length x) - pos - 1) + with + Not_found -> x + + + let is_scoped_name name = String.contains name '/' + + + let split_name x = + get_module_name x, get_local_name x + + + let normalize_list l = + let isupper c = (c >= 'A' && c <= 'Z') in + let tolower c = Char.chr (Char.code c + 32) in + let rec aux hump accu = function + | [] -> List.rev accu + | h::t when h = '_' || h = '-' -> + aux true ('-'::accu) t + | h::t when isupper h && not hump -> (* first hump character *) + aux true ((tolower h)::'-'::accu) t + | h::t when isupper h && hump -> (* another hump character *) + aux hump ((tolower h)::accu) t + | h::t when h = '.' || h = ':' || h = '/' -> + aux true (h::accu) t + | h::t -> (* end of hump *) + aux false (h::accu) t + in + match l with + | [] -> [] + | h::_ -> aux (isupper h) [] l + + + (* check if the name is normal, i.e. no uppercase characters and no hyphens *) + let is_normal_name s = + let len = String.length s in + let rec aux i = + if i = len + then true (* the name is normal *) + else + match s.[i] with + | 'A'..'Z' | '_' -> false + | _ -> aux (i+1) + in + aux 0 + + + (* convert an arbitary valid name to lowercase name which words are separated by + * dashes; for example "CamelCase" will become "camel-case"; already lowercased + * names will remain intact *) + let normalize_name s = + if is_normal_name s + then s + else string_of_list (normalize_list (list_of_string s)) + end + +module U = Util + +(* NOTE: Std can be opened explicitly as U.Std or C.Std or included implicitly + * by opening Piqic_common *) +module Std = U.Std +include Std + + +(* a datastructure for output construction *) +module Iolist = + struct + type iolist = + Ios of string + | Iol of iolist list + | Ioc of char + | Eol + | Indent of iolist + + (* iolist construction *) + let (^^) a b = + match a, b with + | Ios _, Iol b -> Iol (a::b) + | Ios " ", Eol -> Eol + | _, _ -> Iol [a;b] + + let eol = Eol + let ios x = Ios x + let iol l = Iol l + let ioc c = Ioc c + let indent x = Indent x + + let iod delim l = (* iol with elements separated by delim *) + let insert_delim accu x = + match x with + | Iol [] -> accu + | _ -> accu ^^ (ios delim) ^^ x + in + match l with + | [] -> Iol [] + | h::t -> + List.fold_left insert_delim h t + + let ioi l = (* indented list *) + indent (iol l) + + let ioq x = (* double-quoted string *) + iol [ios "\""; ios x; ios "\""] + + let (|>) x f = f x + + let newlines l = + let newline x = + match x with + | Indent _ -> x + | _ -> x ^^ Eol + in + List.map newline l + + let prefix s l = + let prefix x = + ios s ^^ x + in + List.map prefix l + + (* iolist output *) + let to_buffer0 buf l = + let add_eol () = + Buffer.add_char buf '\n'; + in + let add_indent level = + for i = 1 to level * 2 + do + Buffer.add_char buf ' ' + done + in + let rec aux level (newline, unindent) = function + | Eol -> + if not unindent (* don't print another newline after unindent *) + then add_eol (); + (true, false) + | Ios s -> + if newline + then add_indent level; + Buffer.add_string buf s; + let newline = + if s = "" + then false + else (s.[String.length s - 1] = '\n') + in + (newline, false) + | Iol l -> + List.fold_left (fun accu x -> aux level accu x) (newline, unindent) l + | Ioc c -> + if newline + then add_indent level; + Buffer.add_char buf c; + (false, false) + | Indent x -> + if not newline (* don't print a newline before indent *) + then add_eol (); + let newline, unindent = aux (level + 1) (true, unindent) x in + if not newline + then add_eol (); (* don't print another newline before unindent *) + (true, true) + in + ignore (aux 0 (true, false) l) + + let to_buffer l = + let buf = Buffer.create 4096 in + to_buffer0 buf l; + buf + + let to_string l = + let buf = to_buffer l in + Buffer.contents buf + + let to_channel ch l = + let buf = to_buffer l in + Buffer.output_buffer ch buf + end +open Iolist + + +(* idtable implemented as map: string -> 'a *) +module Idtable = + struct + module M = Map.Make(String) + + type 'a t = 'a M.t + + let empty = M.empty + + let add idtable name entry = + M.add name entry idtable + + let find idtable name = + M.find name idtable + + let remove idtable name = + M.remove name idtable + + let mem idtable name = + M.mem name idtable + + let fold f accu idtable = + M.fold f idtable accu + end + + +(* indexes of Piqi module contents *) +type index = { + i_piqi: T.piqi; + import: Import.t Idtable.t; (* import name -> Import.t *) + typedef: T.typedef Idtable.t; (* typedef name -> Typedef.t *) +} + + +type context = { + (* the module being processed *) + piqi: T.piqi; + (* index of the piqi module being compiled *) + index: index; + + (* indication whether the module that is being processed is a Piqi + * self-spec, i.e. the module's name is "piqi" or it includes another module + * named "piqi" *) + is_self_spec: bool; + + (* original modules being compiled (imported modules ++ [piqi]) *) + modules: T.piqi list; + + (* index of imported modules: piqi.modname -> index *) + module_index: index Idtable.t; +} + + +(* + * Commonly used functions + *) + +let some_of = function + | Some x -> x + | None -> assert false + + +let error = Piqi_common.piqi_error +let warning = Piqi_common.piqi_warning + + +let gen_code = function + | None -> assert false + | Some code -> ios (Int32.to_string code) + + +(* polymorphic variant name starting with a ` *) +let gen_pvar_name name = + ios "`" ^^ ios name + + +(* + * set ocaml names if not specified by user + *) + +(* command-line flags *) +let flag_normalize_names = ref true +let flag_cc = ref false +let flag_gen_preserve_unknown_fields = ref false + + +let ocaml_reserved = Hashtbl.create 83 +let () = Array.iter (fun n -> Hashtbl.add ocaml_reserved n ()) + [|"and"; "as"; "assert"; "asr"; "begin"; "class"; + "constraint"; "do"; "done"; "downto"; "else"; "end"; + "exception"; "external"; "false"; "for"; "fun"; "function"; + "functor"; "if"; "in"; "include"; "inherit"; "initializer"; + "land"; "lazy"; "let"; "lor"; "lsl"; "lsr"; + "lxor"; "match"; "method"; "mod"; "module"; "mutable"; + "new"; "object"; "of"; "open"; "or"; "private"; + "rec"; "sig"; "struct"; "then"; "to"; "true"; + "try"; "type"; "val"; "virtual"; "when"; "while"; + "with"|] + +(* ocaml name of piqi name *) +let ocaml_name n = + if Hashtbl.mem ocaml_reserved n then n ^ "_" else + let n = + if !flag_normalize_names + then U.normalize_name n + else n + in + U.dashes_to_underscores n + + +let ocaml_lcname n = (* lowercase *) + String.uncapitalize (ocaml_name n) + + +let ocaml_ucname n = (* uppercase *) + String.capitalize (ocaml_name n) + + +let mlname target_name n = + match target_name with + | Some _ -> + target_name + | None -> + Some (ocaml_lcname n) + + +(* variant of mlname for optional names *) +let mlname_opt target_name n = + match target_name with + | Some _ -> target_name + | None -> + match n with + | None -> None + | Some n -> + Some (ocaml_lcname n) + + +let mlname_field x = + let open Field in ( + if x.ocaml_array && x.mode <> `repeated + then error ".ocaml-array flag can be used only with repeated fields"; + + if x.ocaml_optional && x.mode <> `optional + then error ".ocaml-optional flag can be used only with optional fields"; + + {x with ocaml_name = mlname_opt x.ocaml_name x.name} + ) + + +let mlname_record x = + R.({ + x with + ocaml_name = mlname x.ocaml_name x.name; + field = List.map mlname_field x.field; + }) + + +let mlname_option (x: T.option) :T.option = + O.({x with ocaml_name = mlname_opt x.ocaml_name x.name}) + + +let mlname_variant (x: T.variant) :T.variant = + V.({ + x with + ocaml_name = mlname x.ocaml_name x.name; + option = List.map mlname_option x.option; + }) + + +let mlname_enum x = + E.({ + x with + ocaml_name = mlname x.ocaml_name x.name; + option = List.map mlname_option x.option; + }) + + +let mlname_alias x = + A.({x with ocaml_name = mlname x.ocaml_name x.name}) + + +let mlname_list x = + L.({x with ocaml_name = mlname x.ocaml_name x.name}) + + +let mlname_typedef = function + | `record x -> `record (mlname_record x) + | `variant x -> `variant (mlname_variant x) + | `enum x -> `enum (mlname_enum x) + | `alias x -> `alias (mlname_alias x) + | `list x -> `list (mlname_list x) + + +let mlname_func x = + Func.({x with ocaml_name = mlname x.ocaml_name x.name}) + + +let mlname_import x = + let open Import in + if x.ocaml_name <> None + then x + else + let name = + match x.name with + | Some n -> n + | None -> x.modname + in + {x with ocaml_name = Some (ocaml_ucname name)} + + +let mlname_piqi (piqi:T.piqi) = + let open P in + let ocaml_module = + if piqi.ocaml_module <> None + then piqi.ocaml_module + else + (* NOTE: modname is always defined in "piqi compile" output *) + let modname = some_of piqi.modname in + let n = U.get_local_name modname in (* strip module path *) + Some (ocaml_ucname n ^ "_piqi") + in + { + piqi with + ocaml_module = ocaml_module; + typedef = List.map mlname_typedef piqi.typedef; + func = List.map mlname_func piqi.func; + import = List.map mlname_import piqi.import; + } + + +let typedef_name = function + | `record x -> x.R.name + | `variant x -> x.V.name + | `enum x -> x.E.name + | `alias x -> x.A.name + | `list x -> x.L.name + + +let typedef_mlname = function + | `record t -> some_of t.R.ocaml_name + | `variant t -> some_of t.V.ocaml_name + | `enum t -> some_of t.E.ocaml_name + | `alias t -> some_of t.A.ocaml_name + | `list t -> some_of t.L.ocaml_name + + +(* check whether the piqi module is a self-specification, i.e. piqi.piqi or + * piqi.X.piqi + * + * XXX: this check is an approximation of the orignal criteria that says a + * module is a self-spec if it is named piqi or includes a module named piqi. We + * can't know this for sure, because information about included modules is, by + * design, not preserved in "piqi compile" output *) +let is_self_spec piqi = + if !flag_cc + then true + else + let basename = U.get_local_name (some_of piqi.P.modname) in + U.string_startswith basename "piqi." || basename = "piqi" + + +(* check whether the piqi module depends on "piqi-any" type (i.e. one of its + * definitions has piqi-any as field/option/alias type *) +let depends_on_piqi_any (piqi: T.piqi) = + let typedef_depends_on_piqi_any x = + let is_any x = (x = "piqi-any") in + let is_any_opt = function + | Some x -> is_any x + | None -> false + in + match x with + | `record x -> List.exists (fun x -> is_any_opt x.F.typename) x.R.field + | `variant x -> List.exists (fun x -> is_any_opt x.O.typename) x.V.option + | `list x -> is_any x.L.typename + | `alias x -> is_any_opt x.A.typename + | `enum _ -> false + in + List.exists typedef_depends_on_piqi_any piqi.P.typedef + + +let load_self_spec () = + let self_spec_bin = T.piqi in + let buf = Piqirun.init_from_string self_spec_bin in + T.parse_piqi buf + + +let is_builtin_alias x = + (* presence of piqi_type field means this alias typedef corresponds to one + * of built-in types *) + x.A.piqi_type <> None + + +let is_builtin_typedef typedef = + match typedef with + | `alias a -> is_builtin_alias a + | _ -> false + + +let make_idtable l = + List.fold_left (fun accu (k, v) -> Idtable.add accu k v) Idtable.empty l + + +(* index typedefs by name *) +let index_typedefs l = + make_idtable (List.map (fun x -> typedef_name x, x) l) + + +let make_import_name x = + match x.Import.name with + | None -> x.Import.modname + | Some n -> n + + +(* index imports by name *) +let index_imports l = + make_idtable (List.map (fun x -> make_import_name x, x) l) + + +(* generate an index of all imports and definitions of a given module *) +let index_module piqi = + { + i_piqi = piqi; + import = index_imports piqi.P.import; + typedef = index_typedefs piqi.P.typedef; + } + + +(* make an index of module name -> index *) +let make_module_index piqi_list = + make_idtable (List.map (fun x -> some_of x.P.modname, index_module x) piqi_list) + + +let option_to_list = function + | None -> [] + | Some x -> [x] + + +let get_used_typenames typedef = + let l = + match typedef with + | `record x -> + U.flatmap (fun x -> option_to_list x.F.typename) x.R.field + | `variant x -> + U.flatmap (fun x -> option_to_list x.O.typename) x.V.option + | `alias x -> + (* NOTE: alias typename is undefined for lowest-level built-in types *) + option_to_list x.A.typename + | `list x -> + [x.L.typename] + | `enum _ -> + [] + in + U.uniq l + + +let rec get_used_builtin_typedefs typedefs builtins_index = + if typedefs = [] + then [] + else + let typenames = U.uniq (U.flatmap get_used_typenames typedefs) in + let builtin_typenames = List.filter (Idtable.mem builtins_index) typenames in + let builtin_typedefs = List.map (Idtable.find builtins_index) builtin_typenames in + (* get built-in types' dependencies (that are also built-in types) -- usually + * no more than 2-3 recursion steps is needed *) + let res = (get_used_builtin_typedefs builtin_typedefs builtins_index) @ builtin_typedefs in + U.uniqq res + + +(* append the list of built-in typedefs that are actually referenced by the + * module *) +let add_builtin_typedefs piqi builtins_index = + (* exclude builtin typedefs that are masked by the local typedefs *) + let typedef_names = List.map typedef_name piqi.P.typedef in + let builtins_index = List.fold_left Idtable.remove builtins_index typedef_names in + let used_builtin_typedefs = get_used_builtin_typedefs piqi.P.typedef builtins_index in + (* change the module as if the built-ins were defined locally *) + P.({ + piqi with + typedef = used_builtin_typedefs @ piqi.P.typedef + }) + + +let init piqi_list = + let named_piqi_list = List.map mlname_piqi piqi_list in + + (* the module being compiled is the last element of the list; preceding + * modules are imported dependencies *) + let l = List.rev named_piqi_list in + let piqi = List.hd l in + let imports = List.rev (List.tl l) in + + let is_self_spec = is_self_spec piqi in + let self_spec = + if is_self_spec + then piqi + else + let piqi = load_self_spec () in + mlname_piqi piqi + in + let builtin_typedefs = + if is_self_spec + then + (* for self-specs, all build-in types should be defined inside + * XXX: remove unused built-in typedefs from generated self-spec? *) + [] + else + List.filter is_builtin_typedef self_spec.P.typedef + in + let builtins_index = index_typedefs builtin_typedefs in + let piqi = add_builtin_typedefs piqi builtins_index in + let imports = List.map (fun x -> add_builtin_typedefs x builtins_index) imports in + + (* index the compiled module's contents *) + let index = index_module piqi in + + (* index imported modules *) + let mod_index = make_module_index imports in + { + piqi = piqi; + index = index; + + is_self_spec = is_self_spec; + + modules = piqi_list; + module_index = mod_index; + } + + +let switch_context context piqi = + if context.piqi == piqi + then context (* already current => no-op *) + else + let index = Idtable.find context.module_index (some_of piqi.P.modname) in + { + context with + piqi = piqi; + index = index; + } + + +(* the name of the top-level module being compiled *) +let top_modname context = + some_of context.piqi.P.ocaml_module + + +let scoped_name context name = + top_modname context ^ "." ^ name + + +let gen_parent_mod import = + match import with + | None -> iol [] + | Some x -> + let ocaml_modname = some_of x.Import.ocaml_name in + ios ocaml_modname ^^ ios "." + + +let resolve_import context import = + Idtable.find context.module_index import.Import.modname + + +let resolve_local_typename ?import index name = + let typedef = Idtable.find index.typedef name in + (import, index.i_piqi, typedef) + + +(* resolve type name to its type definition and the module where it was defined + * and the import its module was imported with *) +let resolve_typename context typename = + let index = context.index in + match U.split_name typename with + | None, name -> (* local type *) + (* NOTE: this will also resolve built-in types *) + resolve_local_typename index name + | Some import_name, name -> (* imported type *) + let import = Idtable.find index.import import_name in + let imported_index = resolve_import context import in + resolve_local_typename imported_index name ~import + + +(* unwind aliases to the lowest-level non-alias typedef or one of the built-in + * primitive Piqi types *) +type resolved_type = [ T.typedef | T.piqi_type] + +let rec unalias context typedef :(T.piqi * resolved_type) = + match typedef with + | `alias {A.typename = Some typename} -> + let import, parent_piqi, aliased_typedef = resolve_typename context typename in + let parent_context = switch_context context parent_piqi in + unalias parent_context aliased_typedef + | `alias {A.piqi_type = Some piqi_type} -> + context.piqi, (piqi_type :> resolved_type) + | _ -> + context.piqi, (typedef :> resolved_type) + + +let type_mlname context typename = + let import, parent_piqi, typedef = resolve_typename context typename in + typedef_mlname typedef + + +let mlname_of context ocaml_name typename = + match ocaml_name, typename with + | Some n, _ -> n + | None, Some typename -> + type_mlname context typename + | _ -> + assert false + + +let mlname_of_field context x = + let open F in + mlname_of context x.ocaml_name x.typename + + +let mlname_of_option context x = + let open O in + mlname_of context x.ocaml_name x.typename + + +let gen_builtin_type_name ?(ocaml_type: string option) (piqi_type :T.piqi_type) = + match ocaml_type with + | Some x -> x + | None -> + match piqi_type with + | `int -> "int" + | `float -> "float" + | `bool -> "bool" + | `string | `binary -> "string" + | `any -> + (* must be handled separately *) + assert false + + +let can_be_protobuf_packed context typedef = + let piqi, resolved_type = unalias context typedef in + match resolved_type with + | `int | `float | `bool -> true + | `enum _ -> true (* enum values can be packed in Protobuf *) + | _ -> false + + +(* custom types handling: used by piqic_ocaml_out, piqic_ocaml_in *) +let gen_convert_value context ocaml_type direction typename value = + match typename, ocaml_type with + | Some typename, Some ocaml_type -> (* custom OCaml type *) + let name = type_mlname context typename in + iol [ + ios "("; + ios ocaml_type; + ios direction; + ios name; + ios "("; value; ios ")"; + ios ")" + ] + | _ -> + value + + +let get_default_wire_type piqi_type = + match piqi_type with + | `int -> `zigzag_varint + | `float -> `fixed64 + | `bool -> `varint + | _ -> `block + + +let gen_wire_type_name piqi_type wire_type = + let wire_type = + match wire_type with + | Some x -> x + | None -> + get_default_wire_type piqi_type + in + match wire_type with + | `varint -> "varint" + | `zigzag_varint -> "zigzag_varint" + | `fixed32 -> "fixed32" + | `fixed64 -> "fixed64" + | `signed_varint -> "signed_varint" + | `signed_fixed32 -> "signed_fixed32" + | `signed_fixed64 -> "signed_fixed64" + | `block -> "block" + + +(* this is similar to unalias, but instead of returning resolved_type it returns + * resolved protobuf wire type *) +let rec get_wire_type context typename = + let import, parent_piqi, typedef = resolve_typename context typename in + let parent_context = switch_context context parent_piqi in + get_typedef_wire_type parent_context typedef + +and get_typedef_wire_type context typedef = + match typedef with + | `alias {A.protobuf_wire_type = Some wire_type} -> + (* NOTE: top-level aliases override protobuf_wire_type for lower-level + * aliases *) + Some wire_type + | `alias {A.typename = Some typename} -> + get_wire_type context typename + | `alias {A.piqi_type = Some piqi_type} -> + Some (get_default_wire_type piqi_type) + | _ -> + None + + +(* gen wire type width in bits if it is a fixed-sized type *) +let gen_wire_type_width wt = + match wt with + | `fixed32 | `signed_fixed32 -> "32" + | `fixed64 | `signed_fixed64 -> "64" + | _ -> "" + + +(* calculates and generates the width of a packed wire element in bits: + * generated value can be 32, 64 or empty *) +let gen_elem_wire_width context typename is_packed = + let open L in + if not is_packed + then "" + else + match get_wire_type context typename with + | None -> "" + | Some x -> + gen_wire_type_width x + + +let gen_field_mode context f = + let open F in + match f.mode with + | `required -> "required" + | `optional when f.default <> None && (not f.ocaml_optional) -> + "required" (* optional + default *) + | `optional -> "optional" + | `repeated -> + let mode = + if f.protobuf_packed + then "packed_repeated" + else "repeated" + in + if f.ocaml_array + then + let typename = some_of f.typename in (* always defined for repeated fields *) + let width = gen_elem_wire_width context typename f.protobuf_packed in + mode ^ "_array" ^ width + else + mode + + +let gen_packed_prefix is_packed = + ios (if is_packed then "packed_" else "") + + +(* generate: (packed_)?(list|array|array32|array64) *) +let gen_list_repr context l = + let open L in + let packed_prefix = gen_packed_prefix l.protobuf_packed in + let repr = + if l.ocaml_array + then ios "array" ^^ ios (gen_elem_wire_width context l.typename l.protobuf_packed) + else ios "list" + in + packed_prefix ^^ repr + + +let gen_cc s = + if !flag_cc + then ios s + else iol [] + diff --git a/piqi-ocaml/piqic-ocaml/piqic_ocaml.ml b/piqi-ocaml/piqic-ocaml/piqic_ocaml.ml new file mode 100644 index 0000000..9f8a735 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_ocaml.ml @@ -0,0 +1,271 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + + +(* + * Piqi compiler for OCaml + *) + +module C = Piqic_common +open C +open Iolist + + +(* command-line flags *) +let flag_pp = ref false +let flag_gen_defaults = ref false (* deprecated -- always enabled by default *) +let flag_embed_piqi = ref false +let flag_multi_format = ref false +let flag_runtime = ref "" +let flag_version = ref false +let flag_piqi_version = ref false + + +let arg__pp = + "--pp", Arg.Set flag_pp, + "(DEPRECATED) pretty-print output using CamlP4 (camlp4o)" + +let arg__normalize_names = + "--normalize-names", Arg.Bool (fun x -> C.flag_normalize_names := x), + "true|false turn CamlCase-style names into \"camel_case\" (default = true)" + +let arg__reserved_name = + "--reserved-name", Arg.String (fun x -> Hashtbl.add Piqic_common.ocaml_reserved x ()), + "add a reserved name in addition to the standard OCaml keywords" + +let arg__gen_defaults = + "--gen-defaults", Arg.Set flag_gen_defaults, + "(DEPRECATED) always enabled: generate default value constructors for generated types" + +let arg__gen_preserve_unknown_fields = + "--gen-preserve-unknown-fields", Arg.Set C.flag_gen_preserve_unknown_fields, + "generate code that preserve unknown Protobuf fields when they are serialized back" + +let arg__embed_piqi = + "--embed-piqi", Arg.Set flag_embed_piqi, + "embed Piqi modules encoded in binary format in the generated code" + +let arg__multi_format = + "--multi-format", Arg.Set flag_multi_format, + "generate extended OCaml stubs for multi-format (JSON/XML/Piq/Pb) serialization" + +let arg__ext = + "--ext", Arg.Set flag_multi_format, + "same as --multi-format" + +let arg__runtime = + "--runtime", Arg.Set_string flag_runtime, + " name of the Protobuf serialization runtime module (default = Piqirun)" + +let arg__cc = + "--cc", Arg.Set C.flag_cc, + "compiler compiler mode -- used only for building piqilib" + +let arg__version = + "--version", Arg.Set flag_version, + "print piqi-ocaml version and exit" + +let arg__piqi_version = + "--piqi-version", Arg.Set flag_piqi_version, + "print piqi version and exit" + + +let ocaml_pretty_print ifile ofile = + (* NOTE: we need "-printer o", because Camlp4o uses the Camlp4AutoPrinter by + * default (no -printer argument provided), which will either produce ocaml + * code or a binary AST depending on whether the output is a terminal or not + * (regardless of any -o option provided). started on a terminal, the results + * of piqic-ocaml --pp was a binary AST file *) + let cmd = Printf.sprintf "camlp4o -printer o -o %s %s" ofile ifile in + let res = Sys.command cmd in + if res <> 0 + then C.error ("command execution failed: " ^ cmd) + + +let gen_output_file ofile code = + if not !flag_pp + then + let ch = Piqi_command.open_output ofile in + Iolist.to_channel ch code; + Piqi_command.close_output () + else + begin + (* prettyprint generated OCaml code using Camlp4 *) + let tmp_file = ofile ^ ".tmp.ml" in + (try + let tmp_ch = open_out tmp_file in + Iolist.to_channel tmp_ch code; + close_out tmp_ch; + with Sys_error s -> + C.error ("error writing temporary file: " ^ s)); + ocaml_pretty_print tmp_file ofile; + Piqi_command.add_tmp_file tmp_file; + end + + +(* build a list of all import dependencies including the specified module and + * encode each Piqi module in the list using Protobuf encoding *) +let gen_embedded_piqi piqi_list = + let piqi = List.hd (List.rev piqi_list) in + let s = Piqirun.to_string (T.gen_piqi piqi) in + iol [ + ios "let piqi = "; ioq (String.escaped s); eol + ] + + +let gen_custom_runtime () = + if !flag_runtime <> "" + then iol [ios "module Piqirun = "; ios !flag_runtime; eol; eol] + else iol [] + + +let gen_piqi_ml context = + let modname = C.top_modname context in + let code = iol [ + gen_custom_runtime (); + + Piqic_ocaml_types.gen_piqi context; + Piqic_ocaml_in.gen_piqi context; + Piqic_ocaml_out.gen_piqi context; + Piqic_ocaml_defaults.gen_piqi context; + + (* NOTE: --multi-format serialization depends on --embded-piqi *) + if !flag_embed_piqi || !flag_multi_format + then gen_embedded_piqi context.modules + else iol []; + + ios "include "; ios modname; eol; + ] + in + let ofile = String.uncapitalize modname ^ ".ml" in + gen_output_file ofile code + + +let gen_piqi_ext_ml context = + let code = iol [ + gen_custom_runtime (); + Piqic_ocaml_ext.gen_piqi context; + ] + in + let modname = C.top_modname context in + let ofile = String.uncapitalize modname ^ "_ext.ml" in + + gen_output_file ofile code + + +let piqic context = + (* chdir to the output directory *) + Piqi_command.chdir_output !Piqi_command.odir; + + gen_piqi_ml context; + + if !flag_multi_format + then gen_piqi_ext_ml context + + +(* this is the same as calling "piqi compile ..." and reading its output but, + * instead, we are just using the library functions *) +let piqi_compile_piqi ifile = + let self_spec_bin = T.piqi in + (* by adding "ocaml" extension, we tell the library to automatically load + * *.ocaml.piqi extension modules *) + Piqi_compile.compile self_spec_bin ifile ~extensions:["ocaml"] + + +let load_piqi_list ifile = + let bin = piqi_compile_piqi ifile in + (* read the compiled piqi bundle *) + let buf = Piqirun.init_from_string bin in + let bundle = T.parse_piqi_bundle buf in + (* return the list of piqi modules: list of dependencies @ [input module] *) + bundle.T.Piqi_bundle.piqi + + +let piqic_file ifile = + (* load input .piqi file and its dependencies *) + let piqi_list = load_piqi_list ifile in + let context = C.init piqi_list in + piqic context + + +let speclist = Piqi_compile.getopt_speclist @ + [ + Piqi_command.arg_C; + arg__normalize_names; + arg__reserved_name; + arg__pp; + arg__gen_defaults; + arg__gen_preserve_unknown_fields; + (* TODO: deprecated and remove in the next major release (together with --pp) *) + Piqi_command.arg__keep_tmp_files; + arg__embed_piqi; + arg__multi_format; + arg__ext; + arg__runtime; + arg__cc; + arg__version; + arg__piqi_version; + ] + + +let usage = "\ +Usage: piqic-ocaml [options] <.piqi file> + piqic-ocaml [--version | --piqi-version] + +Options:" + + +let print_and_exit s = + print_endline s; + exit 0 + + +let run () = + (* handle --version and --piqi-version; doing it separately from the rest of + * args, because normally we expect one positional arg and this is + * automatically handled by Piqi_command.parse_args () *) + let argv1 = + if Array.length Sys.argv > 1 + then Sys.argv.(1) + else "" + in + if argv1 = "--version" + then print_and_exit Piqic_ocaml_version.version + else if argv1 = "--piqi-version" + then print_and_exit Piqi_version.version; + + (* normal invocation *) + Piqi_command.parse_args () ~usage ~speclist; + + if !flag_gen_defaults + then C.warning "--gen-defaults flag is deprecated: always generating defaults"; + + if !flag_pp + then C.warning "--pp flag is deprecated (generated code is now pretty-printed by default)"; + + (match Piqi_command.arg__keep_tmp_files with + | _, Arg.Set keep_tmp_files, _ -> + if !keep_tmp_files + then C.warning "--keep-tmp-files flag is deprecated (useless without deprecated --pp)"; + | _ -> () + ); + + piqic_file !Piqi_command.ifile + + +let _ = + Piqi_command.run_command run + diff --git a/piqi-ocaml/piqic-ocaml/piqic_ocaml_defaults.ml b/piqi-ocaml/piqic-ocaml/piqic_ocaml_defaults.ml new file mode 100644 index 0000000..e1eee95 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_ocaml_defaults.ml @@ -0,0 +1,234 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + + +(* + * This module generates default values for OCaml types generated by + * Piqic_ocaml_types + * + * The generated default_* functions return minimal serializable values of Piqi + * types + * + * CAVEAT: the logic is very primitive and it doesn't guarantee that default + * variant values are finite + *) + +module C = Piqic_common +open C +open Iolist + + +let gen_type context typename = Piqic_ocaml_in.gen_default_type context typename + + +let gen_int piqi_type wire_type = + let wire_type = + match wire_type with + | Some x -> x + | None -> + C.get_default_wire_type piqi_type + in + let f = + match wire_type with + | `varint -> Piqirun.int64_to_varint + | `zigzag_varint -> Piqirun.int64_to_zigzag_varint + | `fixed32 -> Piqirun.int64_to_fixed32 + | `fixed64 -> Piqirun.int64_to_fixed64 + | `signed_varint -> Piqirun.int64_to_signed_varint + | `signed_fixed32 -> Piqirun.int64_to_signed_fixed32 + | `signed_fixed64 -> Piqirun.int64_to_signed_fixed64 + | `block -> + assert false + in + let buf = f (-1) 0L in + Piqirun.to_string buf + + +let gen_builtin_type context piqi_type ocaml_type wire_type = + match piqi_type with + | `any -> + if context.is_self_spec + then ios "default_any ()" + else ios "Piqi_piqi.default_any ()" + | `string | `binary -> + ios "\"\"" + | `bool -> + ios "false" + | `float -> + ios "0.0" + | `int -> + match ocaml_type with + | None | Some "int" -> ios "0" + | Some "int32" -> ios "0l" + | Some "int64" -> ios "0L" + | _ -> + (* XXX: this is the most generic way to handle it; accounting for + * potential future extensions *) + let typename = C.gen_builtin_type_name piqi_type ?ocaml_type in + let wire_typename = C.gen_wire_type_name piqi_type wire_type in + let default = gen_int piqi_type wire_type in + let default_expr = iod " " [ + ios "(Piqirun.parse_default"; ioq (String.escaped default); ios ")"; + ] + in + iol [ + ios "Piqirun."; + ios typename; + ios "_of_"; + ios wire_typename; + default_expr; + ] + + +(* copy-pasted Piqic_ocaml_out.gen_alias_type -- not sure how to avoid this *) +let rec gen_alias_type ?wire_type context a = + let open A in + match a.typename with + | None -> (* this is a built-in type, so piqi_type must be defined *) + let piqi_type = some_of a.piqi_type in + gen_builtin_type context piqi_type a.ocaml_type wire_type + | Some typename -> + let import, parent_piqi, typedef = C.resolve_typename context typename in + match typedef with + | `alias a when wire_type <> None -> + (* need special handing in case when higher-level alias overrides + * protobuf_wire_type *) + let context = C.switch_context context parent_piqi in + gen_alias_type context a ?wire_type + | _ -> + gen_type context typename + + +let gen_field_default_cons context rname f = + let open Field in + let fname = C.mlname_of_field context f in + let ffname = (* fully-qualified field name *) + iol [ios rname; ios "."; ios fname] + in + let value = Piqic_ocaml_in.gen_field_default_value context f in + (* field construction code *) + iol [ffname; ios " = "; value; ios ";"] + + +let gen_record context r = + (* fully-qualified capitalized record name *) + let rname = String.capitalize (some_of r.R.ocaml_name) in + (* order fields by are by their integer codes *) + let fields = List.sort (fun a b -> compare a.F.code b.F.code) r.R.field in + let fconsl = (* field constructor list *) + if fields <> [] + then List.map (gen_field_default_cons context rname) fields + else [ios rname; ios "._dummy = ();"] + in + let fconsl = + if !C.flag_gen_preserve_unknown_fields + then fconsl @ [iol [ios rname; ios ".piqi_unknown_pb = [];"]] + else fconsl + in (* fake_ function delcaration *) + iol [ + ios "default_"; ios (some_of r.R.ocaml_name); ios " () ="; + ioi [ + ios "{"; + ioi (newlines fconsl); + ios "}"; + ] + ] + + +let gen_enum e = + let open Enum in + (* there must be at least one option *) + let const = List.hd e.option in + iol [ + ios "default_"; ios (some_of e.ocaml_name); ios " () = "; + C.gen_pvar_name (some_of const.O.ocaml_name) + ] + + +let gen_option context varname o = + let open Option in + let name = C.mlname_of_option context o in + match o.typename with + | None -> (* this is a flag, i.e. option without a type *) + C.gen_pvar_name name + | Some typename -> + let import, parent_piqi, typedef = C.resolve_typename context typename in + match o.ocaml_name, typedef with + | None, `variant _ | None, `enum _ -> + iol [ + ios "("; gen_type context typename; ios " :> "; ios varname; ios ")" + ] + | _ -> + iol [ + C.gen_pvar_name name; + ios " ("; gen_type context typename; ios ")"; + ] + + +let gen_variant context v = + let open Variant in + let name = some_of v.ocaml_name in + let scoped_name = C.scoped_name context name in + (* there must be at least one option *) + let opt = gen_option context scoped_name (List.hd v.option) in + iol [ + ios "default_"; ios name; ios " () = "; opt; + ] + + +let gen_alias context a = + let open Alias in + (* TODO: handle a new ocaml_default property the same way we do in + * piqic-erlang *) + iol [ + ios "default_"; ios (some_of a.ocaml_name); ios " () = "; + C.gen_convert_value context a.ocaml_type "_of_" a.typename (gen_alias_type context a); + ] + + +let gen_list l = + let open L in + iol [ + ios "default_"; ios (some_of l.ocaml_name); ios " () = "; + if l.ocaml_array + then ios "[||]" + else ios "[]"; + ] + + +let gen_typedef context typedef = + match typedef with + | `record t -> gen_record context t + | `variant t -> gen_variant context t + | `enum t -> gen_enum t + | `list t -> gen_list t + | `alias t -> gen_alias context t + + +let gen_typedefs context typedefs = + if typedefs = [] + then iol [] + else + let defs = List.map (gen_typedef context) typedefs in + iol [ + ios "let rec "; iod "and " (newlines defs); + eol; eol + ] + + +let gen_piqi context = + gen_typedefs context context.piqi.P.typedef + diff --git a/piqi-ocaml/piqic-ocaml/piqic_ocaml_ext.ml b/piqi-ocaml/piqic-ocaml/piqic_ocaml_ext.ml new file mode 100644 index 0000000..c298f97 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_ocaml_ext.ml @@ -0,0 +1,142 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + + +(* + * generation of interfaces for multi-format JSON/XML/Protobuf/Piq serialization + *) + +module C = Piqic_common +open C +open Iolist + + +let gen_init_piqi modname = + (* init embedded piqi spec *) + iol [ + ios "let piqi = "; ios modname; ios ".piqi"; eol; + eol; eol; + ios "let () = Piqirun_ext.init_piqi piqi"; eol; + ] + + +let typedef_scoped_name context typedef = + let piqi = context.piqi in + let modname = some_of piqi.P.modname in + let name = C.typedef_name typedef in + modname ^ "/" ^ name + + +let gen_init_piqi_type context typedef = + let name = C.typedef_mlname typedef in + let scoped_name = typedef_scoped_name context typedef in + iol [ + ios "let _"; ios name; ios "_piqi_type = "; + ios "Piqirun_ext.find_piqi_type "; ioq scoped_name; + eol; + ] + + +let gen_convert name input_format output_format data = + let piqi_type = "_" ^ name ^ "_piqi_type" in + iod " " [ + ios "Piqirun_ext.convert"; + ios piqi_type; ios input_format; ios output_format; ios data; + ] + + +let gen_parse modname typedef = + let name = C.typedef_mlname typedef in + iol [ + ios "let parse_"; ios name; ios " ?opts x (format :Piqirun_ext.input_format) ="; + ioi [ + ios "let x_pb = "; gen_convert name "format" "`pb" "x"; ios " ?opts in"; eol; + ios "let buf = Piqirun.init_from_string x_pb in"; eol; + ios modname; ios ".parse_"; ios name; ios " buf" + ]; + eol; + ] + + +let gen_gen modname typedef = + let name = C.typedef_mlname typedef in + iol [ + ios "let gen_"; ios name; ios " ?opts x (format :Piqirun_ext.output_format) ="; + ioi [ + ios "let buf = "; ios modname; ios ".gen_"; ios name; ios " x in"; eol; + ios "let x_pb = Piqirun.to_string buf in"; eol; + gen_convert name "`pb" "format" "x_pb"; ios " ?opts" + ]; + eol; + ] + + +let gen_print typedef = + let name = C.typedef_mlname typedef in + iol [ + ios "let print_"; ios name; ios " ?opts x ="; eol; + ios " Stdlib.print_endline (gen_"; ios name; ios " x `piq ?opts)"; + eol; + ios "let prerr_"; ios name; ios " ?opts x ="; eol; + ios " Stdlib.prerr_endline (gen_"; ios name; ios " x `piq ?opts)"; + eol; + ] + + +(* NOTE: the only purpose of this is to make sure that all the dependencies are + * going to be linked in. Otherwise, Piqi modules can end up being missing and + * uninitialized. This, in turn, leads to crash on multi-format serialization of + * nested types from imported modules *) +let gen_import context import = + let open Import in + let index = C.resolve_import context import in + let piqi = index.i_piqi in + iol [ + ios "module "; ios (some_of import.ocaml_name); ios "_ext"; ios " = "; + ios (some_of piqi.P.ocaml_module); ios "_ext"; + eol; + ] + + +let gen_imports context l = + let l = List.map (gen_import context) l in + iol l + + +let gen_piqi context = + let piqi = context.piqi in + let modname = some_of piqi.P.ocaml_module in + let typedefs = piqi.P.typedef in + + (* XXX, TODO: skipping built-in typedefs for now; in theory we could generate + * piqi_piqi_ext.ml and include it as a part of piqilib to make serialization + * for built-in types to work *) + let typedefs = List.filter (fun x -> not (C.is_builtin_typedef x)) typedefs in + + let type_initializers = List.map (gen_init_piqi_type context) typedefs in + let parsers = List.map (gen_parse modname) typedefs in + let generators = List.map (gen_gen modname) typedefs in + let printers = List.map gen_print typedefs in + + iol [ + gen_imports context piqi.P.import; + gen_init_piqi modname; eol; eol; + iol type_initializers; eol; eol; + iol (newlines parsers); eol; + iol (newlines generators); eol; + iol (newlines printers); eol; + ] + diff --git a/piqi-ocaml/piqic-ocaml/piqic_ocaml_in.ml b/piqi-ocaml/piqic-ocaml/piqic_ocaml_in.ml new file mode 100644 index 0000000..aa8a628 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_ocaml_in.ml @@ -0,0 +1,376 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + + +(* + * generation of Protocol Buffers -> OCaml decoders + *) + +module C = Piqic_common +open C +open Iolist + + +let gen_type ?(is_packed=false) context typename = + let import, parent_piqi, typedef = C.resolve_typename context typename in + let packed_prefix = C.gen_packed_prefix is_packed in + let parent_mod = C.gen_parent_mod import in + iol [ + parent_mod; + packed_prefix; ios "parse_"; + ios (C.typedef_mlname typedef) + ] + + +let gen_builtin_type context piqi_type ocaml_type wire_type is_packed = + match piqi_type with + | `any -> + if context.is_self_spec + then ios "parse_any" (* XXX: handle the case when ocaml_type <> None *) + else ios "Piqi_piqi.parse_any" + | _ -> + let packed_prefix = C.gen_packed_prefix is_packed in + let typename = C.gen_builtin_type_name piqi_type ?ocaml_type in + let wire_typename = C.gen_wire_type_name piqi_type wire_type in + iol [ + gen_cc "(fun x -> let count = next_count() in refer count ("; + ios "Piqirun."; + ios typename; + ios "_of_"; packed_prefix; + ios wire_typename; + gen_cc " x))"; + ] + + +(* copy-pasted Piqic_ocaml_out.gen_alias_type -- not sure how to avoid this *) +let rec gen_alias_type ?wire_type ?(is_packed=false) context a = + let open A in + match a.typename with + | None -> (* this is a built-in type, so piqi_type must be defined *) + let piqi_type = some_of a.piqi_type in + gen_builtin_type context piqi_type a.ocaml_type wire_type is_packed + | Some typename -> + let import, parent_piqi, typedef = C.resolve_typename context typename in + match typedef with + | `alias a when wire_type <> None -> + (* need special handing in case when higher-level alias overrides + * protobuf_wire_type *) + let context = C.switch_context context parent_piqi in + gen_alias_type context a ?wire_type ~is_packed + | _ -> + gen_type context typename ~is_packed + + +(* TODO: parse defaults once at boot time rather than each time when we need to + * parse a field *) +let gen_default = function + | None -> iol [] + | Some piqi_any -> + let pb = some_of piqi_any.Any.protobuf in + iol [ios "~default:"; ioq (String.escaped pb) ] + + +let esc x = ios "_" ^^ ios x + + +let gen_default_type context typename = + let import, parent_piqi, typedef = C.resolve_typename context typename in + let parent_mod = C.gen_parent_mod import in + iol [parent_mod; ios "default_"; ios (C.typedef_mlname typedef); ios " ()"] + + +let gen_field_default_value context f = + let open Field in + let typename = some_of f.typename in + match f.mode, f.default with + | `required, _ -> + gen_default_type context typename + | `optional, Some piqi_any when not f.ocaml_optional -> + let pb = some_of piqi_any.Any.protobuf in + let default_str = String.escaped pb in + iol [ + gen_cc "(Piqloc.pause (); let res = "; + gen_type context typename; + ios " (Piqirun.parse_default "; ioq default_str; ios ")"; + gen_cc " in Piqloc.resume (); res)"; + ] + | `optional, _ -> ios "None" + | `repeated, _ -> + if f.ocaml_array + then ios "[||]" + else ios "[]" + + +let gen_field_cons context rname f = + let open Field in + let fname = C.mlname_of_field context f in + let ffname = (* fully-qualified field name *) + iol [ios rname; ios "."; ios fname] + in + (* field construction code *) + iol [ ffname; ios " = "; esc fname; ios ";" ] + + +let gen_field_parser context f = + let open Field in + let fname = C.mlname_of_field context f in + let mode = C.gen_field_mode context f in + let code = C.gen_code f.code in + let typename = some_of f.typename in + if not f.internal + then + let fcons = + (* field constructor *) + iod " " [ + (* "parse_(required|optional|repeated)_field" function invocation *) + ios "Piqirun.parse_" ^^ ios mode ^^ ios "_field"; + code; + gen_type context typename ~is_packed:f.protobuf_packed; + + (* when parsing packed repeated fields, we should also accept + * fields in unpacked representation; therefore, specifying an + * unpacked field parser as another parameter *) + if f.protobuf_packed + then gen_type context typename + else iol []; + + ios "x"; + gen_default f.default; + ] + in + (* field parsing code *) + iol [ ios "let "; esc fname; ios ", x = "; fcons; ios " in"; eol ] + else + let fcons = gen_field_default_value context f in + iol [ ios "let "; esc fname; ios " = "; fcons; ios " in"; eol ] + + +let gen_record context r = + (* fully-qualified capitalized record name *) + let rname = String.capitalize (some_of r.R.ocaml_name) in + (* order fields by are by their integer codes *) + let fields = List.sort (fun a b -> compare a.F.code b.F.code) r.R.field in + let fconsl = (* field constructor list *) + if fields <> [] + then List.map (gen_field_cons context rname) fields + else [ios rname; ios "._dummy = ();"] + in + let fconsl = + if !C.flag_gen_preserve_unknown_fields + then fconsl @ [iol [ios rname; ios ".piqi_unknown_pb = x;"]] + else fconsl + in + let fparserl = (* field parsers list *) + List.map (gen_field_parser context) fields + in + let rcons = (* record constructor *) + iol [ + iol fparserl; + ios "Piqirun.check_unparsed_fields x;"; eol; + ios "{"; + ioi (newlines fconsl); + ios "}"; + ] + in (* parse_ function delcaration *) + iol [ + ios "parse_"; ios (some_of r.R.ocaml_name); ios " x ="; + ioi [ + ios "let x = Piqirun.parse_record x in"; eol; + gen_cc "let count = next_count() in refer count (\n"; + rcons; + gen_cc ")\n"; + ] + ] + + +let gen_const c = + let open Option in + let name = C.gen_pvar_name (some_of c.ocaml_name) in + iol [ios "| "; C.gen_code c.code; ios "l -> "; name] + + +let gen_enum e ~is_packed = + let open Enum in + let consts = List.map gen_const e.option in + let packed_prefix = C.gen_packed_prefix is_packed in + iol [ + packed_prefix; ios "parse_"; ios (some_of e.ocaml_name); ios " x ="; + ioi [ + gen_cc "let count = next_count() in refer count ("; + ios "match Piqirun.int32_of_"; packed_prefix; ios "signed_varint x with"; + ioi [ + iol (newlines consts); + ios "| x -> Piqirun.error_enum_const x"; + ]; + gen_cc ")\n"; + ] + ] + + +let gen_enum e = + (* generate two functions: one for parsing normal value; another one -- for + * packed value *) + iol [ + gen_enum e ~is_packed:false; eol; + ios "and "; + gen_enum e ~is_packed:true + ] + + +let gen_option context varname o = + let open Option in + let name = C.mlname_of_option context o in + let code = C.gen_code o.code in + match o.typename with + | None -> (* this is a flag, i.e. option without a type *) + iol [ + ios "| "; code; ios " when x = Piqirun.Varint 1 -> "; + (* NOTE: providing special handling for boxed values, see "refer" *) + gen_cc "let count = next_count() in refer count "; + C.gen_pvar_name name; + ] + | Some typename -> + let import, parent_piqi, typedef = C.resolve_typename context typename in + match o.ocaml_name, typedef with + | None, `variant _ | None, `enum _ -> + (* handle variant and enum subtyping cases by lifting their labels + * and clauses to the top level -- in fact, relying on OCaml here + * by using # construct *) + iol [ + ios "| "; code; ios " -> "; + ios "("; gen_type context typename; ios " x :> "; ios varname; ios ")" + ] + | _ -> + iol [ + ios "| "; code; ios " ->"; + indent (ioi [ + ios "let res = "; + gen_cc "let count = curr_count() in refer count ("; + gen_type context typename; ios " x"; + gen_cc ")"; + ios " in"; eol; + C.gen_pvar_name name; ios " res"; + ]) + ] + + +let gen_variant context v = + let open Variant in + let name = some_of v.ocaml_name in + let scoped_name = C.scoped_name context name in + let options = List.map (gen_option context scoped_name) v.option in + iol [ + ios "parse_"; ios name; ios " x ="; + ioi [ + ios "let code, x = Piqirun.parse_variant x in"; eol; + gen_cc "let count = next_count() in refer count (\n"; + ios "match code with"; + ioi [ + iol (newlines options); + ios "| _ -> Piqirun.error_variant x code"; + ]; + gen_cc ")\n"; + ] + ] + + +let gen_alias context a ~is_packed = + let open Alias in + let packed_prefix = C.gen_packed_prefix is_packed in + iol [ + packed_prefix; ios "parse_"; ios (some_of a.ocaml_name); ios " x = "; + C.gen_convert_value context a.ocaml_type "_of_" a.typename ( + iol [ + gen_alias_type context a ?wire_type:a.protobuf_wire_type ~is_packed; + ios " x"; + ] + ) + ] + + +let gen_alias context a = + let open Alias in + if C.can_be_protobuf_packed context (`alias a) + then + (* if a value can be packed, we need to generate two functions: one for + * parsing regular (unpacked) representation, and another one for + * parsing packed form *) + iol [ + gen_alias context a ~is_packed:false; eol; + ios "and "; + gen_alias context a ~is_packed:true + ] + else + gen_alias context a ~is_packed:false + + +let gen_list context l = + let open L in + let repr = C.gen_list_repr context l in + iol [ + ios "parse_"; ios (some_of l.ocaml_name); ios " x ="; eol; + gen_cc " let count = next_count() in refer count (\n"; + (* Piqirun.parse_(packed_)?(list|array|array32|array64) *) + ios " Piqirun.parse_"; repr; + ios " ("; gen_type context l.typename ~is_packed:l.protobuf_packed; ios ")"; + + (* when parsing packed repeated fields, we should also accept + * fields in unpacked representation; therefore, specifying an + * unpacked field parser as another parameter *) + if l.protobuf_packed + then iol [ + ios " ("; gen_type context l.typename; ios ")"; + ] + else iol []; + + ios " x"; eol; + gen_cc " )\n"; + ] + + +let gen_typedef context typedef = + match typedef with + | `record t -> gen_record context t + | `variant t -> gen_variant context t + | `enum t -> gen_enum t + | `list t -> gen_list context t + | `alias t -> gen_alias context t + + +let gen_typedefs context typedefs = + if typedefs = [] + then iol [] + else + let defs = List.map (gen_typedef context) typedefs in + iol [ + gen_cc "let next_count = Piqloc.next_icount\n"; + gen_cc "let curr_count () = !Piqloc.icount\n"; + (* NOTE: providing special handling for boxed objects, since they are not + * references and can not be uniquely identified. Moreover they can mask + * integers which are used for enumerating objects *) + gen_cc "let refer ref obj = + if not (Obj.is_int (Obj.repr obj)) + then Piqloc.addrefret ref obj + else obj\n"; + + ios "let rec "; iod "and " (newlines (newlines defs)); + eol + ] + + +let gen_piqi context = + gen_typedefs context context.piqi.P.typedef + diff --git a/piqi-ocaml/piqic-ocaml/piqic_ocaml_out.ml b/piqi-ocaml/piqic-ocaml/piqic_ocaml_out.ml new file mode 100644 index 0000000..5552ce4 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_ocaml_out.ml @@ -0,0 +1,327 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + + +(* + * generation of OCaml -> Protocol Buffers encoders + *) + +module C = Piqic_common +open C +open Iolist + + +let gen_type ?(is_packed=false) context typename = + let import, parent_piqi, typedef = C.resolve_typename context typename in + let packed_prefix = C.gen_packed_prefix is_packed in + let parent_mod = C.gen_parent_mod import in + iol [ + parent_mod; + packed_prefix; ios "gen__"; + ios (C.typedef_mlname typedef) + ] + + +let gen_builtin_type context piqi_type ocaml_type wire_type is_packed = + match piqi_type with + | `any -> + (* TODO, XXX: why do we need an extra closure here? *) + if context.is_self_spec + then + (* XXX: handle the case when ocaml_type <> None *) + ios "(fun code x -> gen__any code x)" + else + ios "(fun code x -> Piqi_piqi.gen__any code x)" + | _ -> + let packed_prefix = C.gen_packed_prefix is_packed in + let typename = C.gen_builtin_type_name piqi_type ?ocaml_type in + let wire_typename = C.gen_wire_type_name piqi_type wire_type in + (* XXX: packed isn't used in cc mode, we can safely remove generation of + * reference1 *) + iol [ + (if is_packed then gen_cc "(reference1 " else gen_cc "(reference "); + ios "Piqirun."; + ios typename; + ios "_to_"; packed_prefix; + ios wire_typename; + gen_cc ")"; + ] + + +let rec gen_alias_type ?wire_type ?(is_packed=false) context a = + let open A in + match a.typename with + | None -> (* this is a built-in type, so piqi_type must be defined *) + let piqi_type = some_of a.piqi_type in + gen_builtin_type context piqi_type a.ocaml_type wire_type is_packed + | Some typename -> + let import, parent_piqi, typedef = C.resolve_typename context typename in + match typedef with + | `alias a when wire_type <> None -> + (* need special handing in case when higher-level alias overrides + * protobuf_wire_type *) + let context = C.switch_context context parent_piqi in + gen_alias_type context a ?wire_type ~is_packed + | _ -> + gen_type context typename ~is_packed + + +let gen_field context rname f = + let open Field in + let fname = C.mlname_of_field context f in + let ffname = (* fully-qualified field name *) + iod "." [ios "x"; ios rname; ios fname] + in + let code = C.gen_code f.code in + let mode = C.gen_field_mode context f in + let typename = some_of f.typename in + (* field generation code *) + let fgen = iod " " [ + ios "Piqirun.gen_" ^^ ios mode ^^ ios "_field"; + code; + gen_type context typename ~is_packed:f.protobuf_packed; + ffname + ] + in (fname, fgen) + + +let gen_record context r = + (* fully-qualified capitalized record name *) + let rname = String.capitalize (some_of r.R.ocaml_name) in + (* skip fields marked as .internal *) + let fields = r.R.field in + let fields = List.filter (fun x -> not x.F.internal) fields in + (* order fields by are by their integer codes *) + let fields = List.sort (fun a b -> compare a.F.code b.F.code) fields in + let fgens = (* field generators list *) + List.map (gen_field context rname) fields + in + (* field names *) + let fnames, _ = List.split fgens in + + let esc x = ios "_" ^^ ios x in + + (* field generator code *) + let fgens_code = List.map + (fun (name, gen) -> iol [ios "let "; esc name; ios " = "; gen; ios " in"; eol]) + fgens + in + let unknown_fields = + if !C.flag_gen_preserve_unknown_fields + then [iol [ios "(Piqirun.gen_parsed_field_list "; ios "x."; ios rname; ios ".piqi_unknown_pb)"]] + else [ios "[]"] + in (* gen_ function delcaration *) + iol [ + ios "gen__"; ios (some_of r.R.ocaml_name); ios " code x ="; + ioi [ + gen_cc "refer x;\n"; + iol fgens_code; + ios "Piqirun.gen_record code ("; + iod " :: " ((List.map esc fnames) @ unknown_fields); + ios ")"; + ] + ] + + +let gen_const c = + let open Option in + iol [ + ios "| "; C.gen_pvar_name (some_of c.ocaml_name); ios " -> "; + C.gen_code c.code; ios "l"; (* ocaml int32 literal *) + ] + + +let gen_enum_consts l = + let consts = List.map gen_const l in + iol [ + ios "(match x with"; + ioi (newlines consts); + ios ")" + ] + + +let gen_unpacked_enum e = + let open Enum in + iol [ + ios "gen__"; ios (some_of e.ocaml_name); ios " code x ="; + ioi [ + gen_cc "refer x;\n"; + ios "Piqirun.int32_to_signed_varint code "; gen_enum_consts e.option; + ] + ] + + +let gen_packed_enum e = + let open Enum in + iol [ + ios "packed_gen__"; ios (some_of e.ocaml_name); ios " x ="; + ioi [ + gen_cc "refer x;\n"; + ios "Piqirun.int32_to_packed_signed_varint "; gen_enum_consts e.option; + ] + ] + + +let gen_enum e = + (* generate two functions: one for generating normal value; another one -- for + * packed value *) + iol [ + gen_unpacked_enum e; eol; + ios "and "; + gen_packed_enum e; + ] + + +let gen_option context o = + let open Option in + let name = C.mlname_of_option context o in + let code = C.gen_code o.code in + match o.typename with + | None -> (* this is a flag, i.e. option without a type *) + iol [ + ios "| "; C.gen_pvar_name name; ios " -> "; + gen_cc "refer x; "; + ios "Piqirun.gen_bool_field "; code; ios " true"; + ] + | Some typename -> + let import, parent_piqi, typedef = C.resolve_typename context typename in + match o.ocaml_name, typedef with + | None, `variant _ | None, `enum _ -> + (* handle variant and enum subtyping cases by lifting their labels + * and clauses to the top level -- in fact, relying on OCaml here + * by using # construct *) + let scoped_typename = Piqic_ocaml_types.gen_typedef_type context typedef ?import in + iol [ + ios "| (#"; ios scoped_typename; ios " as x) -> "; + gen_type context typename; ios " "; code; ios " x"; + ] + | _ -> + iol [ + ios "| "; C.gen_pvar_name name; ios " x -> "; + gen_type context typename; ios " "; code; ios " x"; + ] + + +let gen_variant context v = + let open Variant in + let options = List.map (gen_option context) v.option in + let typename = Piqic_ocaml_types.gen_typedef_type context (`variant v) in + iol [ + ios "gen__"; ios (some_of v.ocaml_name); ios " code (x:"; ios typename; ios ") ="; + ioi [ + gen_cc "refer x;\n"; + ios "Piqirun.gen_record code [(match x with"; + ioi (newlines options); + ios ")]"; + ] + ] + + +let gen_unpacked_alias context a = + let open Alias in + iol [ + ios "gen__"; ios (some_of a.ocaml_name); ios " code x = "; + gen_alias_type context a ?wire_type:a.protobuf_wire_type; + ios " code"; + C.gen_convert_value context a.ocaml_type "_to_" a.typename (ios " x"); + ] + + +let gen_packed_alias context a = + let open Alias in + iol [ + ios "packed_gen__"; ios (some_of a.ocaml_name); ios " x = "; + gen_alias_type context a ?wire_type:a.protobuf_wire_type ~is_packed:true; + C.gen_convert_value context a.ocaml_type "_to_" a.typename (ios " x"); + ] + + +let gen_alias context a = + let open Alias in + if C.can_be_protobuf_packed context (`alias a) + then + (* if a value can be packed, we need to generate two functions: one for + * generating regular (unpacked) representation, and another one for + * generating packed form *) + iol [ + gen_unpacked_alias context a; eol; + ios "and "; + gen_packed_alias context a; + ] + else + gen_unpacked_alias context a + + +let gen_list context l = + let open L in + let repr = C.gen_list_repr context l in + iol [ + ios "gen__"; ios (some_of l.ocaml_name); ios " code x = "; + gen_cc "reference "; + (* Piqirun.gen_(packed_)?(list|array|array32|array64) *) + ios "(Piqirun.gen_"; repr; ios " ("; + gen_type context l.typename ~is_packed:l.protobuf_packed; + ios ")) code x"; + ] + + +(* generate gen__ functions *) +let gen_typedef_2 context typedef = + match typedef with + | `alias t -> gen_alias context t + | `record t -> gen_record context t + | `variant t -> gen_variant context t + | `enum t -> gen_enum t + | `list t -> gen_list context t + + +(* generate gen_ functions *) +let gen_typedef_1 x = + let name = ios (C.typedef_mlname x) in + iol [ + ios "let gen_"; name; ios " x = "; + ios "gen__"; name; ios " (-1) x"; + ] + + +let gen_typedefs context typedefs = + if typedefs = [] + then iol [] + else + let defs_2 = List.map (gen_typedef_2 context) typedefs in + let defs_1 = List.map gen_typedef_1 typedefs in + iol [ + gen_cc "let next_count = Piqloc.next_ocount\n"; + (* NOTE: providing special handling for boxed objects, since they are not + * references and can not be uniquely identified. Moreover they can mask + * integers which are used for enumerating objects *) + gen_cc "let refer obj = + let count = next_count () in + if not (Obj.is_int (Obj.repr obj)) + then Piqloc.addref obj count\n"; + gen_cc "let reference f code x = refer x; f code x\n"; + gen_cc "let reference1 f x = refer x; f x\n"; + + ios "let rec "; iod "and " (newlines (newlines defs_2)); + eol; + iol (newlines defs_1); + eol; eol; + ] + + +let gen_piqi context = + gen_typedefs context context.piqi.P.typedef + diff --git a/piqi-ocaml/piqic-ocaml/piqic_ocaml_types.ml b/piqi-ocaml/piqic-ocaml/piqic_ocaml_types.ml new file mode 100644 index 0000000..2d0b5f5 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_ocaml_types.ml @@ -0,0 +1,425 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + + +(* + * generation of Ocaml type definitions + *) + +module C = Piqic_common +open C +open Iolist + + +let gen_builtin_type context piqi_type = + match piqi_type with + | `any -> + if context.is_self_spec + then C.scoped_name context "any" + else "Piqi_piqi.any" + | t -> + C.gen_builtin_type_name t + + +let gen_typedef_type ?import context typedef = + let ocaml_name = C.typedef_mlname typedef in + match import with + | None -> (* local typedef *) + C.scoped_name context ocaml_name + | Some import -> + let ocaml_modname = some_of import.Import.ocaml_name in + (ocaml_modname ^ "." ^ ocaml_name) + + +(* XXX: check type compatibility *) +let rec gen_type context typename = + let import, parent_piqi, typedef = C.resolve_typename context typename in + let context = C.switch_context context parent_piqi in + match typedef with + | `alias a -> + let ocaml_name = some_of a.A.ocaml_name in + (* skip cyclic type abbreviations *) + let ocaml_type = gen_alias_type context a in + if ocaml_name = ocaml_type (* cyclic type abbreviation? *) + then ocaml_type + else gen_typedef_type context typedef ?import + | _ -> (* record | variant | list | enum *) + gen_typedef_type context typedef ?import + + +and gen_alias_type context a = + let open Alias in + match a.ocaml_type, a.typename with + | Some x, _ -> x + | None, None -> + (* this is an alias for a built-in type (piqi_type field must be defined + * when neither of type and ocaml_type fields are present) *) + gen_builtin_type context (some_of a.piqi_type) + | None, Some typename -> + gen_type context typename + + +let ios_gen_type context typename = + ios (gen_type context typename) + + +let gen_field_type context f = + let open F in + match f.typename with + | None -> ios "bool"; (* flags are represented as booleans *) + | Some typename -> + let deftype = ios_gen_type context typename in + match f.mode with + | `required -> deftype + | `optional when f.default <> None && (not f.ocaml_optional) -> + deftype (* optional + default *) + | `optional -> deftype ^^ ios " option" + | `repeated -> + deftype ^^ + if f.ocaml_array + then ios " array" + else ios " list" + + +let gen_field context f = + let open F in + iol [ + ios "mutable "; (* NOTE: defining all fields as mutable at the moment *) + ios (C.mlname_of_field context f); + ios ": "; + gen_field_type context f; + ios ";" + ] + + +(* generate record type in record module; see also gen_record' *) +let gen_record_mod context r = + let modname = String.capitalize (some_of r.R.ocaml_name) in + let fields = r.R.field in + let fdefs = (* field definition list *) + if fields <> [] + then List.map (gen_field context) fields + else [ios "_dummy: unit;"] + in + let fdefs = + if !C.flag_gen_preserve_unknown_fields + then fdefs @ [ios "piqi_unknown_pb: (int * Piqirun.t) list;"] + else fdefs + in + (* record def constructor *) + let rcons = [ + ios "type t = "; ios "{"; + ioi (newlines fdefs); + ios "}"; + ] + in iol [ + ios modname; ios ":"; + ioi [ + ios "sig"; + ioi rcons; + ios "end"; ios " = "; ios modname; + ] + ] + + +let gen_option context o = + let open Option in + match o.ocaml_name, o.typename with + | ocaml_name, Some typename -> ( + let import, parent_piqi, typedef = C.resolve_typename context typename in + match ocaml_name, typedef with + | None, `variant x -> + (* NOTE: for some reason, ocaml complains about fully qualified + * polymorphic variants in recursive modules, so we need to use + * non-qualified names in this case *) + if import = None (* local typedef? *) + then ios (some_of x.V.ocaml_name) + else ios_gen_type context typename + | None, `enum x -> + if import = None (* local typedef? *) + then ios (some_of x.E.ocaml_name) + else ios_gen_type context typename + | _ -> + (* same as C.mlname_of_option but avoid resoving the same type + * again *) + let mlname = + match ocaml_name with + | Some n -> n + | None -> C.typedef_mlname typedef + in + let n = C.gen_pvar_name mlname in + n ^^ ios " of " ^^ ios_gen_type context typename + ) + | Some n, None -> + C.gen_pvar_name n + | None, None -> + assert false + + +let gen_alias context a = + let open Alias in + let ocaml_name = some_of a.ocaml_name in + let ocaml_type = gen_alias_type context a in + if ocaml_name = ocaml_type (* cyclic type abbreviation? *) + then [] (* avoid generating cyclic type abbreviations *) + else [iol [ + ios ocaml_name; ios " = "; ios ocaml_type; + ]] + + +let gen_list context l = + let open L in + iol [ + ios (some_of l.ocaml_name); ios " = "; + ios_gen_type context l.typename; + if l.ocaml_array + then ios " array" + else ios " list"; + ] + + +let gen_options context options = + let options_code = List.map (gen_option context) options in + ioi [ + ios "["; + ioi (prefix "| " options_code |> newlines); + ios "]" + ] + + +let gen_variant context v = + let open Variant in + iol [ + ios (some_of v.ocaml_name); ios " ="; + gen_options context v.option; + ] + + +let gen_enum context e = + let open Enum in + iol [ + ios (some_of e.ocaml_name); ios " ="; + gen_options context e.option; + ] + + +let gen_record context r = + let name = some_of r.R.ocaml_name in + let modname = String.capitalize name in + iol [ ios name; ios " = "; ios (modname ^ ".t") ] + + +let gen_typedef context typedef = + match typedef with + | `record t -> [gen_record context t] + | `variant t -> [gen_variant context t] + | `enum t -> [gen_enum context t] + | `list t -> [gen_list context t] + | `alias t -> gen_alias context t + + +let gen_mod_typedef context typedef = + match typedef with + | `record r -> + [gen_record_mod context r] + (* XXX: generate modules for variants? *) + | _ -> [] + + +let gen_typedefs context (typedefs:T.typedef list) = + let top_modname = C.top_modname context in + (* generated typedefs that must be wrapped into ocaml modules *) + let def_mods = U.flatmap (gen_mod_typedef context) typedefs in + (* generated the rest of typedefs wrapped into into an ocaml module *) + let other_defs = U.flatmap (gen_typedef context) typedefs in + let top_mod = iol [ + ios top_modname; + ios ":"; + ioi [ + ios "sig"; + ioi (prefix "type " other_defs |> newlines); + ios "end"; ios " = "; ios top_modname; + ] + ] + in + let code = iol [ + ios "module rec "; top_mod; + iol (prefix "and " def_mods); + ] + in + iol [ + code; + eol; + ] + + +let gen_import context import = + let open Import in + let index = C.resolve_import context import in + let imported_modname = + match import.ocaml_module with + | Some modname -> (* local override *) + modname + | None -> (* original modname *) + let piqi = index.i_piqi in + some_of piqi.P.ocaml_module + in + iod " " [ + ios "module "; ios (some_of import.ocaml_name); ios "="; + ios imported_modname; + eol; eol + ] + + +let gen_imports context l = + let l = List.map (gen_import context) l in + iol l + + +let default_visitor _ = () + + +(* depth-first graph traversal *) +let dfs + ?(pre_visit = default_visitor) + ?(cycle_visit = default_visitor) + ?(post_visit = default_visitor) + (nodes: 'a list) + (get_adjacent_vertixes: ('a -> 'a list)) = + let black = ref [] in (* visited nodes, i.e. after last_visit *) + let grey = ref [] in (* nodes between first_visit and last_visit *) + let set_color node = function + | `black -> black := node::!black + | `grey -> grey := node::!grey + in + let get_color node = + if List.memq node !black + then `black + else if List.memq node !grey + then `grey + else `white + in + let rec aux node = + match get_color node with + | `black -> () (* already processed -- nothing to do *) + | `grey -> (* found a cycle -- run a handler and return *) + cycle_visit node + | `white -> + set_color node `grey; + pre_visit node; (* run a pre-visit handler *) + + List.iter aux (get_adjacent_vertixes node); + + set_color node `black; + post_visit node (* run a post-visit handler *) + in + List.iter aux nodes + + +(* topological sort of a graph *) +let tsort + ?(cycle_visit = (fun _ -> failwith "found a cycle!")) + (nodes: 'a list) + (get_adjacent_vertixes: ('a -> 'a list)) : 'a list = + let stack = ref [] in + let post_visit node = + stack := node::!stack + in + dfs nodes get_adjacent_vertixes ~post_visit ~cycle_visit; + List.rev !stack + + +(* NOTE: for some reason, ocaml complains about fully qualified polymorphic + * variants in recursive modules, so instead of relying on OCaml, we need to + * preorder variants ourselves without relying on OCaml to figure out the order + * automatically *) +let order_variants context l = + (* topologically sort local variant defintions *) + let cycle_visit def = + C.error ("cyclic OCaml variant definition: " ^ typedef_name def) + in + let get_adjacent_vertixes = function + | `variant v -> + (* get the list of included variants *) + U.flatmap (fun o -> + match o.O.typename with + | Some typename when o.O.ocaml_name = None -> + let import, parent_piqi, typedef = C.resolve_typename context typename in + (match typedef with + | ((`variant _) as typedef) + | ((`enum _) as typedef) -> + if import <> None (* imported? *) + then [] (* omit any imported definitions *) + else [typedef] + | _ -> [] + ) + | _ -> [] + ) v.V.option + | _ -> [] + in + tsort l get_adjacent_vertixes ~cycle_visit + + +(* make sure we define aliases for built-in ocaml types first; some aliases + * (e.g. float) can override the default OCaml type names which results in + * cyclic type definitions without such ordering *) +let order_aliases l = + let rank def = + match def with + | `alias x -> + if C.is_builtin_alias x + then + (* aliases of built-in OCaml types go first *) + if x.A.ocaml_type <> None then 1 else 2 + else 100 + | _ -> + assert false + in + let compare_alias a b = + rank a - rank b + in + List.stable_sort compare_alias l + + +let order_typedefs context typedefs = + (* we apply this specific ordering only to variants, to be more specific -- + * only to those variants that include other variants by not specifying tags + * for the options *) + let variants, rest = + List.partition (function + | `variant _ | `enum _ -> true + | _ -> false) + typedefs + in + let aliases, rest = + List.partition (function + | `alias _ -> true + | _ -> false) + rest + in + (* return the updated list of definitions with sorted variants and aliases *) + (order_aliases aliases) @ (order_variants context variants) @ rest + + +let gen_piqi context = + let piqi = context.piqi in + let typedefs = order_typedefs context piqi.P.typedef in + iol [ + gen_imports context piqi.P.import; + gen_typedefs context typedefs; + eol; eol + ] + diff --git a/piqi-ocaml/piqic-ocaml/piqic_piqi.ml b/piqi-ocaml/piqic-ocaml/piqic_piqi.ml new file mode 100644 index 0000000..a7cfd60 --- /dev/null +++ b/piqi-ocaml/piqic-ocaml/piqic_piqi.ml @@ -0,0 +1,1108 @@ +module rec Piqic_piqi: + sig + type uint = int + type uint32 = int32 + type uint64 = int64 + type float64 = float + type float32 = float + type protobuf_int32 = int32 + type protobuf_int64 = int64 + type binary = string + type piqi_any = Piqic_piqi.any + type int32_fixed = int32 + type uint32_fixed = Piqic_piqi.uint32 + type int64_fixed = int64 + type uint64_fixed = Piqic_piqi.uint64 + type float = Piqic_piqi.float64 + type word = string + type name = Piqic_piqi.word + type typename = Piqic_piqi.name + type piq_format = + [ + | `word + | `text + ] + type protobuf_wire_type = + [ + | `varint + | `zigzag_varint + | `fixed32 + | `fixed64 + | `signed_varint + | `signed_fixed32 + | `signed_fixed64 + | `block + ] + type typedef = + [ + | `record of Piqic_piqi.record + | `variant of Piqic_piqi.variant + | `enum of Piqic_piqi.enum + | `alias of Piqic_piqi.alias + | `list of Piqic_piqi.piqi_list + ] + type piqi_type = + [ + | `int + | `float + | `bool + | `string + | `binary + | `any + ] + type field_mode = + [ + | `required + | `optional + | `repeated + ] + type record = Record.t + type field = Field.t + type variant = Variant.t + type option = Option.t + type enum = Enum.t + type alias = Alias.t + type piqi_list = Piqi_list.t + type piqi = Piqi.t + type import = Import.t + type any = Any.t + type func = Func.t + type piqi_bundle = Piqi_bundle.t + end = Piqic_piqi +and Record: + sig + type t = { + mutable name: Piqic_piqi.name; + mutable field: Piqic_piqi.field list; + mutable piq_positional: bool option; + mutable piq_allow_unnesting: bool option; + mutable protobuf_name: string option; + mutable protobuf_custom: string list; + mutable json_name: string option; + mutable ocaml_name: string option; + } + end = Record +and Field: + sig + type t = { + mutable name: Piqic_piqi.name option; + mutable typename: Piqic_piqi.typename option; + mutable mode: Piqic_piqi.field_mode; + mutable default: Piqic_piqi.piqi_any option; + mutable deprecated: bool; + mutable piq_format: Piqic_piqi.piq_format option; + mutable piq_positional: bool option; + mutable piq_flag_default: Piqic_piqi.piqi_any option; + mutable piq_alias: Piqic_piqi.name option; + mutable protobuf_name: string option; + mutable code: int32 option; + mutable protobuf_packed: bool; + mutable json_name: string option; + mutable json_omit_missing: bool option; + mutable getopt_letter: Piqic_piqi.word option; + mutable getopt_doc: string option; + mutable internal: bool; + mutable ocaml_name: string option; + mutable ocaml_array: bool; + mutable ocaml_optional: bool; + } + end = Field +and Variant: + sig + type t = { + mutable name: Piqic_piqi.name; + mutable option: Piqic_piqi.option list; + mutable protobuf_name: string option; + mutable protobuf_custom: string list; + mutable protobuf_oneof: string option; + mutable json_name: string option; + mutable ocaml_name: string option; + } + end = Variant +and Option: + sig + type t = { + mutable name: Piqic_piqi.name option; + mutable typename: Piqic_piqi.typename option; + mutable deprecated: bool; + mutable piq_format: Piqic_piqi.piq_format option; + mutable piq_alias: Piqic_piqi.name option; + mutable protobuf_name: string option; + mutable code: int32 option; + mutable json_name: string option; + mutable getopt_letter: Piqic_piqi.word option; + mutable getopt_doc: string option; + mutable ocaml_name: string option; + } + end = Option +and Enum: + sig + type t = { + mutable name: Piqic_piqi.name; + mutable option: Piqic_piqi.option list; + mutable protobuf_name: string option; + mutable protobuf_custom: string list; + mutable protobuf_prefix: string option; + mutable json_name: string option; + mutable ocaml_name: string option; + } + end = Enum +and Alias: + sig + type t = { + mutable name: Piqic_piqi.name; + mutable typename: Piqic_piqi.typename option; + mutable piqi_type: Piqic_piqi.piqi_type option; + mutable piq_format: Piqic_piqi.piq_format option; + mutable protobuf_name: string option; + mutable protobuf_type: string option; + mutable protobuf_wire_type: Piqic_piqi.protobuf_wire_type option; + mutable json_name: string option; + mutable ocaml_name: string option; + mutable ocaml_type: string option; + } + end = Alias +and Piqi_list: + sig + type t = { + mutable name: Piqic_piqi.name; + mutable typename: Piqic_piqi.typename; + mutable piq_format: Piqic_piqi.piq_format option; + mutable protobuf_name: string option; + mutable protobuf_custom: string list; + mutable protobuf_packed: bool; + mutable json_name: string option; + mutable ocaml_name: string option; + mutable ocaml_array: bool; + } + end = Piqi_list +and Piqi: + sig + type t = { + mutable modname: Piqic_piqi.word option; + mutable typedef: Piqic_piqi.typedef list; + mutable import: Piqic_piqi.import list; + mutable func: Piqic_piqi.func list; + mutable custom_field: Piqic_piqi.word list; + mutable protobuf_custom: string list; + mutable protobuf_package: string option; + mutable file: string option; + mutable included_file: string list; + mutable ocaml_module: string option; + } + end = Piqi +and Import: + sig + type t = { + mutable modname: Piqic_piqi.word; + mutable name: Piqic_piqi.name option; + mutable ocaml_name: string option; + mutable ocaml_module: string option; + } + end = Import +and Any: + sig + type t = { + mutable typename: string option; + mutable protobuf: Piqic_piqi.binary option; + mutable json: string option; + mutable xml: string option; + mutable piq: string option; + } + end = Any +and Func: + sig + type t = { + mutable name: Piqic_piqi.name; + mutable input: Piqic_piqi.typename option; + mutable output: Piqic_piqi.typename option; + mutable error: Piqic_piqi.typename option; + mutable ocaml_name: string option; + } + end = Func +and Piqi_bundle: + sig + type t = { + mutable piqi: Piqic_piqi.piqi list; + } + end = Piqi_bundle + + +let rec parse_piq_format x = + let code, x = Piqirun.parse_variant x in + match code with + | 251462090 when x = Piqirun.Varint 1 -> `word + | 217697453 when x = Piqirun.Varint 1 -> `text + | _ -> Piqirun.error_variant x code + +and parse_protobuf_int32 x = Piqirun.int32_of_signed_varint x +and packed_parse_protobuf_int32 x = Piqirun.int32_of_packed_signed_varint x + +and parse_protobuf_int64 x = Piqirun.int64_of_signed_varint x +and packed_parse_protobuf_int64 x = Piqirun.int64_of_packed_signed_varint x + +and parse_protobuf_wire_type x = + match Piqirun.int32_of_signed_varint x with + | 329594984l -> `varint + | 99211597l -> `zigzag_varint + | 136997651l -> `fixed32 + | 136998322l -> `fixed64 + | 441915897l -> `signed_varint + | 488499298l -> `signed_fixed32 + | 488499969l -> `signed_fixed64 + | 352089421l -> `block + | x -> Piqirun.error_enum_const x +and packed_parse_protobuf_wire_type x = + match Piqirun.int32_of_packed_signed_varint x with + | 329594984l -> `varint + | 99211597l -> `zigzag_varint + | 136997651l -> `fixed32 + | 136998322l -> `fixed64 + | 441915897l -> `signed_varint + | 488499298l -> `signed_fixed32 + | 488499969l -> `signed_fixed64 + | 352089421l -> `block + | x -> Piqirun.error_enum_const x + +and parse_bool x = Piqirun.bool_of_varint x +and packed_parse_bool x = Piqirun.bool_of_packed_varint x + +and parse_string x = Piqirun.string_of_block x + +and parse_binary x = Piqirun.string_of_block x + +and parse_piqi_any x = parse_any x + +and parse_int x = Piqirun.int_of_zigzag_varint x +and packed_parse_int x = Piqirun.int_of_packed_zigzag_varint x + +and parse_uint x = Piqirun.int_of_varint x +and packed_parse_uint x = Piqirun.int_of_packed_varint x + +and parse_int32 x = Piqirun.int32_of_zigzag_varint x +and packed_parse_int32 x = Piqirun.int32_of_packed_zigzag_varint x + +and parse_uint32 x = Piqirun.int32_of_varint x +and packed_parse_uint32 x = Piqirun.int32_of_packed_varint x + +and parse_int64 x = Piqirun.int64_of_zigzag_varint x +and packed_parse_int64 x = Piqirun.int64_of_packed_zigzag_varint x + +and parse_uint64 x = Piqirun.int64_of_varint x +and packed_parse_uint64 x = Piqirun.int64_of_packed_varint x + +and parse_float64 x = Piqirun.float_of_fixed64 x +and packed_parse_float64 x = Piqirun.float_of_packed_fixed64 x + +and parse_float32 x = Piqirun.float_of_fixed32 x +and packed_parse_float32 x = Piqirun.float_of_packed_fixed32 x + +and parse_int32_fixed x = Piqirun.int32_of_signed_fixed32 x +and packed_parse_int32_fixed x = Piqirun.int32_of_packed_signed_fixed32 x + +and parse_uint32_fixed x = Piqirun.int32_of_fixed32 x +and packed_parse_uint32_fixed x = Piqirun.int32_of_packed_fixed32 x + +and parse_int64_fixed x = Piqirun.int64_of_signed_fixed64 x +and packed_parse_int64_fixed x = Piqirun.int64_of_packed_signed_fixed64 x + +and parse_uint64_fixed x = Piqirun.int64_of_fixed64 x +and packed_parse_uint64_fixed x = Piqirun.int64_of_packed_fixed64 x + +and parse_float x = parse_float64 x +and packed_parse_float x = packed_parse_float64 x + +and parse_word x = parse_string x + +and parse_name x = parse_word x + +and parse_typedef x = + let code, x = Piqirun.parse_variant x in + match code with + | 502036113 -> + let res = parse_record x in + `record res + | 484589701 -> + let res = parse_variant x in + `variant res + | 51800833 -> + let res = parse_enum x in + `enum res + | 26300816 -> + let res = parse_alias x in + `alias res + | 129178718 -> + let res = parse_piqi_list x in + `list res + | _ -> Piqirun.error_variant x code + +and parse_piqi_type x = + match Piqirun.int32_of_signed_varint x with + | 5246191l -> `int + | 43435420l -> `float + | 18580522l -> `bool + | 288368849l -> `string + | 218872833l -> `binary + | 4848364l -> `any + | x -> Piqirun.error_enum_const x +and packed_parse_piqi_type x = + match Piqirun.int32_of_packed_signed_varint x with + | 5246191l -> `int + | 43435420l -> `float + | 18580522l -> `bool + | 288368849l -> `string + | 218872833l -> `binary + | 4848364l -> `any + | x -> Piqirun.error_enum_const x + +and parse_typename x = parse_name x + +and parse_record x = + let x = Piqirun.parse_record x in + let _field, x = Piqirun.parse_repeated_field 9671866 parse_field x in + let _protobuf_name, x = Piqirun.parse_optional_field 90072013 parse_string x in + let _protobuf_custom, x = Piqirun.parse_repeated_field 112352691 parse_string x in + let _name, x = Piqirun.parse_required_field 150958667 parse_name x in + let _piq_allow_unnesting, x = Piqirun.parse_optional_field 172744920 parse_bool x in + let _piq_positional, x = Piqirun.parse_optional_field 197354217 parse_bool x in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _json_name, x = Piqirun.parse_optional_field 515275216 parse_string x in + Piqirun.check_unparsed_fields x; + { + Record.field = _field; + Record.protobuf_name = _protobuf_name; + Record.protobuf_custom = _protobuf_custom; + Record.name = _name; + Record.piq_allow_unnesting = _piq_allow_unnesting; + Record.piq_positional = _piq_positional; + Record.ocaml_name = _ocaml_name; + Record.json_name = _json_name; + } + +and parse_field x = + let x = Piqirun.parse_record x in + let _code, x = Piqirun.parse_optional_field 29667629 parse_int32 x in + let _deprecated, x = Piqirun.parse_required_field 69402483 parse_bool x ~default:"\b\000" in + let _protobuf_name, x = Piqirun.parse_optional_field 90072013 parse_string x in + let _piq_flag_default, x = Piqirun.parse_optional_field 112451637 parse_piqi_any x in + let _mode, x = Piqirun.parse_required_field 140563299 parse_field_mode x ~default:"\b\223\162\138\147\001" in + let _internal, x = Piqirun.parse_required_field 141977405 parse_bool x ~default:"\b\000" in + let _name, x = Piqirun.parse_optional_field 150958667 parse_name x in + let _protobuf_packed, x = Piqirun.parse_required_field 179842426 parse_bool x ~default:"\b\000" in + let _piq_positional, x = Piqirun.parse_optional_field 197354217 parse_bool x in + let _json_omit_missing, x = Piqirun.parse_optional_field 201807079 parse_bool x in + let _getopt_letter, x = Piqirun.parse_optional_field 215188758 parse_word x in + let _typename, x = Piqirun.parse_optional_field 218690234 parse_typename x in + let _piq_format, x = Piqirun.parse_optional_field 296833484 parse_piq_format x in + let _ocaml_array, x = Piqirun.parse_required_field 333250744 parse_bool x ~default:"\b\000" in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _piq_alias, x = Piqirun.parse_optional_field 434682011 parse_name x in + let _getopt_doc, x = Piqirun.parse_optional_field 442330184 parse_string x in + let _default, x = Piqirun.parse_optional_field 465819841 parse_piqi_any x in + let _ocaml_optional, x = Piqirun.parse_required_field 488413665 parse_bool x ~default:"\b\000" in + let _json_name, x = Piqirun.parse_optional_field 515275216 parse_string x in + Piqirun.check_unparsed_fields x; + { + Field.code = _code; + Field.deprecated = _deprecated; + Field.protobuf_name = _protobuf_name; + Field.piq_flag_default = _piq_flag_default; + Field.mode = _mode; + Field.internal = _internal; + Field.name = _name; + Field.protobuf_packed = _protobuf_packed; + Field.piq_positional = _piq_positional; + Field.json_omit_missing = _json_omit_missing; + Field.getopt_letter = _getopt_letter; + Field.typename = _typename; + Field.piq_format = _piq_format; + Field.ocaml_array = _ocaml_array; + Field.ocaml_name = _ocaml_name; + Field.piq_alias = _piq_alias; + Field.getopt_doc = _getopt_doc; + Field.default = _default; + Field.ocaml_optional = _ocaml_optional; + Field.json_name = _json_name; + } + +and parse_field_mode x = + match Piqirun.int32_of_signed_varint x with + | 308449631l -> `required + | 510570400l -> `optional + | 274054266l -> `repeated + | x -> Piqirun.error_enum_const x +and packed_parse_field_mode x = + match Piqirun.int32_of_packed_signed_varint x with + | 308449631l -> `required + | 510570400l -> `optional + | 274054266l -> `repeated + | x -> Piqirun.error_enum_const x + +and parse_variant x = + let x = Piqirun.parse_record x in + let _protobuf_name, x = Piqirun.parse_optional_field 90072013 parse_string x in + let _protobuf_custom, x = Piqirun.parse_repeated_field 112352691 parse_string x in + let _name, x = Piqirun.parse_required_field 150958667 parse_name x in + let _protobuf_oneof, x = Piqirun.parse_optional_field 154222907 parse_string x in + let _option, x = Piqirun.parse_repeated_field 192598901 parse_option x in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _json_name, x = Piqirun.parse_optional_field 515275216 parse_string x in + Piqirun.check_unparsed_fields x; + { + Variant.protobuf_name = _protobuf_name; + Variant.protobuf_custom = _protobuf_custom; + Variant.name = _name; + Variant.protobuf_oneof = _protobuf_oneof; + Variant.option = _option; + Variant.ocaml_name = _ocaml_name; + Variant.json_name = _json_name; + } + +and parse_option x = + let x = Piqirun.parse_record x in + let _code, x = Piqirun.parse_optional_field 29667629 parse_int32 x in + let _deprecated, x = Piqirun.parse_required_field 69402483 parse_bool x ~default:"\b\000" in + let _protobuf_name, x = Piqirun.parse_optional_field 90072013 parse_string x in + let _name, x = Piqirun.parse_optional_field 150958667 parse_name x in + let _getopt_letter, x = Piqirun.parse_optional_field 215188758 parse_word x in + let _typename, x = Piqirun.parse_optional_field 218690234 parse_typename x in + let _piq_format, x = Piqirun.parse_optional_field 296833484 parse_piq_format x in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _piq_alias, x = Piqirun.parse_optional_field 434682011 parse_name x in + let _getopt_doc, x = Piqirun.parse_optional_field 442330184 parse_string x in + let _json_name, x = Piqirun.parse_optional_field 515275216 parse_string x in + Piqirun.check_unparsed_fields x; + { + Option.code = _code; + Option.deprecated = _deprecated; + Option.protobuf_name = _protobuf_name; + Option.name = _name; + Option.getopt_letter = _getopt_letter; + Option.typename = _typename; + Option.piq_format = _piq_format; + Option.ocaml_name = _ocaml_name; + Option.piq_alias = _piq_alias; + Option.getopt_doc = _getopt_doc; + Option.json_name = _json_name; + } + +and parse_enum x = + let x = Piqirun.parse_record x in + let _protobuf_name, x = Piqirun.parse_optional_field 90072013 parse_string x in + let _protobuf_custom, x = Piqirun.parse_repeated_field 112352691 parse_string x in + let _name, x = Piqirun.parse_required_field 150958667 parse_name x in + let _option, x = Piqirun.parse_repeated_field 192598901 parse_option x in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _protobuf_prefix, x = Piqirun.parse_optional_field 366391188 parse_string x in + let _json_name, x = Piqirun.parse_optional_field 515275216 parse_string x in + Piqirun.check_unparsed_fields x; + { + Enum.protobuf_name = _protobuf_name; + Enum.protobuf_custom = _protobuf_custom; + Enum.name = _name; + Enum.option = _option; + Enum.ocaml_name = _ocaml_name; + Enum.protobuf_prefix = _protobuf_prefix; + Enum.json_name = _json_name; + } + +and parse_alias x = + let x = Piqirun.parse_record x in + let _protobuf_name, x = Piqirun.parse_optional_field 90072013 parse_string x in + let _name, x = Piqirun.parse_required_field 150958667 parse_name x in + let _protobuf_type, x = Piqirun.parse_optional_field 157803580 parse_string x in + let _protobuf_wire_type, x = Piqirun.parse_optional_field 198202944 parse_protobuf_wire_type x in + let _piqi_type, x = Piqirun.parse_optional_field 198318774 parse_piqi_type x in + let _typename, x = Piqirun.parse_optional_field 218690234 parse_typename x in + let _piq_format, x = Piqirun.parse_optional_field 296833484 parse_piq_format x in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _ocaml_type, x = Piqirun.parse_optional_field 419588219 parse_string x in + let _json_name, x = Piqirun.parse_optional_field 515275216 parse_string x in + Piqirun.check_unparsed_fields x; + { + Alias.protobuf_name = _protobuf_name; + Alias.name = _name; + Alias.protobuf_type = _protobuf_type; + Alias.protobuf_wire_type = _protobuf_wire_type; + Alias.piqi_type = _piqi_type; + Alias.typename = _typename; + Alias.piq_format = _piq_format; + Alias.ocaml_name = _ocaml_name; + Alias.ocaml_type = _ocaml_type; + Alias.json_name = _json_name; + } + +and parse_piqi_list x = + let x = Piqirun.parse_record x in + let _protobuf_name, x = Piqirun.parse_optional_field 90072013 parse_string x in + let _protobuf_custom, x = Piqirun.parse_repeated_field 112352691 parse_string x in + let _name, x = Piqirun.parse_required_field 150958667 parse_name x in + let _protobuf_packed, x = Piqirun.parse_required_field 179842426 parse_bool x ~default:"\b\000" in + let _typename, x = Piqirun.parse_required_field 218690234 parse_typename x in + let _piq_format, x = Piqirun.parse_optional_field 296833484 parse_piq_format x in + let _ocaml_array, x = Piqirun.parse_required_field 333250744 parse_bool x ~default:"\b\000" in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _json_name, x = Piqirun.parse_optional_field 515275216 parse_string x in + Piqirun.check_unparsed_fields x; + { + Piqi_list.protobuf_name = _protobuf_name; + Piqi_list.protobuf_custom = _protobuf_custom; + Piqi_list.name = _name; + Piqi_list.protobuf_packed = _protobuf_packed; + Piqi_list.typename = _typename; + Piqi_list.piq_format = _piq_format; + Piqi_list.ocaml_array = _ocaml_array; + Piqi_list.ocaml_name = _ocaml_name; + Piqi_list.json_name = _json_name; + } + +and parse_piqi x = + let x = Piqirun.parse_record x in + let _modname, x = Piqirun.parse_optional_field 13841580 parse_word x in + let _included_file, x = Piqirun.parse_repeated_field 35129965 parse_string x in + let _file, x = Piqirun.parse_optional_field 62639740 parse_string x in + let _protobuf_custom, x = Piqirun.parse_repeated_field 112352691 parse_string x in + let _import, x = Piqirun.parse_repeated_field 142778725 parse_import x in + let _custom_field, x = Piqirun.parse_repeated_field 162247646 parse_word x in + let _func, x = Piqirun.parse_repeated_field 340962072 parse_func x in + let _ocaml_module, x = Piqirun.parse_optional_field 375807149 parse_string x in + let _protobuf_package, x = Piqirun.parse_optional_field 376215364 parse_string x in + let _typedef, x = Piqirun.parse_repeated_field 416823115 parse_typedef x in + Piqirun.check_unparsed_fields x; + { + Piqi.modname = _modname; + Piqi.included_file = _included_file; + Piqi.file = _file; + Piqi.protobuf_custom = _protobuf_custom; + Piqi.import = _import; + Piqi.custom_field = _custom_field; + Piqi.func = _func; + Piqi.ocaml_module = _ocaml_module; + Piqi.protobuf_package = _protobuf_package; + Piqi.typedef = _typedef; + } + +and parse_import x = + let x = Piqirun.parse_record x in + let _modname, x = Piqirun.parse_required_field 13841580 parse_word x in + let _name, x = Piqirun.parse_optional_field 150958667 parse_name x in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _ocaml_module, x = Piqirun.parse_optional_field 375807149 parse_string x in + Piqirun.check_unparsed_fields x; + { + Import.modname = _modname; + Import.name = _name; + Import.ocaml_name = _ocaml_name; + Import.ocaml_module = _ocaml_module; + } + +and parse_any x = + let x = Piqirun.parse_record x in + let _piq, x = Piqirun.parse_optional_field 5593176 parse_string x in + let _xml, x = Piqirun.parse_optional_field 5991895 parse_string x in + let _protobuf, x = Piqirun.parse_optional_field 6461771 parse_binary x in + let _json, x = Piqirun.parse_optional_field 107495976 parse_string x in + let _typename, x = Piqirun.parse_optional_field 218690234 parse_string x in + Piqirun.check_unparsed_fields x; + { + Any.piq = _piq; + Any.xml = _xml; + Any.protobuf = _protobuf; + Any.json = _json; + Any.typename = _typename; + } + +and parse_func x = + let x = Piqirun.parse_record x in + let _name, x = Piqirun.parse_required_field 150958667 parse_name x in + let _output, x = Piqirun.parse_optional_field 209784577 parse_typename x in + let _error, x = Piqirun.parse_optional_field 321506248 parse_typename x in + let _ocaml_name, x = Piqirun.parse_optional_field 351856652 parse_string x in + let _input, x = Piqirun.parse_optional_field 505267210 parse_typename x in + Piqirun.check_unparsed_fields x; + { + Func.name = _name; + Func.output = _output; + Func.error = _error; + Func.ocaml_name = _ocaml_name; + Func.input = _input; + } + +and parse_piqi_bundle x = + let x = Piqirun.parse_record x in + let _piqi, x = Piqirun.parse_repeated_field 1 parse_piqi x in + Piqirun.check_unparsed_fields x; + { + Piqi_bundle.piqi = _piqi; + } + + +let rec gen__piq_format code (x:Piqic_piqi.piq_format) = + Piqirun.gen_record code [(match x with + | `word -> Piqirun.gen_bool_field 251462090 true + | `text -> Piqirun.gen_bool_field 217697453 true + )] + +and gen__protobuf_int32 code x = Piqirun.int32_to_signed_varint code x +and packed_gen__protobuf_int32 x = Piqirun.int32_to_packed_signed_varint x + +and gen__protobuf_int64 code x = Piqirun.int64_to_signed_varint code x +and packed_gen__protobuf_int64 x = Piqirun.int64_to_packed_signed_varint x + +and gen__protobuf_wire_type code x = + Piqirun.int32_to_signed_varint code (match x with + | `varint -> 329594984l + | `zigzag_varint -> 99211597l + | `fixed32 -> 136997651l + | `fixed64 -> 136998322l + | `signed_varint -> 441915897l + | `signed_fixed32 -> 488499298l + | `signed_fixed64 -> 488499969l + | `block -> 352089421l + ) +and packed_gen__protobuf_wire_type x = + Piqirun.int32_to_packed_signed_varint (match x with + | `varint -> 329594984l + | `zigzag_varint -> 99211597l + | `fixed32 -> 136997651l + | `fixed64 -> 136998322l + | `signed_varint -> 441915897l + | `signed_fixed32 -> 488499298l + | `signed_fixed64 -> 488499969l + | `block -> 352089421l + ) + +and gen__bool code x = Piqirun.bool_to_varint code x +and packed_gen__bool x = Piqirun.bool_to_packed_varint x + +and gen__string code x = Piqirun.string_to_block code x + +and gen__binary code x = Piqirun.string_to_block code x + +and gen__piqi_any code x = (fun code x -> gen__any code x) code x + +and gen__int code x = Piqirun.int_to_zigzag_varint code x +and packed_gen__int x = Piqirun.int_to_packed_zigzag_varint x + +and gen__uint code x = Piqirun.int_to_varint code x +and packed_gen__uint x = Piqirun.int_to_packed_varint x + +and gen__int32 code x = Piqirun.int32_to_zigzag_varint code x +and packed_gen__int32 x = Piqirun.int32_to_packed_zigzag_varint x + +and gen__uint32 code x = Piqirun.int32_to_varint code x +and packed_gen__uint32 x = Piqirun.int32_to_packed_varint x + +and gen__int64 code x = Piqirun.int64_to_zigzag_varint code x +and packed_gen__int64 x = Piqirun.int64_to_packed_zigzag_varint x + +and gen__uint64 code x = Piqirun.int64_to_varint code x +and packed_gen__uint64 x = Piqirun.int64_to_packed_varint x + +and gen__float64 code x = Piqirun.float_to_fixed64 code x +and packed_gen__float64 x = Piqirun.float_to_packed_fixed64 x + +and gen__float32 code x = Piqirun.float_to_fixed32 code x +and packed_gen__float32 x = Piqirun.float_to_packed_fixed32 x + +and gen__int32_fixed code x = Piqirun.int32_to_signed_fixed32 code x +and packed_gen__int32_fixed x = Piqirun.int32_to_packed_signed_fixed32 x + +and gen__uint32_fixed code x = Piqirun.int32_to_fixed32 code x +and packed_gen__uint32_fixed x = Piqirun.int32_to_packed_fixed32 x + +and gen__int64_fixed code x = Piqirun.int64_to_signed_fixed64 code x +and packed_gen__int64_fixed x = Piqirun.int64_to_packed_signed_fixed64 x + +and gen__uint64_fixed code x = Piqirun.int64_to_fixed64 code x +and packed_gen__uint64_fixed x = Piqirun.int64_to_packed_fixed64 x + +and gen__float code x = gen__float64 code x +and packed_gen__float x = packed_gen__float64 x + +and gen__word code x = gen__string code x + +and gen__name code x = gen__word code x + +and gen__typedef code (x:Piqic_piqi.typedef) = + Piqirun.gen_record code [(match x with + | `record x -> gen__record 502036113 x + | `variant x -> gen__variant 484589701 x + | `enum x -> gen__enum 51800833 x + | `alias x -> gen__alias 26300816 x + | `list x -> gen__piqi_list 129178718 x + )] + +and gen__piqi_type code x = + Piqirun.int32_to_signed_varint code (match x with + | `int -> 5246191l + | `float -> 43435420l + | `bool -> 18580522l + | `string -> 288368849l + | `binary -> 218872833l + | `any -> 4848364l + ) +and packed_gen__piqi_type x = + Piqirun.int32_to_packed_signed_varint (match x with + | `int -> 5246191l + | `float -> 43435420l + | `bool -> 18580522l + | `string -> 288368849l + | `binary -> 218872833l + | `any -> 4848364l + ) + +and gen__typename code x = gen__name code x + +and gen__record code x = + let _field = Piqirun.gen_repeated_field 9671866 gen__field x.Record.field in + let _protobuf_name = Piqirun.gen_optional_field 90072013 gen__string x.Record.protobuf_name in + let _protobuf_custom = Piqirun.gen_repeated_field 112352691 gen__string x.Record.protobuf_custom in + let _name = Piqirun.gen_required_field 150958667 gen__name x.Record.name in + let _piq_allow_unnesting = Piqirun.gen_optional_field 172744920 gen__bool x.Record.piq_allow_unnesting in + let _piq_positional = Piqirun.gen_optional_field 197354217 gen__bool x.Record.piq_positional in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Record.ocaml_name in + let _json_name = Piqirun.gen_optional_field 515275216 gen__string x.Record.json_name in + Piqirun.gen_record code (_field :: _protobuf_name :: _protobuf_custom :: _name :: _piq_allow_unnesting :: _piq_positional :: _ocaml_name :: _json_name :: []) + +and gen__field code x = + let _code = Piqirun.gen_optional_field 29667629 gen__int32 x.Field.code in + let _deprecated = Piqirun.gen_required_field 69402483 gen__bool x.Field.deprecated in + let _protobuf_name = Piqirun.gen_optional_field 90072013 gen__string x.Field.protobuf_name in + let _piq_flag_default = Piqirun.gen_optional_field 112451637 gen__piqi_any x.Field.piq_flag_default in + let _mode = Piqirun.gen_required_field 140563299 gen__field_mode x.Field.mode in + let _internal = Piqirun.gen_required_field 141977405 gen__bool x.Field.internal in + let _name = Piqirun.gen_optional_field 150958667 gen__name x.Field.name in + let _protobuf_packed = Piqirun.gen_required_field 179842426 gen__bool x.Field.protobuf_packed in + let _piq_positional = Piqirun.gen_optional_field 197354217 gen__bool x.Field.piq_positional in + let _json_omit_missing = Piqirun.gen_optional_field 201807079 gen__bool x.Field.json_omit_missing in + let _getopt_letter = Piqirun.gen_optional_field 215188758 gen__word x.Field.getopt_letter in + let _typename = Piqirun.gen_optional_field 218690234 gen__typename x.Field.typename in + let _piq_format = Piqirun.gen_optional_field 296833484 gen__piq_format x.Field.piq_format in + let _ocaml_array = Piqirun.gen_required_field 333250744 gen__bool x.Field.ocaml_array in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Field.ocaml_name in + let _piq_alias = Piqirun.gen_optional_field 434682011 gen__name x.Field.piq_alias in + let _getopt_doc = Piqirun.gen_optional_field 442330184 gen__string x.Field.getopt_doc in + let _default = Piqirun.gen_optional_field 465819841 gen__piqi_any x.Field.default in + let _ocaml_optional = Piqirun.gen_required_field 488413665 gen__bool x.Field.ocaml_optional in + let _json_name = Piqirun.gen_optional_field 515275216 gen__string x.Field.json_name in + Piqirun.gen_record code (_code :: _deprecated :: _protobuf_name :: _piq_flag_default :: _mode :: _internal :: _name :: _protobuf_packed :: _piq_positional :: _json_omit_missing :: _getopt_letter :: _typename :: _piq_format :: _ocaml_array :: _ocaml_name :: _piq_alias :: _getopt_doc :: _default :: _ocaml_optional :: _json_name :: []) + +and gen__field_mode code x = + Piqirun.int32_to_signed_varint code (match x with + | `required -> 308449631l + | `optional -> 510570400l + | `repeated -> 274054266l + ) +and packed_gen__field_mode x = + Piqirun.int32_to_packed_signed_varint (match x with + | `required -> 308449631l + | `optional -> 510570400l + | `repeated -> 274054266l + ) + +and gen__variant code x = + let _protobuf_name = Piqirun.gen_optional_field 90072013 gen__string x.Variant.protobuf_name in + let _protobuf_custom = Piqirun.gen_repeated_field 112352691 gen__string x.Variant.protobuf_custom in + let _name = Piqirun.gen_required_field 150958667 gen__name x.Variant.name in + let _protobuf_oneof = Piqirun.gen_optional_field 154222907 gen__string x.Variant.protobuf_oneof in + let _option = Piqirun.gen_repeated_field 192598901 gen__option x.Variant.option in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Variant.ocaml_name in + let _json_name = Piqirun.gen_optional_field 515275216 gen__string x.Variant.json_name in + Piqirun.gen_record code (_protobuf_name :: _protobuf_custom :: _name :: _protobuf_oneof :: _option :: _ocaml_name :: _json_name :: []) + +and gen__option code x = + let _code = Piqirun.gen_optional_field 29667629 gen__int32 x.Option.code in + let _deprecated = Piqirun.gen_required_field 69402483 gen__bool x.Option.deprecated in + let _protobuf_name = Piqirun.gen_optional_field 90072013 gen__string x.Option.protobuf_name in + let _name = Piqirun.gen_optional_field 150958667 gen__name x.Option.name in + let _getopt_letter = Piqirun.gen_optional_field 215188758 gen__word x.Option.getopt_letter in + let _typename = Piqirun.gen_optional_field 218690234 gen__typename x.Option.typename in + let _piq_format = Piqirun.gen_optional_field 296833484 gen__piq_format x.Option.piq_format in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Option.ocaml_name in + let _piq_alias = Piqirun.gen_optional_field 434682011 gen__name x.Option.piq_alias in + let _getopt_doc = Piqirun.gen_optional_field 442330184 gen__string x.Option.getopt_doc in + let _json_name = Piqirun.gen_optional_field 515275216 gen__string x.Option.json_name in + Piqirun.gen_record code (_code :: _deprecated :: _protobuf_name :: _name :: _getopt_letter :: _typename :: _piq_format :: _ocaml_name :: _piq_alias :: _getopt_doc :: _json_name :: []) + +and gen__enum code x = + let _protobuf_name = Piqirun.gen_optional_field 90072013 gen__string x.Enum.protobuf_name in + let _protobuf_custom = Piqirun.gen_repeated_field 112352691 gen__string x.Enum.protobuf_custom in + let _name = Piqirun.gen_required_field 150958667 gen__name x.Enum.name in + let _option = Piqirun.gen_repeated_field 192598901 gen__option x.Enum.option in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Enum.ocaml_name in + let _protobuf_prefix = Piqirun.gen_optional_field 366391188 gen__string x.Enum.protobuf_prefix in + let _json_name = Piqirun.gen_optional_field 515275216 gen__string x.Enum.json_name in + Piqirun.gen_record code (_protobuf_name :: _protobuf_custom :: _name :: _option :: _ocaml_name :: _protobuf_prefix :: _json_name :: []) + +and gen__alias code x = + let _protobuf_name = Piqirun.gen_optional_field 90072013 gen__string x.Alias.protobuf_name in + let _name = Piqirun.gen_required_field 150958667 gen__name x.Alias.name in + let _protobuf_type = Piqirun.gen_optional_field 157803580 gen__string x.Alias.protobuf_type in + let _protobuf_wire_type = Piqirun.gen_optional_field 198202944 gen__protobuf_wire_type x.Alias.protobuf_wire_type in + let _piqi_type = Piqirun.gen_optional_field 198318774 gen__piqi_type x.Alias.piqi_type in + let _typename = Piqirun.gen_optional_field 218690234 gen__typename x.Alias.typename in + let _piq_format = Piqirun.gen_optional_field 296833484 gen__piq_format x.Alias.piq_format in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Alias.ocaml_name in + let _ocaml_type = Piqirun.gen_optional_field 419588219 gen__string x.Alias.ocaml_type in + let _json_name = Piqirun.gen_optional_field 515275216 gen__string x.Alias.json_name in + Piqirun.gen_record code (_protobuf_name :: _name :: _protobuf_type :: _protobuf_wire_type :: _piqi_type :: _typename :: _piq_format :: _ocaml_name :: _ocaml_type :: _json_name :: []) + +and gen__piqi_list code x = + let _protobuf_name = Piqirun.gen_optional_field 90072013 gen__string x.Piqi_list.protobuf_name in + let _protobuf_custom = Piqirun.gen_repeated_field 112352691 gen__string x.Piqi_list.protobuf_custom in + let _name = Piqirun.gen_required_field 150958667 gen__name x.Piqi_list.name in + let _protobuf_packed = Piqirun.gen_required_field 179842426 gen__bool x.Piqi_list.protobuf_packed in + let _typename = Piqirun.gen_required_field 218690234 gen__typename x.Piqi_list.typename in + let _piq_format = Piqirun.gen_optional_field 296833484 gen__piq_format x.Piqi_list.piq_format in + let _ocaml_array = Piqirun.gen_required_field 333250744 gen__bool x.Piqi_list.ocaml_array in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Piqi_list.ocaml_name in + let _json_name = Piqirun.gen_optional_field 515275216 gen__string x.Piqi_list.json_name in + Piqirun.gen_record code (_protobuf_name :: _protobuf_custom :: _name :: _protobuf_packed :: _typename :: _piq_format :: _ocaml_array :: _ocaml_name :: _json_name :: []) + +and gen__piqi code x = + let _modname = Piqirun.gen_optional_field 13841580 gen__word x.Piqi.modname in + let _included_file = Piqirun.gen_repeated_field 35129965 gen__string x.Piqi.included_file in + let _file = Piqirun.gen_optional_field 62639740 gen__string x.Piqi.file in + let _protobuf_custom = Piqirun.gen_repeated_field 112352691 gen__string x.Piqi.protobuf_custom in + let _import = Piqirun.gen_repeated_field 142778725 gen__import x.Piqi.import in + let _custom_field = Piqirun.gen_repeated_field 162247646 gen__word x.Piqi.custom_field in + let _func = Piqirun.gen_repeated_field 340962072 gen__func x.Piqi.func in + let _ocaml_module = Piqirun.gen_optional_field 375807149 gen__string x.Piqi.ocaml_module in + let _protobuf_package = Piqirun.gen_optional_field 376215364 gen__string x.Piqi.protobuf_package in + let _typedef = Piqirun.gen_repeated_field 416823115 gen__typedef x.Piqi.typedef in + Piqirun.gen_record code (_modname :: _included_file :: _file :: _protobuf_custom :: _import :: _custom_field :: _func :: _ocaml_module :: _protobuf_package :: _typedef :: []) + +and gen__import code x = + let _modname = Piqirun.gen_required_field 13841580 gen__word x.Import.modname in + let _name = Piqirun.gen_optional_field 150958667 gen__name x.Import.name in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Import.ocaml_name in + let _ocaml_module = Piqirun.gen_optional_field 375807149 gen__string x.Import.ocaml_module in + Piqirun.gen_record code (_modname :: _name :: _ocaml_name :: _ocaml_module :: []) + +and gen__any code x = + let _piq = Piqirun.gen_optional_field 5593176 gen__string x.Any.piq in + let _xml = Piqirun.gen_optional_field 5991895 gen__string x.Any.xml in + let _protobuf = Piqirun.gen_optional_field 6461771 gen__binary x.Any.protobuf in + let _json = Piqirun.gen_optional_field 107495976 gen__string x.Any.json in + let _typename = Piqirun.gen_optional_field 218690234 gen__string x.Any.typename in + Piqirun.gen_record code (_piq :: _xml :: _protobuf :: _json :: _typename :: []) + +and gen__func code x = + let _name = Piqirun.gen_required_field 150958667 gen__name x.Func.name in + let _output = Piqirun.gen_optional_field 209784577 gen__typename x.Func.output in + let _error = Piqirun.gen_optional_field 321506248 gen__typename x.Func.error in + let _ocaml_name = Piqirun.gen_optional_field 351856652 gen__string x.Func.ocaml_name in + let _input = Piqirun.gen_optional_field 505267210 gen__typename x.Func.input in + Piqirun.gen_record code (_name :: _output :: _error :: _ocaml_name :: _input :: []) + +and gen__piqi_bundle code x = + let _piqi = Piqirun.gen_repeated_field 1 gen__piqi x.Piqi_bundle.piqi in + Piqirun.gen_record code (_piqi :: []) + + +let gen_piq_format x = gen__piq_format (-1) x +let gen_protobuf_int32 x = gen__protobuf_int32 (-1) x +let gen_protobuf_int64 x = gen__protobuf_int64 (-1) x +let gen_protobuf_wire_type x = gen__protobuf_wire_type (-1) x +let gen_bool x = gen__bool (-1) x +let gen_string x = gen__string (-1) x +let gen_binary x = gen__binary (-1) x +let gen_piqi_any x = gen__piqi_any (-1) x +let gen_int x = gen__int (-1) x +let gen_uint x = gen__uint (-1) x +let gen_int32 x = gen__int32 (-1) x +let gen_uint32 x = gen__uint32 (-1) x +let gen_int64 x = gen__int64 (-1) x +let gen_uint64 x = gen__uint64 (-1) x +let gen_float64 x = gen__float64 (-1) x +let gen_float32 x = gen__float32 (-1) x +let gen_int32_fixed x = gen__int32_fixed (-1) x +let gen_uint32_fixed x = gen__uint32_fixed (-1) x +let gen_int64_fixed x = gen__int64_fixed (-1) x +let gen_uint64_fixed x = gen__uint64_fixed (-1) x +let gen_float x = gen__float (-1) x +let gen_word x = gen__word (-1) x +let gen_name x = gen__name (-1) x +let gen_typedef x = gen__typedef (-1) x +let gen_piqi_type x = gen__piqi_type (-1) x +let gen_typename x = gen__typename (-1) x +let gen_record x = gen__record (-1) x +let gen_field x = gen__field (-1) x +let gen_field_mode x = gen__field_mode (-1) x +let gen_variant x = gen__variant (-1) x +let gen_option x = gen__option (-1) x +let gen_enum x = gen__enum (-1) x +let gen_alias x = gen__alias (-1) x +let gen_piqi_list x = gen__piqi_list (-1) x +let gen_piqi x = gen__piqi (-1) x +let gen_import x = gen__import (-1) x +let gen_any x = gen__any (-1) x +let gen_func x = gen__func (-1) x +let gen_piqi_bundle x = gen__piqi_bundle (-1) x + + +let rec default_piq_format () = `word +and default_protobuf_int32 () = default_int32 () +and default_protobuf_int64 () = default_int64 () +and default_protobuf_wire_type () = `varint +and default_bool () = false +and default_string () = "" +and default_binary () = "" +and default_piqi_any () = default_any () +and default_int () = 0 +and default_uint () = 0 +and default_int32 () = 0l +and default_uint32 () = 0l +and default_int64 () = 0L +and default_uint64 () = 0L +and default_float64 () = 0.0 +and default_float32 () = 0.0 +and default_int32_fixed () = default_int32 () +and default_uint32_fixed () = default_uint32 () +and default_int64_fixed () = default_int64 () +and default_uint64_fixed () = default_uint64 () +and default_float () = default_float64 () +and default_word () = default_string () +and default_name () = default_word () +and default_typedef () = `record (default_record ()) +and default_piqi_type () = `int +and default_typename () = default_name () +and default_record () = + { + Record.field = []; + Record.protobuf_name = None; + Record.protobuf_custom = []; + Record.name = default_name (); + Record.piq_allow_unnesting = None; + Record.piq_positional = None; + Record.ocaml_name = None; + Record.json_name = None; + } +and default_field () = + { + Field.code = None; + Field.deprecated = parse_bool (Piqirun.parse_default "\b\000"); + Field.protobuf_name = None; + Field.piq_flag_default = None; + Field.mode = parse_field_mode (Piqirun.parse_default "\b\223\162\138\147\001"); + Field.internal = parse_bool (Piqirun.parse_default "\b\000"); + Field.name = None; + Field.protobuf_packed = parse_bool (Piqirun.parse_default "\b\000"); + Field.piq_positional = None; + Field.json_omit_missing = None; + Field.getopt_letter = None; + Field.typename = None; + Field.piq_format = None; + Field.ocaml_array = parse_bool (Piqirun.parse_default "\b\000"); + Field.ocaml_name = None; + Field.piq_alias = None; + Field.getopt_doc = None; + Field.default = None; + Field.ocaml_optional = parse_bool (Piqirun.parse_default "\b\000"); + Field.json_name = None; + } +and default_field_mode () = `required +and default_variant () = + { + Variant.protobuf_name = None; + Variant.protobuf_custom = []; + Variant.name = default_name (); + Variant.protobuf_oneof = None; + Variant.option = []; + Variant.ocaml_name = None; + Variant.json_name = None; + } +and default_option () = + { + Option.code = None; + Option.deprecated = parse_bool (Piqirun.parse_default "\b\000"); + Option.protobuf_name = None; + Option.name = None; + Option.getopt_letter = None; + Option.typename = None; + Option.piq_format = None; + Option.ocaml_name = None; + Option.piq_alias = None; + Option.getopt_doc = None; + Option.json_name = None; + } +and default_enum () = + { + Enum.protobuf_name = None; + Enum.protobuf_custom = []; + Enum.name = default_name (); + Enum.option = []; + Enum.ocaml_name = None; + Enum.protobuf_prefix = None; + Enum.json_name = None; + } +and default_alias () = + { + Alias.protobuf_name = None; + Alias.name = default_name (); + Alias.protobuf_type = None; + Alias.protobuf_wire_type = None; + Alias.piqi_type = None; + Alias.typename = None; + Alias.piq_format = None; + Alias.ocaml_name = None; + Alias.ocaml_type = None; + Alias.json_name = None; + } +and default_piqi_list () = + { + Piqi_list.protobuf_name = None; + Piqi_list.protobuf_custom = []; + Piqi_list.name = default_name (); + Piqi_list.protobuf_packed = parse_bool (Piqirun.parse_default "\b\000"); + Piqi_list.typename = default_typename (); + Piqi_list.piq_format = None; + Piqi_list.ocaml_array = parse_bool (Piqirun.parse_default "\b\000"); + Piqi_list.ocaml_name = None; + Piqi_list.json_name = None; + } +and default_piqi () = + { + Piqi.modname = None; + Piqi.included_file = []; + Piqi.file = None; + Piqi.protobuf_custom = []; + Piqi.import = []; + Piqi.custom_field = []; + Piqi.func = []; + Piqi.ocaml_module = None; + Piqi.protobuf_package = None; + Piqi.typedef = []; + } +and default_import () = + { + Import.modname = default_word (); + Import.name = None; + Import.ocaml_name = None; + Import.ocaml_module = None; + } +and default_any () = + { + Any.piq = None; + Any.xml = None; + Any.protobuf = None; + Any.json = None; + Any.typename = None; + } +and default_func () = + { + Func.name = default_name (); + Func.output = None; + Func.error = None; + Func.ocaml_name = None; + Func.input = None; + } +and default_piqi_bundle () = + { + Piqi_bundle.piqi = []; + } + + +let piqi = "\226\202\2304\004piqi\226\231\249\238\001\tpiqi.piqi\234\202\203\153\011\nPiqic_piqi\218\244\134\182\012T\170\136\200\184\014N\218\164\238\191\004\npiq-format\170\183\218\222\005\025\232\146\150q\148\135\232\239\001\152\247\223\136\002\000\218\164\238\191\004\004word\170\183\218\222\005\025\232\146\150q\218\178\206\207\001\152\247\223\136\002\000\218\164\238\191\004\004text\218\244\134\182\012B\130\153\170d=\218\164\238\191\004\014protobuf-int32\226\195\252\217\004\005int32\128\228\138\244\005\249\179\220\210\001\176\171\195\244\005\239\153\192\002\210\171\158\194\006\005int32\218\244\134\182\012B\130\153\170d=\218\164\238\191\004\014protobuf-int64\226\195\252\217\004\005int64\128\228\138\244\005\249\179\220\210\001\176\171\195\244\005\239\153\192\002\210\171\158\194\006\005int64\218\244\134\182\012\197\002\138\176\205\197\001\190\002\218\164\238\191\004\018protobuf-wire-type\170\183\218\222\005\027\232\146\150q\208\225\169\186\002\152\247\223\136\002\000\218\164\238\191\004\006varint\170\183\218\222\005!\232\146\150q\154\229\206^\152\247\223\136\002\000\218\164\238\191\004\rzigzag-varint\170\183\218\222\005\028\232\146\150q\166\172\211\130\001\152\247\223\136\002\000\218\164\238\191\004\007fixed32\170\183\218\222\005\028\232\146\150q\228\182\211\130\001\152\247\223\136\002\000\218\164\238\191\004\007fixed64\170\183\218\222\005\"\232\146\150q\242\231\184\165\003\152\247\223\136\002\000\218\164\238\191\004\rsigned-varint\170\183\218\222\005#\232\146\150q\196\161\239\209\003\152\247\223\136\002\000\218\164\238\191\004\014signed-fixed32\170\183\218\222\005#\232\146\150q\130\172\239\209\003\152\247\223\136\002\000\218\164\238\191\004\014signed-fixed64\170\183\218\222\005\026\232\146\150q\154\213\227\207\002\152\247\223\136\002\000\218\164\238\191\004\005block\218\244\134\182\012\024\130\153\170d\019\218\164\238\191\004\004bool\176\171\195\244\005\170\136\238\b\218\244\134\182\012\027\130\153\170d\022\218\164\238\191\004\006string\176\171\195\244\005\209\209\192\137\001\218\244\134\182\012\026\130\153\170d\021\218\164\238\191\004\006binary\176\171\195\244\005\129\248\174h\218\244\134\182\012\028\130\153\170d\023\218\164\238\191\004\bpiqi-any\176\171\195\244\005\236\245\167\002\218\244\134\182\0125\130\153\170d0\218\164\238\191\004\003int\226\195\252\217\004\006sint32\128\228\138\244\005\205\178\167/\176\171\195\244\005\239\153\192\002\218\135\205\192\012\003int\218\244\134\182\0127\130\153\170d2\218\164\238\191\004\004uint\226\195\252\217\004\006uint32\128\228\138\244\005\232\240\148\157\001\176\171\195\244\005\239\153\192\002\218\135\205\192\012\003int\218\244\134\182\0129\130\153\170d4\218\164\238\191\004\005int32\226\195\252\217\004\006sint32\128\228\138\244\005\205\178\167/\176\171\195\244\005\239\153\192\002\218\135\205\192\012\005int32\218\244\134\182\012;\130\153\170d6\218\164\238\191\004\006uint32\226\195\252\217\004\006uint32\128\228\138\244\005\232\240\148\157\001\176\171\195\244\005\239\153\192\002\218\135\205\192\012\005int32\218\244\134\182\0129\130\153\170d4\218\164\238\191\004\005int64\226\195\252\217\004\006sint64\128\228\138\244\005\205\178\167/\176\171\195\244\005\239\153\192\002\218\135\205\192\012\005int64\218\244\134\182\012;\130\153\170d6\218\164\238\191\004\006uint64\226\195\252\217\004\006uint64\128\228\138\244\005\232\240\148\157\001\176\171\195\244\005\239\153\192\002\218\135\205\192\012\005int64\218\244\134\182\012;\130\153\170d6\218\164\238\191\004\007float64\226\195\252\217\004\006double\128\228\138\244\005\178\219\169A\176\171\195\244\005\156\139\219\020\218\135\205\192\012\005float\218\244\134\182\012:\130\153\170d5\218\164\238\191\004\007float32\226\195\252\217\004\005float\128\228\138\244\005\147\214\169A\176\171\195\244\005\156\139\219\020\218\135\205\192\012\005float\218\244\134\182\012B\130\153\170d=\218\164\238\191\004\011int32-fixed\226\195\252\217\004\bsfixed32\128\228\138\244\005\226\208\247\232\001\176\171\195\244\005\239\153\192\002\210\171\158\194\006\005int32\218\244\134\182\012B\130\153\170d=\218\164\238\191\004\012uint32-fixed\226\195\252\217\004\007fixed32\128\228\138\244\005\147\214\169A\176\171\195\244\005\239\153\192\002\210\171\158\194\006\006uint32\218\244\134\182\012B\130\153\170d=\218\164\238\191\004\011int64-fixed\226\195\252\217\004\bsfixed64\128\228\138\244\005\129\214\247\232\001\176\171\195\244\005\239\153\192\002\210\171\158\194\006\005int64\218\244\134\182\012B\130\153\170d=\218\164\238\191\004\012uint64-fixed\226\195\252\217\004\007fixed64\128\228\138\244\005\178\219\169A\176\171\195\244\005\239\153\192\002\210\171\158\194\006\006uint64\218\244\134\182\012&\130\153\170d!\218\164\238\191\004\005float\176\171\195\244\005\156\139\219\020\210\171\158\194\006\007float64\218\244\134\182\012'\130\153\170d\"\218\164\238\191\004\004word\210\171\158\194\006\006string\226\156\170\236\b\006\208\156\160\191\007\001\218\244\134\182\012\025\130\153\170d\020\218\164\238\191\004\004name\210\171\158\194\006\004word\218\244\134\182\012\206\001\170\136\200\184\014\199\001\234\188\204\215\002\012piqi_typedef\218\164\238\191\004\007typedef\170\183\218\222\005\027\232\146\150q\162\218\227\222\003\152\247\223\136\002\000\210\171\158\194\006\006record\170\183\218\222\005\028\232\146\150q\138\130\146\206\003\152\247\223\136\002\000\210\171\158\194\006\007variant\170\183\218\222\005\024\232\146\150q\130\172\1791\152\247\223\136\002\000\210\171\158\194\006\004enum\170\183\218\222\005\025\232\146\150q\160\198\138\025\152\247\223\136\002\000\210\171\158\194\006\005alias\170\183\218\222\005\"\232\146\150q\188\241\152{\152\247\223\136\002\000\210\171\158\194\006\004list\226\128\157\190\n\004list\218\244\134\182\012\223\001\138\176\205\197\001\216\001\218\164\238\191\004\tpiqi-type\170\183\218\222\005\023\232\146\150q\222\179\128\005\152\247\223\136\002\000\218\164\238\191\004\003int\170\183\218\222\005\025\232\146\150q\184\150\182)\152\247\223\136\002\000\218\164\238\191\004\005float\170\183\218\222\005\024\232\146\150q\212\144\220\017\152\247\223\136\002\000\218\164\238\191\004\004bool\170\183\218\222\005\027\232\146\150q\162\163\129\147\002\152\247\223\136\002\000\218\164\238\191\004\006string\170\183\218\222\005\027\232\146\150q\130\240\221\208\001\152\247\223\136\002\000\218\164\238\191\004\006binary\170\183\218\222\005\023\232\146\150q\216\235\207\004\152\247\223\136\002\000\218\164\238\191\004\003any\162\249\213\245\n\npiqi_type_\218\244\134\182\012'\130\153\170d\"\218\164\238\191\004\004type\210\171\158\194\006\004name\226\128\157\190\n\btypename\218\244\134\182\012\167\005\138\233\142\251\014\160\005\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$;\232\146\150q\244\210\156\t\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\005field\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$\\\232\146\150q\210\139\155\188\001\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\014piq-positional\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$a\232\146\150q\176\131\223\164\001\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\019piq-allow-unnesting\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\154\143\243U\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$Q\232\146\150q\230\246\146k\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-custom\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$L\232\146\150q\160\231\179\235\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tjson-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\006record\218\244\134\182\012\246\r\138\233\142\251\014\239\r\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$;\232\146\150q\244\202\199\208\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$\\\232\146\150q\198\205\134\134\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\004mode\208\215\133\174\005\000\210\171\158\194\006\nfield-mode\192\139\160\247\t\000\138\140\251\240\r\011\218\148\211\024\006\b\223\162\138\147\001\136\158\147\199\014\000\210\203\242$L\232\146\150q\130\227\158\188\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\007default\208\215\133\174\005\000\210\171\158\194\006\bpiqi-any\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$d\232\146\150q\230\253\151B\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\ndeprecated\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\210\203\242$A\232\146\150q\152\199\138\155\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\npiq-format\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$\\\232\146\150q\210\139\155\188\001\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\014piq-positional\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$T\232\146\150q\234\128\159k\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\016piq-flag-default\208\215\133\174\005\000\210\171\158\194\006\bpiqi-any\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$J\232\146\150q\182\226\197\158\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tpiq-alias\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\154\143\243U\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$E\232\146\150q\218\196\165\028\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\004code\208\215\133\174\005\000\210\171\158\194\006\005int32\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$j\232\146\150q\244\181\193\171\001\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-packed\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\210\203\242$L\232\146\150q\160\231\179\235\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tjson-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$_\232\146\150q\206\211\186\192\001\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\017json-omit-missing\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$N\232\146\150q\172\148\156\205\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rgetopt-letter\208\215\133\174\005\000\210\171\158\194\006\004word\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\144\177\235\165\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\ngetopt-doc\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$c\232\146\150q\250\156\179\135\001\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\binternal\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$f\232\146\150q\240\130\232\189\002\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\011ocaml-array\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\210\203\242$i\232\146\150q\194\231\228\209\003\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\014ocaml-optional\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\218\164\238\191\004\005field\218\244\134\182\012\127\138\176\205\197\001y\218\164\238\191\004\nfield-mode\170\183\218\222\005\029\232\146\150q\190\197\148\166\002\152\247\223\136\002\000\218\164\238\191\004\brequired\170\183\218\222\005\029\232\146\150q\192\190\245\230\003\152\247\223\136\002\000\218\164\238\191\004\boptional\170\183\218\222\005\029\232\146\150q\244\241\173\133\002\152\247\223\136\002\000\218\164\238\191\004\brepeated\218\244\134\182\012\185\004\138\233\142\251\014\178\004\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$=\232\146\150q\234\205\214\183\001\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\006option\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\154\143\243U\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$Q\232\146\150q\230\246\146k\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-custom\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$Q\232\146\150q\246\132\138\147\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\014protobuf-oneof\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$L\232\146\150q\160\231\179\235\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tjson-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\007variant\218\244\134\182\012\247\006\138\233\142\251\014\240\006\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$;\232\146\150q\244\202\199\208\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$d\232\146\150q\230\253\151B\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\ndeprecated\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\210\203\242$A\232\146\150q\152\199\138\155\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\npiq-format\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$J\232\146\150q\182\226\197\158\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tpiq-alias\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\154\143\243U\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$E\232\146\150q\218\196\165\028\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\004code\208\215\133\174\005\000\210\171\158\194\006\005int32\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$L\232\146\150q\160\231\179\235\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tjson-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$N\232\146\150q\172\148\156\205\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rgetopt-letter\208\215\133\174\005\000\210\171\158\194\006\004word\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\144\177\235\165\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\ngetopt-doc\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\006option\218\244\134\182\012\198\004\138\233\142\251\014\191\004\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$=\232\146\150q\234\205\214\183\001\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\006option\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\154\143\243U\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$Q\232\146\150q\230\246\146k\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-custom\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$R\232\146\150q\168\190\181\221\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-prefix\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$L\232\146\150q\160\231\179\235\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tjson-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\234\188\204\215\002\tpiqi_enum\218\164\238\191\004\004enum\218\244\134\182\012\137\006\138\233\142\251\014\130\006\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$;\232\146\150q\244\202\199\208\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$@\232\146\150q\236\234\144\189\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\tpiqi-type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$A\232\146\150q\152\199\138\155\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\npiq-format\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\154\143\243U\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$P\232\146\150q\248\144\191\150\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-type\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$I\232\146\150q\128\217\130\189\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\018protobuf-wire-type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$L\232\146\150q\160\231\179\235\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tjson-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\246\161\147\144\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-type\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\005alias\218\244\134\182\012\141\006\138\233\142\251\014\134\006\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$;\232\146\150q\244\202\199\208\001\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$A\232\146\150q\152\199\138\155\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\npiq-format\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\154\143\243U\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\rprotobuf-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$Q\232\146\150q\230\246\146k\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-custom\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$j\232\146\150q\244\181\193\171\001\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-packed\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\210\203\242$L\232\146\150q\160\231\179\235\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\tjson-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$f\232\146\150q\240\130\232\189\002\152\247\223\136\002\000\170\131\252\172\003\007\218\148\211\024\002\b\001\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\011ocaml-array\208\215\133\174\005\000\210\171\158\194\006\004bool\192\139\160\247\t\000\138\140\251\240\r\007\218\148\211\024\002\b\000\136\158\147\199\014\000\218\164\238\191\004\004list\226\128\157\190\n\tpiqi_list\218\244\134\182\012\165\006\138\233\142\251\014\158\006\210\203\242$S\232\146\150q\216\210\153\r\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\006module\208\215\133\174\005\000\210\171\158\194\006\004word\192\139\160\247\t\000\226\128\157\190\n\007modname\136\158\147\199\014\000\210\203\242$>\232\146\150q\150\221\193\141\003\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\007typedef\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$=\232\146\150q\202\133\149\136\001\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\006import\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$?\232\146\150q\176\172\149\197\002\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\bfunction\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\188\207\221\154\001\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\218\164\238\191\004\012custom-field\208\215\133\174\005\000\210\171\158\194\006\004word\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$Q\232\146\150q\230\246\146k\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\218\164\238\191\004\015protobuf-custom\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$S\232\146\150q\136\221\228\230\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\016protobuf-package\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$F\232\146\150q\248\185\222;\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\004file\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\218\169\192!\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\218\164\238\191\004\rincluded-file\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\218\242\178\230\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\012ocaml-module\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\004piqi\218\244\134\182\012\209\002\138\233\142\251\014\202\002\210\203\242$S\232\146\150q\216\210\153\r\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\218\164\238\191\004\006module\208\215\133\174\005\000\210\171\158\194\006\004word\192\139\160\247\t\000\226\128\157\190\n\007modname\136\158\147\199\014\000\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$O\232\146\150q\218\242\178\230\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\012ocaml-module\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\006import\218\244\134\182\012\152\003\138\233\142\251\014\145\003\210\203\242$U\232\146\150q\244\202\199\208\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\004type\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\226\128\157\190\n\btypename\136\158\147\199\014\000\210\203\242$J\232\146\150q\150\229\148\006\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\bprotobuf\208\215\133\174\005\000\210\171\158\194\006\006binary\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$F\232\146\150q\208\136\194f\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\004json\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$E\232\146\150q\174\183\219\005\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\003xml\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$E\232\146\150q\176\225\170\005\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\003piq\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\003any\218\244\134\182\012\147\003\138\233\142\251\014\140\003\210\203\242$;\232\146\150q\150\201\251\143\001\152\247\223\136\002\000\152\182\154\152\004\223\162\138\147\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004name\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$F\232\146\150q\148\144\238\225\003\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\005input\208\215\133\174\005\000\210\171\158\194\006\004type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$G\232\146\150q\130\188\136\200\001\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\006output\208\215\133\174\005\000\210\171\158\194\006\004type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$F\232\146\150q\144\175\206\178\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\005error\208\215\133\174\005\000\210\171\158\194\006\004type\192\139\160\247\t\000\136\158\147\199\014\000\210\203\242$M\232\146\150q\152\160\199\207\002\152\247\223\136\002\000\152\182\154\152\004\160\223\186\243\001\232\243\204\157\004\000\218\164\238\191\004\nocaml-name\208\215\133\174\005\000\210\171\158\194\006\006string\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\bfunction\226\128\157\190\n\004func\218\244\134\182\012b\138\233\142\251\014\\\210\203\242$7\232\146\150q\002\152\247\223\136\002\000\152\182\154\152\004\250\248\214\130\001\232\243\204\157\004\000\208\215\133\174\005\000\210\171\158\194\006\004piqi\192\139\160\247\t\000\136\158\147\199\014\000\218\164\238\191\004\tpiqi-list\226\128\157\190\n\011piqi_bundle" +include Piqic_piqi diff --git a/piqi-ocaml/piqirun/.gitignore b/piqi-ocaml/piqirun/.gitignore new file mode 100644 index 0000000..209892b --- /dev/null +++ b/piqi-ocaml/piqirun/.gitignore @@ -0,0 +1 @@ +/META diff --git a/piqi-ocaml/piqirun/META.in b/piqi-ocaml/piqirun/META.in new file mode 100644 index 0000000..53c41b0 --- /dev/null +++ b/piqi-ocaml/piqirun/META.in @@ -0,0 +1,15 @@ +description = "Runtime support for stubs generated by'piqic-ocaml'" + +package "pb" ( + description = "Piqi runtime library for Protocol Buffers serialization" + archive(byte) = "piqirun.cmo" + archive(native) = "piqirun.cmx" + requires = "bytes stdlib-shims" +) + +package "ext" ( + description = "Piqi runtime library for multi-format JSON/XML/Protobuf/Piq serialization" + requires = "piqilib piqirun.pb" + archive(byte) = "piqirun_ext.cmo" + archive(native) = "piqirun_ext.cmx" +) diff --git a/piqi-ocaml/piqirun/Makefile b/piqi-ocaml/piqirun/Makefile new file mode 100644 index 0000000..5c202cb --- /dev/null +++ b/piqi-ocaml/piqirun/Makefile @@ -0,0 +1,58 @@ +OCAMLMAKEFILE := ../make/OCamlMakefile + + +RESULT = piqirun + + +# piqirun_ext.ml depends on it +PACKS = piqilib stdlib-shims + + +SOURCES = \ + piqirun.ml \ + piqirun_ext.ml piqirun_ext.mli + +LIBINSTALL_FILES = \ + piqirun.cmi piqirun.cmo piqirun.cmx piqirun.o \ + piqirun_ext.mli piqirun_ext.cmi piqirun_ext.cmo piqirun_ext.cmx piqirun_ext.o \ + piqirun.ml # TODO: piqirun.mli + + +PRE_TARGETS = META + + +all: bcl ncl + + +debug: dcl top + + +# NOTE: when installing, uninstall first to avoid "already installed" error +install: uninstall libinstall + + +uninstall: libuninstall + + +META: ../VERSION META.in + echo "version = \"`head -1 $<`\"" >$@ + cat META.in >>$@ + + +test: bcl + ocaml piqirun.cmo test.ml + + +# these commands are useful for debugging: +#ocamlc -c -g piqirun.cmo test.ml +#ocaml -init test.ocaml piqirun.cmo test.cmo +# +#ocamlc -g piqirun.cmo test.ml +#OCAMLRUNPARAM=b ./a.out + + +clean:: + rm -f test.cm? a.out + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/piqirun/dune b/piqi-ocaml/piqirun/dune new file mode 100644 index 0000000..feedf88 --- /dev/null +++ b/piqi-ocaml/piqirun/dune @@ -0,0 +1,13 @@ +(library + (name piqirun) + (public_name piqirun.pb) + (wrapped false) + (libraries piqilib stdlib-shims) + (modules piqirun)) + +(library + (name piqirun_ext) + (public_name piqirun.ext) + (wrapped false) + (libraries piqilib stdlib-shims) + (modules piqirun_ext)) diff --git a/piqi-ocaml/piqirun/piqirun.ml b/piqi-ocaml/piqirun/piqirun.ml new file mode 100644 index 0000000..7ab5400 --- /dev/null +++ b/piqi-ocaml/piqirun/piqirun.ml @@ -0,0 +1,1559 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2017, 2018 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +(* Runtime support for piqi/Protocol Buffers wire format encoding + * + * Encoding rules follow this specification: + * + * http://code.google.com/apis/protocolbuffers/docs/encoding.html + *) + + +(* + * Runtime support for parsers (decoders). + * + *) + +exception Error of int * string + + +let string_of_loc pos = + string_of_int pos + + +let strerr loc s = + string_of_loc loc ^ ": " ^ s + + +let buf_error loc s = + (* + failwith (strerr s loc) + *) + raise (Error (loc, s)) + + +let error obj s = + let loc = -1 in (* TODO, XXX: obj location db? *) + buf_error loc s + + +type string_slice = + { + s : string; + start_pos : int; (* position of `s` in the input stream *) + len :int; + mutable pos : int; + } + + +(* the below alternative tail-recursive implementation of stdlib's List.map is + * copied from Core (https://github.com/janestreet/core_kernel) + * + * note that the order of arguments was changed back to match the one of + * stdlib's + *) + +let list_map_slow f l = List.rev (List.rev_map f l) + +let rec list_count_map f l ctr = + match l with + | [] -> [] + | [x1] -> + let f1 = f x1 in + [f1] + | [x1; x2] -> + let f1 = f x1 in + let f2 = f x2 in + [f1; f2] + | [x1; x2; x3] -> + let f1 = f x1 in + let f2 = f x2 in + let f3 = f x3 in + [f1; f2; f3] + | [x1; x2; x3; x4] -> + let f1 = f x1 in + let f2 = f x2 in + let f3 = f x3 in + let f4 = f x4 in + [f1; f2; f3; f4] + | x1 :: x2 :: x3 :: x4 :: x5 :: tl -> + let f1 = f x1 in + let f2 = f x2 in + let f3 = f x3 in + let f4 = f x4 in + let f5 = f x5 in + f1 :: f2 :: f3 :: f4 :: f5 :: + (if ctr > 1000 + then list_map_slow f tl + else list_count_map f tl (ctr + 1)) + +let list_map f l = list_count_map f l 0 + + +module List = + struct + include List + + let map = list_map + end + + +module IBuf = + struct + type t = + | String of string_slice + | Channel of in_channel + + + let of_channel x = Channel x + + + let of_string x start_pos = + String + { s = x; len = String.length x; + start_pos = start_pos; pos = 0; + } + + + let to_string buf = + match buf with + | String x -> + (* XXX, TODO: try to avoid extra alloaction if the buffer holds the + * whole desired string? *) + String.sub x.s x.pos (x.len - x.pos) + | Channel x -> + (* XXX: optimize using block reads? OTOH, it seems like this + * function is not supposed to be called for channels at all *) + let res = Buffer.create 20 in + try + while true (* this cycle exist only on End_of_file exception *) + do + Buffer.add_char res (input_char x) + done; "" + with End_of_file -> + Buffer.contents res + + + let pos buf = + match buf with + | String x -> x.pos + x.start_pos + | Channel x -> pos_in x + + + let size buf = + match buf with + | String x -> x.len - x.pos + | Channel x -> + (* this function should is not called for channels *) + assert false + + + let error buf s = + let loc = pos buf in + buf_error loc s + + + exception End_of_buffer + + + (* get the next byte from the buffer and return it as an integer *) + let next_byte buf = + match buf with + | String x -> + if x.pos >= x.len + then + raise End_of_buffer + else + let res = x.s.[x.pos] in + x.pos <- x.pos + 1; + Char.code res + | Channel x -> + (try input_byte x + with End_of_file -> raise End_of_buffer) + + + (* get the next [length] bytes the buffer and return it as a string *) + let next_block buf length = + match buf with + | String x -> + if x.pos + length > x.len + then + (* XXX: adjusting position to provide proper EOB location *) + (x.pos <- x.len; raise End_of_buffer) + else + (* NOTE: start_pos, pos and the string itself remain the same in + * the new buffer *) + let res = String { x with len = x.pos + length } in + (* skip the new buffer in the current buffer *) + x.pos <- x.pos + length; + res + | Channel x -> + let start_pos = pos_in x in + let s = Bytes.create length in + (try Stdlib.really_input x s 0 length + with End_of_file -> raise End_of_buffer + ); + of_string (Bytes.unsafe_to_string s) start_pos + + + let of_string x = + of_string x 0 + end + + +type t = + | Varint of int + | Varint64 of int64 (* used if int width is not enough *) + | Int32 of int32 + | Int64 of int64 + | Block of IBuf.t + | Top_block of IBuf.t (* top-level block *) + + +(* initializers for embedded records/variants (i.e. their contents start without + * any leading headers/delimiters/separators) *) +let init_from_channel ch = + Top_block (IBuf.of_channel ch) + + +let init_from_string s = + Top_block (IBuf.of_string s) + + +let error_variant obj code = + error obj ("unknown variant: " ^ string_of_int code) +let error_missing obj code = + error obj ("missing field: " ^ string_of_int code) + +let error_enum_const obj = error obj "unknown enum constant" + + +(* TODO, XXX: issue warning on unparsed fields or change behaviour depending on + * "strict" config option ? *) +let check_unparsed_fields l = + () + (* + List.iter (fun (code, x) -> error code "unknown field") l + *) + + +let next_varint_byte buf = + let x = IBuf.next_byte buf in + (* msb indicating that more bytes will follow *) + let msb = x land 0x80 in + let x = x land 0x7f in + msb, x + + +let parse_varint64 i buf msb x partial_res = + let rec aux i msb x res = + let x = Int64.of_int x in + let y = Int64.shift_left x (i*7) in + if (Int64.shift_right_logical y (i*7)) <> x + then + IBuf.error buf "integer overflow while reading varint" + else + let res = Int64.logor res y in + if msb = 0 + then Varint64 res (* no more octets => return *) + else + let msb, x = next_varint_byte buf in + aux (i+1) msb x res (* continue reading octets *) + in aux i msb x (Int64.of_int partial_res) + + +(* TODO: optimize using Sys.word_size and manual cycle unrolling *) +let parse_varint_common buf i res = + let rec aux i res = + let msb, x = next_varint_byte buf in + let y = x lsl (i*7) in + (* NOTE: by using asr rather than lsr we disallow signed integers to appear + * in Varints, they will rather be returned as Varint64 *) + if y asr (i*7) <> x + then + (* switch to Varint64 in case of overflow *) + parse_varint64 i buf msb x res + else + let res = res lor y in + if msb = 0 + then Varint res (* no more octets => return *) + else aux (i+1) res (* continue reading octets *) + in + try aux i res + with IBuf.End_of_buffer -> + IBuf.error buf "unexpected end of buffer while reading varint" + + +let parse_varint buf = + parse_varint_common buf 0 0 + + +let try_parse_varint buf = + (* try to read the first byte and don't handle End_of_buffer exception *) + let msb, x = next_varint_byte buf in + if msb = 0 + then Varint x (* no more octets => return *) + else parse_varint_common buf 1 x + + +(* TODO, XXX: check signed overflow *) +(* TODO: optimize for little-endian architecture *) +let parse_fixed32 buf = + try + let res = ref 0l in + for i = 0 to 3 + do + let x = IBuf.next_byte buf in + let x = Int32.of_int x in + let x = Int32.shift_left x (i*8) in + res := Int32.logor !res x + done; + !res + with IBuf.End_of_buffer -> + IBuf.error buf "unexpected end of buffer while reading fixed32" + + +let parse_fixed64 buf = + try + let res = ref 0L in + for i = 0 to 7 + do + let x = IBuf.next_byte buf in + let x = Int64.of_int x in + let x = Int64.shift_left x (i*8) in + res := Int64.logor !res x + done; + !res + with IBuf.End_of_buffer -> + IBuf.error buf "unexpected end of buffer while reading fixed64" + + +let try_parse_fixed32 buf = + (* try to read the first byte and don't handle End_of_buffer exception *) + let b1 = IBuf.next_byte buf in + let res = ref (Int32.of_int b1) in + try + for i = 1 to 3 + do + let x = IBuf.next_byte buf in + let x = Int32.of_int x in + let x = Int32.shift_left x (i*8) in + res := Int32.logor !res x + done; + !res + with IBuf.End_of_buffer -> + IBuf.error buf "unexpected end of buffer while reading fixed32" + + +let try_parse_fixed64 buf = + (* try to read the first byte and don't handle End_of_buffer exception *) + let b1 = IBuf.next_byte buf in + let res = ref (Int64.of_int b1) in + try + for i = 1 to 7 + do + let x = IBuf.next_byte buf in + let x = Int64.of_int x in + let x = Int64.shift_left x (i*8) in + res := Int64.logor !res x + done; + !res + with IBuf.End_of_buffer -> + IBuf.error buf "unexpected end of buffer while reading fixed64" + + +let parse_block buf = + (* XXX: is there a length limit or it is implementation specific? *) + match parse_varint buf with + | Varint length when length >= 0 -> + (try IBuf.next_block buf length + with IBuf.End_of_buffer -> error buf "unexpected end of block") + | Varint _ | Varint64 _ -> + IBuf.error buf "block length is too long" + | _ -> assert false + + +(* TODO: optimize using Sys.word_size *) +let parse_field_header buf = + (* the range for field codes is 1 - (2^29 - 1) which mean on 32-bit + * machine ocaml's int may not hold the full value *) + match try_parse_varint buf with + | Varint key -> + let wire_type = key land 7 in + let field_code = key lsr 3 in + wire_type, field_code + + | Varint64 key when Int64.logand key 0xffff_ffff_0000_0000L <> 0L -> + IBuf.error buf "field code is too big" + + | Varint64 key -> + let wire_type = Int64.to_int (Int64.logand key 7L) in + let field_code = Int64.to_int (Int64.shift_right_logical key 3) in + wire_type, field_code + | _ -> assert false + + +let parse_field buf = + try + let wire_type, field_code = parse_field_header buf in + let field_value = + match wire_type with + | 0 -> parse_varint buf + | 1 -> Int64 (parse_fixed64 buf) + | 2 -> Block (parse_block buf) + | 5 -> Int32 (parse_fixed32 buf) + | 3 | 4 -> IBuf.error buf "groups are not supported" + | _ -> IBuf.error buf ("unknown wire type " ^ string_of_int wire_type) + in + Some (field_code, field_value) + with + IBuf.End_of_buffer -> None + + +(* parse header of a top-level value of a primitive type (i.e. generated with a + * special "-1" code) *) +let parse_toplevel_header buf = + match parse_field buf with + | None -> + error buf "unexpected end of buffer when reading top-level header" + | Some (field_code, field_value) -> + if field_code = 1 + then field_value + else error buf "invalid top-level header for a primitive type" + + +let rec expect_int32 = function + | Int32 i -> i + | Top_block buf -> expect_int32 (parse_toplevel_header buf) + | obj -> error obj "fixed32 expected" + + +let rec expect_int64 = function + | Int64 i -> i + | Top_block buf -> expect_int64 (parse_toplevel_header buf) + | obj -> error obj "fixed64 expected" + + +(* + * Convert Zig-zag varint to normal varint + *) + +let rec zigzag_varint_of_varint = function + | Varint x -> + let sign = - (x land 1) in + let res = (x lsr 1) lxor sign in + Varint res + | Varint64 x -> + let sign = Int64.neg (Int64.logand x 1L) in + let res = Int64.logxor (Int64.shift_right_logical x 1) sign in + Varint64 res + | Top_block buf -> zigzag_varint_of_varint (parse_toplevel_header buf) + | obj -> error obj "varint expected" + + +(* + * Parsing primitive types + *) + + +let max_uint = + match Sys.word_size with + | 32 -> 0x0000_0000_7fff_ffffL (* on 32-bit, int is 31-bit wide *) + | 64 -> 0x7fff_ffff_ffff_ffffL (* on 64-bit, int is 63-bit wide *) + | _ -> assert false + + +let int64_of_uint x = + (* prevent turning into a negative value *) + Int64.logand (Int64.of_int x) max_uint + +let int64_of_uint32 x = + (* prevent turning into a negative value *) + Int64.logand (Int64.of_int32 x) 0x0000_0000_ffff_ffffL + + +(* this encoding is only for unsigned integers *) +let rec int_of_varint obj = + match obj with + | Varint x -> x + | Varint64 x -> + let res = Int64.to_int x in + if int64_of_uint res <> x + then error obj "int overflow in 'int_of_varint'"; + res + | Top_block buf -> int_of_varint (parse_toplevel_header buf) + | _ -> + error obj "varint expected" + + +let rec int_of_signed_varint obj = + match obj with + | Varint x -> x + | Varint64 x -> + let res = Int64.to_int x in + if Int64.of_int res <> x + then error obj "int overflow in 'int_of_signed_varint'"; + res + | Top_block buf -> int_of_signed_varint (parse_toplevel_header buf) + | _ -> + error obj "varint expected" + + +(* this encoding is only for signed integers *) +let int_of_zigzag_varint x = + int_of_signed_varint (zigzag_varint_of_varint x) + +let int_of_fixed32 x = + Int32.to_int (expect_int32 x) + +let int_of_fixed64 x = + Int64.to_int (expect_int64 x) + + +(* this encoding is only for unsigned integers *) +let rec int64_of_varint = function + | Varint x -> int64_of_uint x + | Varint64 x -> x + | Top_block buf -> int64_of_varint (parse_toplevel_header buf) + | obj -> error obj "varint expected" + + +let rec int64_of_signed_varint = function + | Varint x -> Int64.of_int x + | Varint64 x -> x + | Top_block buf -> int64_of_signed_varint (parse_toplevel_header buf) + | obj -> error obj "varint expected" + + +(* this encoding is only for signed integers *) +let int64_of_zigzag_varint x = + int64_of_signed_varint (zigzag_varint_of_varint x) + + +let int64_of_fixed32 x = + let x = expect_int32 x in + int64_of_uint32 x + +let int64_of_fixed64 = expect_int64 + +let int64_of_signed_fixed32 x = Int64.of_int32 (expect_int32 x) + +let int64_of_signed_fixed64 = int64_of_fixed64 + + +(* this encoding is only for unsigned integers *) +let rec int32_of_varint obj = + match obj with + | Varint x -> + (* don't bother handling separate cases for now: which type is wider -- + * int32 or int *) + int32_of_varint (Varint64 (int64_of_uint x)) + | Varint64 x -> + let res = Int64.to_int32 x in + if int64_of_uint32 res <> x + then error obj "int32 overflow in 'int32_of_varint'"; + res + | Top_block buf -> int32_of_varint (parse_toplevel_header buf) + | obj -> + error obj "varint expected" + + +let rec int32_of_signed_varint obj = + match obj with + | Varint x -> + (* don't bother handling separate cases for now: which type is wider -- + * int32 or int *) + int32_of_signed_varint (Varint64 (Int64.of_int x)) + | Varint64 x -> + let res = Int64.to_int32 x in + if Int64.of_int32 res <> x + then error obj "int32 overflow in 'int32_of_signed_varint'"; + res + | Top_block buf -> int32_of_signed_varint (parse_toplevel_header buf) + | obj -> + error obj "varint expected" + + +(* this encoding is only for signed integers *) +let int32_of_zigzag_varint x = + int32_of_signed_varint (zigzag_varint_of_varint x) + +let int32_of_fixed32 = expect_int32 + +let int32_of_signed_fixed32 = int32_of_fixed32 + + +let float_of_int32 x = + Int32.float_of_bits x (* XXX *) + +let float_of_int64 x = + Int64.float_of_bits x (* XXX *) + +let float_of_fixed64 buf = + float_of_int64 (expect_int64 buf) + +let float_of_fixed32 buf = + float_of_int32 (expect_int32 buf) + + +let bool_of_varint obj = + match int_of_varint obj with + | 0 -> false + | 1 -> true + | _ -> error obj "invalid boolean constant" + +let parse_bool_field = bool_of_varint + + +let rec parse_binary_field obj = + match obj with + | Block buf -> IBuf.to_string buf + | Top_block buf -> parse_binary_field (parse_toplevel_header buf) + | obj -> error obj "block expected" + +let validate_string s = s (* XXX: validate utf8-encoded string *) + +let parse_string_field obj = + validate_string (parse_binary_field obj) + +let string_of_block = parse_string_field +let word_of_block = parse_string_field (* word is encoded as string *) +let text_of_block = parse_string_field (* text is encoded as string *) + + +(* + * Parsing packed fields (packed encoding is used only for primitive + * numeric types) + *) + + +let int_of_packed_varint buf = + int_of_varint (try_parse_varint buf) + +let int_of_packed_signed_varint buf = + int_of_signed_varint (try_parse_varint buf) + +let int_of_packed_zigzag_varint buf = + int_of_zigzag_varint (try_parse_varint buf) + +let int_of_packed_fixed32 buf = + Int32.to_int (try_parse_fixed32 buf) + +let int_of_packed_fixed64 buf = + Int64.to_int (try_parse_fixed64 buf) + + +let int64_of_packed_varint buf = + int64_of_varint (try_parse_varint buf) + +let int64_of_packed_signed_varint buf = + int64_of_signed_varint (try_parse_varint buf) + +let int64_of_packed_zigzag_varint buf = + int64_of_zigzag_varint (try_parse_varint buf) + +let int64_of_packed_fixed64 buf = + try_parse_fixed64 buf + +let int64_of_packed_fixed32 buf = + let x = try_parse_fixed32 buf in + int64_of_uint32 x + +let int64_of_packed_signed_fixed64 = int64_of_packed_fixed64 + +let int64_of_packed_signed_fixed32 buf = + Int64.of_int32 (try_parse_fixed32 buf) + + +let int32_of_packed_varint buf = + int32_of_varint (try_parse_varint buf) + +let int32_of_packed_signed_varint buf = + int32_of_signed_varint (try_parse_varint buf) + +let int32_of_packed_zigzag_varint buf = + int32_of_zigzag_varint (try_parse_varint buf) + +let int32_of_packed_fixed32 buf = + try_parse_fixed32 buf + +let int32_of_packed_signed_fixed32 = int32_of_packed_fixed32 + + +let float_of_packed_fixed32 buf = + float_of_int32 (try_parse_fixed32 buf) + +let float_of_packed_fixed64 buf = + float_of_int64 (try_parse_fixed64 buf) + + +let bool_of_packed_varint buf = + bool_of_varint (try_parse_varint buf) + + +(* + * Parsing complex user-defined types + *) + +let parse_record_buf buf = + let rec parse_unordered accu = + match parse_field buf with + | Some field -> + parse_unordered (field::accu) + | None -> + let res = List.rev accu in + (* stable-sort the obtained fields by codes: it is safe to use + * subtraction, because field codes are 29-bit integers *) + List.stable_sort (fun (a, _) (b, _) -> a - b) res + in + let rec parse_ordered accu = + match parse_field buf with + | Some ((code, _value) as field) -> + (* check if the fields appear in order *) + (match accu with + | (prev_code, _)::_ when prev_code > code -> + (* the field is out of order *) + parse_unordered (field::accu) + | _ -> + parse_ordered (field::accu) + ) + | None -> + List.rev accu + in + parse_ordered [] + + +let parse_record obj = + match obj with + | Block buf + | Top_block buf -> parse_record_buf buf + | obj -> error obj "block expected" + + +let parse_variant obj = + match parse_record obj with + | [x] -> x + | [] -> error obj "empty variant" + | _ -> error obj "variant contains more than one option" + + +(* find all fields with the given code in the list of fields sorted by codes *) +let find_fields code l = + let rec aux accu unknown_accu = function + | (code', obj)::t when code' = code -> + aux (obj::accu) unknown_accu t + | ((code', _) as h)::t when code' < code -> + (* skipping the field which code is less than the requested one *) + aux accu (h::unknown_accu) t + | rem -> + List.rev accu, List.rev_append unknown_accu rem + in + aux [] [] l + + +(* find the last instance of a field given its code in the list of fields sorted + * by codes *) +let find_field code l = + let rec try_find_next_field prev_value = function + | (code', value)::t when code' = code -> (* field is found again *) + try_find_next_field value t + | rem -> (* previous field was the last one *) + Some prev_value, rem + in + let rec find_first_field unknown_accu = function + | (code', value)::t when code' = code -> (* field is found *) + (* check if this is the last instance of it, if not, continue iterating + * through the list *) + let res, rem = try_find_next_field value t in + res, List.rev_append unknown_accu rem + | ((code', _) as h)::t when code' < code -> + (* skipping the field which code is less than the requested one *) + find_first_field (h::unknown_accu) t + | rem -> (* not found *) + None, rem + + in + match find_first_field [] l with + | None, rem -> + (* not found => returning the original list *) + None, l + | res -> + (* found => returning found value + everything else *) + res + + +let parse_binobj parse_fun binobj = + let buf = init_from_string binobj in + parse_fun buf + + +let parse_default binobj = + let buf = init_from_string binobj in + buf + + +(* XXX, NOTE: using default with required or optional-default fields *) +let parse_required_field code parse_value ?default l = + let res, rem = find_field code l in + match res with + | None -> + (match default with + | Some x -> parse_value (parse_default x), l + | None -> error_missing l code) + | Some x -> + parse_value x, rem + + +let parse_optional_field code parse_value ?default l = + let res, rem = find_field code l in + match res with + | None -> + (match default with + | Some x -> Some (parse_value (parse_default x)), l + | None -> None, l) + | Some x -> + Some (parse_value x), rem + + +let parse_repeated_field code parse_value l = + let res, rem = find_fields code l in + List.map parse_value res, rem + + +(* similar to List.map but store results in a newly created output array *) +let map_l2a f l = + let len = List.length l in + (* create and initialize the results array *) + let a = Array.make len (Obj.magic 1) in + let rec aux i = function + | [] -> () + | h::t -> + a.(i) <- f h; + aux (i+1) t + in + aux 0 l; a + + +let parse_repeated_array_field code parse_value l = + let res, rem = find_fields code l in + map_l2a parse_value res, rem + + +let parse_packed_fields parse_packed_value buf = + let rec aux accu = + try + (* try parsing another packed element *) + let value = parse_packed_value buf in + aux (value :: accu) + with IBuf.End_of_buffer -> (* no more packed elements *) + (* NOTE: accu is returned in reversed order and will reversed to a normal + * order at a later stage in rev_flatmap *) + accu + in + aux [] + + +let parse_packed_field parse_packed_value parse_value obj = + match obj with + | Block buf -> + parse_packed_fields parse_packed_value buf + | _ -> + [parse_value obj] + + +let parse_packed_array_field elem_size parse_packed_value buf = + let size = IBuf.size buf in + let elem_count = size / elem_size in + + (* make sure the array contains whole elements w/o any trailing fractions *) + if size mod elem_size <> 0 + then IBuf.error buf "invalid packed fixed-width field"; + + (* create a new array for results *) + let a = Array.make elem_count (Obj.magic 1) in + (* parse packed elements and store resuts in the array *) + for i = 0 to elem_count - 1 + do + a.(i) <- parse_packed_value buf + done; + (* return the resulting array *) + a + + +(* the same as List.flatten (List.map (fun x -> List.rev (f x)) l), but more + * efficient and tail recursive *) +let rev_flatmap f l = + let l = List.rev_map f l in + List.fold_left (fun accu x -> List.rev_append x accu) [] l + + +let parse_packed_repeated_field code parse_packed_value parse_value l = + let fields, rem = find_fields code l in + let res = rev_flatmap (parse_packed_field parse_packed_value parse_value) fields in + res, rem + + +let parse_packed_repeated_array_field code parse_packed_value parse_value l = + let res, rem = parse_packed_repeated_field code parse_packed_value parse_value l in + Array.of_list res, rem + + +let parse_packed_repeated_array_fixed_field elem_size code parse_packed_value parse_value l = + let fields, rem = find_fields code l in + match fields with + | [Block buf] -> + let res = parse_packed_array_field elem_size parse_packed_value buf in + res, rem + | _ -> + (* this is the case when there are several repeated entries with the + * same code each containing packed repeated values -- need to handle + * this case, but not optimizing for it *) + parse_packed_repeated_array_field code parse_packed_value parse_value l + + +let parse_packed_repeated_array32_field code parse_packed_value parse_value l = + parse_packed_repeated_array_fixed_field 4 code parse_packed_value parse_value l + +let parse_packed_repeated_array64_field code parse_packed_value parse_value l = + parse_packed_repeated_array_fixed_field 8 code parse_packed_value parse_value l + + +let parse_list_elem parse_value (code, x) = + (* NOTE: expecting "1" as list element code *) + if code = 1 + then parse_value x + else error x "invalid list element code" + + +let parse_list parse_value obj = + let l = parse_record obj in + List.map (parse_list_elem parse_value) l + + +let parse_array parse_value obj = + let l = parse_record obj in + map_l2a (parse_list_elem parse_value) l + + +let parse_packed_list_1 parse_packed_value parse_value fields = + rev_flatmap (parse_list_elem (parse_packed_field parse_packed_value parse_value)) fields + + +let parse_packed_list parse_packed_value parse_value obj = + let fields = parse_record obj in + parse_packed_list_1 parse_packed_value parse_value fields + + +let parse_packed_array parse_packed_value parse_value obj = + let res = parse_packed_list parse_packed_value parse_value obj in + Array.of_list res + + +let parse_packed_array_fixed elem_size parse_packed_value parse_value obj = + let l = parse_record obj in + match l with + | [1, Block buf] -> + parse_packed_array_field elem_size parse_packed_value buf + | _ -> + (* this is the case when there are several list entries each containing + * packed repeated values -- need to handle this case, but not + * optimizing for it *) + let res = parse_packed_list_1 parse_packed_value parse_value l in + Array.of_list res + + +let parse_packed_array32 parse_packed_value parse_value obj = + parse_packed_array_fixed 4 parse_packed_value parse_value obj + +let parse_packed_array64 parse_packed_value parse_value obj = + parse_packed_array_fixed 8 parse_packed_value parse_value obj + + +(* + * Runtime support for generators (encoders) + *) + +module OBuf = + struct + (* auxiliary iolist type and related primitives *) + type t = + Ios of string + | Iol of t list + | Iol_size of int * (t list) (* iolist with known size *) + | Iob of char + | IBuf of IBuf.t + + + let ios x = Ios x + let iol l = Iol l + let iob b = Iob b + + + (* iolist buf output *) + let to_buffer0 buf l = + let rec aux = function + | Ios s -> Buffer.add_string buf s + | Iol l | Iol_size (_, l) -> List.iter aux l + | Iob b -> Buffer.add_char buf b + | IBuf (IBuf.String x) -> Buffer.add_substring buf x.s x.pos (x.len - x.pos) + | IBuf (IBuf.Channel x) -> assert false + in aux l + + + (* iolist output size *) + let rec size = function + | Ios s -> String.length s + | Iol l -> List.fold_left (fun accu x -> accu + (size x)) 0 l + | Iol_size (size, _) -> size + | Iob _ -> 1 + | IBuf x -> IBuf.size x + + + let iol_size l = + let n = size (Iol l) in + Iol_size (n, l) + + + let iol_known_size n l = + Iol_size (n, l) + + + let to_string l = + let buf = Buffer.create (size l) in + to_buffer0 buf l; + Buffer.contents buf + + + let to_buffer l = + let buf = Buffer.create 80 in + to_buffer0 buf l; + buf + + + let to_channel ch code = + let buf = to_buffer code in + Buffer.output_buffer ch buf + end + + +open OBuf + + +let to_string = OBuf.to_string +let to_buffer = OBuf.to_buffer +let to_channel = OBuf.to_channel + + +let iob i = (* IO char represented as Ios '_' *) + iob (Char.chr i) + + +(* + * Generating varint values and fields + *) + +let gen_varint64_value x = + let rec aux x = + let b = Int64.to_int (Int64.logand x 0x7FL) in (* base 128 *) + let rem = Int64.shift_right_logical x 7 in + (* Printf.printf "x: %LX, byte: %X, rem: %LX\n" x b rem; *) + if rem = 0L + then [iob b] + else + begin + (* set msb indicating that more bytes will follow *) + let b = b lor 0x80 in + (iob b) :: (aux rem) + end + in iol (aux x) + + +let gen_unsigned_varint_value x = + let rec aux x = + let b = x land 0x7F in (* base 128 *) + let rem = x lsr 7 in + if rem = 0 + then [iob b] + else + begin + (* set msb indicating that more bytes will follow *) + let b = b lor 0x80 in + (iob b) :: (aux rem) + end + in iol (aux x) + + +let gen_signed_varint_value x = + (* negative varints are encoded as bit-complement 64-bit varints, always + * producing 10-bytes long value *) + if x < 0 + then gen_varint64_value (Int64.of_int x) + else gen_unsigned_varint_value x + + +let gen_unsigned_varint32_value x = + let rec aux x = + let b = Int32.to_int (Int32.logand x 0x7Fl) in (* base 128 *) + let rem = Int32.shift_right_logical x 7 in + if rem = 0l + then [iob b] + else + begin + (* set msb indicating that more bytes will follow *) + let b = b lor 0x80 in + (iob b) :: (aux rem) + end + in iol (aux x) + + +let gen_signed_varint32_value x = + (* negative varints are encoded as bit-complement 64-bit varints, always + * producing 10-bytes long value *) + if Int32.compare x 0l < 0 (* x < 0? *) + then gen_varint64_value (Int64.of_int32 x) + else gen_unsigned_varint32_value x + + +let gen_key ktype code = + (* make sure that the field code is in the valid range *) + assert (code < 1 lsl 29 && code >= 1); + if code land (1 lsl 28) <> 0 && Sys.word_size == 32 + then + (* prevent an overflow of 31-bit OCaml integer on 32-bit platform *) + let ktype = Int32.of_int ktype in + let code = Int32.of_int code in + let x = Int32.logor ktype (Int32.shift_left code 3) in + gen_unsigned_varint32_value x + else + gen_unsigned_varint_value (ktype lor (code lsl 3)) + + +(* gen key for primitive types *) +let gen_primitive_key ktype code = + (* -1 is a special code meaning that values of primitive types must be + * generated with a field header with code 1: (abs (-1)) == 1 + * + * This way, "-1" is treated the same as "1", leading to a uniform interface + * with generators for length-delimited types. + * + * For types which values are encoded as length-delimited blocks (i.e. + * records, variants, lists), -1 means suppress generation of a surrounding + * field header that includes the key and the length of data (see generators + * for these types below) *) + gen_key ktype (abs code) + + +let gen_signed_varint_field code x = + iol [ + gen_primitive_key 0 code; + gen_signed_varint_value x; + ] + +let gen_varint_field code x = + iol [ + gen_primitive_key 0 code; + gen_unsigned_varint_value x; + ] + +let gen_signed_varint32_field code x = + iol [ + gen_primitive_key 0 code; + gen_signed_varint32_value x; + ] + +let gen_varint32_field code x = + iol [ + gen_primitive_key 0 code; + gen_unsigned_varint32_value x; + ] + +let gen_varint64_field code x = + iol [ + gen_primitive_key 0 code; + gen_varint64_value x; + ] + + +(* + * Generating fixed32 and fixed64 values and fields + *) + +let gen_fixed32_value x = (* little-endian *) + let s = Bytes.create 4 in + let x = ref x in + for i = 0 to 3 + do + let b = Char.chr (Int32.to_int (Int32.logand !x 0xFFl)) in + Bytes.set s i b; + x := Int32.shift_right_logical !x 8 + done; + ios (Bytes.unsafe_to_string s) + + +let gen_fixed64_value x = (* little-endian *) + let s = Bytes.create 8 in + let x = ref x in + for i = 0 to 7 + do + let b = Char.chr (Int64.to_int (Int64.logand !x 0xFFL)) in + Bytes.set s i b; + x := Int64.shift_right_logical !x 8 + done; + ios (Bytes.unsafe_to_string s) + + +let gen_fixed32_field code x = + iol [ + gen_primitive_key 5 code; + gen_fixed32_value x; + ] + + +let gen_fixed64_field code x = + iol [ + gen_primitive_key 1 code; + gen_fixed64_value x; + ] + + +(* + * Zig-zag encoding for int, int32 and int64 + *) + + +let zigzag_of_int x = + (* encode signed integer using ZigZag encoding; + * NOTE: using arithmetic right shift *) + (x lsl 1) lxor (x asr 62) (* XXX: can use lesser value than 62 on 32 bit? *) + + +let zigzag_of_int32 x = + (* encode signed integer using ZigZag encoding; + * NOTE: using arithmetic right shift *) + Int32.logxor (Int32.shift_left x 1) (Int32.shift_right x 31) + + +let zigzag_of_int64 x = + (* encode signed integer using ZigZag encoding; + * NOTE: using arithmetic right shift *) + Int64.logxor (Int64.shift_left x 1) (Int64.shift_right x 63) + + +(* + * Public Piqi runtime functions for generating primitive types + *) + + +let int_to_varint code x = + gen_varint_field code x + +let int_to_signed_varint code x = + gen_signed_varint_field code x + +let int_to_zigzag_varint code x = + gen_varint_field code (zigzag_of_int x) + + +let int64_to_varint code x = + gen_varint64_field code x + +let int64_to_signed_varint = int64_to_varint + +let int64_to_zigzag_varint code x = + int64_to_varint code (zigzag_of_int64 x) + +let int64_to_fixed64 code x = + gen_fixed64_field code x + +let int64_to_fixed32 code x = + gen_fixed32_field code (Int64.to_int32 x) + +let int64_to_signed_fixed64 = int64_to_fixed64 + +let int64_to_signed_fixed32 = int64_to_fixed32 + + +let int32_to_varint code x = + gen_varint32_field code x + +let int32_to_signed_varint code x = + gen_signed_varint32_field code x + +let int32_to_zigzag_varint code x = + gen_varint32_field code (zigzag_of_int32 x) + +let int32_to_fixed32 code x = + gen_fixed32_field code x + +let int32_to_signed_fixed32 = int32_to_fixed32 + + +let int32_of_float x = + Int32.bits_of_float x (* XXX *) + +let int64_of_float x = + Int64.bits_of_float x (* XXX *) + + +let float_to_fixed32 code x = + gen_fixed32_field code (int32_of_float x) + +let float_to_fixed64 code x = + gen_fixed64_field code (int64_of_float x) + + +let int_of_bool = function + | true -> 1 + | false -> 0 + +let bool_to_varint code x = + gen_varint_field code (int_of_bool x) + +let gen_bool_field = bool_to_varint + + +let gen_string_field code s = + let contents = ios s in + iol [ + gen_primitive_key 2 code; + gen_unsigned_varint_value (String.length s); + contents; + ] + +let string_to_block = gen_string_field +let binary_to_block = gen_string_field (* binaries use the same encoding as strings *) +let word_to_block = gen_string_field (* word is encoded as string *) +let text_to_block = gen_string_field (* text is encoded as string *) + + +(* the inverse of parse_field *) +let gen_parsed_field (code, value) = + match value with + | Varint x -> + gen_varint_field code x + | Varint64 x -> + gen_varint64_field code x + | Int32 x -> + gen_fixed32_field code x + | Int64 x -> + gen_fixed64_field code x + | Block x -> + iol [ + gen_primitive_key 2 code; + gen_unsigned_varint_value (IBuf.size x); + IBuf x + ] + | Top_block x -> (* impossible clause *) + assert false + + +let gen_parsed_field_list l = + List.map gen_parsed_field l + + +(* + * Generating packed fields (packed encoding is used only for primitive + * numeric types) + *) + + +let int_to_packed_varint x = + gen_unsigned_varint_value x + +let int_to_packed_signed_varint x = + gen_signed_varint_value x + +let int_to_packed_zigzag_varint x = + gen_unsigned_varint_value (zigzag_of_int x) + + +let int64_to_packed_varint x = + gen_varint64_value x + +let int64_to_packed_signed_varint x = + gen_varint64_value x + +let int64_to_packed_zigzag_varint x = + gen_varint64_value (zigzag_of_int64 x) + +let int64_to_packed_fixed64 x = + gen_fixed64_value x + +let int64_to_packed_fixed32 x = + gen_fixed32_value (Int64.to_int32 x) + +let int64_to_packed_signed_fixed64 = int64_to_packed_fixed64 + +let int64_to_packed_signed_fixed32 = int64_to_packed_fixed32 + + +let int32_to_packed_varint x = + gen_unsigned_varint32_value x + +let int32_to_packed_signed_varint x = + gen_signed_varint32_value x + +let int32_to_packed_zigzag_varint x = + gen_unsigned_varint32_value (zigzag_of_int32 x) + +let int32_to_packed_fixed32 x = + gen_fixed32_value x + +let int32_to_packed_signed_fixed32 = int32_to_packed_fixed32 + + +let float_to_packed_fixed32 x = + gen_fixed32_value (int32_of_float x) + +let float_to_packed_fixed64 x = + gen_fixed64_value (int64_of_float x) + + +let bool_to_packed_varint x = + gen_unsigned_varint_value (int_of_bool x) + + +(* + * Generating complex user-defined types + *) + +let gen_required_field code f x = f code x + + +let gen_optional_field code f = function + | Some x -> f code x + | None -> iol [] + + +let gen_repeated_field code f l = + iol (List.map (f code) l) + + +(* similar to Array.map but produces list instead of array *) +let map_a2l f a = + let rec aux i accu = + if i < 0 + then accu + else + let res = f a.(i) in + aux (i-1) (res::accu) + in + aux ((Array.length a) - 1) [] + + +let gen_repeated_array_field code f l = + iol (map_a2l (f code) l) + + +let gen_packed_repeated_field_common code contents = + let size = OBuf.size contents in + if size = 0 + then contents (* don't generate anything for empty repeated packed field *) + else + iol [ + gen_key 2 code; + gen_unsigned_varint_value size; + contents; + ] + + +let gen_packed_repeated_field code f l = + let contents = iol_size (List.map f l) in + gen_packed_repeated_field_common code contents + + +let gen_packed_repeated_array_field code f l = + let contents = iol_size (map_a2l f l) in + gen_packed_repeated_field_common code contents + + +let gen_packed_repeated_array32_field code f l = + let size = 4 * Array.length l in + let contents = iol_known_size size (map_a2l f l) in + gen_packed_repeated_field_common code contents + + +let gen_packed_repeated_array64_field code f l = + let size = 8 * Array.length l in + let contents = iol_known_size size (map_a2l f l) in + gen_packed_repeated_field_common code contents + + +let gen_record code contents = + let contents = iol_size contents in + (* special code meaning that key and length sould not be generated *) + if code = -1 + then contents + else + iol [ + gen_key 2 code; + (* the length of fields data *) + gen_unsigned_varint_value (OBuf.size contents); + contents; + ] + + +(* generate binary representation of _list .proto structure *) +let gen_list f code l = + (* NOTE: using "1" as list element code *) + let contents = List.map (f 1) l in + gen_record code contents + + +let gen_array f code l = + (* NOTE: using "1" as list element code *) + let contents = map_a2l (f 1) l in + gen_record code contents + + +let gen_packed_list f code l = + (* NOTE: using "1" as list element code *) + let field = gen_packed_repeated_field 1 f l in + gen_record code [field] + + +let gen_packed_array f code l = + let field = gen_packed_repeated_array_field 1 f l in + gen_record code [field] + +let gen_packed_array32 f code l = + let field = gen_packed_repeated_array32_field 1 f l in + gen_record code [field] + +let gen_packed_array64 f code l = + let field = gen_packed_repeated_array64_field 1 f l in + gen_record code [field] + + +let gen_binobj gen_obj x = + let obuf = gen_obj (-1) x in + (* return the result encoded as a binary string *) + OBuf.to_string obuf + + +(* generate length-delimited block of data. The inverse operation to + * parse_block() below *) +let gen_block iodata = + iol [ + gen_unsigned_varint_value (OBuf.size iodata); + iodata; + ] + + +(* XXX, TODO: return Some or None on End_of_buffer *) +let parse_block buf = + Top_block (parse_block buf) + diff --git a/piqi-ocaml/piqirun/piqirun_ext.ml b/piqi-ocaml/piqirun/piqirun_ext.ml new file mode 100644 index 0000000..778c36c --- /dev/null +++ b/piqi-ocaml/piqirun/piqirun_ext.ml @@ -0,0 +1,93 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +(* Runtime support for JSON-XML-Protobuf-Piq serialization + * + * This module is used by OCaml modules generated by + * "piqic-ocaml --multi-format" Piqi compiler + *) + + +type input_format = [ `piq | `json | `xml | `pb | `pib ] + +type output_format = [ input_format | `json_pretty | `xml_pretty ] + +type piqi_type = Piqi_common.T.piqtype + +type options = Piqi_convert.options + + +let _ = + Piqi_convert.init () + + +let add_piqi (piqi_bin: string) = + let buf = Piqi_piqirun.init_from_string piqi_bin in + let piqi = Piqi.piqi_of_pb buf in + Piqi_db.add_piqi piqi; + () + + +let seen = ref [] + +let init_piqi piqi = + if not (List.memq piqi !seen) + then ( + seen:= piqi :: !seen; + add_piqi piqi + ) + + +let find_piqi_type (typename :string) :piqi_type = + Piqi_convert.find_type typename + + +(* preallocate default convert options *) +let default_options = Piqi_convert.make_options () + +let default_options_no_pp = + { + default_options with + Piqi_convert.pretty_print = false + } + + +let make_options = Piqi_convert.make_options + + +let convert + ?opts + (piqi_type :piqi_type) + (input_format :input_format) + (output_format :output_format) + (data :string) :string = + if output_format = (input_format :> output_format) + then data + else ( + let output_format, default_opts = + match output_format with + | `json_pretty -> `json, default_options + | `xml_pretty -> `xml, default_options + | (#input_format as x) -> x, default_options_no_pp + in + let opts = + match opts with + | None -> default_opts + | Some x -> x + in + Piqi_convert.convert piqi_type input_format output_format data ~opts + ) + diff --git a/piqi-ocaml/piqirun/piqirun_ext.mli b/piqi-ocaml/piqirun/piqirun_ext.mli new file mode 100644 index 0000000..4adb630 --- /dev/null +++ b/piqi-ocaml/piqirun/piqirun_ext.mli @@ -0,0 +1,85 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +(* Runtime support for JSON-XML-Protobuf-Piq serialization + * + * This module is used by OCaml modules generated by + * "piqic-ocaml --multi-format" Piqi compiler + *) + + +type input_format = [ `json | `pb | `piq | `pib | `xml ] + +type output_format = [ input_format | `json_pretty | `xml_pretty ] + +type piqi_type + +type options + + +val init_piqi : string -> unit + +val find_piqi_type : string -> piqi_type + + +(* Construct serialization options to be passed as an optional argument to + * gen_ and parse_ functions. Available options: + * + * pretty_print + * + * Pretty-print generated JSON and XML output (default = true) + * + * json_omit_missing_fields + * + * Omit missing optional and empty repeated fields from JSON + * output instead of representing them as {"field_name": null} and + * {"field_name", []} JSON fields (default = true) + * + * use_strict_parsing + * + * Treat unknown and duplicate fields as errors when parsing JSON, + * XML and Piq formats (default = false) + * + * piq_frameless_output + * + * Print a frame (i.e. : []) around a single output Piq object + * (default=false) + * + * piq_frameless_input + * + * Expect a frame around a single input Piq object (default=false) + * + * piq_relaxed_parsing + * + * Parse Piq format using "relaxed" mode (default=false); + * + * For instance, when set to `true`, single-word string literals don't have + * to be quoted + *) +val make_options: + ?pretty_print:bool -> + ?json_omit_missing_fields:bool -> + ?json_omit_null_fields:bool -> (* deprecated: use json_omit_missing_fields instead *) + ?use_strict_parsing:bool -> + ?piq_frameless_output:bool -> + ?piq_frameless_input:bool -> + ?piq_relaxed_parsing:bool -> + unit -> options + +val convert: + ?opts:options -> + piqi_type -> input_format -> output_format -> string -> string + diff --git a/piqi-ocaml/piqirun/test.ml b/piqi-ocaml/piqirun/test.ml new file mode 120000 index 0000000..9617a92 --- /dev/null +++ b/piqi-ocaml/piqirun/test.ml @@ -0,0 +1 @@ +../tests/piqirun/test.ml \ No newline at end of file diff --git a/piqi-ocaml/piqirun/test.ocaml b/piqi-ocaml/piqirun/test.ocaml new file mode 100644 index 0000000..ca97a9f --- /dev/null +++ b/piqi-ocaml/piqirun/test.ocaml @@ -0,0 +1,19 @@ +open Test +(* +#trace test_int;; +#trace test_int32;; +#trace test_int64;; +#trace Piqirun.int64_of_varint;; +#trace test_parse_varint;; +#trace Piqirun.next_varint_byte;; +*) +#trace Piqirun.int_to_zigzag_varint;; +#trace Piqirun.parse_varint;; +#trace Piqirun.int_of_varint;; +#trace test_zigzag_int;; +#trace test_zigzag_int32;; +#trace test_zigzag_int64;; +#trace test_parse_zigzag_varint;; +#trace Piqirun.int_of_zigzag_varint;; +#trace Piqirun.zigzag_varint_of_varint;; +test ();; diff --git a/piqi-ocaml/tests/Makefile b/piqi-ocaml/tests/Makefile new file mode 100644 index 0000000..7b31863 --- /dev/null +++ b/piqi-ocaml/tests/Makefile @@ -0,0 +1,18 @@ +include ../make/Makefile.dirs + + +DIRS = \ + piqirun \ + addressbook \ + piqi \ + perf \ + packed \ + array \ + misc \ + misc1 \ + custom-types \ + piq-config \ + +ifneq ($(shell which protoc), ) +DIRS += riak_pb +endif diff --git a/piqi-ocaml/tests/addressbook b/piqi-ocaml/tests/addressbook new file mode 120000 index 0000000..d7079ea --- /dev/null +++ b/piqi-ocaml/tests/addressbook @@ -0,0 +1 @@ +../examples/addressbook \ No newline at end of file diff --git a/piqi-ocaml/tests/array/Makefile b/piqi-ocaml/tests/array/Makefile new file mode 100644 index 0000000..a4e83c1 --- /dev/null +++ b/piqi-ocaml/tests/array/Makefile @@ -0,0 +1,13 @@ +PIQI ?= piqi + + +all: + $(MAKE) -f Makefile.ocaml + $(PIQI) convert -t pb test-all.piq + ./test + cmp test-all.piq.pb test-all.piq.pb.array + + +clean: + $(MAKE) -f Makefile.ocaml clean + rm -f test-all.piq.* test-all-lists.piq.* diff --git a/piqi-ocaml/tests/array/Makefile.ocaml b/piqi-ocaml/tests/array/Makefile.ocaml new file mode 100644 index 0000000..854bcde --- /dev/null +++ b/piqi-ocaml/tests/array/Makefile.ocaml @@ -0,0 +1,38 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = test + + +SOURCES = $(PIQI_ML_FILES) test.ml + + +PIQI_FILES = packed.piqi + +PIQI_ML_FILES = \ + packed_piqi.ml \ + + +PRE_TARGETS = $(PIQI_ML_FILES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +#PIQIC_FLAGS = + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb + + +all: nc #top + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/array/packed.piqi b/piqi-ocaml/tests/array/packed.piqi new file mode 100644 index 0000000..c2b2f1a --- /dev/null +++ b/piqi-ocaml/tests/array/packed.piqi @@ -0,0 +1,332 @@ +.record [ + .name r-int + .field [ + .type i + .repeated + .ocaml-array + ] +] + +.enum [ + .name e + .option [ + .name a + .code -1 + + ] + .option [ + .name b + .code 2 + ] + .option [ + .name c + .code 0 + ] + .option [ + .name d + .code 100_000_000 + ] +] + +.record [ + .name r-enum + .field [ + .type e + .repeated + .ocaml-array + ] +] + +.record [ + .name r-bool + .field [ + .type b + .repeated + .ocaml-array + ] +] + +.record [ + .name r-all + .field [ + .name bool + .type bool + .repeated + .ocaml-array + ] + .field [ + .name u32 + .type uint32 + .repeated + .ocaml-array + ] + .field [ + .name u64 + .type uint64 + .repeated + .ocaml-array + ] + .field [ + .name s32 + .type int32 + .repeated + .ocaml-array + ] + .field [ + .name s64 + .type int64 + .repeated + .ocaml-array + ] + .field [ + .name i32 + .type protobuf-int32 + .repeated + .ocaml-array + ] + .field [ + .name i64 + .type protobuf-int64 + .repeated + .ocaml-array + ] + .field [ + .name uf32 + .type uint32-fixed + .repeated + .ocaml-array + ] + .field [ + .name uf64 + .type uint64-fixed + .repeated + .ocaml-array + ] + .field [ + .name if32 + .type int32-fixed + .repeated + .ocaml-array + ] + .field [ + .name if64 + .type int64-fixed + .repeated + .ocaml-array + ] + .field [ + .name f32 + .type float32 + .repeated + .ocaml-array + ] + .field [ + .name f64 + .type float64 + .repeated + .ocaml-array + ] + + + .field [ + .name e + .type e + .repeated + .ocaml-array + ] + .field [ + .name b + .type b + .repeated + .ocaml-array + ] + .field [ + .name i + .type i + .repeated + .ocaml-array + ] + + .field [ + .name lists + .type r-all-lists + ] +] + +.alias [ + .name i + .type int +] + +.alias [ + .name b + .type bool +] + +.list [ + .name bool-list + .type bool + .ocaml-array +] + +.list [ + .name int-list + .type int + .ocaml-array +] + +.list [ + .name e-list + .type e + .ocaml-array +] + +.list [ + .name i-list + .type i + .ocaml-array +] + +.list [ + .name b-list + .type b + .ocaml-array +] + + +.list [ + .name u32-list + .type uint32 + .ocaml-array +] +.list [ + .name u64-list + .type uint64 + .ocaml-array +] +.list [ + .name s32-list + .type int32 + .ocaml-array +] +.list [ + .name s64-list + .type int64 + .ocaml-array +] +.list [ + .name i32-list + .type protobuf-int32 + .ocaml-array +] +.list [ + .name i64-list + .type protobuf-int64 + .ocaml-array +] + +.list [ + .name uf32-list + .type uint32-fixed + .ocaml-array +] +.list [ + .name uf64-list + .type uint64-fixed + .ocaml-array +] +.list [ + .name if32-list + .type int32-fixed + .ocaml-array +] +.list [ + .name if64-list + .type int64-fixed + .ocaml-array +] +.list [ + .name f32-list + .type float32 + .ocaml-array +] +.list [ + .name f64-list + .type float64 + .ocaml-array +] + + +.record [ + .name r-all-lists + .field [ + .name bool + .type bool-list + ] + .field [ + .name u32 + .type u32-list + ] + .field [ + .name u64 + .type u64-list + ] + .field [ + .name s32 + .type s32-list + ] + .field [ + .name s64 + .type s64-list + ] + .field [ + .name i32 + .type i32-list + ] + .field [ + .name i64 + .type i64-list + ] + .field [ + .name uf32 + .type uf32-list + ] + .field [ + .name uf64 + .type uf64-list + ] + .field [ + .name if32 + .type if32-list + ] + .field [ + .name if64 + .type if64-list + ] + .field [ + .name f32 + .type f32-list + ] + .field [ + .name f64 + .type f64-list + ] + + + .field [ + .name e + .type e-list + ] + .field [ + .name b + .type b-list + ] + .field [ + .name i + .type i-list + ] +] + + +.custom-field ocaml-array + diff --git a/piqi-ocaml/tests/array/test-all.piq b/piqi-ocaml/tests/array/test-all.piq new file mode 120000 index 0000000..f74b7d0 --- /dev/null +++ b/piqi-ocaml/tests/array/test-all.piq @@ -0,0 +1 @@ +../packed/test-all.piq \ No newline at end of file diff --git a/piqi-ocaml/tests/array/test.ml b/piqi-ocaml/tests/array/test.ml new file mode 100644 index 0000000..e7fba11 --- /dev/null +++ b/piqi-ocaml/tests/array/test.ml @@ -0,0 +1,17 @@ + +let t () = + print_endline "testing Piqi repeated fields and Piqi lists represented as OCaml arrays"; + let ich = open_in_bin "test-all.piq.pb" in + let buf = Piqirun.init_from_channel ich in + let piqi = Packed_piqi.parse_r_all buf in + + let och = open_out_bin "test-all.piq.pb.array" in + let data = Packed_piqi.gen_r_all piqi in + Piqirun.to_channel och data; + + close_in ich; + close_out och; + () + + +let _ = t () diff --git a/piqi-ocaml/tests/custom-types b/piqi-ocaml/tests/custom-types new file mode 120000 index 0000000..cdd9625 --- /dev/null +++ b/piqi-ocaml/tests/custom-types @@ -0,0 +1 @@ +../examples/custom-types \ No newline at end of file diff --git a/piqi-ocaml/tests/misc/Ad.piqi b/piqi-ocaml/tests/misc/Ad.piqi new file mode 100644 index 0000000..11e0b24 --- /dev/null +++ b/piqi-ocaml/tests/misc/Ad.piqi @@ -0,0 +1,8 @@ +.ocaml-module "Ad" +.custom-field ocaml-module + +.alias [ + .name id + .type int64 +] + diff --git a/piqi-ocaml/tests/misc/Makefile b/piqi-ocaml/tests/misc/Makefile new file mode 100644 index 0000000..c139cd8 --- /dev/null +++ b/piqi-ocaml/tests/misc/Makefile @@ -0,0 +1,48 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = test + + +SOURCES = $(PIQI_ML_FILES) + + +PIQI_FILES = \ + empty-record.piqi \ + \ + Ad.piqi P.piqi Protocol.piqi \ + \ + variant-1.piqi variant-2.piqi + + +PIQI_ML_FILES = \ + empty_record_piqi.ml \ + \ + ad.ml p.ml protocol.ml \ + \ + variant_1_piqi.ml variant_2_piqi.ml + + +PRE_TARGETS = $(PIQI_ML_FILES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +#PIQIC_FLAGS = + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb + + +all: nc #top + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/misc/P.piqi b/piqi-ocaml/tests/misc/P.piqi new file mode 100644 index 0000000..7c26137 --- /dev/null +++ b/piqi-ocaml/tests/misc/P.piqi @@ -0,0 +1,24 @@ +.ocaml-module "P" +(.custom-field ocaml-module ocaml-name) + +.import [ + .module Ad + .ocaml-name "Common_ad" +] + +.variant [ + .name reply + .option [ + .name page + .type Ad/id + ] +] + +.variant [ + .name voidvarianttosolvepiqibug + .option [ + .name bad + .type int + ] +] + diff --git a/piqi-ocaml/tests/misc/Protocol.piqi b/piqi-ocaml/tests/misc/Protocol.piqi new file mode 100644 index 0000000..4d851d7 --- /dev/null +++ b/piqi-ocaml/tests/misc/Protocol.piqi @@ -0,0 +1,14 @@ +.ocaml-module "Protocol" +.custom-field ocaml-module + +.import [ .module Ad ] + +.variant [ + .name op + .option [ .name ping ] + .option [ + .name get-balance + .type Ad/id + ] +] + diff --git a/piqi-ocaml/tests/misc/empty-record.piqi b/piqi-ocaml/tests/misc/empty-record.piqi new file mode 100644 index 0000000..a0845bb --- /dev/null +++ b/piqi-ocaml/tests/misc/empty-record.piqi @@ -0,0 +1,3 @@ +.record [ + .name r +] diff --git a/piqi-ocaml/tests/misc/variant-1.piqi b/piqi-ocaml/tests/misc/variant-1.piqi new file mode 100644 index 0000000..6d1e4bd --- /dev/null +++ b/piqi-ocaml/tests/misc/variant-1.piqi @@ -0,0 +1,4 @@ +.enum [ + .name e + .option [ a ] +] diff --git a/piqi-ocaml/tests/misc/variant-2.piqi b/piqi-ocaml/tests/misc/variant-2.piqi new file mode 100644 index 0000000..74c631b --- /dev/null +++ b/piqi-ocaml/tests/misc/variant-2.piqi @@ -0,0 +1,53 @@ + +.import [ variant-1 ] + + +.variant [ + .name v + + % testing automatic implicit reordering of variants when generating OCaml + % types (type "e" is defined below, but in OCaml types it must appear above) + .option [ + .type v1 + ] + + % testing correct OCaml representation of imported sub-variant + .option [ + .type variant-1/e + ] +] + + +.variant [ + .name v1 + .option [ + .type ee + ] +] + + +.enum [ + .name ee + .option [ b ] +] + + +% NOTE: without specifying ".ocaml_name l", these two mutually cyclic +% definitions should trigger a piqic error (because OCaml won't compile code +% containing cycles like that, even if types are finite) +.variant [ + .name loop1 + .option [ + .ocaml-name "l" + .type loop2 + ] +] + +.variant [ + .name loop2 + .option [ .type loop1 ] + .option [ .name foo ] +] + + +.custom-field ocaml-name diff --git a/piqi-ocaml/tests/misc1/Makefile b/piqi-ocaml/tests/misc1/Makefile new file mode 100644 index 0000000..a9e6e23 --- /dev/null +++ b/piqi-ocaml/tests/misc1/Makefile @@ -0,0 +1,38 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = t +SOURCES = id_piqi.ml id_piqi_ext.ml example_piqi.ml example_piqi_ext.ml test.ml + + +PRE_TARGETS = id_piqi.ml id_piqi_ext.ml example_piqi.ml example_piqi_ext.ml + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.ext + + +PIQI ?= piqi +PIQIC = ../../piqic-ocaml/piqic-ocaml +PIQIC_FLAGS = --ext + + +all: native-code test #byte-code + + +test: + ./$(RESULT) + + +%_piqi.ml: %.proto $(realpath $(PIQI)) $(PIQIC) +ifneq ($(shell which protoc), ) + $(PIQI) of-proto $< +endif + $(PIQIC) $(PIQIC_FLAGS) $<.piqi + + +clean:: + rm -f *.tmp.ml + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/misc1/example.proto b/piqi-ocaml/tests/misc1/example.proto new file mode 100644 index 0000000..2c86d46 --- /dev/null +++ b/piqi-ocaml/tests/misc1/example.proto @@ -0,0 +1,7 @@ +package test; +import "id.proto"; + +message example +{ + required Id id = 1; +} diff --git a/piqi-ocaml/tests/misc1/example.proto.piqi b/piqi-ocaml/tests/misc1/example.proto.piqi new file mode 100644 index 0000000..670ff25 --- /dev/null +++ b/piqi-ocaml/tests/misc1/example.proto.piqi @@ -0,0 +1,12 @@ +.protobuf-package "test" + +.import [ .module id ] + +.record [ + .name example + .field [ + .name id + .type id/Id + .code 1 + ] +] diff --git a/piqi-ocaml/tests/misc1/id.proto b/piqi-ocaml/tests/misc1/id.proto new file mode 100644 index 0000000..2b89e47 --- /dev/null +++ b/piqi-ocaml/tests/misc1/id.proto @@ -0,0 +1,5 @@ +package test; +message Id +{ + required int64 id = 1; // Unique ID +} diff --git a/piqi-ocaml/tests/misc1/id.proto.piqi b/piqi-ocaml/tests/misc1/id.proto.piqi new file mode 100644 index 0000000..27e1110 --- /dev/null +++ b/piqi-ocaml/tests/misc1/id.proto.piqi @@ -0,0 +1,10 @@ +.protobuf-package "test" + +.record [ + .name Id + .field [ + .name id + .type protobuf-int64 + .code 1 + ] +] diff --git a/piqi-ocaml/tests/misc1/test.ml b/piqi-ocaml/tests/misc1/test.ml new file mode 100644 index 0000000..d5d2d87 --- /dev/null +++ b/piqi-ocaml/tests/misc1/test.ml @@ -0,0 +1,2 @@ +let x = Example_piqi.default_example () in +Example_piqi_ext.prerr_example x diff --git a/piqi-ocaml/tests/packed/Makefile b/piqi-ocaml/tests/packed/Makefile new file mode 100644 index 0000000..5f80079 --- /dev/null +++ b/piqi-ocaml/tests/packed/Makefile @@ -0,0 +1,24 @@ +PIQI ?= piqi + + +all: + cat packed.piqi | sed -e 's/\.protobuf-packed//' > unpacked.piqi + cat test-all.piq | sed -e 's/:packed/:unpacked/' > test-all-unpacked.piq + + $(MAKE) -f Makefile.ocaml + + $(PIQI) convert -t pb test-all.piq + ./test + cmp test-all.piq.pb test-all.piq.pb.packed + cmp test-all.piq.pb test-all.piq.pb.packed-array + + cp test-all.piq.pb test-all.piq.pb.orig + $(PIQI) convert -t pb -o test-all.piq.pb test-all-unpacked.piq + ./test + cmp test-all.piq.pb.orig test-all.piq.pb.packed + cmp test-all.piq.pb.orig test-all.piq.pb.packed-array + + +clean: + $(MAKE) -f Makefile.ocaml clean + rm -f test-all.piq.* unpacked.piqi test-all-unpacked.piq diff --git a/piqi-ocaml/tests/packed/Makefile.ocaml b/piqi-ocaml/tests/packed/Makefile.ocaml new file mode 100644 index 0000000..6673abe --- /dev/null +++ b/piqi-ocaml/tests/packed/Makefile.ocaml @@ -0,0 +1,40 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = test + + +SOURCES = $(PIQI_ML_FILES) test_packed.ml test_packed_array.ml + + +PIQI_FILES = packed-nocompat.piqi packed.piqi packed-array.piqi + +PIQI_ML_FILES = \ + packed_nocompat_piqi.ml \ + packed_piqi.ml \ + packed_array_piqi.ml \ + + +PRE_TARGETS = $(PIQI_ML_FILES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +#PIQIC_FLAGS = + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb + + +all: nc #top + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/packed/packed-array.piqi b/piqi-ocaml/tests/packed/packed-array.piqi new file mode 100644 index 0000000..414e50a --- /dev/null +++ b/piqi-ocaml/tests/packed/packed-array.piqi @@ -0,0 +1,375 @@ +.record [ + .name r-int + .field [ + .type i + .repeated + .protobuf-packed + .ocaml-array + ] +] + +.enum [ + .name e + .option [ + .name a + .code -1 + + ] + .option [ + .name b + .code 2 + ] + .option [ + .name c + .code 0 + ] + .option [ + .name d + .code 100_000_000 + ] +] + +.record [ + .name r-enum + .field [ + .type e + .repeated + .protobuf-packed + .ocaml-array + ] +] + +.record [ + .name r-bool + .field [ + .type b + .repeated + .protobuf-packed + .ocaml-array + ] +] + +.record [ + .name r-all + .field [ + .name bool + .type bool + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name u32 + .type uint32 + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name u64 + .type uint64 + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name s32 + .type int32 + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name s64 + .type int64 + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name i32 + .type protobuf-int32 + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name i64 + .type protobuf-int64 + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name uf32 + .type uint32-fixed + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name uf64 + .type uint64-fixed + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name if32 + .type int32-fixed + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name if64 + .type int64-fixed + .repeated + .protobuf-packed + .ocaml-array + ] + + .field [ + .name f + .type float + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name f32 + .type float32 + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name f64 + .type float64 + .repeated + .protobuf-packed + .ocaml-array + ] + + + .field [ + .name e + .type e + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name b + .type b + .repeated + .protobuf-packed + .ocaml-array + ] + .field [ + .name i + .type i + .repeated + .protobuf-packed + .ocaml-array + ] + + .field [ + .name lists + .type r-all-lists + ] +] + +.alias [ + .name i + .type int +] + +.alias [ + .name b + .type bool +] + +.list [ + .name bool-list + .type bool + .protobuf-packed + .ocaml-array +] + +.list [ + .name int-list + .type int + .protobuf-packed + .ocaml-array +] + +.list [ + .name e-list + .type e + .protobuf-packed + .ocaml-array +] + +.list [ + .name i-list + .type i + .protobuf-packed + .ocaml-array +] + +.list [ + .name b-list + .type b + .protobuf-packed + .ocaml-array +] + + +.list [ + .name u32-list + .type uint32 + .protobuf-packed + .ocaml-array +] +.list [ + .name u64-list + .type uint64 + .protobuf-packed + .ocaml-array +] +.list [ + .name s32-list + .type int32 + .protobuf-packed + .ocaml-array +] +.list [ + .name s64-list + .type int64 + .protobuf-packed + .ocaml-array +] +.list [ + .name i32-list + .type protobuf-int32 + .protobuf-packed + .ocaml-array +] +.list [ + .name i64-list + .type protobuf-int64 + .protobuf-packed + .ocaml-array +] + +.list [ + .name uf32-list + .type uint32-fixed + .protobuf-packed + .ocaml-array +] +.list [ + .name uf64-list + .type uint64-fixed + .protobuf-packed + .ocaml-array +] +.list [ + .name if32-list + .type int32-fixed + .protobuf-packed + .ocaml-array +] +.list [ + .name if64-list + .type int64-fixed + .protobuf-packed + .ocaml-array +] +.list [ + .name f32-list + .type float32 + .protobuf-packed + .ocaml-array +] +.list [ + .name f64-list + .type float64 + .protobuf-packed + .ocaml-array +] + + +.record [ + .name r-all-lists + .field [ + .name bool + .type bool-list + ] + .field [ + .name u32 + .type u32-list + ] + .field [ + .name u64 + .type u64-list + ] + .field [ + .name s32 + .type s32-list + ] + .field [ + .name s64 + .type s64-list + ] + .field [ + .name i32 + .type i32-list + ] + .field [ + .name i64 + .type i64-list + ] + .field [ + .name uf32 + .type uf32-list + ] + .field [ + .name uf64 + .type uf64-list + ] + .field [ + .name if32 + .type if32-list + ] + .field [ + .name if64 + .type if64-list + ] + .field [ + .name f32 + .type f32-list + ] + .field [ + .name f64 + .type f64-list + ] + + + .field [ + .name e + .type e-list + ] + .field [ + .name b + .type b-list + ] + .field [ + .name i + .type i-list + ] +] + + +.custom-field ocaml-array diff --git a/piqi-ocaml/tests/packed/packed-nocompat.piqi b/piqi-ocaml/tests/packed/packed-nocompat.piqi new file mode 100644 index 0000000..3e2a23d --- /dev/null +++ b/piqi-ocaml/tests/packed/packed-nocompat.piqi @@ -0,0 +1,31 @@ +% This module contains "ee" alias which is not compatible with Protocol Buffers. +% +% When mapped to Protobuf, another "ee" enum definition is generated with the +% same enum elements, which is not allowed in Protobuf. + +.include [ .module packed ] + +.alias [ + .name ee + .type e +] + + +.extend [ + .typedef r-all + + .with.field [ + .name ee + .type ee + .repeated + .protobuf-packed + ] +] + + +.list [ + .name ee-list + .type ee + .protobuf-packed +] + diff --git a/piqi-ocaml/tests/packed/packed.piqi b/piqi-ocaml/tests/packed/packed.piqi new file mode 100644 index 0000000..a7d1d76 --- /dev/null +++ b/piqi-ocaml/tests/packed/packed.piqi @@ -0,0 +1,335 @@ +.record [ + .name r-int + .field [ + .type i + .repeated + .protobuf-packed + ] +] + +.enum [ + .name e + .option [ + .name a + .code -1 + + ] + .option [ + .name b + .code 2 + ] + .option [ + .name c + .code 0 + ] + .option [ + .name d + .code 100_000_000 + ] +] + +.record [ + .name r-enum + .field [ + .type e + .repeated + .protobuf-packed + ] +] + +.record [ + .name r-bool + .field [ + .type b + .repeated + .protobuf-packed + ] +] + +.record [ + .name r-all + .field [ + .name bool + .type bool + .repeated + .protobuf-packed + ] + .field [ + .name u32 + .type uint32 + .repeated + .protobuf-packed + ] + .field [ + .name u64 + .type uint64 + .repeated + .protobuf-packed + ] + .field [ + .name s32 + .type int32 + .repeated + .protobuf-packed + ] + .field [ + .name s64 + .type int64 + .repeated + .protobuf-packed + ] + .field [ + .name i32 + .type protobuf-int32 + .repeated + .protobuf-packed + ] + .field [ + .name i64 + .type protobuf-int64 + .repeated + .protobuf-packed + ] + .field [ + .name uf32 + .type uint32-fixed + .repeated + .protobuf-packed + ] + .field [ + .name uf64 + .type uint64-fixed + .repeated + .protobuf-packed + ] + .field [ + .name if32 + .type int32-fixed + .repeated + .protobuf-packed + ] + .field [ + .name if64 + .type int64-fixed + .repeated + .protobuf-packed + ] + + .field [ + .name f + .type float + .repeated + .protobuf-packed + ] + .field [ + .name f32 + .type float32 + .repeated + .protobuf-packed + ] + .field [ + .name f64 + .type float64 + .repeated + .protobuf-packed + ] + + + .field [ + .name e + .type e + .repeated + .protobuf-packed + ] + .field [ + .name b + .type b + .repeated + .protobuf-packed + ] + .field [ + .name i + .type i + .repeated + .protobuf-packed + ] + + .field [ + .name lists + .type r-all-lists + ] +] + +.alias [ + .name i + .type int +] + +.alias [ + .name b + .type bool +] + +.list [ + .name bool-list + .type bool + .protobuf-packed +] + +.list [ + .name int-list + .type int + .protobuf-packed +] + +.list [ + .name e-list + .type e + .protobuf-packed +] + +.list [ + .name i-list + .type i + .protobuf-packed +] + +.list [ + .name b-list + .type b + .protobuf-packed +] + + +.list [ + .name u32-list + .type uint32 + .protobuf-packed +] +.list [ + .name u64-list + .type uint64 + .protobuf-packed +] +.list [ + .name s32-list + .type int32 + .protobuf-packed +] +.list [ + .name s64-list + .type int64 + .protobuf-packed +] +.list [ + .name i32-list + .type protobuf-int32 + .protobuf-packed +] +.list [ + .name i64-list + .type protobuf-int64 + .protobuf-packed +] + +.list [ + .name uf32-list + .type uint32-fixed + .protobuf-packed +] +.list [ + .name uf64-list + .type uint64-fixed + .protobuf-packed +] +.list [ + .name if32-list + .type int32-fixed + .protobuf-packed +] +.list [ + .name if64-list + .type int64-fixed + .protobuf-packed +] +.list [ + .name f32-list + .type float32 + .protobuf-packed +] +.list [ + .name f64-list + .type float64 + .protobuf-packed +] + + +.record [ + .name r-all-lists + .field [ + .name bool + .type bool-list + ] + .field [ + .name u32 + .type u32-list + ] + .field [ + .name u64 + .type u64-list + ] + .field [ + .name s32 + .type s32-list + ] + .field [ + .name s64 + .type s64-list + ] + .field [ + .name i32 + .type i32-list + ] + .field [ + .name i64 + .type i64-list + ] + .field [ + .name uf32 + .type uf32-list + ] + .field [ + .name uf64 + .type uf64-list + ] + .field [ + .name if32 + .type if32-list + ] + .field [ + .name if64 + .type if64-list + ] + .field [ + .name f32 + .type f32-list + ] + .field [ + .name f64 + .type f64-list + ] + + + .field [ + .name e + .type e-list + ] + .field [ + .name b + .type b-list + ] + .field [ + .name i + .type i-list + ] +] diff --git a/piqi-ocaml/tests/packed/test-all.piq b/piqi-ocaml/tests/packed/test-all.piq new file mode 100644 index 0000000..3aa464f --- /dev/null +++ b/piqi-ocaml/tests/packed/test-all.piq @@ -0,0 +1,100 @@ +:packed/r-all [ + + (.bool true false true true false false true) + + + (.u32 0 1 100 0xffff_ffff) + + (.u64 0 1 100 0xffff_ffff 0xffff_ffff_ffff_ffff 18446744073709551615) + + + (.s32 -1 0 1 100 0x7fff_ffff -0x8000_0000) + + (.s64 -1 0 1 100 0x7fff_ffff -0x8000_0000 + 0x7fff_ffff_ffff_ffff -0x8000_0000_0000_0000 + ) + + + (.i32 -1 0 1 100 0x7fff_ffff -0x8000_0000) + + (.i64 -1 0 1 100 0x7fff_ffff -0x8000_0000 + 0x7fff_ffff_ffff_ffff -0x8000_0000_0000_0000 + ) + + + (.uf32 0 1 100 0xffff_ffff) + + (.uf64 0 1 100 0xffff_ffff 0xffff_ffff_ffff_ffff 18446744073709551615) + + + (.if32 -1 0 1 100 0x7fff_ffff -0x8000_0000) + + (.if64 -1 0 1 100 0x7fff_ffff -0x8000_0000 + 0x7fff_ffff_ffff_ffff -0x8000_0000_0000_0000 + ) + + + % TODO: uncomment infinities and NaN when Piqi/Erlang support is added + (.f32 -1.999999999 0.0 1.001 4.44444 123456.123456 -123456.123456) % -0.inf 0.inf 0.nan) + + (.f64 -1.999999999 0.0 1.001 4.44444 123456.123456 -123456.123456) % -0.inf 0.inf 0.nan) + + + (.e .a .b .c .d .d .c .b .a .d .d .c .c .b .b .a .a) + + (.b true false true true false false true) + + (.i -100_000_000 -1 0 2 100_000_000 1 2 3 4 5 -1000 + -1 0 1 100 0x3fff_ffff -0x4000_0000 + ) + + .lists [ + .bool [true false true true false false true] + + + .u32 [0 1 100 0xffff_ffff] + + .u64 [0 1 100 0xffff_ffff 0xffff_ffff_ffff_ffff] + + + .s32 [-1 0 1 100 0x7fff_ffff -0x8000_0000] + + .s64 [-1 0 1 100 0x7fff_ffff -0x8000_0000 + 0x7fff_ffff_ffff_ffff -0x8000_0000_0000_0000 + ] + + + .i32 [-1 0 1 100 0x7fff_ffff -0x8000_0000] + + .i64 [-1 0 1 100 0x7fff_ffff -0x8000_0000 + 0x7fff_ffff_ffff_ffff -0x8000_0000_0000_0000 + ] + + + .uf32 [0 1 100 0xffff_ffff] + + .uf64 [0 1 100 0xffff_ffff 0xffff_ffff_ffff_ffff] + + + .if32 [-1 0 1 100 0x7fff_ffff -0x8000_0000] + + .if64 [-1 0 1 100 0x7fff_ffff -0x8000_0000 + 0x7fff_ffff_ffff_ffff -0x8000_0000_0000_0000 + ] + + + % TODO: uncomment infinities and NaN when Piqi/Erlang support is added + .f32 [-1.999999999 0.0 1.001 4.44444 123456.123456 -123456.123456] % -0.inf 0.inf 0.nan] + + .f64 [-1.999999999 0.0 1.001 4.44444 123456.123456 -123456.123456] % -0.inf 0.inf 0.nan] + + + .e [.a .b .c .d .d .c .b .a .d .d .c .c .b .b .a .a] + + .b [true false true true false false true] + + .i [-100_000_000 -1 0 2 100_000_000 1 2 3 4 5 -1000 + -1 0 1 100 0x3fff_ffff -0x4000_0000 + ] + ] +] diff --git a/piqi-ocaml/tests/packed/test_packed.ml b/piqi-ocaml/tests/packed/test_packed.ml new file mode 100644 index 0000000..7fadd27 --- /dev/null +++ b/piqi-ocaml/tests/packed/test_packed.ml @@ -0,0 +1,17 @@ + +let t () = + print_endline "testing packed repeated fields"; + let ich = open_in_bin "test-all.piq.pb" in + let buf = Piqirun.init_from_channel ich in + let piqi = Packed_piqi.parse_r_all buf in + + let och = open_out_bin "test-all.piq.pb.packed" in + let data = Packed_piqi.gen_r_all piqi in + Piqirun.to_channel och data; + + close_in ich; + close_out och; + () + + +let _ = t () diff --git a/piqi-ocaml/tests/packed/test_packed_array.ml b/piqi-ocaml/tests/packed/test_packed_array.ml new file mode 100644 index 0000000..f70c192 --- /dev/null +++ b/piqi-ocaml/tests/packed/test_packed_array.ml @@ -0,0 +1,17 @@ + +let t () = + print_endline "testing packed repeated fields represented as OCaml arrays"; + let ich = open_in_bin "test-all.piq.pb" in + let buf = Piqirun.init_from_channel ich in + let piqi = Packed_array_piqi.parse_r_all buf in + + let och = open_out_bin "test-all.piq.pb.packed-array" in + let data = Packed_array_piqi.gen_r_all piqi in + Piqirun.to_channel och data; + + close_in ich; + close_out och; + () + + +let _ = t () diff --git a/piqi-ocaml/tests/perf/Makefile b/piqi-ocaml/tests/perf/Makefile new file mode 100644 index 0000000..16c5fcd --- /dev/null +++ b/piqi-ocaml/tests/perf/Makefile @@ -0,0 +1,34 @@ +.PHONY: all ocaml test clean + + +PIQI ?= piqi + + +all: ocaml test + + +ocaml: piqi-obj.piqi + $(MAKE) -f Makefile.ocaml + + +piqi-obj.piqi: + $(PIQI) cc | sed -e 's/\.module .*//;s/\.code .*//' > piqi.piqi + ln -sf ../../piqic-ocaml/piqi.ocaml.piqi + $(PIQI) expand -e ocaml piqi.piqi > $@ + + +test: ocaml + $(PIQI) convert -t pb addressbook.piq + + echo ":piqi-obj/piqi [" > piqi.piq + cat piqi-obj.piqi >> piqi.piq + echo "]" >> piqi.piq + + $(PIQI) convert --no-warnings --add-defaults -t pb piqi.piq + #./test + + +clean: + $(MAKE) -f Makefile.ocaml clean + rm -f addressbook.piq.pb piqi-expanded.piqi piqi-obj.* piqi.ocaml.piqi piqi.piq piqi.piq.pb piqi.piqi + diff --git a/piqi-ocaml/tests/perf/Makefile.ocaml b/piqi-ocaml/tests/perf/Makefile.ocaml new file mode 100644 index 0000000..f5b3a3b --- /dev/null +++ b/piqi-ocaml/tests/perf/Makefile.ocaml @@ -0,0 +1,45 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = test + + +SOURCES = \ + $(PIQI_ML_FILES) \ + test.ml + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = unix piqirun.ext + + +PIQI_FILES = addressbook.proto.piqi piqi.piqi piqi-obj.piqi + +PIQI_ML_FILES = \ + addressbook_piqi.ml addressbook_piqi_ext.ml \ + piqi_piqi.ml piqi_piqi_ext.ml \ + piqi_obj_piqi.ml piqi_obj_piqi_ext.ml + + +PRE_TARGETS = $(PIQI_ML_FILES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +PIQIC_FLAGS = --multi-format --no-warnings + + +all: native-code #byte-code debug-code + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + +clean:: + rm -f *.tmp.ml + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/perf/README b/piqi-ocaml/tests/perf/README new file mode 100644 index 0000000..feb036d --- /dev/null +++ b/piqi-ocaml/tests/perf/README @@ -0,0 +1,14 @@ +Performance tests for serialization and de-serialization of OCaml data +structures to/from Protocol Buffers, JSON, XML and Piq data formats. + +The tests are performed on two different objects. The first one is a relatively +small and not very complicated "addressbook.piq". The second one is the expanded +Piqi self-specification which is 10 times as large as the first one and has more +complex structure. + +To run the tests: + + make + + ./test + diff --git a/piqi-ocaml/tests/perf/addressbook.ocaml.piqi b/piqi-ocaml/tests/perf/addressbook.ocaml.piqi new file mode 120000 index 0000000..2738136 --- /dev/null +++ b/piqi-ocaml/tests/perf/addressbook.ocaml.piqi @@ -0,0 +1 @@ +../addressbook/addressbook.ocaml.piqi \ No newline at end of file diff --git a/piqi-ocaml/tests/perf/addressbook.piq b/piqi-ocaml/tests/perf/addressbook.piq new file mode 120000 index 0000000..aae88a3 --- /dev/null +++ b/piqi-ocaml/tests/perf/addressbook.piq @@ -0,0 +1 @@ +../addressbook/addressbook.piq \ No newline at end of file diff --git a/piqi-ocaml/tests/perf/addressbook.proto.piqi b/piqi-ocaml/tests/perf/addressbook.proto.piqi new file mode 120000 index 0000000..a3122e4 --- /dev/null +++ b/piqi-ocaml/tests/perf/addressbook.proto.piqi @@ -0,0 +1 @@ +../addressbook/addressbook.proto.piqi \ No newline at end of file diff --git a/piqi-ocaml/tests/perf/test.ml b/piqi-ocaml/tests/perf/test.ml new file mode 100644 index 0000000..fec1bbb --- /dev/null +++ b/piqi-ocaml/tests/perf/test.ml @@ -0,0 +1,170 @@ + +let read_file filename = + let ch = open_in_bin filename in + let size = in_channel_length ch in + let res = Bytes.create size in + really_input ch res 0 size; + close_in ch; + Bytes.unsafe_to_string res + + +let string_of_format = function + | `pb -> "pb" + | `json -> "json" + | `json_pretty -> "json_pretty" + | `xml -> "xml" + | `xml_pretty -> "xml_pretty" + | `piq -> "piq" + | `pib -> "pib" + + +let printf = Printf.printf + + +let test f n = + printf "count: %d\n%!" n; + + let t1 = Unix.gettimeofday () in + + for i = 1 to n + do + f (); + (* + Gc.minor (); + *) + Gc.minor (); + done; + + let t2 = Unix.gettimeofday () in + let seconds = t2 -. t1 in + + let per_second = (float_of_int n) /. seconds in + let per_second = truncate per_second in + + printf "time: %f seconds\n%!" seconds; + printf "rate: %d calls per second\n\n%!" per_second; + + per_second + + +let test_convert codec format input n = + let f = fun () -> codec input format in + test f n + + +let test_rw reader writer (format: Piqirun_ext.output_format) bytes n = + printf "size of Protobuf binary: %d\n%!" (String.length bytes); + + (* read the object into OCaml term representation *) + let output = reader bytes `pb in + + (* write the object into desired test input format *) + let input = writer output format in + (* + printf "input: %s\n" input; + *) + + let input_format = + match format with + | `json_pretty -> `json + | `xml_pretty -> `xml + | #Piqirun_ext.input_format as x -> x + in + + printf "reading %s objects...\n%!" (string_of_format format); + let i_rate = test_convert reader input_format input n in + + printf "writing %s objects...\n%!" (string_of_format format); + let o_rate = test_convert writer format output n in + + printf "%s read/write rate: %d/%d\n\n%!" (string_of_format format) i_rate o_rate; + + print_newline (); + + () + + +let test_rw_all reader writer bytes n = + let formats = [`pb; `json; `json_pretty; `xml; `xml_pretty; `piq; `pib;] in + List.iter (fun format -> test_rw reader writer format bytes n) formats + + +let test_addressbook () = + printf "*** testing OCaml serialization of medium objects ***\n\n"; + + let filename = "addressbook.piq.pb" in + + (* Read the addressbook encoded in Protobuf format *) + let bytes = read_file filename in + + let reader = Addressbook_piqi_ext.parse_address_book in + let writer = Addressbook_piqi_ext.gen_address_book in + + let n = 100000 in + + test_rw_all reader writer bytes n; + (* + test_rw_all reader writer bytes n; + + test_rw reader writer `pb bytes n; + test_rw reader writer `json bytes n; + test_rw reader writer `json_pretty bytes n; + test_rw reader writer `xml bytes n; + test_rw reader writer `xml_pretty bytes n; + test_rw reader writer `pib bytes n; + test_rw reader writer `piq bytes n; + *) + () + + +let test_piqi () = + printf "*** testing OCaml serialization of big objects ***\n\n"; + + let filename = "piqi.piq.pb" in + + (* Read the Piqi self-specification encoded in Protobuf format *) + let bytes = read_file filename in + + let reader = Piqi_obj_piqi_ext.parse_piqi in + let writer = Piqi_obj_piqi_ext.gen_piqi in + + let n = 20000 in + + test_rw_all reader writer bytes n; + (* + test_rw_all reader writer bytes n; + + test_rw reader writer `pb bytes n; + test_rw reader writer `json bytes n; + test_rw reader writer `json_pretty bytes n; + test_rw reader writer `xml bytes n; + test_rw reader writer `xml_pretty bytes n; + test_rw reader writer `pib bytes n; + test_rw reader writer `piq bytes n; + *) + () + + +let set_gc_options () = + (* Don't set custom options if the OCAMLRUNPARAM environment variable is + * defined *) + try ignore (Sys.getenv "OCAMLRUNPARAM") + with Not_found -> + let opt = Gc.get () in + opt.Gc.minor_heap_size <- 4 * 1024 * 1024; (* Minor heap size: 4m *) + opt.Gc.space_overhead <- 200; (* run major GC less frequently, but waste more RAM *) + Gc.set opt + + +let _ = + (* + Gc.compact (); + Gc.print_stat stdout; + print_newline (); + *) + set_gc_options (); + + test_addressbook (); + test_piqi (); + () + diff --git a/piqi-ocaml/tests/piq-config b/piqi-ocaml/tests/piq-config new file mode 120000 index 0000000..45425e3 --- /dev/null +++ b/piqi-ocaml/tests/piq-config @@ -0,0 +1 @@ +../examples/piq-config \ No newline at end of file diff --git a/piqi-ocaml/tests/piqi/Makefile b/piqi-ocaml/tests/piqi/Makefile new file mode 100644 index 0000000..24529b0 --- /dev/null +++ b/piqi-ocaml/tests/piqi/Makefile @@ -0,0 +1,21 @@ +PIQI ?= piqi + + +all: prep test + + +prep: + $(PIQI) cc > piqi.piqi + $(PIQI) convert --add-defaults -t pb piqi.piqi + + +test: + $(MAKE) -f Makefile.ocaml + ./otest + cmp *.pb + + +clean: + $(MAKE) -f Makefile.ocaml clean + rm -f piqi.piqi piqi.piqi.pb* t.* + diff --git a/piqi-ocaml/tests/piqi/Makefile.ocaml b/piqi-ocaml/tests/piqi/Makefile.ocaml new file mode 100644 index 0000000..40ba539 --- /dev/null +++ b/piqi-ocaml/tests/piqi/Makefile.ocaml @@ -0,0 +1,30 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = otest + + +SOURCES = $(PIQI_ML_SOURCES) test.ml +PIQI_ML_SOURCES = piqi_piqi.ml piqobj_piqi.ml + + +PRE_TARGETS = $(PIQI_ML_SOURCES) + + +PIQIC = ../../piqic-ocaml/piqic-ocaml +#PIQIC_FLAGS = + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb + + +all: bc #top + + +$(PIQI_ML_SOURCES): *.piqi + $(PIQIC) $(PIQIC_FLAGS) piqi.piqi + $(PIQIC) $(PIQIC_FLAGS) piqobj.piqi + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/piqi/README b/piqi-ocaml/tests/piqi/README new file mode 100644 index 0000000..4892398 --- /dev/null +++ b/piqi-ocaml/tests/piqi/README @@ -0,0 +1,10 @@ + +Compile complex piqi specification "piqi/piqi.piqi" to produce OCaml +parsers and generators. + +Then build a program which reads and writes back a serialized binary object +which happens to be a serialized "piqi.piqi" specification. + +Also testing piqi imports in OCaml by compiling and linking "piqobj.piqi" which +imports "piqi.piqi". + diff --git a/piqi-ocaml/tests/piqi/piqi.ocaml.piqi b/piqi-ocaml/tests/piqi/piqi.ocaml.piqi new file mode 120000 index 0000000..051a8f5 --- /dev/null +++ b/piqi-ocaml/tests/piqi/piqi.ocaml.piqi @@ -0,0 +1 @@ +../../piqic-ocaml/piqi.ocaml.piqi \ No newline at end of file diff --git a/piqi-ocaml/tests/piqi/piqobj.piqi b/piqi-ocaml/tests/piqi/piqobj.piqi new file mode 100644 index 0000000..81dcdd7 --- /dev/null +++ b/piqi-ocaml/tests/piqi/piqobj.piqi @@ -0,0 +1,132 @@ +% Internal representation of Piq data +% +% Copyright 2009, 2010, 2011, 2012 Anton Lavrik + + +.import [ .module piqi ] + + +.variant [ + .name typedef + + .option [ .type record ] + .option [ .type variant ] + .option [ .type enum ] + .option [ .type list ] + .option [ .type alias ] +] + + +.variant [ + .name obj + + .option [ .type typedef ] + + % built-in objects + .option [ + .name int + .type int64 + ] + + .option [ + .name uint + .type uint64 + ] + + .option [ .type float ] + .option [ .type bool ] + .option [ .type string ] + .option [ .type binary ] + .option [ .type any ] +] + + +.record [ + .name record + .field [ + .name t + .type piqi/record + ] + .field [ + .type field + .repeated + ] +] + + +.record [ + .name field + .field [ + .name t + .type piqi/field + ] + .field [ + .type obj + .optional + ] +] + + +.record [ + .name variant + .field [ + .name t + .type piqi/variant + ] + .field [ .type option ] +] + + +.record [ + .name option + .field [ + .name t + .type piqi/option + ] + .field [ + .type obj + .optional + ] +] + + +.record [ + .name list + .field [ + .name t + .type piqi/list + ] + .field [ + .type obj + .repeated + ] +] + + +.record [ + .name alias + .field [ + .name t + .type piqi/alias + ] + .field [ .type obj ] +] + + +.record [ + .name any + .field [ + .name t + .type piqi/alias + ] + .field [ .type obj .optional ] +] + + +.alias [ + .name enum + .type variant +] + + +.custom-field ocaml-name diff --git a/piqi-ocaml/tests/piqi/test.ml b/piqi-ocaml/tests/piqi/test.ml new file mode 100644 index 0000000..2b0135f --- /dev/null +++ b/piqi-ocaml/tests/piqi/test.ml @@ -0,0 +1,16 @@ + +let t () = + let ich = open_in_bin "piqi.piqi.pb" in + let buf = Piqirun.init_from_channel ich in + let piqi = Piqi_piqi.parse_piqi buf in + + let och = open_out_bin "piqi.piqi.pb.pb" in + let data = Piqi_piqi.gen_piqi piqi in + Piqirun.to_channel och data; + + close_in ich; + close_out och; + () + + +let _ = t () diff --git a/piqi-ocaml/tests/piqirun/Makefile b/piqi-ocaml/tests/piqirun/Makefile new file mode 100644 index 0000000..89e981d --- /dev/null +++ b/piqi-ocaml/tests/piqirun/Makefile @@ -0,0 +1,18 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = test + +SOURCES = test.ml + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb + + +all: bc + ./test + + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/piqirun/test.ml b/piqi-ocaml/tests/piqirun/test.ml new file mode 100644 index 0000000..b3bad2d --- /dev/null +++ b/piqi-ocaml/tests/piqirun/test.ml @@ -0,0 +1,267 @@ +(* + Copyright 2009, 2010, 2011, 2012, 2013 Anton Lavrik + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +open Piqirun + + +(* superposition operator *) +let ( ** ) f g x = f (g x) + + +let assert_eq a b = assert (a = b) + + +let test_key x = + let test_parse x = + (IBuf.of_string ** OBuf.to_string) x + in + assert (x = ((fun x -> let _, code = parse_field_header x in code) ** test_parse ** gen_key 0) x) + + +let test_gen_parse x = + (init_from_string ** to_string) x + + +(* + * Names of the test_* functions correspond to Piqi types: there are 12 + * different integer types + *) + +let test_int x = + assert (x = (int_of_zigzag_varint ** test_gen_parse ** int_to_zigzag_varint (-1)) x) + +let test_int32 x = + assert (x = (int32_of_zigzag_varint ** test_gen_parse ** int32_to_zigzag_varint (-1)) x) + +let test_int64 x = + assert (x = (int64_of_zigzag_varint ** test_gen_parse ** int64_to_zigzag_varint (-1)) x) + + +let test_fixed_int32 x = + assert (x = (int32_of_signed_fixed32 ** test_gen_parse ** int32_to_signed_fixed32 (-1)) x) + +let test_fixed_int64 x = + assert (x = (int64_of_signed_fixed64 ** test_gen_parse ** int64_to_signed_fixed64 (-1)) x) + + +let test_proto_int x = (* NOTE: this type is not currently defined in Piqi *) + assert (x = (int_of_signed_varint ** test_gen_parse ** int_to_signed_varint (-1)) x) + +let test_proto_int32 x = + assert (x = (int32_of_signed_varint ** test_gen_parse ** int32_to_signed_varint (-1)) x) + +let test_proto_int64 x = + assert (x = (int64_of_signed_varint ** test_gen_parse ** int64_to_signed_varint (-1)) x) + + +let test_uint x = + assert (x = (int_of_varint ** test_gen_parse ** int_to_varint (-1)) x) + +let test_uint32 x = + assert (x = (int32_of_varint ** test_gen_parse ** int32_to_varint (-1)) x) + +let test_uint64 x = + assert (x = (int64_of_varint ** test_gen_parse ** int64_to_varint (-1)) x) + + +let test_fixed_uint32 x = + assert (x = (int32_of_fixed32 ** test_gen_parse ** int32_to_fixed32 (-1)) x) + +let test_fixed_uint64 x = + assert (x = (int64_of_fixed64 ** test_gen_parse ** int64_to_fixed64 (-1)) x) + + +(* + * Testing packed + *) + +let test_packed_gen_parse x = + (IBuf.of_string ** OBuf.to_string) x + + +(* + * Names of the test_* functions correspond to Piqi types: there are 12 + * different integer types + *) + +let test_packed_int x = + assert (x = (int_of_packed_zigzag_varint ** test_packed_gen_parse ** int_to_packed_zigzag_varint) x) + +let test_packed_int32 x = + assert (x = (int32_of_packed_zigzag_varint ** test_packed_gen_parse ** int32_to_packed_zigzag_varint) x) + +let test_packed_int64 x = + assert (x = (int64_of_packed_zigzag_varint ** test_packed_gen_parse ** int64_to_packed_zigzag_varint) x) + + +let test_packed_fixed_int32 x = + assert (x = (int32_of_packed_signed_fixed32 ** test_packed_gen_parse ** int32_to_packed_signed_fixed32) x) + +let test_packed_fixed_int64 x = + assert (x = (int64_of_packed_signed_fixed64 ** test_packed_gen_parse ** int64_to_packed_signed_fixed64) x) + + +let test_packed_proto_int x = (* NOTE: this type is not currently defined in Piqi *) + assert (x = (int_of_packed_signed_varint ** test_packed_gen_parse ** int_to_packed_signed_varint) x) + +let test_packed_proto_int32 x = + assert (x = (int32_of_packed_signed_varint ** test_packed_gen_parse ** int32_to_packed_signed_varint) x) + +let test_packed_proto_int64 x = + assert (x = (int64_of_packed_signed_varint ** test_packed_gen_parse ** int64_to_packed_signed_varint) x) + + +let test_packed_uint x = + assert (x = (int_of_packed_varint ** test_packed_gen_parse ** int_to_packed_varint) x) + +let test_packed_uint32 x = + assert (x = (int32_of_packed_varint ** test_packed_gen_parse ** int32_to_packed_varint) x) + +let test_packed_uint64 x = + assert (x = (int64_of_packed_varint ** test_packed_gen_parse ** int64_to_packed_varint) x) + + +let test_packed_fixed_uint32 x = + assert (x = (int32_of_packed_fixed32 ** test_packed_gen_parse ** int32_to_packed_fixed32) x) + +let test_packed_fixed_uint64 x = + assert (x = (int64_of_packed_fixed64 ** test_packed_gen_parse ** int64_to_packed_fixed64) x) + + + +let int_input = + [ + 0; 1; 2; 3; -1; -2; -3; + min_int; min_int + 1; min_int + 2; min_int + 3; + max_int; max_int - 1; max_int - 2; max_int - 3; + ] + + +let uint_input = + let max_uint = lnot 0 in + [ + 0; 1; 2; 3; + max_uint; + ] + + +open Int32 + +let int32_input = + let int_intput = List.map (fun x -> of_int x) int_input in + int_intput @ + [ + min_int; succ min_int; succ (succ min_int); succ (succ (succ min_int)); + max_int; pred max_int; pred (pred max_int); pred (pred (pred max_int)); + ] + + +let uint32_input = + let max_uint = lognot 0l in + [ + 0l; 1l; 2l; 3l; + max_uint; + ] + + +open Int64 + +let int64_input = + let int_intput = List.map (fun x -> of_int x) int_input in + let int32_intput = List.map (fun x -> of_int32 x) int32_input in + int_intput @ + int32_intput @ + [ + min_int; succ min_int; succ (succ min_int); succ (succ (succ min_int)); + max_int; pred max_int; pred (pred max_int); pred (pred (pred max_int)); + ] + + +let uint64_input = + let max_uint = lognot 0L in + let uint32_intput = List.map (fun x -> int64_of_uint32 x) uint32_input in + uint32_intput @ + [ + max_uint; + ] + + +let max_key = (1 lsl 29) - 1 + +let key_input = [ 1; 2; 3; max_key - 1; max_key ] + + +(* TODO: + * tests for malformed/broken/unexpectedly terminated input + * tests for OCaml's type overflows + * tests for cross-type reading, e.g. int64 -> int32, varint -> int64, etc. + * tests for bools, floats and other types + * + *) + +let test _ = + List.iter test_key key_input; + + (* tests for integer fields *) + + List.iter test_int int_input; + List.iter test_int32 int32_input; + List.iter test_int64 int64_input; + + List.iter test_fixed_int32 int32_input; + List.iter test_fixed_int64 int64_input; + + List.iter test_proto_int int_input; + List.iter test_proto_int32 int32_input; + List.iter test_proto_int64 int64_input; + + + List.iter test_uint uint_input; + List.iter test_uint32 uint32_input; + List.iter test_uint64 uint64_input; + + List.iter test_fixed_uint32 uint32_input; + List.iter test_fixed_uint64 uint64_input; + + (* tests for packed integers *) + + List.iter test_packed_int int_input; + List.iter test_packed_int32 int32_input; + List.iter test_packed_int64 int64_input; + + List.iter test_packed_fixed_int32 int32_input; + List.iter test_packed_fixed_int64 int64_input; + + List.iter test_packed_proto_int int_input; + List.iter test_packed_proto_int32 int32_input; + List.iter test_packed_proto_int64 int64_input; + + + List.iter test_packed_uint uint_input; + List.iter test_packed_uint32 uint32_input; + List.iter test_packed_uint64 uint64_input; + + List.iter test_packed_fixed_uint32 uint32_input; + List.iter test_packed_fixed_uint64 uint64_input; + + () + + +let _ = + if !Sys.interactive + then () + else test () + diff --git a/piqi-ocaml/tests/riak_pb/Makefile b/piqi-ocaml/tests/riak_pb/Makefile new file mode 100644 index 0000000..391daf9 --- /dev/null +++ b/piqi-ocaml/tests/riak_pb/Makefile @@ -0,0 +1,51 @@ +OCAMLMAKEFILE := ../../make/OCamlMakefile + + +RESULT = riak_pb + + +SOURCES = \ + $(PIQI_ML_FILES) + + +PROTO_FILES = riak.proto riak_kv.proto riak_search.proto + +PIQI_FILES = $(PROTO_FILES:%=%.piqi) + +PIQI_ML_FILES = $(PROTO_FILES:%.proto=%_piqi.ml) + + +export OCAMLPATH := ../..:$(OCAMLPATH) +PACKS = piqirun.pb + + +PIQI ?= piqi +PIQIC = ../../piqic-ocaml/piqic-ocaml +#PIQIC_FLAGS = + + +PRE_TARGETS = $(PIQI_FILES) $(PIQI_ML_FILES) + + +all: native-code-library #byte-code + + +$(PIQI_ML_FILES): $(PIQI_FILES) + set -e; \ + for i in $^; do \ + $(PIQIC) $(PIQIC_FLAGS) $$i ; \ + done + + +$(PIQI_FILES): $(PROTO_FILES) + set -e; \ + for i in $^; do \ + $(PIQI) of-proto $$i ; \ + done + + +clean:: + rm -f *.tmp.ml *.proto.piqi *.ml + + +include $(OCAMLMAKEFILE) diff --git a/piqi-ocaml/tests/riak_pb/README b/piqi-ocaml/tests/riak_pb/README new file mode 100644 index 0000000..2cbbcee --- /dev/null +++ b/piqi-ocaml/tests/riak_pb/README @@ -0,0 +1,5 @@ +Riak Protocol Buffers definitions were downloaded from + + git@github.com:basho/riak_pb.git + + commit: ab277e0900887699aeafcd8c1d0495fc5b4e304e diff --git a/piqi-ocaml/tests/riak_pb/riak.proto b/piqi-ocaml/tests/riak_pb/riak.proto new file mode 100644 index 0000000..2508abb --- /dev/null +++ b/piqi-ocaml/tests/riak_pb/riak.proto @@ -0,0 +1,44 @@ +/* ------------------------------------------------------------------- +** +** riak.proto: Protocol buffers for Riak +** +** Copyright (c) 2007-2010 Basho Technologies, Inc. All Rights Reserved. +** +** This file is provided to you under the Apache License, +** Version 2.0 (the "License"); you may not use this file +** except in compliance with the License. You may obtain +** a copy of the License at +** +** http://www.apache.org/licenses/LICENSE-2.0 +** +** Unless required by applicable law or agreed to in writing, +** software distributed under the License is distributed on an +** "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +** KIND, either express or implied. See the License for the +** specific language governing permissions and limitations +** under the License. +** +** ------------------------------------------------------------------- +*/ + +/* +** Revision: 1.2 +*/ + +// Error response - may be generated for any Req +message RpbErrorResp { + required bytes errmsg = 1; + required uint32 errcode = 2; +} + +// Get server info request - no message defined, just send RpbGetServerInfoReq message code +message RpbGetServerInfoResp { + optional bytes node = 1; + optional bytes server_version = 2; +} + +// Key/value pair - used for user metadata, indexes, search doc fields +message RpbPair { + required bytes key = 1; + optional bytes value = 2; +} diff --git a/piqi-ocaml/tests/riak_pb/riak_kv.ocaml.piqi b/piqi-ocaml/tests/riak_pb/riak_kv.ocaml.piqi new file mode 100644 index 0000000..3830082 --- /dev/null +++ b/piqi-ocaml/tests/riak_pb/riak_kv.ocaml.piqi @@ -0,0 +1,9 @@ +.include [ .module riak_kv ] + +.extend [ + (.field RpbListKeysResp.done RpbMapRedResp.done) + + .with.ocaml-name "isdone" +] + +.custom-field ocaml-name diff --git a/piqi-ocaml/tests/riak_pb/riak_kv.proto b/piqi-ocaml/tests/riak_pb/riak_kv.proto new file mode 100644 index 0000000..9e8fe2a --- /dev/null +++ b/piqi-ocaml/tests/riak_pb/riak_kv.proto @@ -0,0 +1,203 @@ +/* ------------------------------------------------------------------- +** +** riak_kv.proto: Protocol buffers for riak KV +** +** Copyright (c) 2007-2010 Basho Technologies, Inc. All Rights Reserved. +** +** This file is provided to you under the Apache License, +** Version 2.0 (the "License"); you may not use this file +** except in compliance with the License. You may obtain +** a copy of the License at +** +** http://www.apache.org/licenses/LICENSE-2.0 +** +** Unless required by applicable law or agreed to in writing, +** software distributed under the License is distributed on an +** "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +** KIND, either express or implied. See the License for the +** specific language governing permissions and limitations +** under the License. +** +** ------------------------------------------------------------------- +*/ + +/* +** Revision: 1.2 +*/ + +import "riak.proto"; // for RpbPair + +// Get ClientId Request - no message defined, just send RpbGetClientIdReq message code +message RpbGetClientIdResp { + required bytes client_id = 1; // Client id in use for this connection +} + +message RpbSetClientIdReq { + required bytes client_id = 1; // Client id to use for this connection +} +// Set ClientId Request - no message defined, just send RpbSetClientIdReq message code + + +// Get Request - retrieve bucket/key +message RpbGetReq { + required bytes bucket = 1; + required bytes key = 2; + optional uint32 r = 3; + optional uint32 pr = 4; + optional bool basic_quorum = 5; + optional bool notfound_ok = 6; + optional bytes if_modified = 7; // fail if the supplied vclock does not match + optional bool head = 8; // return everything but the value + optional bool deletedvclock = 9; // return the tombstone's vclock, if applicable +} + +// Get Response - if the record was not found there will be no content/vclock +message RpbGetResp { + repeated RpbContent content = 1; + optional bytes vclock = 2; // the opaque vector clock for the object + optional bool unchanged = 3; +} + + +// Put request - if options.return_body is set then the updated metadata/data for +// the key will be returned. +message RpbPutReq { + required bytes bucket = 1; + optional bytes key = 2; + optional bytes vclock = 3; + required RpbContent content = 4; + optional uint32 w = 5; + optional uint32 dw = 6; + optional bool return_body = 7; + optional uint32 pw = 8; + optional bool if_not_modified = 9; + optional bool if_none_match = 10; + optional bool return_head = 11; +} + +// Put response - same as get response with optional key if one was generated +message RpbPutResp { + repeated RpbContent content = 1; + optional bytes vclock = 2; // the opaque vector clock for the object + optional bytes key = 3; // the key generated, if any +} + + +// Delete request +message RpbDelReq { + required bytes bucket = 1; + required bytes key = 2; + optional uint32 rw = 3; + optional bytes vclock = 4; + optional uint32 r = 5; + optional uint32 w = 6; + optional uint32 pr = 7; + optional uint32 pw = 8; + optional uint32 dw = 9; +} + +// Delete response - not defined, will return a RpbDelResp on success or RpbErrorResp on failure + +// List buckets request - no message defined, just send RpbListBucketsReq + +// List buckets response +message RpbListBucketsResp { + repeated bytes buckets = 1; +} + + +// List keys in bucket request +message RpbListKeysReq { + required bytes bucket = 1; +} + +// List keys in bucket response - one or more of these packets will be sent +// the last one will have done set true (and may not have any keys in it) +message RpbListKeysResp { + repeated bytes keys = 1; + optional bool done = 2; +} + +// Get bucket properties request +message RpbGetBucketReq { + required bytes bucket = 1; +} + +// Get bucket properties response +message RpbGetBucketResp { + required RpbBucketProps props = 1; +} + +// Set bucket properties request +message RpbSetBucketReq { + required bytes bucket = 1; + required RpbBucketProps props = 2; +} + + +// Set bucket properties response - no message defined, just send RpbSetBucketResp + + +// Map/Reduce request +message RpbMapRedReq { + required bytes request = 1; + required bytes content_type = 2; +} + +// Map/Reduce response +// one or more of these packets will be sent the last one will have done set +// true (and may not have phase/data in it) +message RpbMapRedResp { + optional uint32 phase = 1; + optional bytes response = 2; + optional bool done = 3; +} + +// Secondary Index query request +message RpbIndexReq { + enum IndexQueryType { + eq = 0; + range = 1; + } + + required bytes bucket = 1; + required bytes index = 2; + required IndexQueryType qtype = 3; + optional bytes key = 4; + optional bytes range_min = 5; + optional bytes range_max = 6; +} + +// Secondary Index query response +message RpbIndexResp { + repeated bytes keys = 1; +} + +// Content message included in get/put responses +// Holds the value and associated metadata +message RpbContent { + required bytes value = 1; + optional bytes content_type = 2; // the media type/format + optional bytes charset = 3; + optional bytes content_encoding = 4; + optional bytes vtag = 5; + repeated RpbLink links = 6; // links to other resources + optional uint32 last_mod = 7; + optional uint32 last_mod_usecs = 8; + repeated RpbPair usermeta = 9; // user metadata stored with the object + repeated RpbPair indexes = 10; // user metadata stored with the object + optional bool deleted = 11; +} + +// Link metadata +message RpbLink { + optional bytes bucket = 1; + optional bytes key = 2; + optional bytes tag = 3; +} + +// Bucket properties +message RpbBucketProps { + optional uint32 n_val = 1; + optional bool allow_mult = 2; +} diff --git a/piqi-ocaml/tests/riak_pb/riak_search.proto b/piqi-ocaml/tests/riak_pb/riak_search.proto new file mode 100644 index 0000000..35f4b10 --- /dev/null +++ b/piqi-ocaml/tests/riak_pb/riak_search.proto @@ -0,0 +1,51 @@ +/* ------------------------------------------------------------------- +** +** riak_search.proto: Protocol buffers for Riak Search +** +** Copyright (c) 2012 Basho Technologies, Inc. All Rights Reserved. +** +** This file is provided to you under the Apache License, +** Version 2.0 (the "License"); you may not use this file +** except in compliance with the License. You may obtain +** a copy of the License at +** +** http://www.apache.org/licenses/LICENSE-2.0 +** +** Unless required by applicable law or agreed to in writing, +** software distributed under the License is distributed on an +** "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +** KIND, either express or implied. See the License for the +** specific language governing permissions and limitations +** under the License. +** +** ------------------------------------------------------------------- +*/ + +/* +** Revision: 1.2 +*/ + +import "riak.proto"; + +message RpbSearchDoc { + repeated RpbPair fields = 1; +} + +message RpbSearchQueryReq { + required bytes q = 1; // Query string + required bytes index = 2; // Index + optional uint32 rows = 3; // Limit rows + optional uint32 start = 4; // Starting offset + optional bytes sort = 5; // Sort order + optional bytes filter = 6; // Inline fields filtering query + optional bytes df = 7; // Default field + optional bytes op = 8; // Default op + repeated bytes fl = 9; // Return fields limit (for ids only, generally) + optional bytes presort = 10; // Presort (key / score) +} + +message RpbSearchQueryResp { + repeated RpbSearchDoc docs = 1; // Result documents + optional float max_score = 2; // Maximum score + optional uint32 num_found = 3; // Number of results +}