pax_global_header00006660000000000000000000000064135645304060014520gustar00rootroot0000000000000052 comment=9bb03c26b700cf78bcd5b7da14cb898c631a5520 sexplib-0.13.0/000077500000000000000000000000001356453040600132475ustar00rootroot00000000000000sexplib-0.13.0/.gitignore000066400000000000000000000000411356453040600152320ustar00rootroot00000000000000_build *.install *.merlin _opam sexplib-0.13.0/CHANGES.md000066400000000000000000000364121356453040600146470ustar00rootroot00000000000000## v0.11 - Switched `Sexplib`'s sexp parser to use the `Parsexp` library. See https://github.com/janestreet/parsexp - Remove the `location` field from the `parse_error` type. - Dropped dependency on Base. ## v0.10 - Added `val Sexp.is_unit : t -> bool` - Enabled `-safe-string` ## v0.9 ## 113.43.00 - Sexps and EOF are a mess. Try to improve the situation somewhat! In particular, this feature makes improvements to when `Parsing_whitespace` sexp parser state is reported: it now distinguishes the case `Parsing_toplevel_whitespace` from `Parsing_nested_whitespace` and it's only a valid empty parse if `eof` happens in `Parsing_toplevel_whitespace`. See test diffs for examples of strings that were previously valid empty parses, but are now incomplete. One of the craziest is probably "(foo #| bar". ## 113.33.00 - Changes `Sexp.to_string` to escape all non-ASCII characters. Previously chars >= 127 are escaped or not depending on: 1. other character in the string 2. the system 3. environment variable settings (2) and (3) are because `String.escaped` from the stdlib uses the C function `isprint` which is locale and OS dependent. This can cause invalid UTF-8 sequence to be printed by sexplib, which is annoying: https://github.com/janestreet/sexplib/issues/18 Starting with this release, sexplib: 1. copies the `String.escaped` function of OCaml 4.03 which escapes all non-ascii characters 2. make sure we escape the string when it contains characters >= 127 - Clean up the documentation for sexplib, modernizing it to include `ppx_sexp_conv`, and breaking up the documentation between sexplib and `ppx_sexp_conv`. Also changed the formatting to use org-mode, so it will render properly on github. Markdown doesn't render well by default, unless you use quite different conventions about linebeaks. - In sexp macro library, avoid returning success when there is any error reading a sexp. In particular, this prevents sexp resolve <(echo '(:use x)') from silently succeeding. Also, now we no longer read an included file multiple times. This lets even crazy stuff like this to work: $ echo 'hi ' | sexp resolve <(echo '((:include /dev/stdin) (:include /dev/stdin))') ## 113.24.00 - Switch code in `lib` subdir to ppx-style. ## 112.35.00 - Inline some calls that js_of_ocaml was unable to recognise as tail-recursive (cf. issue #14) ## 112.24.00 Minor update: documentation. ## 112.17.00 - Added `sexp_of_` support for GADTs, and remove the not-quite-working support for `of_sexp`. ## 112.06.00 - Improved the implementation of `Exn.sexp_of_t`, using the unique id in exceptions in OCaml 4.02. We use the identifier to map exception constructors to converters. ## 112.01.00 - Replaced occurrences of `Obj.magic 0` with `Obj.magic None`. With the former the compiler might think the destination type is always an integer and instruct the GC to ignore references to such values. The latter doesn't have this problem as options are not always integers. ## 111.25.00 - Fix compatibility with OCaml 4.02 ## 111.17.00 - Make the camlp4 dependency optional ## 111.13.00 - In `Sexplib.Std`, renamed `Macro` as `Sexp_macro`. ## 111.11.00 - Added error locations to `Macro`-expansion errors. ## 110.01.00 - Added `with sexp` support for mutually recursive types with common fields. For instance: ```ocaml type a = { fl : float } and b = { fl : int } with sexp ``` Closes #3 - Fixed the behavior of sexplib on `private` types. sexplib used to ignore the `private` modifier, which means generated functions had the wrong type. Now, it generates a function with the right type for `sexp_of` and refuses to generate anything for `of_sexp`. - Added `Macro.expand_local_macros`, which macro expands sexps, failing on `:include` macros. - Fixed `Macro`'s handling of nested `:include`'s which was broken with respect to paths. Prior to this fix, `:include`'s were broken with respect to the path used to resolve the filename. Including a file outside the current directory which included another file relative to that one would break. ## 109.60.00 - Moved unix-specific code to a new object section, sexplib_unix ## 109.53.00 - Changed `sexp_of_float` to (usually) use as few digits as possible, without losing precision. - Split the part of `Sexplib` that depends on `Num` into a separate library, `Sexplib_num`. This was done to eliminate the dependence of `Core_kernel` on `Num`, which is not usable on javascript. ## 109.52.00 - Added a `Macro` module, with `load_sexp*` functions that support file includes and templates. The following new syntaxes are supported: ```ocaml (:include filename) (:let f (arg1 ... argn) sexp1 ... sexpn) (:use f (arg1 valn) ... (argn valn)) (:concat a1 ... an) ``` - Added support to `with sexp` for a subset of GADTs. The new support is for types that use existentially quantified variables or plain variants written with GADT syntax. Existentially quantified variables still have to be wrapped with `sexp_opaque` generate compiling code. - Fixed a type error in the code generated by `with sexp` in some cases of variant inclusions. ## 109.20.00 - Renamed converter generated by `with sexp` for polymorphic variants so it is hidden from the toplevel. `of_sexp` created a value named `_of_sexp__` to handle polymorphic variants. To hide it from the toplevel, we renamed it as `___of_sexp__`. We kept the `__` suffix to avoid any confusion with a type named `__`. ## 109.12.00 - A tiny lexer improvement in `lexer.mll`. Used `lexbuf.lex_{start|curr}_pos` instead of `lexbuf.lex_{start|curr}_p.pos_cnum` for computing the length of a lexeme since the difference is the same. ## 109.10.00 - Improved error messages in presence of GADTs. - Made `with sexp` work with types containing `as` in signatures. ## 109.09.00 - Fixed an `unused rec` warning in the code generated by `pa_sexp` in rare cases. ## 2012-07-15 - Added support for S-expression default record fields. - Added syntax for S-expression comments and for nested block comments. - Fixed a few minor bugs and inconsistencies in the parsers and updated their whitespace handling to conform with the upcoming OCaml 4.00 compiler. The parser specification now also supports Menhir. - Rewrote README in Markdown and improved documentation. - Minor bug fix in the preprocessing module. - Eliminated new warnings available in OCaml 4.00. ## 2011-09-18 - Improved documentation. ## 2011-09-15 - Fixes to improve package dependency resolution. ## 2011-07-05 - Fixed a parser position bug. Parser positions passed by the user were not updated correctly. - Internal code beautification. ## 2011-07-04 - Internal updates to sync with Jane Street. ## 2011-01-30 - Fixed a code generation bug with toplevel entries. Thanks to Yong Lu for the report! ## 2010-12-27 - Added support for MoreLabels.Hashtbl and improved reporting of error locations with preprocessor. ## 2010-12-26 - Worked around a compiler bug that is expected to be fixed in OCaml 3.12.1. This workaround temporarily removes the interface for module Conv (conv.mli), thus exposing the internals. This should not cause any problems for end users as long as they do not depend on the exported internal representations. The interface will become constrained again as soon as the fixed compiler is out. ## 2010-12-22 Major release. - Merged with Jane Street version. This has caused an API-change that requires "open Sexplib.Conv" at the top of files that use the syntax extension. - Renamed functions: * sexp_of_lazy -> sexp_of_lazy_t * lazy_of_sexp -> lazy_t_of_sexp - Some standard library modules are now re-exported with predefined S-expression converters in module Conv. ## 2010-09-25 - Fixed inferred types of generated functions when dealing with arrow types. ## 2010-08-26 - Fixed a lexer bug when parsing comments. ## 2010-05-21 - Added support for sexp_bool record field annotations. ## 2010-05-18 - Improved performance of converting S-expressions to strings. ## 2010-04-12 - Changed API of Of_sexp_error exception. ## 2010-04-07 - Added of_(big)string_conv_exn functions. ## 2010-04-01 - Merged with Jane Street version. Major new features (various functions): * Type-annotated parsing for better error messages * Greatly improved performance of exception converters ## 2009-12-21 - Improved saving of files. ## 2009-10-12 - Added sexp_array record field extension. ## 2009-09-19 - Added missing variant type cases. - Fixed handling of variance annotations. ## 2009-09-15 - Internal cleanups. ## 2009-07-28 - Added better support for conversion of exception types. ## 2009-06-23 - Fixed build problem. Thanks to Sylvain Le Gall for the patch! ## 2009-05-08 - Fixed build problems on Windows and OCamlMakefile issues. Thanks to Sylvain Le Gall for the patch! ## 2009-04-22 - Added macro support for all types of vectors, matrices, and for bigstrings. ## 2009-04-21 - Merged with Jane Street version, no user-relevant changes. ## 2009-03-09 - Merged with Jane Street version, no user-relevant changes. ## 2009-03-01 - Fixed build problem on Mac OS X by updating OCamlMakefile. ## 2009-01-20 - Automatically add S-expression pretty-printers to toplevels. ## 2008-09-30 - Added a new feature: sexp_opaque. It prevents the need for / use of type converters for a given type in a particular type context. Removed abstract types to unify them with this new concept. ## 2008-09-29 - Added a new feature: sexp_list. This is similar to the handling of sexp_option. By default an empty list is assumed for unspecified records using sexp_list as qualifier. Such record fields bound to empty lists will also not be printed anymore for better readability. ## 2008-09-23 - Added missing Not_found-exception to standard exception converters. ## 2008-08-20 - Removed dependency on threads. Fixed build problems. ## 2008-08-08 - Nifty new feature: exceptions can now be converted to S-expressions, too! The "with sexp" syntax extension can be used with exceptions, thus registering a conversion function. A global exception conversion function can then be called to convert an arbitrary exception into an S-expression, which can then be printed out. This should greatly improve readability of uncaught exceptions while making life extremely easy for the developer. - Renamed the ParseError exception to Parse_error to be more compliant with Jane Street naming conventions. ## 2008-07-25 - Added utilities for conversion error handling. Minor fixes. ## 2008-04-24 - Made Sexp-interface manifest. ## 2008-03-20 - Fixed META-file (missing num dependency). ## 2008-03-17 - Improved META-file. ## 2008-03-13 - Fully allow function types in converters. Raise runtime exceptions on converting from S-expressions instead when function type encountered. ## 2008-02-11 - Fixed code generation problems with variance annotations in signatures, and empty types. ## 2007-12-17 - Added support for generating signature entries for S-expression converters. Thanks to Till Varoquaux for the patch! ## 2007-11-29 - Added support for converting big_int, nat, num, and ratio. ## 2007-11-26 - Added support for parsing from bigstrings (char bigarrays). ## 2007-11-02 - Added syntax support for option types to use the ordinary sum type syntax. This should improve readability. The old syntax will be accepted, too, if Conv.read_old_option_format is set to true (this is currently the default). The old format will be used for writing if Conv.write_old_option_format is true (currently the default). The old syntax is deprecated and will probably not be supported by default in the near future. Reading new-style option values will always succeed. ## 2007-09-14 - Fixed bug in S-expression preprocessor concerning record field names. ## 2007-08-06 - Added support for converting functions to S-expressions. ## 2007-07-20 - Fixed position information and improved speed of S-expression parser. Fixed S-expression macro bug concerning contained polymorphic variants. ## 2007-06-28 - Improved Sexplib code generation. ## 2007-06-22 - Fixed escaping bug in S-expression parser. ## 2007-06-01 - Added correct handling of recursive types + test case. ## 2007-04-18 - Added missing conversion functions from S-expressions to pairs and triples. ## 2007-03-21 - Updated OCamlMakefile. ## 2007-03-02 - Improved error messages when parsing illegal type definitions. ## 2007-01-30 - Added triple conversions. ## 2006-11-22 - Updated OCamlMakefile. ## 2006-10-13 - Improved checking of records for extra or duplicate fields. ## 2006-09-06 - Added support for polymorphic record fields. ## 2006-09-05 - Added support for manifest types. ## 2006-08-16 - Improved error messages. ## 2006-07-28 - Added a new, hand-written S-expression parser that supports partial parsing and should be approx. 10x faster than the previous one. ## 2006-06-20 - Fixed a code generation problem leading to compilation errors concerning the use of type aliases within polymorphic variant type definitions. This fix also solves potential erroneous appearances of backtracking exceptions in user code. ## 2006-03-21 - Added -for-pack option to Makefile and cleaned up distribution for a new public release. ## 2006-03-13 - Sexplib now accepts capitalized booleans. ## 2006-03-03 - Added customizable indentation levels. - Improved documentation. - Fixed API-problem concerning backward compatibility. ## 2006-03-01 - Added a missing flush for string conversions with a buffer. ## 2006-02-08 - Eliminated unused variable warnings in Sexplib-generated code. ## 2006-01-11 - Added functions for pretty-printing to buffers. - Improved performance of outputting S-expressions to channels. ## 2006-01-09 - Added functions load_sexp and load_sexps. ## 2006-01-04 - Changed float conversion from %E to %G (more readable). ## 2005-12-28 - Made machine representation for S-expressions more compact ## 2005-12-15 - Fixed a problem appearing with OCaml-release 3.08.4: CamlP4 obviously performs more strict checking on some constructs now and crashed with an exception when generating S-expression code for records containing only one field ("singleton tuple problem"). This problem is fixed now. ## 2005-11-25 - Fixed problem with type variables that could not be generalized. ## 2005-11-23 - Added a missing case in type definitions (path alias) ## 2005-11-17 - Major release: 2.0 Fixed a major design problem. The user now has to pass lex buffers instead of channels to input-functions. Reason: trailing characters in channels were lost due to ocamllex buffering them in the non-exposed lex buffer. This lex buffer is now exposed. The functions have been renamed ("input_X" -> "scan_X") to reflect this change. ## 2005-11-16 - Added label to conversion function "input_cnv_sexps". ## 2005-11-11 - Fixed a bug in the pretty-printer: strings in atoms were not escaped in the function "to_string_mach" (and therefore also "to_string"). ## 2005-11-07 - Initial release. sexplib-0.13.0/CHANGES.txt000066400000000000000000000240331356453040600150620ustar00rootroot000000000000002012-07-15: Added support for S-expression default record fields. Added syntax for S-expression comments and for nested block comments. Fixed a few minor bugs and inconsistencies in the parsers and updated their whitespace handling to conform with the upcoming OCaml 4.00 compiler. The parser specification now also supports Menhir. Rewrote README in Markdown and improved documentation. Minor bug fix in the preprocessing module. Eliminated new warnings available in OCaml 4.00. 2011-09-18: Improved documentation. 2011-09-15: Fixes to improve package dependency resolution. 2011-07-05: Fixed a parser position bug. Parser positions passed by the user were not updated correctly. Internal code beautification. 2011-07-04: Internal updates to sync with Jane Street. 2011-01-30: Fixed a code generation bug with toplevel entries. Thanks to Yong Lu for the report! 2010-12-27: Added support for MoreLabels.Hashtbl and improved reporting of error locations with preprocessor. 2010-12-26: Worked around a compiler bug that is expected to be fixed in OCaml 3.12.1. This workaround temporarily removes the interface for module Conv (conv.mli), thus exposing the internals. This should not cause any problems for end users as long as they do not depend on the exported internal representations. The interface will become constrained again as soon as the fixed compiler is out. 2010-12-22: Major release. Merged with Jane Street version. This has caused an API-change that requires "open Sexplib.Conv" at the top of files that use the syntax extension. Renamed functions: * sexp_of_lazy -> sexp_of_lazy_t * lazy_of_sexp -> lazy_t_of_sexp Some standard library modules are now re-exported with predefined S-expression converters in module Conv. 2010-09-25: Fixed inferred types of generated functions when dealing with arrow types. 2010-08-26: Fixed a lexer bug when parsing comments. 2010-05-21: Added support for sexp_bool record field annotations. 2010-05-18: Improved performance of converting S-expressions to strings. 2010-04-12: Changed API of Of_sexp_error exception. 2010-04-07: Added of_(big)string_conv_exn functions. 2010-04-01: Merged with Jane Street version. Major new features (various functions): * Type-annotated parsing for better error messages * Greatly improved performance of exception converters 2009-12-21: Improved saving of files. 2009-10-12: Added sexp_array record field extension. 2009-09-19: Added missing variant type cases. Fixed handling of variance annotations. 2009-09-15: Internal cleanups. 2009-07-28: Added better support for conversion of exception types. 2009-06-23: Fixed build problem. Thanks to Sylvain Le Gall for the patch! 2009-05-08: Fixed build problems on Windows and OCamlMakefile issues. Thanks to Sylvain Le Gall for the patch! 2009-04-22: Added macro support for all types of vectors, matrices, and for bigstrings. 2009-04-21: Merged with Jane Street version, no user-relevant changes. 2009-03-09: Merged with Jane Street version, no user-relevant changes. 2009-03-01: Fixed build problem on Mac OS X by updating OCamlMakefile. 2009-01-20: Automatically add S-expression pretty-printers to toplevels. 2008-09-30: Added a new feature: sexp_opaque. It prevents the need for / use of type converters for a given type in a particular type context. Removed abstract types to unify them with this new concept. 2008-09-29: Added a new feature: sexp_list. This is similar to the handling of sexp_option. By default an empty list is assumed for unspecified records using sexp_list as qualifier. Such record fields bound to empty lists will also not be printed anymore for better readability. 2008-09-23: Added missing Not_found-exception to standard exception converters. 2008-08-20: Removed dependency on threads. Fixed build problems. 2008-08-08: Nifty new feature: exceptions can now be converted to S-expressions, too! The "with sexp" syntax extension can be used with exceptions, thus registering a conversion function. A global exception conversion function can then be called to convert an arbitrary exception into an S-expression, which can then be printed out. This should greatly improve readability of uncaught exceptions while making life extremely easy for the developer. Renamed the ParseError exception to Parse_error to be more compliant with Jane Street naming conventions. 2008-07-25: Added utilities for conversion error handling. Minor fixes. 2008-04-24: Made Sexp-interface manifest. 2008-03-20: Fixed META-file (missing num dependency). 2008-03-17: Improved META-file. 2008-03-13: Fully allow function types in converters. Raise runtime exceptions on converting from S-expressions instead when function type encountered. 2008-02-11: Fixed code generation problems with variance annotations in signatures, and empty types. 2007-12-17: Added support for generating signature entries for S-expression converters. Thanks to Till Varoquaux for the patch! 2007-11-29: Added support for converting big_int, nat, num, and ratio. 2007-11-26: Added support for parsing from bigstrings (char bigarrays). 2007-11-02: Added syntax support for option types to use the ordinary sum type syntax. This should improve readability. The old syntax will be accepted, too, if Conv.read_old_option_format is set to true (this is currently the default). The old format will be used for writing if Conv.write_old_option_format is true (currently the default). The old syntax is deprecated and will probably not be supported by default in the near future. Reading new-style option values will always succeed. 2007-09-14: Fixed bug in S-expression preprocessor concerning record field names. 2007-08-06: Added support for converting functions to S-expressions. 2007-07-20: Fixed position information and improved speed of S-expression parser. Fixed S-expression macro bug concerning contained polymorphic variants. 2007-06-28: Improved Sexplib code generation. 2007-06-22: Fixed escaping bug in S-expression parser. 2007-06-01: Added correct handling of recursive types + test case. 2007-04-18: Added missing conversion functions from S-expressions to pairs and triples. 2007-03-21: Updated OCamlMakefile. 2007-03-02: Improved error messages when parsing illegal type definitions. 2007-01-30: Added triple conversions. 2006-11-22: Updated OCamlMakefile. 2006-10-13: Improved checking of records for extra or duplicate fields. 2006-09-06: Added support for polymorphic record fields. 2006-09-05: Added support for manifest types. 2006-08-16: Improved error messages. 2006-07-28: Added a new, hand-written S-expression parser that supports partial parsing and should be approx. 10x faster than the previous one. 2006-06-20: Fixed a code generation problem leading to compilation errors concerning the use of type aliases within polymorphic variant type definitions. This fix also solves potential erroneous appearances of backtracking exceptions in user code. 2006-03-21: Added -for-pack option to Makefile and cleaned up distribution for a new public release. 2006-03-13: Sexplib now accepts capitalized booleans. 2006-03-03: Added customizable indentation levels. Improved documentation. Fixed API-problem concerning backward compatibility. 2006-03-03: Added customizable indentation levels. Improved documentation. 2006-03-01: Added a missing flush for string conversions with a buffer. 2006-02-08: Eliminated unused variable warnings in Sexplib-generated code. 2006-01-11: Added functions for pretty-printing to buffers. Improved performance of outputting S-expressions to channels. 2006-01-09: Added functions load_sexp and load_sexps. 2006-01-04: Changed float conversion from %E to %G (more readable). 2005-12-28: Made machine representation for S-expressions more compact 2005-12-15: Fixed a problem appearing with OCaml-release 3.08.4: CamlP4 obviously performs more strict checking on some constructs now and crashed with an exception when generating S-expression code for records containing only one field ("singleton tuple problem"). This problem is fixed now. 2005-11-25: Fixed problem with type variables that could not be generalized. 2005-11-23: Added a missing case in type definitions (path alias) 2005-11-17: Major release: 2.0 Fixed a major design problem. The user now has to pass lex buffers instead of channels to input-functions. Reason: trailing characters in channels were lost due to ocamllex buffering them in the non-exposed lex buffer. This lex buffer is now exposed. The functions have been renamed ("input_X" -> "scan_X") to reflect this change. 2005-11-16: Added label to conversion function "input_cnv_sexps". 2005-11-11: Fixed a bug in the pretty-printer: strings in atoms were not escaped in the function "to_string_mach" (and therefore also "to_string"). 2005-11-07: Initial release. sexplib-0.13.0/CONTRIBUTING.md000066400000000000000000000044101356453040600154770ustar00rootroot00000000000000This repository contains open source software that is developed and maintained by [Jane Street][js]. Contributions to this project are welcome and should be submitted via GitHub pull requests. Signing contributions --------------------- We require that you sign your contributions. Your signature certifies that you wrote the patch or otherwise have the right to pass it on as an open-source patch. The rules are pretty simple: if you can certify the below (from [developercertificate.org][dco]): ``` Developer Certificate of Origin Version 1.1 Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 1 Letterman Drive Suite D4700 San Francisco, CA, 94129 Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Developer's Certificate of Origin 1.1 By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved. ``` Then you just add a line to every git commit message: ``` Signed-off-by: Joe Smith ``` Use your real name (sorry, no pseudonyms or anonymous contributions.) If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with git commit -s. [dco]: http://developercertificate.org/ [js]: https://opensource.janestreet.com/ sexplib-0.13.0/COPYRIGHT.txt000066400000000000000000000007631356453040600153660ustar00rootroot00000000000000Most of this library was written by: Markus Mottl This work is derived from the library "Tywith", version 0.45. The library "Tywith" was written and is distributed by: Martin Sandin The original license of "Tywith" can be found in the file "LICENSE-Tywith.txt". The following company has sponsored and has copyright in part of this work: Jane Street Holding, LLC 1 New York Plaza, 33rd Floor New York, NY 10004 USA sexplib-0.13.0/LICENSE-Tywith.txt000066400000000000000000000030101356453040600163520ustar00rootroot00000000000000--------------------------------------------------------------------------- Copyright (c) 2004 Martin Sandin All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --------------------------------------------------------------------------- sexplib-0.13.0/LICENSE.md000066400000000000000000000021351356453040600146540ustar00rootroot00000000000000The MIT License Copyright (c) 2005--2019 Jane Street Group, LLC Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. sexplib-0.13.0/Makefile000066400000000000000000000004031356453040600147040ustar00rootroot00000000000000INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) default: dune build install: dune install $(INSTALL_ARGS) uninstall: dune uninstall $(INSTALL_ARGS) reinstall: uninstall install clean: dune clean .PHONY: default install uninstall reinstall clean sexplib-0.13.0/README.org000066400000000000000000000112131356453040600147130ustar00rootroot00000000000000 * Sexplib - S-Expressions for OCaml =sexplib= contains functionality for parsing and pretty-printing s-expressions. S-expressions are defined by the following type: #+begin_src ocaml type sexp = Atom of string | List of sexp list #+end_src ** Usage example In this example we build an s-expression that corresponds to =(This (is an) (s expression))=, serialize that into a string, and then parse the string back into an s-expression. #+begin_src ocaml open Sexplib let () = (* Build an Sexp from: (This (is an) (s expression)) *) let exp1 = Sexp.(List [ Atom "This"; List [Atom "is"; Atom "an"]; List [Atom "s"; Atom "expression"] ]) in (* Serialize an Sexp object into a string *) print_endline (Sexp.to_string exp1); (* Parse a string and produce a Sexp object *) let exp2 = Sexp.of_string "(This (is an) (s expression))" in (* Ensure we parsed what we expected. *) assert (Sexp.compare exp1 exp2 = 0) #+end_src ** About This library is often used in conjunction with =ppx_sexp_conv=, a syntax extension which generates code from type definitions for efficiently converting OCaml-values to s-expressions and vice versa. Together, these two libraries make it easy to convert your OCaml values to and from a human-readable serializable form, without the tedium of having to write your own converters. The library also offers functionality for extracting and replacing sub-expressions in s-expressions. Here, we'll only document =sexplib= proper. If you want to know more about the way in which OCaml types are mapped on to s-expressions, you should look at the documentation for [[https://github.com/janestreet/ppx_sexp_conv][=ppx_sexp_conv=]]. ** Lexical conventions of s-expression Whitespace, which consists of the space, newline, horizontal tab, and form feed characters, is ignored unless within an OCaml-string, where it is treated according to OCaml-conventions. The left parenthesis opens a new list, the right one closes it again. Lists can be empty. The double quote denotes the beginning and end of a string following the lexical conventions of OCaml (see the [[http://caml.inria.fr/pub/docs/manual-ocaml/][OCaml-manual]] for details). All characters other than double quotes, left and right parentheses, whitespace, carriage return, and comment-introducing characters or sequences (see next paragraph) are considered part of a contiguous string. ** Comments There are three kinds of comments: - /line comments/ are introduced with =;=, and end at the newline. - /sexp comments/ are introduced with =#;=, and end at the end of the following s-expression. - /block comments/ are introduced with =#|= and end with =|#=. These can be nested, and double-quotes within them must be balanced and be lexically correct OCaml strings. ** Grammar of s-expressions S-expressions are either strings (= atoms) or lists. The lists can recursively contain further s-expressions or be empty, and must be balanced, i.e., parentheses must match. ** Examples #+begin_src scheme this_is_an_atom_123'&^%! ; this is a comment "another atom in an OCaml-string \"string in a string\" \123" ; empty list follows below () ; a more complex example ( ( list in a list ; comment within a list (list in a list in a list) 42 is the answer to all questions #; (this S-expression (has been commented out) ) #| Block comments #| can be "nested" |# |# ) ) #+end_src ** I/O and Type Conversions There are multiple ways to perform I/O with s-expressions. If exact error locations are required when type conversions fail, s-expressions need to be parsed with location annotations. The associated parser is slower, however, and needs more memory. In most cases users may therefore want to use functions like =load_sexp_conv= or =load_sexp_conv_exn=, which load s-expressions from files and convert them. They initially read the file without location annotations for performance reasons. Only if conversions fail will the file be reparsed with location annotations. Type errors can then be reported accurately with file name, line number, column, and file position. ** Custom converters In addition to the converters provided automatically by =ppx_sexp_conv=, it's possible to write one's own sexp-converter. For such converters to be available by other automatically generated converters, it should follow the convention of being defined in the same scope as the type, and should be named =sexp_of_[type]= and =[type]_of_sexp=. You must report failures by raising the =Of_sexp_error=-exception so that then =sexplib='s tools for pinpointing the location of type errors within an s-expression file will work properly. sexplib-0.13.0/THIRD-PARTY.txt000066400000000000000000000002751356453040600155630ustar00rootroot00000000000000The repository contains 3rd-party code in the following locations and under the following licenses: - src: based on Tywith, by Martin Sandin. License can be found in LICENSE-Tywith.txt sexplib-0.13.0/dune-project000066400000000000000000000000171356453040600155670ustar00rootroot00000000000000(lang dune 1.5)sexplib-0.13.0/num/000077500000000000000000000000001356453040600140465ustar00rootroot00000000000000sexplib-0.13.0/num/lib/000077500000000000000000000000001356453040600146145ustar00rootroot00000000000000sexplib-0.13.0/num/lib/dune000066400000000000000000000001551356453040600154730ustar00rootroot00000000000000(library (name sexplib_num) (public_name sexplib.num) (libraries num sexplib) (preprocess no_preprocessing))sexplib-0.13.0/num/lib/sexplib_num_conv.ml000066400000000000000000000023341356453040600205220ustar00rootroot00000000000000open Sexplib.Sexp open Sexplib.Conv let exn_to_string e = to_string_hum (sexp_of_exn e) let sexp_of_big_int n = Atom (Big_int.string_of_big_int n) let sexp_of_nat n = Atom (Nat.string_of_nat n) let sexp_of_ratio n = Atom (Ratio.string_of_ratio n) let sexp_of_num n = Atom (Num.string_of_num n) let big_int_of_sexp sexp = match sexp with | Atom str -> (try Big_int.big_int_of_string str with exc -> of_sexp_error ("big_int_of_sexp: " ^ exn_to_string exc) sexp) | List _ -> of_sexp_error "big_int_of_sexp: atom needed" sexp let nat_of_sexp sexp = match sexp with | Atom str -> (try Nat.nat_of_string str with exc -> of_sexp_error ("nat_of_sexp: " ^ exn_to_string exc) sexp) | List _ -> of_sexp_error "nat_of_sexp: atom needed" sexp let ratio_of_sexp sexp = match sexp with | Atom str -> (try Ratio.ratio_of_string str with exc -> of_sexp_error ("ratio_of_sexp: " ^ exn_to_string exc) sexp) | List _ -> of_sexp_error "ratio_of_sexp: atom needed" sexp let num_of_sexp sexp = match sexp with | Atom str -> (try Num.num_of_string str with exc -> of_sexp_error ("num_of_sexp: " ^ exn_to_string exc) sexp) | List _ -> of_sexp_error "num_of_sexp: atom needed" sexp sexplib-0.13.0/num/lib/sexplib_num_conv.mli000066400000000000000000000020671356453040600206760ustar00rootroot00000000000000open Sexplib val sexp_of_big_int : Big_int.big_int -> Sexp.t (** [sexp_of_big_int n] converts the value [n] of type [Big_int.big_int] to an S-expression. *) val sexp_of_nat : Nat.nat -> Sexp.t (** [sexp_of_nat n] converts the value [n] of type [Nat.nat] to an S-expression. *) val sexp_of_ratio : Ratio.ratio -> Sexp.t (** [sexp_of_ratio n] converts the value [n] of type [Ratio.ratio] to an S-expression. *) val sexp_of_num : Num.num -> Sexp.t (** [sexp_of_num n] converts the value [n] of type [Num.num] to an S-expression. *) val big_int_of_sexp : Sexp.t -> Big_int.big_int (** [big_int_of_sexp sexp] converts S-expression [sexp] to a value of type [Big_int.big_int]. *) val nat_of_sexp : Sexp.t -> Nat.nat (** [nat_of_sexp sexp] converts S-expression [sexp] to a value of type [Nat.nat]. *) val ratio_of_sexp : Sexp.t -> Ratio.ratio (** [ratio_of_sexp sexp] converts S-expression [sexp] to a value of type [Nat.ratio]. *) val num_of_sexp : Sexp.t -> Num.num (** [num_of_sexp sexp] converts S-expression [sexp] to a value of type [Nat.num]. *) sexplib-0.13.0/num/lib/std.ml000066400000000000000000000011141356453040600157350ustar00rootroot00000000000000 module Big_int = struct include Big_int let sexp_of_big_int = Sexplib_num_conv.sexp_of_big_int let big_int_of_sexp = Sexplib_num_conv.big_int_of_sexp end module Nat = struct include Nat let sexp_of_nat = Sexplib_num_conv.sexp_of_nat let nat_of_sexp = Sexplib_num_conv.nat_of_sexp end module Ratio = struct include Ratio let sexp_of_ratio = Sexplib_num_conv.sexp_of_ratio let ratio_of_sexp = Sexplib_num_conv.ratio_of_sexp end module Num = struct include Num let sexp_of_num = Sexplib_num_conv.sexp_of_num let num_of_sexp = Sexplib_num_conv.num_of_sexp end sexplib-0.13.0/sexplib.opam000066400000000000000000000016011356453040600155710ustar00rootroot00000000000000opam-version: "2.0" version: "v0.13.0" maintainer: "opensource@janestreet.com" authors: ["Jane Street Group, LLC "] homepage: "https://github.com/janestreet/sexplib" bug-reports: "https://github.com/janestreet/sexplib/issues" dev-repo: "git+https://github.com/janestreet/sexplib.git" doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/sexplib/index.html" license: "MIT" build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "ocaml" {>= "4.04.2"} "parsexp" {>= "v0.13" & < "v0.14"} "sexplib0" {>= "v0.13" & < "v0.14"} "dune" {>= "1.5.1"} "num" ] synopsis: "Library for serializing OCaml values to and from S-expressions" description: " Part of Jane Street's Core library The Core suite of libraries is an industrial strength alternative to OCaml's standard library that was developed by Jane Street, the largest industrial user of OCaml. " sexplib-0.13.0/src/000077500000000000000000000000001356453040600140365ustar00rootroot00000000000000sexplib-0.13.0/src/conv.ml000066400000000000000000000101761356453040600153420ustar00rootroot00000000000000open Printf open Bigarray include Sexplib0.Sexp_conv open Sexp type bigstring = (char, int8_unsigned_elt, c_layout) Array1.t type float32_vec = (float, float32_elt, fortran_layout) Array1.t type float64_vec = (float, float64_elt, fortran_layout) Array1.t type vec = float64_vec type float32_mat = (float, float32_elt, fortran_layout) Array2.t type float64_mat = (float, float64_elt, fortran_layout) Array2.t type mat = float64_mat let sexp_of_float_vec vec = let lst_ref = ref [] in for i = Array1.dim vec downto 1 do lst_ref := sexp_of_float vec.{i} :: !lst_ref done; List !lst_ref let sexp_of_bigstring (bstr : bigstring) = let n = Array1.dim bstr in let str = Bytes.create n in for i = 0 to n - 1 do Bytes.set str i bstr.{i} done; Atom (Bytes.unsafe_to_string str) let sexp_of_float32_vec (vec : float32_vec) = sexp_of_float_vec vec let sexp_of_float64_vec (vec : float64_vec) = sexp_of_float_vec vec let sexp_of_vec (vec : vec) = sexp_of_float_vec vec let sexp_of_float_mat mat = let m = Array2.dim1 mat in let n = Array2.dim2 mat in let lst_ref = ref [] in for col = n downto 1 do let vec = Array2.slice_right mat col in for row = m downto 1 do lst_ref := sexp_of_float vec.{row} :: !lst_ref done done; List (sexp_of_int m :: sexp_of_int n :: !lst_ref) let sexp_of_float32_mat (mat : float32_mat) = sexp_of_float_mat mat let sexp_of_float64_mat (mat : float64_mat) = sexp_of_float_mat mat let sexp_of_mat (mat : mat) = sexp_of_float_mat mat let bigstring_of_sexp sexp = match sexp with | Atom str -> let len = String.length str in let bstr = Array1.create char c_layout len in for i = 0 to len - 1 do bstr.{i} <- str.[i] done; bstr | List _ -> of_sexp_error "bigstring_of_sexp: atom needed" sexp let float_vec_of_sexp empty_float_vec create_float_vec sexp = match sexp with | List [] -> empty_float_vec | List lst -> let len = List.length lst in let res = create_float_vec len in let rec loop i = function | [] -> res | h :: t -> res.{i} <- float_of_sexp h; loop (i + 1) t in loop 1 lst | Atom _ -> of_sexp_error "float_vec_of_sexp: list needed" sexp let create_float32_vec = Array1.create float32 fortran_layout let create_float64_vec = Array1.create float64 fortran_layout let empty_float32_vec = create_float32_vec 0 let empty_float64_vec = create_float64_vec 0 let float32_vec_of_sexp = float_vec_of_sexp empty_float32_vec create_float32_vec let float64_vec_of_sexp = float_vec_of_sexp empty_float64_vec create_float64_vec let vec_of_sexp = float_vec_of_sexp empty_float64_vec create_float64_vec let check_too_much_data sexp data res = if data = [] then res else of_sexp_error "float_mat_of_sexp: too much data" sexp let float_mat_of_sexp create_float_mat sexp = match sexp with | List (sm :: sn :: data) -> let m = int_of_sexp sm in let n = int_of_sexp sn in let res = create_float_mat m n in if m = 0 || n = 0 then check_too_much_data sexp data res else let rec loop_cols col data = let vec = Array2.slice_right res col in let rec loop_rows row = function | [] -> of_sexp_error "float_mat_of_sexp: not enough data" sexp | h :: t -> vec.{row} <- float_of_sexp h; if row = m then if col = n then check_too_much_data sexp t res else loop_cols (col + 1) t else loop_rows (row + 1) t in loop_rows 1 data in loop_cols 1 data | List _ -> of_sexp_error "float_mat_of_sexp: list too short" sexp | Atom _ -> of_sexp_error "float_mat_of_sexp: list needed" sexp let create_float32_mat = Array2.create float32 fortran_layout let create_float64_mat = Array2.create float64 fortran_layout let float32_mat_of_sexp = float_mat_of_sexp create_float32_mat let float64_mat_of_sexp = float_mat_of_sexp create_float64_mat let mat_of_sexp = float_mat_of_sexp create_float64_mat let string_of__of__sexp_of to_sexp x = Sexp.to_string (to_sexp x) let of_string__of__of_sexp of_sexp s = try let sexp = Sexp.of_string s in of_sexp sexp with e -> failwith (sprintf "of_string failed on %s with %s" s (Sexp.to_string_hum (sexp_of_exn e))) sexplib-0.13.0/src/conv.mli000066400000000000000000000062141356453040600155110ustar00rootroot00000000000000(** Utility Module for S-expression Conversions *) open Bigarray include module type of Sexplib0.Sexp_conv (** {6 Type aliases} *) type bigstring = (char, int8_unsigned_elt, c_layout) Array1.t type float32_vec = (float, float32_elt, fortran_layout) Array1.t type float64_vec = (float, float64_elt, fortran_layout) Array1.t type vec = float64_vec type float32_mat = (float, float32_elt, fortran_layout) Array2.t type float64_mat = (float, float64_elt, fortran_layout) Array2.t type mat = float64_mat (** {6 Conversion of OCaml-values to S-expressions} *) val sexp_of_bigstring : bigstring -> Sexp.t (** [sexp_of_bigstring bstr] converts a bigstring (character bigarray in C-layout) to an S-expression. *) val sexp_of_float32_vec : float32_vec -> Sexp.t (** [sexp_of_float32_vec vec] converts the one-dimensional bigarray [vec] of 32-bit floats in Fortran-layout to an S-expression. *) val sexp_of_float64_vec : float64_vec -> Sexp.t (** [sexp_of_float64_vec vec] converts the one-dimensional bigarray [vec] of 64-bit floats in Fortran-layout to an S-expression. *) val sexp_of_vec : vec -> Sexp.t (** [sexp_of_vec vec] same as {!Conv.sexp_of_float64_vec}. *) val sexp_of_float32_mat : float32_mat -> Sexp.t (** [sexp_of_float32_mat mat] converts the two-dimensional bigarray [mat] of 32-bit floats in Fortran-layout to an S-expression. *) val sexp_of_float64_mat : float64_mat -> Sexp.t (** [sexp_of_float64_mat mat] converts the two-dimensional bigarray [mat] of 64-bit floats in Fortran-layout to an S-expression. *) val sexp_of_mat : mat -> Sexp.t (** [sexp_of_mat mat] same as {!Conv.sexp_of_float64_mat}. *) val string_of__of__sexp_of : ('a -> Sexp.t) -> 'a -> string (** [string_of__of__sexp_of conv x] converts the OCaml-value [x] to an S-expression represented as a string by using conversion function [conv]. *) (** {6 Conversion of S-expressions to OCaml-values} *) val bigstring_of_sexp : Sexp.t -> bigstring (** [bigstring_of_sexp sexp] converts S-expression [sexp] to a bigstring (character bigarray in C-layout). *) val float32_vec_of_sexp : Sexp.t -> float32_vec (** [float32_vec_of_sexp sexp] converts S-expression [sexp] to a one-dimensional bigarray of 32-bit floats in Fortran-layout. *) val float64_vec_of_sexp : Sexp.t -> float64_vec (** [float64_vec_of_sexp sexp] converts S-expression [sexp] to a one-dimensional bigarray of 64-bit floats in Fortran-layout. *) val vec_of_sexp : Sexp.t -> vec (** [vec_of_sexp sexp] same as {!float64_vec_of_sexp}. *) val float32_mat_of_sexp : Sexp.t -> float32_mat (** [float32_mat_of_sexp sexp] converts S-expression [sexp] to a two-dimensional bigarray of 32-bit floats in Fortran-layout. *) val float64_mat_of_sexp : Sexp.t -> float64_mat (** [float64_mat_of_sexp sexp] converts S-expression [sexp] to a two-dimensional bigarray of 64-bit floats in Fortran-layout. *) val mat_of_sexp : Sexp.t -> mat (** [mat_of_sexp sexp] same as {!Conv.float64_mat_of_sexp}. *) val of_string__of__of_sexp : (Sexp.t -> 'a) -> string -> 'a (** [of_string__of__of_sexp conv str] converts the S-expression [str] represented as a string to an OCaml-value by using conversion function [conv]. *) sexplib-0.13.0/src/conv_error.ml000066400000000000000000000000411356453040600165410ustar00rootroot00000000000000include Sexplib0.Sexp_conv_error sexplib-0.13.0/src/dune000066400000000000000000000002541356453040600147150ustar00rootroot00000000000000(library (name sexplib) (libraries bigarray parsexp sexplib0) (public_name sexplib) (preprocess no_preprocessing)) (ocamllex lexer) (ocamlyacc parser parser_with_layout)sexplib-0.13.0/src/exn_magic.ml000066400000000000000000000167451356453040600163370ustar00rootroot00000000000000module Extension_constructor = struct [@@@ocaml.warning "-3"] let of_val = Obj.extension_constructor end let register exc exc_name = Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun _exc -> Sexp.Atom exc_name) let magic_field repr n = Obj.magic (Obj.field repr n) let register1 make_exc exc_name sexp_of_arg1 = let exc = make_exc (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in Sexp.List [ Sexp.Atom exc_name; sexp1; ]) let register2 make_exc exc_name sexp_of_arg1 sexp_of_arg2 = let exc = make_exc (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; ]) let register3 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; ]) let register4 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 sexp_of_arg4 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in let sexp4 = sexp_of_arg4 (magic_field repr 4) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; sexp4; ]) let register5 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 sexp_of_arg4 sexp_of_arg5 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in let sexp4 = sexp_of_arg4 (magic_field repr 4) in let sexp5 = sexp_of_arg5 (magic_field repr 5) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; sexp4; sexp5; ]) let register6 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 sexp_of_arg4 sexp_of_arg5 sexp_of_arg6 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in let sexp4 = sexp_of_arg4 (magic_field repr 4) in let sexp5 = sexp_of_arg5 (magic_field repr 5) in let sexp6 = sexp_of_arg6 (magic_field repr 6) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; sexp4; sexp5; sexp6; ]) let register7 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 sexp_of_arg4 sexp_of_arg5 sexp_of_arg6 sexp_of_arg7 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in let sexp4 = sexp_of_arg4 (magic_field repr 4) in let sexp5 = sexp_of_arg5 (magic_field repr 5) in let sexp6 = sexp_of_arg6 (magic_field repr 6) in let sexp7 = sexp_of_arg7 (magic_field repr 7) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; sexp4; sexp5; sexp6; sexp7; ]) let register8 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 sexp_of_arg4 sexp_of_arg5 sexp_of_arg6 sexp_of_arg7 sexp_of_arg8 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in let sexp4 = sexp_of_arg4 (magic_field repr 4) in let sexp5 = sexp_of_arg5 (magic_field repr 5) in let sexp6 = sexp_of_arg6 (magic_field repr 6) in let sexp7 = sexp_of_arg7 (magic_field repr 7) in let sexp8 = sexp_of_arg8 (magic_field repr 8) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; sexp4; sexp5; sexp6; sexp7; sexp8; ]) let register9 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 sexp_of_arg4 sexp_of_arg5 sexp_of_arg6 sexp_of_arg7 sexp_of_arg8 sexp_of_arg9 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in let sexp4 = sexp_of_arg4 (magic_field repr 4) in let sexp5 = sexp_of_arg5 (magic_field repr 5) in let sexp6 = sexp_of_arg6 (magic_field repr 6) in let sexp7 = sexp_of_arg7 (magic_field repr 7) in let sexp8 = sexp_of_arg8 (magic_field repr 8) in let sexp9 = sexp_of_arg9 (magic_field repr 9) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; sexp4; sexp5; sexp6; sexp7; sexp8; sexp9; ]) let register10 make_exc exc_name sexp_of_arg1 sexp_of_arg2 sexp_of_arg3 sexp_of_arg4 sexp_of_arg5 sexp_of_arg6 sexp_of_arg7 sexp_of_arg8 sexp_of_arg9 sexp_of_arg10 = let exc = make_exc (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) (Obj.magic None) in Conv.Exn_converter.add (Extension_constructor.of_val exc) (fun exc -> let repr = Obj.repr exc in let sexp1 = sexp_of_arg1 (magic_field repr 1) in let sexp2 = sexp_of_arg2 (magic_field repr 2) in let sexp3 = sexp_of_arg3 (magic_field repr 3) in let sexp4 = sexp_of_arg4 (magic_field repr 4) in let sexp5 = sexp_of_arg5 (magic_field repr 5) in let sexp6 = sexp_of_arg6 (magic_field repr 6) in let sexp7 = sexp_of_arg7 (magic_field repr 7) in let sexp8 = sexp_of_arg8 (magic_field repr 8) in let sexp9 = sexp_of_arg9 (magic_field repr 9) in let sexp10 = sexp_of_arg10 (magic_field repr 10) in Sexp.List [ Sexp.Atom exc_name; sexp1; sexp2; sexp3; sexp4; sexp5; sexp6; sexp7; sexp8; sexp9; sexp10; ]) sexplib-0.13.0/src/exn_magic.mli000066400000000000000000000050471356453040600165010ustar00rootroot00000000000000(** This file is only kept for compatibility with pa_sexp_conv. *) val register : exn -> string -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register1 : ('a -> exn) -> string -> ('a -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register2 : ('a -> 'b -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register3 : ('a -> 'b -> 'c -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register4 : ('a -> 'b -> 'c -> 'd -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> ('d -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register5 : ('a -> 'b -> 'c -> 'd -> 'e -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> ('d -> Sexp.t) -> ('e -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register6 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> ('d -> Sexp.t) -> ('e -> Sexp.t) -> ('f -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register7 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> ('d -> Sexp.t) -> ('e -> Sexp.t) -> ('f -> Sexp.t) -> ('g -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register8 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> 'h -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> ('d -> Sexp.t) -> ('e -> Sexp.t) -> ('f -> Sexp.t) -> ('g -> Sexp.t) -> ('h -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register9 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> 'h -> 'i -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> ('d -> Sexp.t) -> ('e -> Sexp.t) -> ('f -> Sexp.t) -> ('g -> Sexp.t) -> ('h -> Sexp.t) -> ('i -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] val register10 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> 'h -> 'i -> 'j -> exn) -> string -> ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('c -> Sexp.t) -> ('d -> Sexp.t) -> ('e -> Sexp.t) -> ('f -> Sexp.t) -> ('g -> Sexp.t) -> ('h -> Sexp.t) -> ('i -> Sexp.t) -> ('j -> Sexp.t) -> unit [@@deprecated "[2016-07] use Conv.Exn_converter.add"] sexplib-0.13.0/src/intro.txt000066400000000000000000000265461356453040600157470ustar00rootroot00000000000000@indexes {2 Modules} @all_modules {2 What is Sexplib?} This library contains functionality for parsing and pretty-printing S-expressions. In addition to that it contains a preprocessing module for Camlp4, which can be used to automatically generate code from type definitions for efficiently converting OCaml-values to S-expressions and vice versa. In combination with the parsing and pretty-printing functionality this frees users from having to write their own I/O-routines for datastructures they define. Possible errors during automatic conversions from S-expressions to OCaml-values are reported in human-readable ways with exact location information. Another module in this library allows you to extract and replace sub-expressions in S-expressions. {2 How can you use it?} Make sure you have installed the [type_conv] package on your system, too. It should be obtainable at the same site as [sexplib]. The API (.mli-files) in the [sexplib] library directory is fully documented. Module [Sexp] contains all I/O-functions for S-expressions, module [Conv] helper functions for converting OCaml-values of standard types to S-expressions. Module [Path] supports sub-expression extraction and substitution. Module [pa_sexp_conv.ml] contains the extensions for the Camlp4-preprocessor. It adds the new construct [with sexp] (and [with sexp_of] and [with of_sexp], which are implied by the first). When using this construct right after a type definition, function definitions will be generated automatically, which perform S-expression conversions. E.g. given the following type definition: @color{[type t = A | B with sexp]} The above will generate the functions [sexp_of_t] and [t_of_sexp]. The preprocessor also supports automatic addition of conversion functions to signatures. Just add [with sexp] to the type in a signature, and the appropriate function signatures will be generated. See the file [lib_test/conv_test.ml] for example usage. It also demonstrates how to extract and substitute sub-expressions. {2 Syntax Specification of S-expressions} {9 Lexical conventions of S-expression} Whitespace, which consists of space, newline, carriage return, horizontal tab and form feed, is ignored unless within an OCaml-string, where it is treated according to OCaml-conventions. The semicolon introduces comments. Comments are ignored, and range up to the next newline character. The left parenthesis opens a new list, the right parenthesis closes it again. Lists can be empty. The double quote denotes the beginning and end of a string following the lexical conventions of OCaml (see OCaml-manual for details). All characters other than double quotes, left- and right parentheses, and whitespace are considered part of a contiguous string. {9 Grammar of S-expressions} S-expressions are either strings (= atoms) or lists. The lists can recursively contain further S-expressions or be empty, and must be balanced, i.e. parentheses must match. {9 Examples} {[this_is_an_atom_123'&^%! ; this is a comment "another atom in an OCaml-string \"string in a string\" \123" ; empty list follows below () ; a more complex example ( ( list in a list ; comment within a list (list in a list in a list) 42 is the answer to all questions ) )]} {9 Conversion of basic OCaml-values} Basic OCaml-values like the unit-value, integers (in all representations), floats, strings, and booleans are represented in S-exp syntax in the same way as in OCaml. Strings may also appear without quotes if this does not clash with the lexical conventions for S-expressions. {9 Conversion of OCaml-tuples} OCaml-tuples are simple lists of values in the same order as in the tuple. E.g.: {[(3.14, "foo", "bar bla", 27) <===> (3.14 foo "bar bla" 27)]} {9 Conversion of OCaml-records} OCaml-records are represented as lists of pairs in S-expression syntax. Each pair consists of the name of the record field (first element), and its value (second element). E.g.: @color{[{ foo = 3; bar = "some string"; }]} [<===>] {[( (foo 3) (bar "some string") )]} Type specifications of records allow the use of a special attribute [@sexp.option] which indicates that a record field should be optional. E.g.: @color{[type t = { x : int option; y : int option [@sexp.option]; }]} The attribute [@sexp.option] is treated specially by the code generator. The above would lead to the following equivalences of values and S-expressions: @color{[{ x = Some 1; y = Some 2; }]} [<===>] {[( (x (some 1)) (y 2) )]} And: @color{[{ x = None; y = None; }]} [<===>] {[( (x none) )]} Note how [@sexp.option] allows you to leave away record fields that should default to [None]. It is also unnecessary (and actually wrong) now to write down such a value as an option, i.e. the [some]-tag must be dropped if the field should be defined. The attributes [@sexp.list], [@sexp.array], and [@sexp.bool] can be used in ways similar to the attribute [@sexp.option]. They assume the empty list, empty array, and false value respectively as default values. {9 Conversion of sum types} Constant constructors in sum types are represented as strings. Constructors with arguments are represented as lists, the first element being the constructor name, the rest being its arguments. Constructors may also be started in lowercase in S-expressions, but will always be converted to uppercase when converting from OCaml-values. For example: @color{[type t = A | B of int * float * t with sexp ]} {[B (42, 3.14, B (-1, 2.72, A)) <===> (B 42 3.14 (B -1 2.72 A))]} The above example also demonstrates recursion in datastructures. {9 Conversion of variant types} The conversion of polymorphic variants is almost the same as with sum types. The notable difference is that variant constructors must always start with an either lower- or uppercase character, matching the way it was specified in the type definition. This is because OCaml also distinguishes between upper- and lowercase variant constructors. Note that type specifications containing unions of variant types are also supported by the S-expression converter. {9 Conversion of OCaml-lists and arrays} OCaml-lists and arrays are straightforwardly represented as S-expression lists. {9 Conversion of option types} The option type is converted like ordinary polymorphic sum types, i.e.: {[None <===> none Some value <===> (some value)]} There is a deprecated version of the syntax in which values of option type are represented as lists in S-expressions: {[None <===> () Some value <===> (value)]} Reading of the old-style S-expression syntax for option values is only supported if the reference [Conv.read_old_option_format] is set to [true] (currently the default, which may change soon). A conversion exception is raised otherwise. The old format will be written only if [Conv.write_old_option_format] is true (also currently the default). Reading of the new format is always supported. {9 Conversion of polymorphic values} There is nothing special about polymorphic values as long as there are conversion functions for the type parameters. E.g.: @color{[type 'a t = A | B of 'a with sexp type foo = int t with sexp]} In the above case the conversion functions will behave as if [foo] had been defined as a monomorphic version of [t] with ['a] replaced by [int] on the right hand side. If a datastructure is indeed polymorphic, and you want to convert it, you will have to supply the conversion functions for the type parameters at runtime. E.g. in the above example, if you wanted to convert a value of type ['a t], you would have to write something like this: @color{[sexp_of_t sexp_of_a v]} where [sexp_of_a], which may also be named differently in this particular case, is a function that converts values of type ['a] to an S-expression. Types with more than one parameter require passing conversion functions for those parameters in the order of their appearance on the left hand side of the type definition. {9 Conversion of abstract datatypes} Of course, if you want to convert an abstract datatype to an S-expression, you will have to roll your own conversion function, which should produce values of type [Sexp.t] directly. If, however, you want to make use of your abstract type within definitions of other types, make sure that you call your conversion function appropriately: it should be in the same scope as the typename, and must be named [sexp_of_{typename}]. {9 Conversion of hashtables} Hashtables, which are abstract values in OCaml, are represented as association lists, i.e. lists of key-value pairs, e.g.: @color{[((foo 42) (bar 3))]} Reading in the above S-expression as hashtable mapping strings to integers ([(string, int) Hashtbl.t]) will map ["foo"] to 42 and ["bar"] to 3. Note that the order of elements in the list may matter, because duplicates are kept: bindings will be inserted into the hashtable in order of appearence. Therefore, the last binding of a key will be the ``visible'' one, the others are ``hidden''. See the OCaml-documentation on hashtables for details. Note, too, that polymorphic equality may not hold between conversions. You will have to use a function implementing logical equality for that purpose. {9 Conversion of opaque values} Opaque values are ones for which we do not want to perform conversions. This may be, because we do not have S-expression converters for them, or because we do not want to apply them in a particular type context, e.g. if the resulting S-expression should be printed out but without superfluous information. To prevent the preprocessor from generating calls to converters, simply apply the attribute [@sexp.opaque], e.g.: @color{[type foo = int * (stuff [@sexp.opaque]) with sexp]} Thus, there is no need to specify converters for type [stuff], and if there are any, they will not be used in this particular context. Needless to say, it is not possible to convert such an S-expression back to the original value. Here is an example conversion: {[(42, some_stuff) ===> (42, )]} {9 Conversion of exceptions} S-expression converters for exceptions can be automatically registered using the [with sexp] macro, e.g.: @color{[module M = struct exception Foo of int with sexp end]} Such exceptions will be translated in a similar way as sum types, but their constructor will be prefixed with the fully qualified module path (here: [M.Foo]) so as to be able to discriminate between them without problems. The user can then easily convert an exception matching the above one to an S-expression using [Sexplib.Conv.sexp_of_exn]. User-defined conversion functions can be registered, too, by calling [Sexplib.Conv.add_exn_converter]. This should make it very convenient for users to catch arbitrary exceptions escaping their program and pretty-printing them, including all arguments, as S-expressions. The library already contains mappings for all known exceptions that can escape functions in the OCaml standard library. {2 I/O and type conversions} There are multiple ways of performing I/O with S-expressions. If exact error locations are required when type conversions fail, S-expressions need to be parsed with location annotations. In most cases users may want to use functions like e.g. [load_sexp_conv] or [load_sexp_conv_exn], which load S-expressions from files and convert them. Only when conversions fail, the file will be reparsed with annotations, which is slower, and type errors will be reported accurately with file, line number, column, and file position. sexplib-0.13.0/src/lexer.mli000066400000000000000000000002301356453040600156530ustar00rootroot00000000000000val main : ?buf:Buffer.t -> Lexing.lexbuf -> Parser.token val main_with_layout : ?buf:Buffer.t -> Lexing.lexbuf -> Parser_with_layout.token sexplib-0.13.0/src/lexer.mll000066400000000000000000000240341356453040600156660ustar00rootroot00000000000000{ (** Lexer: Lexer Specification for S-expressions *) open Printf open Lexing let char_for_backslash = function | 'n' -> '\010' | 'r' -> '\013' | 'b' -> '\008' | 't' -> '\009' | c -> c let lf = '\010' let dec_code c1 c2 c3 = 100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48) let hex_code c1 c2 = let d1 = Char.code c1 in let val1 = if d1 >= 97 then d1 - 87 else if d1 >= 65 then d1 - 55 else d1 - 48 in let d2 = Char.code c2 in let val2 = if d2 >= 97 then d2 - 87 else if d2 >= 65 then d2 - 55 else d2 - 48 in val1 * 16 + val2 let found_newline ({ lex_curr_p; _ } as lexbuf) diff = lexbuf.lex_curr_p <- { lex_curr_p with pos_lnum = lex_curr_p.pos_lnum + 1; pos_bol = lex_curr_p.pos_cnum - diff; } (* same length computation as in [Lexing.lexeme] *) let lexeme_len { lex_start_pos; lex_curr_pos; _ } = lex_curr_pos - lex_start_pos let main_failure lexbuf msg = let { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } = lexeme_start_p lexbuf in let msg = sprintf "Sexplib.Lexer.main: %s at line %d char %d" msg pos_lnum (pos_cnum - pos_bol) in failwith msg module type T = sig module Quoted_string_buffer : sig type t val create : int -> t val add_char : t -> char -> unit val add_subbytes : t -> bytes -> int -> int -> unit val add_lexeme : t -> lexbuf -> unit val clear : t -> unit val of_buffer : Buffer.t -> t end module Token : sig type t val lparen : t val rparen : t val eof : t val simple_string : string -> t val hash_semi : t val quoted_string : Lexing.position -> Quoted_string_buffer.t -> t type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t val comment : string -> main:s -> s val block_comment : Lexing.position -> main:s -> s end end module Make (X : T) : sig val main : ?buf:Buffer.t -> Lexing.lexbuf -> X.Token.t end = struct (* BEGIN FUNCTOR BODY CONTAINING GENERATED CODE *) open X } let lf = '\010' let lf_cr = ['\010' '\013'] let dos_newline = "\013\010" let blank = [' ' '\009' '\012'] let unquoted = [^ ';' '(' ')' '"'] # blank # lf_cr let digit = ['0'-'9'] let hexdigit = digit | ['a'-'f' 'A'-'F'] let unquoted_start = unquoted # ['#' '|'] | '#' unquoted # ['|'] | '|' unquoted # ['#'] rule main buf = parse | lf | dos_newline { found_newline lexbuf 0; main buf lexbuf } | blank+ { main buf lexbuf } | (';' (_ # lf_cr)*) as text { Token.comment text ~main buf lexbuf } | '(' { Token.lparen } | ')' { Token.rparen } | '"' { let pos = Lexing.lexeme_start_p lexbuf in Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf pos lexbuf; let tok = Token.quoted_string pos buf in Quoted_string_buffer.clear buf; tok } | "#;" { Token.hash_semi } | "#|" { let pos = Lexing.lexeme_start_p lexbuf in Quoted_string_buffer.add_lexeme buf lexbuf; scan_block_comment buf [pos] lexbuf; let tok = Token.block_comment pos ~main buf lexbuf in Quoted_string_buffer.clear buf; tok } | "|#" { main_failure lexbuf "illegal end of comment" } | "#" "#"+ "|" unquoted* (* unquoted_start can match ##, so ##| (which should be refused) would not not be parsed by this case if the regexp on the left was not there *) | "|" "|"+ "#" unquoted* | unquoted_start unquoted* ("#|" | "|#") unquoted* { main_failure lexbuf "comment tokens in unquoted atom" } | "#" | "|" | unquoted_start unquoted* as str { Token.simple_string str } | eof { Token.eof } and scan_string buf start = parse | '"' { Quoted_string_buffer.add_lexeme buf lexbuf; () } | '\\' lf [' ' '\t']* { let len = lexeme_len lexbuf - 2 in found_newline lexbuf len; Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | '\\' dos_newline [' ' '\t']* { let len = lexeme_len lexbuf - 3 in found_newline lexbuf len; Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | '\\' (['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] as c) { Quoted_string_buffer.add_char buf (char_for_backslash c); Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | '\\' (digit as c1) (digit as c2) (digit as c3) { let v = dec_code c1 c2 c3 in if v > 255 then ( let { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } = lexeme_end_p lexbuf in let msg = sprintf "Sexplib.Lexer.scan_string: \ illegal escape at line %d char %d: `\\%c%c%c'" pos_lnum (pos_cnum - pos_bol - 3) c1 c2 c3 in failwith msg); Quoted_string_buffer.add_char buf (Char.chr v); Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | '\\' 'x' (hexdigit as c1) (hexdigit as c2) { let v = hex_code c1 c2 in Quoted_string_buffer.add_char buf (Char.chr v); Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | '\\' (_ as c) { Quoted_string_buffer.add_char buf '\\'; Quoted_string_buffer.add_char buf c; Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | lf { found_newline lexbuf 0; Quoted_string_buffer.add_char buf lf; Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | ([^ '\\' '"'] # lf)+ { let ofs = lexbuf.lex_start_pos in let len = lexbuf.lex_curr_pos - ofs in Quoted_string_buffer.add_subbytes buf lexbuf.lex_buffer ofs len; Quoted_string_buffer.add_lexeme buf lexbuf; scan_string buf start lexbuf } | eof { let msg = sprintf "Sexplib.Lexer.scan_string: unterminated string at line %d char %d" start.pos_lnum (start.pos_cnum - start.pos_bol) in failwith msg } and scan_block_comment buf locs = parse | ('#'* | '|'*) lf { Quoted_string_buffer.add_lexeme buf lexbuf; found_newline lexbuf 0; scan_block_comment buf locs lexbuf } | (('#'* | '|'*) [^ '"' '#' '|'] # lf)+ { Quoted_string_buffer.add_lexeme buf lexbuf; scan_block_comment buf locs lexbuf } | ('#'* | '|'*) '"' { Quoted_string_buffer.add_lexeme buf lexbuf; let cur = lexeme_end_p lexbuf in let start = { cur with pos_cnum = cur.pos_cnum - 1 } in scan_string buf start lexbuf; scan_block_comment buf locs lexbuf } | '#'+ '|' { Quoted_string_buffer.add_lexeme buf lexbuf; let cur = lexeme_end_p lexbuf in let start = { cur with pos_cnum = cur.pos_cnum - 2 } in scan_block_comment buf (start :: locs) lexbuf } | '|'+ '#' { Quoted_string_buffer.add_lexeme buf lexbuf; match locs with | [_] -> () (* the comment is finished *) | _ :: (_ :: _ as t) -> scan_block_comment buf t lexbuf | [] -> assert false (* impossible *) } | eof { match locs with | [] -> assert false | { pos_lnum; pos_bol; pos_cnum; pos_fname = _ } :: _ -> let msg = sprintf "Sexplib.Lexer.scan_block_comment: \ unterminated block comment at line %d char %d" pos_lnum (pos_cnum - pos_bol) in failwith msg } { (* RESUME FUNCTOR BODY CONTAINING GENERATED CODE *) let main ?buf = let buf = match buf with | None -> Quoted_string_buffer.create 64 | Some buf -> Buffer.clear buf; Quoted_string_buffer.of_buffer buf in main buf end (* END FUNCTOR BODY CONTAINING GENERATED CODE *) module Vanilla = Make (struct module Quoted_string_buffer = struct include Buffer let add_lexeme _ _ = () let of_buffer b = b end module Token = struct open Parser type t = token type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t let eof = EOF let lparen = LPAREN let rparen = RPAREN let hash_semi = HASH_SEMI let simple_string x = STRING x let quoted_string _ buf = STRING (Buffer.contents buf) let block_comment _pos ~main buf lexbuf = main buf lexbuf let comment _text ~main buf lexbuf = main buf lexbuf (* skip and continue lexing *) end end) module With_layout = Make (struct module Quoted_string_buffer = struct type t = { contents : Buffer.t; lexeme : Buffer.t; } let create n = {contents = Buffer.create n; lexeme = Buffer.create n} let of_buffer contents = { contents; lexeme = Buffer.create 64 } let add_char t ch = Buffer.add_char t.contents ch let add_subbytes t str ofs len = Buffer.add_subbytes t.contents str ofs len let add_lexeme t lexbuf = Buffer.add_string t.lexeme (Lexing.lexeme lexbuf) let clear t = Buffer.clear t.lexeme; Buffer.clear t.contents end module Token = struct open Parser_with_layout type t = token type s = Quoted_string_buffer.t -> Lexing.lexbuf -> t let eof = EOF let lparen = LPAREN let rparen = RPAREN let hash_semi = HASH_SEMI let simple_string x = STRING (x, None) let quoted_string pos {Quoted_string_buffer.contents; lexeme} = STRING (Buffer.contents contents, Some (pos, Buffer.contents lexeme)) let block_comment pos ~main:_ {Quoted_string_buffer.contents = _; lexeme} _lexbuf = COMMENT (Buffer.contents lexeme, Some pos) let comment text ~main:_ _buf _lexbuf = COMMENT (text, None) end end) let main = Vanilla.main let main_with_layout = With_layout.main } sexplib-0.13.0/src/parser.mly000066400000000000000000000026131356453040600160570ustar00rootroot00000000000000%{ (* Parser: Grammar Specification for Parsing S-expressions *) open Lexing let parse_failure what = let pos = Parsing.symbol_start_pos () in let msg = Printf.sprintf "Sexplib.Parser: failed to parse line %d char %d: %s" pos.pos_lnum (pos.pos_cnum - pos.pos_bol) what in failwith msg %} %token STRING %token LPAREN RPAREN EOF HASH_SEMI %start sexp %type sexp %start sexp_opt %type sexp_opt %start sexps %type sexps %start rev_sexps %type rev_sexps %% sexp: | sexp_comments sexp_but_no_comment { $2 } | sexp_but_no_comment { $1 } sexp_but_no_comment : STRING { Type.Atom $1 } | LPAREN RPAREN { Type.List [] } | LPAREN rev_sexps_aux RPAREN { Type.List (List.rev $2) } | error { parse_failure "sexp" } sexp_comment : HASH_SEMI sexp_but_no_comment { () } | HASH_SEMI sexp_comments sexp_but_no_comment { () } sexp_comments : sexp_comment { () } | sexp_comments sexp_comment { () } sexp_opt : sexp_but_no_comment { Some $1 } | sexp_comments sexp_but_no_comment { Some $2 } | EOF { None } | sexp_comments EOF { None } rev_sexps_aux : sexp_but_no_comment { [$1] } | sexp_comment { [] } | rev_sexps_aux sexp_but_no_comment { $2 :: $1 } | rev_sexps_aux sexp_comment { $1 } rev_sexps : rev_sexps_aux EOF { $1 } | EOF { [] } sexps : rev_sexps_aux EOF { List.rev $1 } | EOF { [] } sexplib-0.13.0/src/parser_with_layout.mly000066400000000000000000000051111356453040600205030ustar00rootroot00000000000000%{ (* Parser: Grammar Specification for Parsing S-expressions *) (* compare to parser.mly *) open Lexing let parse_failure what = let pos = Parsing.symbol_start_pos () in let msg = Printf.sprintf "Sexplib.Parser: failed to parse line %d char %d: %s" pos.pos_lnum (pos.pos_cnum - pos.pos_bol) what in failwith msg module With_pos = struct open Type_with_layout.Parsed let coerce = Src_pos.Absolute.of_lexing let start_pos () = coerce (Parsing.symbol_start_pos ()) let end_pos () = let p = Parsing.symbol_end_pos () in coerce { p with Lexing.pos_cnum = p.Lexing.pos_cnum - 1 } let atom (x, y) = let (pos, y) = match y with | None -> (start_pos (), Some x) | Some (pos, x) -> (coerce pos, Some x) in Atom (pos, x, y) let list ts = List (start_pos (), ts, end_pos ()) let sexp x = Sexp x let comment x = Comment x let sexp_comment cs t = Sexp_comment (start_pos (), cs, t) let plain_comment (x, pos_opt) = let pos = match pos_opt with | None -> start_pos () | Some pos -> coerce pos in Plain_comment (pos, x) end %} %token STRING %token COMMENT %token LPAREN RPAREN EOF HASH_SEMI %start sexp %type sexp %start sexp_opt %type sexp_opt %start sexps %type sexps %start sexps_abs %type sexps_abs %start rev_sexps %type rev_sexps %% sexp_but_no_comment_abs : STRING { With_pos.atom $1 } | LPAREN rev_sexps_abs RPAREN { With_pos.list (List.rev $2) } | error { parse_failure "sexp" } comment_abs : COMMENT { With_pos.plain_comment $1 } | HASH_SEMI rev_comments_abs sexp_but_no_comment_abs { With_pos.sexp_comment (List.rev $2) $3 } rev_comments_abs : /* nothing */ { [] } | rev_comments_abs comment_abs { $2 :: $1 } sexp_abs : sexp_but_no_comment_abs { With_pos.sexp $1 } | comment_abs { With_pos.comment $1 } rev_sexps_abs : /* empty */ { [] } | rev_sexps_abs sexp_abs { $2 :: $1 } sexp : sexp_abs { Type_with_layout.relativize $1 } sexp_opt : sexp { Some $1 } | EOF { None } rev_sexps_aux : sexp { [$1] } | rev_sexps_aux sexp { $2 :: $1 } rev_sexps : rev_sexps_aux EOF { $1 } | EOF { [] } sexps : rev_sexps_aux EOF { List.rev $1 } | EOF { [] } /* for debugging positions */ sexps_abs : rev_sexps_abs EOF { List.rev $1 } sexplib-0.13.0/src/path.ml000066400000000000000000000123041356453040600153240ustar00rootroot00000000000000(* Path: Module for Substitutions within S-expressions *) open Format open Sexp type el = Pos of int | Match of string * int | Rec of string type t = el list let illegal_atom loc sexp = failwith (sprintf "Path.%s: illegal atom: %s" loc (Sexp.to_string sexp)) let extract_pos_lst loc sexp ix lst = let rec loop acc n = function | [] -> let sexp_str = Sexp.to_string sexp in failwith ( sprintf "Path.%s: illegal index %d in: %s" loc ix sexp_str) | h :: t -> if n = 0 then let subst = function | None -> List.rev_append acc t | Some x -> List.rev_append acc (x :: t) in subst, h else loop (h :: acc) (n - 1) t in loop [] ix lst let extract_pos n = function | List lst as sexp -> let subst, el = extract_pos_lst "extract_pos" sexp n lst in (fun x -> List (subst x)), el | Atom _ as sexp -> illegal_atom "extract_pos" sexp let extract_match tag arg_ix = function | List (Atom str as sexp :: args) when str = tag -> let subst, el = extract_pos_lst "extract_match" (List args) arg_ix args in (fun maybe_x -> List (sexp :: subst maybe_x)), el | List _ as sexp -> let sexp_str = Sexp.to_string sexp in failwith ("Path.extract_match: unexpected nested list in: " ^ sexp_str) | Atom _ as sexp -> illegal_atom "extract_match" sexp let extract_rec key = function | List lst as sexp -> let rec loop acc = function | [] -> let sexp_str = Sexp.to_string sexp in failwith ( sprintf "Path.extract_rec: key \"%s\" not found in: %s" key sexp_str) | List [Atom str as sexp; v] :: rest when str = key -> let subst x = List (List.rev_append acc (List [sexp; x] :: rest)) in subst, v | h :: t -> loop (h :: acc) t in loop [] lst | Atom _ as sexp -> illegal_atom "extract_rec" sexp let id x = x let rec subst_option (sup_subst, el) rest = let sub_subst, sub_el = subst_path el rest in let subst x = sup_subst (Some (sub_subst x)) in subst, sub_el and subst_path sexp = function | Pos n :: t -> subst_option (extract_pos n sexp) t | Match (tag, arg_ix) :: t -> subst_option (extract_match tag arg_ix sexp) t | Rec key :: rest -> let rec_subst, el = extract_rec key sexp in let sub_subst, sub_el = subst_path el rest in let subst x = rec_subst (sub_subst x) in subst, sub_el | [] -> id, sexp let implode lst = let len = List.length lst in let str = Bytes.create len in let rec loop ix = function | h :: t -> Bytes.set str ix h; loop (ix + 1) t | [] -> Bytes.unsafe_to_string str in loop 0 lst let fail_parse msg = failwith ("Path.parse: " ^ msg) let parse str = let len = String.length str in if len = 0 then fail_parse "path empty" else let rec loop acc dot_ix = match str.[dot_ix] with | '.' -> let dot_ix1 = dot_ix + 1 in if dot_ix1 = len then List.rev acc else let rec parse_dot acc str_acc ix = if ix = len then List.rev_append acc [Rec (implode (List.rev str_acc))] else match str.[ix] with | '[' -> let rec parse_index index_acc ix = if ix = len then fail_parse "EOF reading index" else match str.[ix], index_acc with | '0'..'9' as c, None -> parse_index (Some (int_of_char c - 48)) (ix + 1) | '0'..'9' as c, Some index_acc -> let new_index_acc = Some (10 * index_acc + int_of_char c - 48) in parse_index new_index_acc (ix + 1) | ']', None -> fail_parse "empty index" | ']', Some index_acc -> let path_el = if str_acc = [] then Pos index_acc else Match (implode (List.rev str_acc), index_acc) in let ix1 = ix + 1 in if ix1 = len then List.rev_append acc [path_el] else loop (path_el :: acc) ix1 | c, _ -> fail_parse ( sprintf "illegal character in index: %c" c) in parse_index None (ix + 1) | '\\' -> let ix1 = ix + 1 in if ix1 = len then fail_parse "EOF after escape" else parse_dot acc (str.[ix1] :: str_acc) (ix + 1) | '.' -> if str_acc = [] then fail_parse "double '.'"; let path_el = Rec (implode (List.rev str_acc)) in parse_dot (path_el :: acc) [] (ix + 1) | c -> parse_dot acc (c :: str_acc) (ix + 1) in parse_dot acc [] dot_ix1 | c -> fail_parse (sprintf "'.' expected; got '%c'" c) in loop [] 0 let get_subst path str sexp = let path = match path, str with | Some path, _ -> path | None, Some str -> parse str | None, None -> [] in subst_path sexp path let get ?path ?str sexp = snd (get_subst path str sexp) let replace ?path ?str sexp ~subst = let subst_fun, _ = get_subst path str sexp in subst_fun subst let replace_no_path ~str sexp ~subst = replace ~str sexp ~subst sexplib-0.13.0/src/path.mli000066400000000000000000000104271356453040600155010ustar00rootroot00000000000000(** Path: Module for Substitutions within S-expressions *) (** {6 Types} *) (** Type of substitution elements *) type el = | Pos of int (** [Pos n] denotes [n]th element in a tuple *) | Match of string * int (** [Match (tag, n)] denotes [n]th argument of sum matching [tag] *) | Rec of string (** [Rec name] denotes the record field having [name] *) (** Type of substitution paths *) type t = el list (** {6 High-level functions} *) val parse : string -> t (** [parse str] @return a substitution path represented by string [str]. Syntax: "." -> separates path elements; must be present at start of string. "\[4\]" -> specifies the 4th element in a tuple. "some_tag\[4\]" -> tries to match [some_tag], then denotes its 4th argument. "name" -> denotes record field having [name] Example from test code: ".t.x.B[1]" -> choose record field with name [t], then subfield [x]. Match this value against [B], and denote its first argument. @raise Failure if the path is syntactically invalid. *) val get : ?path : t -> ?str : string -> Sexp.t -> Sexp.t (** [get ?path ?str sexp] if [path] is provided, use it as path. Otherwise, if [str] is provided, parse it as a path. If neither is provided, assume an empty path. @return the sub-expression from S-expression [sexp] denoted by the path. @raise Failure if path is syntactically invalid or if the path structure clashes with the structure of the data. *) val replace : ?path : t -> ?str : string -> Sexp.t -> subst : Sexp.t -> Sexp.t (** [replace ?path ?str sexp ~subst] like [get], but does not extract a sub-expression but substitutes it with [subst]. @return resulting S-expression. @raise Failure if path is syntactically invalid or if the path structure clashes with the structure of the data. *) val replace_no_path : str : string -> Sexp.t -> subst : Sexp.t -> Sexp.t (** [replace_no_path ~str sexp ~subst] like [replace], but does not take optional arguments. [str] must be specified. @raise Failure if path is syntactically invalid or if the path structure clashes with the structure of the data. *) val subst_path : Sexp.t -> t -> (Sexp.t -> Sexp.t) * Sexp.t (** [subst_path sexp path] @return the tuple [(subst, sub)], where [subst] is a function that returns an S-expression in which the subexpression denoted by [path] in [sexp] has been substituted by its argument. [sub] is the denoted subexpression. Note that [subst sub = sexp]. @raise Failure if path is syntactically invalid or if the path structure clashes with the structure of the data. *) (** {6 Low-level functions} *) val extract_pos : int -> Sexp.t -> (Sexp.t option -> Sexp.t) * Sexp.t (** [extract_pos n sexp] @return the tuple [(subst, sub)], where [subst] is a function that returns an S-expression in which the subexpression denoted at position [n] in [sexp], which must be a list, has been substituted by [value] if the optional argument is [Some value], or removes the denoted subexpression if the optional argument is [None]. [sub] is the denoted subexpression. Note that [subst (Some sub) = sexp]. @raise Failure if the position cannot be resolved within the given S-expression. *) val extract_match : string -> int -> Sexp.t -> (Sexp.t option -> Sexp.t) * Sexp.t (** [extract_match tag n sexp] @return the tuple [(subst, sub)], where [subst] is a function that returns an S-expression in which the subexpression denoted by matching [tag] and taking its [n]th argument in [sexp] has been substituted by [value] if the argument is [Some value], or removes the denoted subexpression if the optional argument is [None]. [sub] is the denoted subexpression. Note that [subst (Some sub) = sexp]. @raise Failure if the S-expression does not represent a sum tag. *) val extract_rec : string -> Sexp.t -> (Sexp.t -> Sexp.t) * Sexp.t (** [extract_rec name sexp] @return the tuple [(subst, sub)], where [subst] is a function that returns an S-expression in which the subexpression denoted by matching field name [name] in [sexp] has been substituted by its argument. [sub] is the denoted subexpression. Note that [subst (Some sub) = sexp]. @raise Failure if the S-expression does not represent a record. *) sexplib-0.13.0/src/pre_sexp.ml000066400000000000000000000654071356453040600162310ustar00rootroot00000000000000(* Sexp: Module for handling S-expressions (I/O, etc.) *) open Format open Bigarray module Sexplib = Sexplib0 module Conv = Sexplib.Sexp_conv (* conv.ml depends on us so we can only use this module *) include Type type bigstring = (char, int8_unsigned_elt, c_layout) Array1.t include (Sexplib.Sexp : module type of struct include Sexplib.Sexp end with type t := t) include Private (* Output of S-expressions to I/O-channels *) let with_new_buffer oc f = let buf = buffer () in f buf; Buffer.output_buffer oc buf let output_hum oc sexp = with_new_buffer oc (fun buf -> to_buffer_hum sexp ~buf) let output_hum_indent indent oc sexp = with_new_buffer oc (fun buf -> to_buffer_hum ~indent sexp ~buf) let output_mach oc sexp = with_new_buffer oc (fun buf -> to_buffer_mach sexp ~buf) let output = output_mach (* Output of S-expressions to file *) (* The temp file functions in the OCaml Filename module do not support permissions. But opening a file with given permissions is different from opening it and chmoding it to these permissions, because the umask is taken in account. Under Unix there's no easy way to get the umask in a thread-safe way. *) module Tmp_file = struct let prng = ref None let temp_file_name prefix suffix = let rand_state = match !prng with | Some v -> v | None -> let ret = Random.State.make_self_init () in prng := Some ret; ret in let rnd = (Random.State.bits rand_state) land 0xFFFFFF in Printf.sprintf "%s%06x%s" prefix rnd suffix (* Keep the permissions loose. Sexps are usually shared and rarely private*) let open_temp_file ?(perm = 0o666) prefix suffix = let rec try_name counter = let name = temp_file_name prefix suffix in try let oc = open_out_gen [Open_wronly; Open_creat; Open_excl; Open_text] perm name in name, oc with Sys_error _ as e -> if counter >= 1000 then raise e else try_name (counter + 1) in try_name 0 end let save_of_output ?perm output_function file sexp = let tmp_name, oc = Tmp_file.open_temp_file ?perm file "tmp" in begin try output_function oc sexp; close_out oc; with e -> close_out_noerr oc; begin try Sys.remove tmp_name with _ -> () end; raise e end; Sys.rename tmp_name file let output_sexp_nl do_output oc sexp = do_output oc sexp; output_string oc "\n" let save_hum ?perm file sexp = save_of_output ?perm (output_sexp_nl output_hum) file sexp let save_mach ?perm file sexp = save_of_output ?perm output_mach file sexp let save = save_mach let output_sexps_nl do_output oc sexps = List.iter (output_sexp_nl do_output oc) sexps let save_sexps_hum ?perm file sexps = save_of_output ?perm (output_sexps_nl output_hum) file sexps let save_sexps_mach ?perm file sexps = save_of_output ?perm (output_sexps_nl output_mach) file sexps let save_sexps = save_sexps_mach (* Scan functions *) let scan_sexp ?buf lexbuf = Parser.sexp (Lexer.main ?buf) lexbuf let scan_sexp_opt ?buf lexbuf = Parser.sexp_opt (Lexer.main ?buf) lexbuf let scan_sexps ?buf lexbuf = Parser.sexps (Lexer.main ?buf) lexbuf let scan_rev_sexps ?buf lexbuf = Parser.rev_sexps (Lexer.main ?buf) lexbuf let get_main_buf buf = let buf = match buf with | None -> Buffer.create 128 | Some buf -> buf in Lexer.main ~buf let scan_fold_sexps ?buf ~f ~init lexbuf = let main = get_main_buf buf in let rec loop acc = match Parser.sexp_opt main lexbuf with | None -> acc | Some sexp -> loop (f acc sexp) in loop init let scan_iter_sexps ?buf ~f lexbuf = scan_fold_sexps ?buf lexbuf ~init:() ~f:(fun () sexp -> f sexp) let scan_sexps_conv ?buf ~f lexbuf = let coll acc sexp = f sexp :: acc in List.rev (scan_fold_sexps ?buf ~f:coll ~init:[] lexbuf) let sexp_conversion_error_message ?containing_sexp ?location ?invalid_sexp () ~exn : t = List (List.concat [ [ Atom "Of_sexp_error" ] ; (match location with None -> [] | Some x -> [ Atom x ]) ; [ match exn with | Failure x -> Atom x |_ -> Conv.sexp_of_exn exn ] ; (match invalid_sexp with | None -> [] | Some x -> [ List [ Atom "invalid_sexp"; x ]]) ; (match containing_sexp with | None -> [] | Some x -> [ List [ Atom "containing_sexp"; x ]])]) (* Partial parsing *) module Annot = struct type pos = Parsexp.Positions.pos = { line : int; col : int; offset : int } type range = Parsexp.Positions.range = { start_pos : pos; end_pos : pos } type t = Atom of range * Type.t | List of range * t list * Type.t type 'a conv = [ `Result of 'a | `Error of exn * t ] exception Conv_exn of string * exn let () = Conv.Exn_converter.add ~finalise:false [%extension_constructor Conv_exn] (function | Conv_exn (location, exn) -> sexp_conversion_error_message () ~location ~exn | _ -> assert false) type stack = { mutable positions : pos list; mutable stack : t list list; } let get_sexp = function Atom (_, sexp) | List (_, _, sexp) -> sexp let get_range = function Atom (range, _) | List (range, _, _) -> range let sexp_of_conv sexp_of_a = function | `Result a -> Type.List [ Atom "Result"; a |> sexp_of_a ] | `Error (exn, t) -> List [ Atom "Error" ; List [ exn |> Conv.sexp_of_exn ; t |> get_sexp ] ] exception Annot_sexp of t let find_sexp annot_sexp sexp = let rec loop annot_sexp = match annot_sexp with | Atom (_, sub_sexp) | List (_, _, sub_sexp) when sexp == sub_sexp -> raise (Annot_sexp annot_sexp) | List (_, annots, _) -> List.iter loop annots | Atom _ -> () in try loop annot_sexp; None with Annot_sexp res -> Some res end let () = Conv.Exn_converter.add ~finalise:false [%extension_constructor Of_sexp_error] (function | Of_sexp_error (Annot.Conv_exn (location, exn), invalid_sexp) -> sexp_conversion_error_message () ~location ~invalid_sexp ~exn | Of_sexp_error (exn, invalid_sexp) -> sexp_conversion_error_message () ~invalid_sexp ~exn | _ -> (* Reaching this branch indicates a bug in sexplib. *) assert false) module Parse_pos = struct type t = { mutable text_line : int; mutable text_char : int; mutable global_offset : int; mutable buf_pos : int; } let create ?(text_line = 1) ?(text_char = 0) ?(buf_pos = 0) ?(global_offset = 0) () = let fail msg = failwith ("Sexplib.Sexp.Parse_pos.create: " ^ msg) in if text_line < 1 then fail "text_line < 1" else if text_char < 0 then fail "text_char < 0" else if global_offset < 0 then fail "global_offset < 0" else if buf_pos < 0 then fail "buf_pos < 0" else { text_line; text_char; global_offset; buf_pos } let with_buf_pos t buf_pos = { t with buf_pos } end module Cont_state = struct type t = Parsexp.Private.Parser_automaton.Old_parser_cont_state.t = | Parsing_toplevel_whitespace | Parsing_nested_whitespace | Parsing_atom | Parsing_list | Parsing_sexp_comment | Parsing_block_comment let to_string = function | Parsing_toplevel_whitespace -> "Parsing_toplevel_whitespace" | Parsing_nested_whitespace -> "Parsing_nested_whitespace" | Parsing_atom -> "Parsing_atom" | Parsing_list -> "Parsing_list" | Parsing_sexp_comment -> "Parsing_sexp_comment" | Parsing_block_comment -> "Parsing_block_comment" end type ('a, 't) parse_result = | Done of 't * Parse_pos.t | Cont of Cont_state.t * ('a, 't) parse_fun and ('a, 't) parse_fun = pos : int -> len : int -> 'a -> ('a, 't) parse_result type 't parse_state = { parse_pos : Parse_pos.t; } type parse_error = { err_msg : string; parse_state : [ | `Sexp of t list list parse_state | `Annot of Annot.stack parse_state ] } exception Parse_error of parse_error let () = Conv.Exn_converter.add ~finalise:false [%extension_constructor Parse_error] (function | Parse_error pe -> let ppos = match pe.parse_state with | `Sexp { parse_pos; } | `Annot { parse_pos; } -> parse_pos in List [ Atom "Sexplib.Sexp.Parse_error"; List [ List [Atom "err_msg"; Atom pe.err_msg]; List [Atom "text_line"; Conv.sexp_of_int ppos.Parse_pos.text_line]; List [Atom "text_char"; Conv.sexp_of_int ppos.Parse_pos.text_char]; List [ Atom "global_offset"; Conv.sexp_of_int ppos.Parse_pos.global_offset ]; List [Atom "buf_pos"; Conv.sexp_of_int ppos.Parse_pos.buf_pos]; ] ] | _ -> assert false) module Parser_output : sig module type T = sig module Impl : Parsexp.Eager_parser type output exception Found of output val raise_found : Impl.State.Read_only.t -> Impl.parsed_value -> unit end module Bare_sexp : T with type output = Type.t module Annotated_sexp : T with type output = Annot.t end = struct module type T = sig module Impl : Parsexp.Eager_parser type output exception Found of output val raise_found : Impl.State.Read_only.t -> Impl.parsed_value -> unit end module I = Parsexp.Positions.Iterator let rec annotate_sexp sexp iter = match sexp with | Type.Atom _ -> let start_pos = I.advance_exn iter ~skip:0 in let end_pos = I.advance_exn iter ~skip:0 in Annot.Atom ({ start_pos; end_pos }, sexp) | Type.List l -> let start_pos = I.advance_exn iter ~skip:0 in let annot = annotate_sexp_list l iter in let end_pos = I.advance_exn iter ~skip:0 in Annot.List ({ start_pos; end_pos }, annot, sexp) and annotate_sexp_list sexps iter = List.rev (List.rev_map (fun sexp -> annotate_sexp sexp iter) sexps) module Bare_sexp = struct module Impl = Parsexp.Eager type output = Type.t exception Found of output let raise_found _state sexp = raise_notrace (Found sexp) end module Annotated_sexp = struct module Impl = Parsexp.Eager_and_positions type output = Annot.t exception Found of output let raise_found _state (sexp, positions) = let annot = annotate_sexp sexp (I.create positions) in raise_notrace (Found annot) end end module Make_parser (T : sig include Parser_output.T type input val length : input -> int val unsafe_feed_loop : Impl.State.t -> Impl.Stack.t -> input -> max_pos:int -> pos:int -> Impl.Stack.t end) : sig val parse : ?parse_pos:Parse_pos.t -> ?len:int -> T.input -> (T.input, T.output) parse_result end = struct let parse_pos_of_state state buf_pos = { Parse_pos.text_line = T.Impl.State.line state; Parse_pos.text_char = T.Impl.State.column state; Parse_pos.global_offset = T.Impl.State.offset state; Parse_pos.buf_pos = buf_pos; } let check_str_bounds ~pos ~len str = if pos < 0 then invalid_arg "parse: pos < 0"; if len < 0 then invalid_arg "parse: len < 0"; let str_len = T.length str in let pos_len = pos + len in if pos_len > str_len then invalid_arg "parse: pos + len > str_len"; pos_len - 1 let raise_parse_error state pos msg = let parse_state = { parse_pos = parse_pos_of_state state pos } in let parse_error = { err_msg = msg ; parse_state = `Sexp parse_state } in raise (Parse_error parse_error) let handle_parsexp_error state pos e = let open Parsexp.Private.Parser_automaton in let msg = Error.message e in match Error.old_parser_exn e with | `Parse_error -> raise_parse_error state pos msg | `Failure -> failwith msg let rec run_feed_loop state stack ~pos ~len str = let max_pos = check_str_bounds ~pos ~len str in let previous_offset = T.Impl.State.offset state in match T.unsafe_feed_loop state stack str ~max_pos ~pos with | stack -> mk_cont_state state stack | exception T.Found result -> let offset = T.Impl.State.offset state in let next_pos = pos + (offset - previous_offset) in Done (result, parse_pos_of_state state next_pos) | exception Parsexp.Private.Parser_automaton.Parse_error err -> handle_parsexp_error state (pos + (T.Impl.State.offset state - previous_offset)) err and mk_cont_state state stack = let parse_fun = let used_ref = ref false in fun ~pos ~len str -> if !used_ref then failwith "Sexplib.Sexp: parser continuation called twice" else begin used_ref := true; run_feed_loop state stack ~pos ~len str end in let cont_state = T.Impl.State.old_parser_cont_state state in Cont (cont_state, parse_fun) let parse ?(parse_pos = Parse_pos.create ()) ?len str = let pos, buf_pos = let { Parse_pos.text_line; text_char; global_offset; buf_pos; } = parse_pos in { Parsexp.Positions. line = text_line ; col = text_char ; offset = global_offset }, buf_pos in let state = T.Impl.State.create ~pos ~no_sexp_is_error:false T.raise_found in let stack = T.Impl.Stack.empty in let len = match len with | Some x -> x | None -> T.length str - buf_pos in run_feed_loop state stack str ~pos:buf_pos ~len end[@@inline always] module String_single_sexp = Make_parser (struct include Parser_output.Bare_sexp type input = string let length = String.length let rec unsafe_feed_loop state stack str ~max_pos ~pos = if pos <= max_pos then begin let stack = Impl.feed state (String.unsafe_get str pos) stack in unsafe_feed_loop state stack str ~max_pos ~pos:(pos + 1) end else stack end) let parse_str = String_single_sexp.parse let parse = String_single_sexp.parse module String_single_annot = Make_parser (struct include Parser_output.Annotated_sexp type input = string let length = String.length let rec unsafe_feed_loop state stack str ~max_pos ~pos = if pos <= max_pos then begin let stack = Impl.feed state (String.unsafe_get str pos) stack in unsafe_feed_loop state stack str ~max_pos ~pos:(pos + 1) end else stack end) let parse_str_annot = String_single_annot.parse module Bigstring_single_sexp = Make_parser (struct include Parser_output.Bare_sexp type input = bigstring let length = Array1.dim let rec unsafe_feed_loop state stack (str : input) ~max_pos ~pos = if pos <= max_pos then begin let stack = Impl.feed state (Array1.unsafe_get str pos) stack in unsafe_feed_loop state stack str ~max_pos ~pos:(pos + 1) end else stack end) let parse_bigstring = Bigstring_single_sexp.parse module Bigstring_single_annot = Make_parser (struct include Parser_output.Annotated_sexp type input = bigstring let length = Array1.dim let rec unsafe_feed_loop state stack (str : input) ~max_pos ~pos = if pos <= max_pos then begin let stack = Impl.feed state (Array1.unsafe_get str pos) stack in unsafe_feed_loop state stack str ~max_pos ~pos:(pos + 1) end else stack end) let parse_bigstring_annot = Bigstring_single_annot.parse (* Input functions *) let mk_this_parse ?parse_pos my_parse = (); fun ~pos ~len str -> let parse_pos = match parse_pos with | None -> Parse_pos.create ~buf_pos:pos () | Some parse_pos -> parse_pos.Parse_pos.buf_pos <- pos; parse_pos in my_parse ?parse_pos:(Some parse_pos) ?len:(Some len) str (* [ws_buf] must contain a single space character *) let feed_end_of_input ~this_parse ~ws_buf = (* When parsing atoms, the incremental parser cannot tell whether it is at the end until it hits whitespace. We therefore feed it one space to determine whether it is finished. *) match this_parse ~pos:0 ~len:1 ws_buf with | Done (sexp, _) -> Ok sexp | Cont (cont_state, _) -> Error cont_state let gen_input_sexp my_parse ?parse_pos ic = let buf = Bytes.create 1 in let rec loop this_parse = match input_char ic with | exception End_of_file -> (match feed_end_of_input ~this_parse ~ws_buf:" " with | Ok sexp -> sexp | Error _ -> raise End_of_file) | c -> Bytes.set buf 0 c; match this_parse ~pos:0 ~len:1 (Bytes.unsafe_to_string buf) with | Done (sexp, _) -> sexp | Cont (_, this_parse) -> loop this_parse in loop (mk_this_parse ?parse_pos my_parse) let input_sexp ?parse_pos ic = gen_input_sexp parse ?parse_pos ic let gen_input_rev_sexps my_parse ~ws_buf ?parse_pos ?(buf = Bytes.create 8192) ic = let rev_sexps_ref = ref [] in let buf_len = Bytes.length buf in let rec loop this_parse ~pos ~len = if len > 0 then match this_parse ~pos ~len (Bytes.unsafe_to_string buf) with | Done (sexp, ({ Parse_pos.buf_pos; _ } as parse_pos)) -> rev_sexps_ref := sexp :: !rev_sexps_ref; let n_parsed = buf_pos - pos in let this_parse = mk_this_parse ~parse_pos my_parse in if n_parsed = len then let new_len = input ic buf 0 buf_len in loop this_parse ~pos:0 ~len:new_len else loop this_parse ~pos:buf_pos ~len:(len - n_parsed) | Cont (_, this_parse) -> loop this_parse ~pos:0 ~len:(input ic buf 0 buf_len) else match feed_end_of_input ~this_parse ~ws_buf with | Ok sexp -> sexp :: !rev_sexps_ref | Error Parsing_toplevel_whitespace -> !rev_sexps_ref | Error cont_state -> failwith ( "Sexplib.Sexp.input_rev_sexps: reached EOF while in state " ^ Cont_state.to_string cont_state) in let len = input ic buf 0 buf_len in let this_parse = mk_this_parse ?parse_pos my_parse in loop this_parse ~pos:0 ~len let input_rev_sexps ?parse_pos ?buf ic = gen_input_rev_sexps parse ~ws_buf:" " ?parse_pos ?buf ic let input_sexps ?parse_pos ?buf ic = List.rev (input_rev_sexps ?parse_pos ?buf ic) (* of_string and of_bigstring *) let of_string_bigstring loc my_parse ws_buf get_len get_sub str = match my_parse ?parse_pos:None ?len:None str with | Done (sexp, parse_pos) -> begin match my_parse ?parse_pos:(Some parse_pos) ?len:None str with | Done (_sexp2, _) -> failwith (sprintf ( "Sexplib.Sexp.%s: got multiple S-expressions where only one was expected." ) loc) | Cont (Cont_state.Parsing_toplevel_whitespace, _) -> sexp | Cont (_, _) -> (* not using [feed_end_of_input] here means "a b" will end up here and not in "multiple S-expressions" branch, but it doesn't matter that much *) failwith (sprintf ( "Sexplib.Sexp.%s: S-expression followed by data at position %d...") loc parse_pos.buf_pos) end | Cont (_, this_parse) -> match feed_end_of_input ~this_parse ~ws_buf with | Ok sexp -> sexp | Error cont_state -> let cont_state_str = Cont_state.to_string cont_state in failwith ( sprintf "Sexplib.Sexp.%s: incomplete S-expression while in state %s: %s" loc cont_state_str (get_sub str 0 (get_len str))) let of_string str = of_string_bigstring "of_string" parse " " String.length String.sub str let get_bstr_sub_str bstr pos len = let str = Bytes.create len in for i = 0 to len - 1 do Bytes.set str i (bstr.{pos + i}) done; Bytes.unsafe_to_string str let bstr_ws_buf = Array1.create char c_layout 1 let () = bstr_ws_buf.{0} <- ' ' let of_bigstring bstr = of_string_bigstring "of_bigstring" parse_bigstring bstr_ws_buf Array1.dim get_bstr_sub_str bstr (* Loading *) let gen_load_rev_sexps input_rev_sexps ?buf file = let ic = open_in file in try let sexps = input_rev_sexps ?parse_pos:None ?buf ic in close_in ic; sexps with exc -> close_in_noerr ic; raise exc let load_rev_sexps ?buf file = gen_load_rev_sexps input_rev_sexps ?buf file let load_sexps ?buf file = List.rev (load_rev_sexps ?buf file) let gen_load_sexp_loc = "Sexplib.Sexp.gen_load_sexp" let gen_load_sexp my_parse ?(strict = true) ?(buf = Bytes.create 8192) file = let buf_len = Bytes.length buf in let ic = open_in file in let rec loop this_parse = let len = input ic buf 0 buf_len in if len = 0 then match feed_end_of_input ~this_parse ~ws_buf:" " with | Ok sexp -> sexp | Error cont_state -> failwith ( sprintf "%s: EOF in %s while in state %s" gen_load_sexp_loc file (Cont_state.to_string cont_state)) else match this_parse ~pos:0 ~len (Bytes.unsafe_to_string buf) with | Done (sexp, ({ Parse_pos.buf_pos; _ } as parse_pos)) when strict -> let rec strict_loop this_parse ~pos ~len = match this_parse ~pos ~len (Bytes.unsafe_to_string buf) with | Done _ -> failwith ( sprintf "%s: more than one S-expression in file %s" gen_load_sexp_loc file) | Cont (cont_state, this_parse) -> let len = input ic buf 0 buf_len in if len > 0 then strict_loop this_parse ~pos:0 ~len else if cont_state = Cont_state.Parsing_toplevel_whitespace then sexp else failwith ( sprintf "%s: %s in state %s loading file %s" gen_load_sexp_loc "additional incomplete data" (Cont_state.to_string cont_state) file) in let this_parse = mk_this_parse ~parse_pos my_parse in strict_loop this_parse ~pos:buf_pos ~len:(len - buf_pos) | Done (sexp, _) -> sexp | Cont (_, this_parse) -> loop this_parse in try let sexp = loop (mk_this_parse my_parse) in close_in ic; sexp with exc -> close_in_noerr ic; raise exc let load_sexp ?strict ?buf file = gen_load_sexp parse ?strict ?buf file module Annotated = struct include Annot let parse = parse_str_annot let parse_bigstring = parse_bigstring_annot let input_rev_sexps ?parse_pos ?buf ic = gen_input_rev_sexps parse ~ws_buf:" " ?parse_pos ?buf ic let input_sexp ?parse_pos ic = gen_input_sexp parse ?parse_pos ic let input_sexps ?parse_pos ?buf ic = List.rev (input_rev_sexps ?parse_pos ?buf ic) let of_string str = of_string_bigstring "Annotated.of_string" parse " " String.length String.sub str let of_bigstring bstr = of_string_bigstring "Annotated.of_bigstring" parse_bigstring bstr_ws_buf Array1.dim get_bstr_sub_str bstr let load_rev_sexps ?buf file = gen_load_rev_sexps input_rev_sexps ?buf file let load_sexps ?buf file = List.rev (load_rev_sexps ?buf file) let load_sexp ?strict ?buf file = gen_load_sexp parse ?strict ?buf file let conv f annot_sexp = let sexp = get_sexp annot_sexp in try `Result (f sexp) with Of_sexp_error (exc, bad_sexp) as e -> match find_sexp annot_sexp bad_sexp with | None -> raise e | Some bad_annot_sexp -> `Error (exc, bad_annot_sexp) let get_conv_exn ~file ~exc annot_sexp = let range = get_range annot_sexp in let { start_pos = { line; col; offset = _ }; end_pos = _ } = range in let loc = sprintf "%s:%d:%d" file line col in Of_sexp_error (Annot.Conv_exn (loc, exc), get_sexp annot_sexp) end let load_sexp_conv ?(strict = true) ?(buf = Bytes.create 8192) file f = let sexp = load_sexp ~strict ~buf file in try `Result (f sexp) with Of_sexp_error _ -> Annotated.conv f (Annotated.load_sexp ~strict ~buf file) let raise_conv_exn ~file = function | `Result res -> res | `Error (exc, annot_sexp) -> raise (Annotated.get_conv_exn ~file ~exc annot_sexp) let load_sexp_conv_exn ?strict ?buf file f = raise_conv_exn ~file (load_sexp_conv ?strict ?buf file f) let load_sexps_conv ?(buf = Bytes.create 8192) file f = let rev_sexps = load_rev_sexps ~buf file in try List.rev_map (fun sexp -> `Result (f sexp)) rev_sexps with Of_sexp_error _ as e -> (match Annotated.load_rev_sexps ~buf file with | [] -> (* File is now empty - perhaps it was a temporary file handle? *) raise e | rev_annot_sexps -> List.rev_map (fun annot_sexp -> Annotated.conv f annot_sexp) rev_annot_sexps) let load_sexps_conv_exn ?(buf = Bytes.create 8192) file f = let rev_sexps = load_rev_sexps ~buf file in try List.rev_map f rev_sexps with Of_sexp_error _ as e -> (match Annotated.load_rev_sexps ~buf file with | [] -> (* File is now empty - perhaps it was a temporary file handle? *) raise e | rev_annot_sexps -> List.rev_map (fun annot_sexp -> raise_conv_exn ~file (Annotated.conv f annot_sexp)) rev_annot_sexps) let gen_of_string_conv of_string annot_of_string str f = let sexp = of_string str in try `Result (f sexp) with Of_sexp_error _ -> Annotated.conv f (annot_of_string str) let of_string_conv str f = gen_of_string_conv of_string Annotated.of_string str f let of_bigstring_conv bstr f = gen_of_string_conv of_bigstring Annotated.of_bigstring bstr f module Of_string_conv_exn = struct type t = { exc : exn; sexp : Type.t; sub_sexp : Type.t } exception E of t let () = Conv.Exn_converter.add ~finalise:false [%extension_constructor E] (function | E osce -> sexp_conversion_error_message () ~invalid_sexp:osce.sub_sexp ~exn:osce.exc ~containing_sexp:osce.sexp | _ -> assert false) end let gen_of_string_conv_exn of_string str f = let sexp = of_string str in try f sexp with Of_sexp_error (exc, sub_sexp) -> raise (Of_string_conv_exn.E { Of_string_conv_exn.exc; sexp; sub_sexp }) let of_string_conv_exn str f = gen_of_string_conv_exn of_string str f let of_bigstring_conv_exn bstr f = gen_of_string_conv_exn of_bigstring bstr f (* Utilities for automated type conversions *) let unit = List [] let is_unit = function | List [] -> true | _ -> false external sexp_of_t : t -> t = "%identity" external t_of_sexp : t -> t = "%identity" (* Utilities for conversion error handling *) type found = [ `Found | `Pos of int * found ] type search_result = [ `Not_found | found ] let rec search_physical sexp ~contained = if sexp == contained then `Found else match sexp with | Atom _ -> `Not_found | List lst -> let rec loop i = function | [] -> `Not_found | h :: t -> let res = search_physical h ~contained in match res with | `Not_found -> loop (i + 1) t | #found as found -> `Pos (i, found) in loop 0 lst let rec subst_found sexp ~subst = function | `Found -> subst | `Pos (pos, found) -> match sexp with | Atom _ -> failwith "Sexplib.Sexp.subst_found: atom when position requested" | List lst -> let rec loop acc pos = function | [] -> failwith "Sexplib.Sexp.subst_found: short list when position requested" | h :: t when pos <> 0 -> loop (h :: acc) (pos - 1) t | h :: t -> List (List.rev_append acc (subst_found h ~subst found :: t)) in loop [] pos lst sexplib-0.13.0/src/sexp.ml000066400000000000000000000000671356453040600153520ustar00rootroot00000000000000include Pre_sexp module With_layout = Sexp_with_layout sexplib-0.13.0/src/sexp.mli000066400000000000000000000001201356453040600155110ustar00rootroot00000000000000(** Sexp: Module for handling S-expressions (I/O, etc.) *) include Sexp_intf.S sexplib-0.13.0/src/sexp_intf.ml000066400000000000000000000625051356453040600163770ustar00rootroot00000000000000(** Sexp_intf: interface specification for handling S-expressions (I/O, etc.) *) open Format open Bigarray module type S = sig (** Type of S-expressions *) type t = Type.t = Atom of string | List of t list (** Type of bigstrings *) type bigstring = (char, int8_unsigned_elt, c_layout) Array1.t val compare : t -> t -> int val equal : t -> t -> bool (** {6 Defaults} *) val default_indent : int ref (** [default_indent] reference to default indentation level for human-readable conversions. Initialisation value: 2. *) (** {6 S-expression size} *) val size : t -> int * int (** [size sexp] @return [(n_atoms, n_chars)], where [n_atoms] is the number of atoms in S-expression [sexp], and [n_chars] is the number of characters in the atoms of the S-expression. *) (** {6 Scan functions} *) val scan_sexp : ?buf : Buffer.t -> Lexing.lexbuf -> t (** [scan_sexp ?buf lexbuf] scans an S-expression from lex buffer [lexbuf] using the optional string buffer [buf] for storing intermediate strings. *) val scan_sexps : ?buf : Buffer.t -> Lexing.lexbuf -> t list (** [scan_sexps ?buf lexbuf] reads a list of whitespace separated S-expressions from lex buffer [lexbuf] using the optional string buffer [buf] for storing intermediate strings. *) val scan_rev_sexps : ?buf : Buffer.t -> Lexing.lexbuf -> t list (** [scan_rev_sexps ?buf lexbuf] same as {!scan_sexps}, but returns the reversed list and is slightly more efficient. *) val scan_sexp_opt : ?buf : Buffer.t -> Lexing.lexbuf -> t option (** [scan_sexp_opt ?buf lexbuf] is equivalent to [scan_sexp ?buf lexbuf] except that it returns [None] when the eof is reached. *) val scan_iter_sexps : ?buf : Buffer.t -> f : (t -> unit) -> Lexing.lexbuf -> unit (** [scan_iter_sexps ?buf ~f lexbuf] iterates over all whitespace separated S-expressions scanned from lex buffer [lexbuf] using function [f], and the optional string buffer [buf] for storing intermediate strings. *) val scan_fold_sexps : ?buf : Buffer.t -> f : ('a -> t -> 'a) -> init : 'a -> Lexing.lexbuf -> 'a (** [scan_fold_sexps ?buf ~f ~init lexbuf] folds over all whitespace separated S-expressions scanned from lex buffer [lexbuf] using function [f], initial state [init], and the optional string buffer [buf] for storing intermediate strings. *) val scan_sexps_conv : ?buf : Buffer.t -> f : (t -> 'a) -> Lexing.lexbuf -> 'a list (** [scan_sexps_conv ?buf ~f lexbuf] maps all whitespace separated S-expressions scanned from lex buffer [lexbuf] to some list using function [f], and the optional string buffer [buf] for storing intermediate strings. *) (** {6 Type and exception definitions for (partial) parsing} *) module Parse_pos : sig (** Position information after complete parse *) type t = Pre_sexp.Parse_pos.t = private { mutable text_line : int; (** Line position in parsed text *) mutable text_char : int; (** Character position in parsed text *) mutable global_offset : int; (** Global/logical offset *) mutable buf_pos : int; (** Read position in string buffer *) } val create : ?text_line : int -> ?text_char : int -> ?buf_pos : int -> ?global_offset : int -> unit -> t (** [create ?text_line ?text_char ?buf_pos ?global_offset ()] @return a parse position with the given parameters. @param text_line default = [1] @param text_char default = [0] @param global_offset default = [0] @param buf_pos default = [0] *) val with_buf_pos : t -> int -> t (** [with_buf_pos t pos] @return a copy of the parse position [t] where [buf_pos] is set to [pos]. *) end module Cont_state : sig (** State of parser continuations *) type t = Pre_sexp.Cont_state.t = | Parsing_toplevel_whitespace | Parsing_nested_whitespace | Parsing_atom | Parsing_list | Parsing_sexp_comment | Parsing_block_comment val to_string : t -> string (** [to_string cont_state] converts state of parser continuation [cont_state] to a string. *) end (** Type of result from calling {!Sexp.parse}. *) type ('a, 't) parse_result = ('a, 't) Pre_sexp.parse_result = | Done of 't * Parse_pos.t (** [Done (t, parse_pos)] finished parsing an S-expression. Current parse position is [parse_pos]. *) | Cont of Cont_state.t * ('a, 't) parse_fun (** [Cont (cont_state, parse_fun)] met the end of input before completely parsing an S-expression. The user has to call [parse_fun] to continue parsing the S-expression in another buffer. [cont_state] is the current parsing state of the continuation. NOTE: the continuation may only be called once and will raise [Failure] otherwise! *) (** Type of parsing functions with given offsets and lengths. *) and ('a, 't) parse_fun = pos : int -> len : int -> 'a -> ('a, 't) parse_result (** Module for parsing S-expressions annotated with location information *) module Annotated : sig (** Position information for annotated S-expressions *) type pos = Pre_sexp.Annotated.pos = { line : int; col : int; offset : int; } (** Range information for annotated S-expressions *) type range = Pre_sexp.Annotated.range = { start_pos : pos; end_pos : pos } (** S-expression annotated with location information *) type t = Pre_sexp.Annotated.t = | Atom of range * Type.t | List of range * t list * Type.t (** Type of conversion results of annotated S-expressions. *) type 'a conv = [ `Result of 'a | `Error of exn * t ] val sexp_of_conv : ('a -> Type.t) -> 'a conv -> Type.t (** Exception associated with conversion errors. First argument describes the location, the second the reason. *) exception Conv_exn of string * exn (** Stack used by annotation parsers *) type stack = Pre_sexp.Annotated.stack = { mutable positions : pos list; mutable stack : t list list; } val get_sexp : t -> Type.t (** [get_sexp annot_sexp] @return S-expression associated with annotated S-expression [annot_sexp]. *) val get_range : t -> range (** [get_range annot_sexp] @return the range associated with annotated S-expression [annot_sexp]. *) val find_sexp : t -> Type.t -> t option (** [find_sexp annot_sexp sexp] @return [Some res] where [res] is the annotated S-expression that is physically equivalent to [sexp] in [annot_sexp], or [None] if there is no such S-expression. *) (** {6 Annotated (partial) parsing} *) val parse : ?parse_pos : Parse_pos.t -> ?len : int -> string -> (string, t) parse_result (** [parse ?parse_pos ?len str] same as {!parse}, but returns an S-expression annotated with location information. *) val parse_bigstring : ?parse_pos : Parse_pos.t -> ?len : int -> bigstring -> (bigstring, t) parse_result (** [parse_bigstring ?parse_pos ?len str] same as {!parse_bigstring}, but returns an S-expression annotated with location information. *) val input_sexp : ?parse_pos : Parse_pos.t -> in_channel -> t (** [input_sexp ?parse_pos ic] like {!input_sexp}, but returns an annotated S-expression instead. *) val input_sexps : ?parse_pos : Parse_pos.t -> ?buf : bytes -> in_channel -> t list (** [input_sexps ?parse_pos ?buf ic] like {!input_sexps}, but returns a list of annotated S-expressions. *) val input_rev_sexps : ?parse_pos : Parse_pos.t -> ?buf : bytes -> in_channel -> t list (** [input_sexps ?parse_pos ?buf ic] like {!input_rev_sexps}, but returns a list of annotated S-expressions. *) (** {6 Loading of annotated S-expressions} *) (** NOTE: these functions should only be used if an annotated S-expression is required. *) val load_sexp : ?strict : bool -> ?buf : bytes -> string -> t (** [load_sexp ?strict ?buf file] like {!load_sexp}, but returns an annotated S-expression. *) val load_sexps : ?buf : bytes -> string -> t list (** [load_sexps ?buf file] like {!load_sexps}, but returns a list of annotated S-expressions. *) val load_rev_sexps : ?buf : bytes -> string -> t list (** [load_rev_sexps ?buf file] like {!load_rev_sexps}, but returns a list of annotated S-expressions. *) (** {6 String and bigstring conversions} *) val of_string : string -> t (** [of_string str] same as {!of_string}, but returns an annotated S-expression. *) val of_bigstring : bigstring -> t (** [of_bigstring bstr] same as {!of_string}, but operates on bigstrings. *) (** Converters using annotations for determining error locations *) val conv : (Type.t -> 'a) -> t -> 'a conv (** [conv f annot_sexp] converts the S-expression associated with annotated S-expression [annot_sexp] using [f]. @return [`Result res] on success, or [`Error (exn, sub_annot_sexp)] otherwise, where [exn] is the exception associated with the conversion error, and [sub_annot_sexp] is the annotated S-expression on which conversion failed. *) val get_conv_exn : file : string -> exc : exn -> t -> exn (** [get_conv_exn ~file ~exc annot_sexp] @return the exception that would be raised for a given [file] and exception [exc] if conversion had failed on annotated S-expression [annot_sexp]. The format of the exception message is "file:line:col" *) end (** Type of state maintained during parsing *) type 't parse_state = 't Pre_sexp.parse_state = private { parse_pos : Parse_pos.t; (** Current parse position *) } (** Type of parse errors *) type parse_error = Pre_sexp.parse_error = { err_msg : string; (** Reason why parsing failed *) parse_state : [ | `Sexp of t list list parse_state | `Annot of Annotated.stack parse_state ] (** State of parser *) } (** Exception raised during partial parsing *) exception Parse_error of parse_error (** {6 Unannotated (partial) parsing} *) val parse : ?parse_pos : Parse_pos.t -> ?len : int -> string -> (string, t) parse_result (** [parse ?parse_pos ?len str] (partially) parses an S-expression in string buffer [str] starting out with position information provided in [parse_pos] and reading at most [len] characters. To parse a single atom that is not delimited by whitespace it is necessary to call this function a second time with the returned continuation, and a dummy buffer that contains whitespace. [parse] starts parsing [str] at position [parse_pos.buf_pos]. Each subsequent [parse_fun] from a [Cont] uses the [buf] and [pos] that is supplied to it. The final [parse_fun] that returns [Done] mutates the [buf_pos] in the originally supplied [parse_pos], and then returns it. @param parse_pos default = [Parse_pos.create ()] @param len default = [String.length str - parse_pos.Parse_pos.buf_pos] *) val parse_bigstring : ?parse_pos : Parse_pos.t -> ?len : int -> bigstring -> (bigstring, t) parse_result (** [parse_bigstring ?parse_pos ?len str] same as {!parse}, but operates on bigstrings. *) val input_sexp : ?parse_pos : Parse_pos.t -> in_channel -> t (** [input_sexp ?parse_pos ic] parses an S-expression from input channel [ic] using initial position information in [parse_pos]. NOTE: this function is not as fast on files as {!Sexp.load_sexp}, and is also slightly slower than the scan-functions. But it is guaranteed that [input_sexp] is only going to read data parseable as an S-expression. Thus, subsequent input functions will see the data immediately following it. @param parse_pos default = [Parse_pos.create ()] *) val input_sexps : ?parse_pos : Parse_pos.t -> ?buf : bytes -> in_channel -> t list (** [input_sexps ?parse_pos ?buf ic] parses whitespace separated S-expressions from input channel [ic] until EOF is reached. Faster than the scan-functions. @param parse_pos default = [Parse_pos.create ()] *) val input_rev_sexps : ?parse_pos : Parse_pos.t -> ?buf : bytes -> in_channel -> t list (** [input_rev_sexps ?parse_pos ?buf ic] same as {!Sexp.input_sexps}, but returns a reversed list of S-expressions, which is slightly more efficient. *) (** {6 Loading of (converted) S-expressions} *) val load_sexp : ?strict : bool -> ?buf : bytes -> string -> t (** [load_sexp ?strict ?buf file] reads one S-expression from [file] using buffer [buf] for storing intermediate data. Faster than the scan-functions. @raise Parse_error if the S-expression is unparseable. @raise Failure if parsing reached the end of file before one S-expression could be read. @raise Failure if [strict] is true and there is more than one S-expression in the file. @param strict default = [true] *) val load_sexps : ?buf : bytes -> string -> t list (** [load_sexps ?buf file] reads a list of whitespace separated S-expressions from [file] using buffer [buf] for storing intermediate data. Faster than the scan-functions. @raise Parse_error if there is unparseable data in the file. @raise Failure if parsing reached the end of file before the last S-expression could be fully read. *) val load_rev_sexps : ?buf : bytes -> string -> t list (** [load_rev_sexps ?buf file] same as {!Sexp.load_sexps}, but returns a reversed list of S-expressions, which is slightly more efficient. *) val load_sexp_conv : ?strict : bool -> ?buf : bytes -> string -> (t -> 'a) -> 'a Annotated.conv (** [load_sexp_conv ?strict ?buf file f] like {!Sexp.load_sexp}, but performs a conversion on the fly using [f]. Performance is equivalent to executing {!Sexp.load_sexp} and performing conversion when there are no errors. In contrast to the plain S-expression loader, this function not only performs the conversion, it will give exact error ranges for conversion errors. @raise Parse_error if there is unparseable data in the file. @raise Failure if parsing reached the end of file before the last S-expression could be fully read. *) val load_sexp_conv_exn : ?strict : bool -> ?buf : bytes -> string -> (t -> 'a) -> 'a (** [load_sexp_conv_exn ?strict ?buf file f] like {!load_sexp_conv}, but returns the converted value or raises [Of_sexp_error] with exact location information in the case of a conversion error. *) val load_sexps_conv : ?buf : bytes -> string -> (t -> 'a) -> 'a Annotated.conv list (** [load_sexps_conv ?buf file f] like {!Sexp.load_sexps}, but performs a conversion on the fly using [f]. Performance is equivalent to executing {!Sexp.load_sexps} and performing conversion when there are no errors. In contrast to the plain S-expression loader, this function not only performs the conversion, it will give exact error ranges for conversion errors. @raise Parse_error if there is unparseable data in the file. @raise Failure if parsing reached the end of file before the last S-expression could be fully read. *) val load_sexps_conv_exn : ?buf : bytes -> string -> (t -> 'a) -> 'a list (** [load_sexps_conv_exn ?buf file f] like {!load_sexps_conv}, but returns the converted value or raises [Of_sexp_error] with exact location information in the case of a conversion error. *) (** {6 Output of S-expressions to I/O-channels} *) (** NOTE: for performance reasons these output functions may need to allocate large strings to write out huge S-expressions. This may cause problems on 32-bit platforms. If you think that you may need to write huge S-expressions on such platforms, you might want to use the pretty-printers that write to formatters instead (see further below). *) val output_hum : out_channel -> t -> unit (** [output_hum oc sexp] outputs S-expression [sexp] to output channel [oc] in human readable form. *) val output_hum_indent : int -> out_channel -> t -> unit (** [output_hum_indent indent oc sexp] outputs S-expression [sexp] to output channel [oc] in human readable form using indentation level [indent]. *) val output_mach : out_channel -> t -> unit (** [output_mach oc sexp] outputs S-expression [sexp] to output channel [oc] in machine readable (i.e. most compact) form. *) val output : out_channel -> t -> unit (** [output oc sexp] same as [output_mach]. *) (** {6 Output of S-expressions to file} *) (** All save-functions write to a temporary file before moving it into place to avoid intermittent garbling of existing files, which may cause problems for other processes that try to read. *) val save_hum : ?perm : int -> string -> t -> unit (** [save_hum ?perm file sexp] outputs S-expression [sexp] to [file] in human readable form. @param perm default = umask *) val save_mach : ?perm : int -> string -> t -> unit (** [save_mach ?perm file sexp] outputs S-expression [sexp] to [file] in machine readable (i.e. most compact) form. @param perm default = umask *) val save : ?perm : int -> string -> t -> unit (** [save ?perm file sexp] same as {!save_mach}. *) val save_sexps_hum : ?perm : int -> string -> t list -> unit (** [save_sexps_hum ?perm file sexps] outputs S-expression list [sexps] to [file] in human readable form, each sexp being followed by a newline. @param perm default = umask *) val save_sexps_mach : ?perm : int -> string -> t list -> unit (** [save_sexps_mach ?perm file sexps] outputs S-expression list [sexps] to [file] in machine readable form, each sexp being followed by a newline. @param perm default = umask *) val save_sexps : ?perm : int -> string -> t list -> unit (** [save_sexps ?perm file sexp] same as {!save_sexps_mach}. *) (** {6 Output of S-expressions to formatters} *) val pp_hum : formatter -> t -> unit (** [pp_hum ppf sexp] outputs S-expression [sexp] to formatter [ppf] in human readable form. *) val pp_hum_indent : int -> formatter -> t -> unit (** [pp_hum_indent n ppf sexp] outputs S-expression [sexp] to formatter [ppf] in human readable form and indentation level [n]. *) val pp_mach : formatter -> t -> unit (** [pp_mach ppf sexp] outputs S-expression [sexp] to formatter [ppf] in machine readable (i.e. most compact) form. *) val pp : formatter -> t -> unit (** [pp ppf sexp] same as [pp_mach]. *) (** {6 String and bigstring conversions} *) (** Module encapsulating the exception raised by string converters when type conversions fail. *) module Of_string_conv_exn : sig type t = { exc : exn; sexp : Type.t; sub_sexp : Type.t } exception E of t end val of_string : string -> t (** [of_string str] converts string [str] to an S-expression. NOTE: trailing whitespace is considered an error, which may be overly strict for some applications. Either strip the string of trailing whitespace first, or, even cheaper, use {!parse} instead. *) val of_string_conv : string -> (t -> 'a) -> 'a Annotated.conv (** [of_string_conv str conv] like {!of_string}, but performs type conversion with [conv]. @return conversion result. *) val of_string_conv_exn : string -> (t -> 'a) -> 'a (** [of_string_conv_exn str conv] like {!of_string_conv}, but raises {!Of_string_conv_exn.E} if type conversion fails. @return converted value. *) val of_bigstring : bigstring -> t (** [of_bigstring bstr] same as {!of_string}, but operates on bigstrings. *) val of_bigstring_conv : bigstring -> (t -> 'a) -> 'a Annotated.conv (** [of_bigstring_conv bstr conv] like {!of_bigstring}, but performs type conversion with [conv]. @return conversion result. *) val of_bigstring_conv_exn : bigstring -> (t -> 'a) -> 'a (** [of_bigstring_conv_exn bstr conv] like {!of_bigstring_conv}, but raises {!Of_string_conv_exn.E} if type conversion fails. @return converted value. *) val to_string_hum : ?indent : int -> t -> string (** [to_string_hum ?indent sexp] converts S-expression [sexp] to a string in human readable form with indentation level [indent]. @param indent default = [!default_indent] *) val to_string_mach : t -> string (** [to_string_mach sexp] converts S-expression [sexp] to a string in machine readable (i.e. most compact) form. *) val to_string : t -> string (** [to_string sexp] same as [to_string_mach]. *) (** {6 Buffer conversions} *) val to_buffer_hum : buf : Buffer.t -> ?indent : int -> t -> unit (** [to_buffer_hum ~buf ?indent sexp] outputs the S-expression [sexp] converted to a string in human readable form to buffer [buf]. @param indent default = [!default_indent] *) val to_buffer_mach : buf : Buffer.t -> t -> unit (** [to_buffer_mach ~buf sexp] outputs the S-expression [sexp] converted to a string in machine readable (i.e. most compact) form to buffer [buf]. *) val to_buffer : buf : Buffer.t -> t -> unit (** [to_buffer ~buf sexp] same as {!to_buffer_mach}. *) val to_buffer_gen : buf : 'buffer -> add_char : ('buffer -> char -> unit) -> add_string : ('buffer -> string -> unit) -> t -> unit (** [to_buffer_gen ~buf ~add_char ~add_string sexp] outputs the S-expression [sexp] converted to a string to buffer [buf] using the output functions [add_char] and [add_string]. *) (** {6 Utilities for automated type conversions} *) val unit : t (** [unit] the unit-value as expressed by an S-expression. *) val is_unit : t -> bool val sexp_of_t : t -> t (** [sexp_of_t sexp] maps S-expressions which are part of a type with automated S-expression conversion to themselves. *) val t_of_sexp : t -> t (** [t_of_sexp sexp] maps S-expressions which are part of a type with automated S-expression conversion to themselves. *) (** {6 Utilities for conversion error handling} *) type found = [ `Found | `Pos of int * found ] (** Type of successful search results. [`Found] means that an S-expression was found at the immediate position, and [`Pos (pos, found)] indicates that it was found at position [pos] within a structure (= S-expression list) where [found] describes recursively where it was found in that structure. *) type search_result = [ `Not_found | found ] (** Type of search results. [`Not_found] means that an S-expression was not found within another S-expression. *) val search_physical : t -> contained : t -> search_result (** [search_physical sexp ~contained] @return the search result indicating whether, and if, where the S-expression [contained] was found within S-expression [sexp]. *) val subst_found : t -> subst : t -> found -> t (** [subst_found sexp ~subst found] @return the S-expression that results from substituting [subst] within S-expression [sexp] at the location described by [found]. *) (** S-expressions annotated with relative source positions and comments *) module With_layout : sig (* relative source positions *) type pos = Src_pos.Relative.t = { row : int; col : int } val sexp_of_pos : pos -> Type.t (** S-expressions annotated with relative source positions and comments. All the positions are relative to the opening paren of the enclosing list, or the first character of the file. *) type t = Type_with_layout.t = | Atom of pos * string * string option (* second is quoted representation *) | List of pos * t_or_comment list * pos (* positions of left and right parens *) and t_or_comment = Type_with_layout.t_or_comment = | Sexp of t | Comment of comment and comment = Type_with_layout.comment = | Plain_comment of pos * string (* line or block comment *) | Sexp_comment of pos * comment list * t (* position of #; *) val sexp_of_t : t -> Type.t val sexp_of_comment : comment -> Type.t val sexp_of_t_or_comment : t_or_comment -> Type.t module Forget : sig val t : t -> Type.t val t_or_comment : t_or_comment -> Type.t option val t_or_comments : t_or_comment list -> Type.t list end module Render : sig type asexp type 'a t (* monad for position-respecting asexp rendering *) val return : 'a -> 'a t val bind : 'a t -> f:('a -> 'b t) -> 'b t val sexp : asexp -> unit t (* assumes that positions in [asexp] are relative *) val run : (char -> unit) -> unit t -> unit end with type asexp := t_or_comment module Parser : sig type token val sexp : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> t_or_comment val sexp_opt : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> t_or_comment option val sexps : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> t_or_comment list val rev_sexps : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> t_or_comment list (* for debugging only, cannot be used otherwise anyway *) val sexps_abs : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Type_with_layout.Parsed.t_or_comment list end module Lexer : sig val main : ?buf:Buffer.t -> Lexing.lexbuf -> Parser.token end end end sexplib-0.13.0/src/sexp_with_layout.ml000066400000000000000000000140121356453040600177750ustar00rootroot00000000000000(* packaging of annotated sexp functions *) module List = struct let iter t ~f = List.iter f t let map t ~f = List.rev (List.rev_map f t) end include Type_with_layout type pos = Src_pos.Relative.t = { row : int; col : int } let sexp_of_pos = Src_pos.Relative.sexp_of_t module Lexer = struct let main = Lexer.main_with_layout end module Parser = Parser_with_layout module Render = struct module Rel_pos = Src_pos.Relative module Abs_pos = Src_pos.Absolute type last_atom = { immed_after : Abs_pos.t; unescaped : bool; } type state = { mutable row_shift : Rel_pos.t; mutable current : Abs_pos.t; mutable last_atom : last_atom option; mutable last_comment_row : int; } (* the point of [immed_after_last_atom] is to prevent (A B C) from rendering as (A BBC) after we replace B with BB *) type 'a t = (char -> unit) -> state -> 'a let return a _putc _st = a let bind m ~f putc st = f (m putc st) putc st let run putc m = m putc { row_shift = Rel_pos.zero; current = Abs_pos.origin; last_atom = None; last_comment_row = 0; (* before the file starts *) } let emit_char putc st c = let {Abs_pos.col; row} = st.current in putc c; if c = '\n' then st.current <- {Abs_pos.row = 1 + row; col = 1} else st.current <- {Abs_pos.row; col = 1 + col} let emit_string putc st str = let n = String.length str in for i = 0 to n - 1 do emit_char putc st str.[i] done let emit_chars putc st c ~n = emit_string putc st (String.make n c) let advance putc ~anchor st ~by:delta ~unescaped_atom ~line_comment = let new_pos = Abs_pos.add (Abs_pos.add anchor delta) st.row_shift in let need_to_leave_room_between_two_unescaped_atoms_lest_they_become_one = unescaped_atom && begin match st.last_atom with | Some {immed_after; unescaped = prev_unescaped} -> new_pos = immed_after && prev_unescaped | None -> false end in (* avoid joining subsequent items into a preceding line comment *) let need_to_clear_line_comment = (new_pos.row = st.last_comment_row) in let need_to_reposition = not (Abs_pos.geq new_pos st.current) || need_to_clear_line_comment || need_to_leave_room_between_two_unescaped_atoms_lest_they_become_one in let (row_delta, new_pos) = if need_to_reposition then begin (* repositioning heuristic: just move to the next fresh row *) let new_row = 1 + st.current.Abs_pos.row in let row_delta = new_row - new_pos.Abs_pos.row in (row_delta, {Abs_pos.row = new_row; col = new_pos.Abs_pos.col}) end else (0, new_pos) in begin (* advance to new_pos by emitting whitespace *) if new_pos.Abs_pos.row > st.current.Abs_pos.row then begin let n = (new_pos.Abs_pos.row - st.current.Abs_pos.row) in emit_chars putc st '\n' ~n end; if new_pos.Abs_pos.col > st.current.Abs_pos.col then begin let n = (new_pos.Abs_pos.col - st.current.Abs_pos.col) in emit_chars putc st ' ' ~n end; end; assert (new_pos = st.current); if line_comment then ( st.last_comment_row <- st.current.row ); st.row_shift <- { st.row_shift with Rel_pos. row = st.row_shift.Rel_pos.row + row_delta; } let rec render_t putc ~anchor (st : state) t = match t with | Atom (delta, text, fmt_text) -> let fmt_text = match fmt_text with | None | Some "" -> Pre_sexp.mach_maybe_esc_str text | Some text -> text in let unescaped = fmt_text.[0] <> '"' in advance putc st ~by:delta ~anchor ~unescaped_atom:unescaped ~line_comment:false; emit_string putc st fmt_text; st.last_atom <- Some { immed_after = st.current; unescaped; }; | List (start_delta, tocs, end_delta) -> advance putc st ~by:start_delta ~anchor ~unescaped_atom:false ~line_comment:false; let child_anchor = Abs_pos.sub st.current st.row_shift in emit_char putc st '('; List.iter tocs ~f:(fun toc -> render_toc putc ~anchor:child_anchor st toc); advance putc st ~by:end_delta ~anchor ~unescaped_atom:false ~line_comment:false; emit_char putc st ')'; () and render_toc putc ~anchor st = function | Sexp t -> render_t putc ~anchor st t | Comment c -> render_c putc ~anchor st c and render_c putc ~anchor st = function | Plain_comment (delta, text) -> let line_comment = String.length text > 0 && text.[0] = ';' in advance putc st ~by:delta ~anchor ~unescaped_atom:false ~line_comment; emit_string putc st text | Sexp_comment (delta, cs, t) -> advance putc st ~by:delta ~anchor ~unescaped_atom:false ~line_comment:false; emit_string putc st "#;"; List.iter cs ~f:(render_c putc ~anchor st); render_t putc ~anchor st t let render asexp putc st = render_toc putc ~anchor:Abs_pos.origin st asexp let sexp = render end module Forget = struct (* In cps to prevent non-tail recursion. The polymorphism in the signature ensures that each function returns only through the continuation. *) module Cps : sig val forget_t : t -> (Type.t -> 'r) -> 'r val forget_toc : t_or_comment -> (Type.t option -> 'r) -> 'r val forget_tocs : t_or_comment list -> (Type.t list -> 'r) -> 'r end = struct let rec forget_t t k = match t with | Atom (_, x, _) -> k (Type.Atom x) | List (_, tocs, _) -> forget_tocs tocs (fun xs -> k (Type.List xs)) and forget_tocs tocs k = match tocs with | [] -> k [] | toc :: tocs -> forget_toc toc (function | None -> forget_tocs tocs k | Some x -> forget_tocs tocs (fun xs -> k (x :: xs))) and forget_toc toc k = match toc with | Comment _ -> k None | Sexp t -> forget_t t (fun x -> k (Some x)) end let t x = Cps.forget_t x (fun y -> y) let t_or_comment x = Cps.forget_toc x (fun y -> y) let t_or_comments x = Cps.forget_tocs x (fun y -> y) end sexplib-0.13.0/src/src_pos.ml000066400000000000000000000020571356453040600160440ustar00rootroot00000000000000(* for lexing positions: - lnum starts from 1 - cnum starts from 0 - pos_bol is the position of the first character of the line for absolute pos: - row starts from 1 - col starts from 1 for relative pos, obviously 0 means same position *) (* operations that make sense for both absolute and relative positions *) module Pos = struct type t = { row : int; col : int } let sexp_of_t {row; col} = Type.Atom (Printf.sprintf "%d:%d" row col) let add t1 t2 = { row = t1.row + t2.row; col = t1.col + t2.col; } let sub t1 t2 = { row = t1.row - t2.row; col = t1.col - t2.col; } let compare {row = r1; col = c1} {row = r2; col = c2} = if r1 = r2 then c1 - c2 else r1 - r2 let geq t1 t2 = compare t1 t2 >= 0 end module Relative = struct include Pos let zero = {row = 0; col = 0} end module Absolute = struct include Pos let origin = {row = 1; col = 1} let of_lexing {Lexing.pos_lnum; pos_cnum; pos_bol; pos_fname = _ } = { row = pos_lnum; col = pos_cnum - pos_bol + 1; } let diff = sub end sexplib-0.13.0/src/src_pos.mli000066400000000000000000000010571356453040600162140ustar00rootroot00000000000000(** source positions, both relative and absolute *) module Relative : sig type t = { row : int; col : int } val sexp_of_t : t -> Type.t val zero : t val add : t -> t -> t val sub : t -> t -> t end module Absolute : sig type t = { row : int; col : int } val sexp_of_t : t -> Type.t val origin : t (* first row, first column *) val of_lexing : Lexing.position -> t val diff : t -> t -> Relative.t val add : t -> Relative.t -> t val sub : t -> Relative.t -> t (*val compare : t -> t -> int*) val geq : t -> t -> bool end sexplib-0.13.0/src/std.ml000066400000000000000000000025461356453040600151710ustar00rootroot00000000000000module Hashtbl = struct include Hashtbl let sexp_of_t = Conv.sexp_of_hashtbl let t_of_sexp = Conv.hashtbl_of_sexp end module Lazy = struct include Lazy let t_of_sexp = Conv.lazy_t_of_sexp let sexp_of_t = Conv.sexp_of_lazy_t end let sexp_of_unit = Conv.sexp_of_unit let unit_of_sexp = Conv.unit_of_sexp let sexp_of_bool = Conv.sexp_of_bool let bool_of_sexp = Conv.bool_of_sexp let sexp_of_string = Conv.sexp_of_string let string_of_sexp = Conv.string_of_sexp let sexp_of_char = Conv.sexp_of_char let char_of_sexp = Conv.char_of_sexp let sexp_of_int = Conv.sexp_of_int let int_of_sexp = Conv.int_of_sexp let sexp_of_float = Conv.sexp_of_float let float_of_sexp = Conv.float_of_sexp let sexp_of_int32 = Conv.sexp_of_int32 let int32_of_sexp = Conv.int32_of_sexp let sexp_of_int64 = Conv.sexp_of_int64 let int64_of_sexp = Conv.int64_of_sexp let sexp_of_nativeint = Conv.sexp_of_nativeint let nativeint_of_sexp = Conv.nativeint_of_sexp let sexp_of_ref = Conv.sexp_of_ref let ref_of_sexp = Conv.ref_of_sexp let sexp_of_lazy_t = Conv.sexp_of_lazy_t let lazy_t_of_sexp = Conv.lazy_t_of_sexp let sexp_of_option = Conv.sexp_of_option let option_of_sexp = Conv.option_of_sexp let sexp_of_list = Conv.sexp_of_list let list_of_sexp = Conv.list_of_sexp let sexp_of_array = Conv.sexp_of_array let array_of_sexp = Conv.array_of_sexp let sexp_of_exn = Conv.sexp_of_exn sexplib-0.13.0/src/type.ml000066400000000000000000000001301356453040600153430ustar00rootroot00000000000000(** Type of S-expressions *) type t = Sexplib0.Sexp.t = Atom of string | List of t list sexplib-0.13.0/src/type_with_layout.ml000066400000000000000000000073611356453040600200100ustar00rootroot00000000000000(** Type of annotated S-expressions *) module List = struct let map t ~f = List.rev (List.rev_map f t) end module Make (Pos : sig type t val sexp_of_t : t -> Type.t end) = struct module T = struct (** In [Atom (_, s, opt)], [s] is the unescaped string, that is the argument of [Type.Atom]. When [opt] is defined, it is the source syntax of [s], that is a string that can be printed as is if one wants to parse and print preserving syntax. This is usually set for quoted atoms (to preserve the fact that were quoted), but it can be useful to do the reverse: set it for atoms that can be parsed unquoted but would be printed with quotes, to preserve the lack of quotes. For instance: Atom (_, "a", None) should be printed {|a|} Atom (_, "a b", None) should be printed {|"a b"|} Atom (_, "a", Some "\"a\"") should be printed {|"a"|} Atom (_, "a b", Some "a b") should be printed {|a b|} or may raise, as it is an error to constructed such an atom (doesn't parse back) *) type t = | Atom of Pos.t * string * string option | List of Pos.t * t_or_comment list * Pos.t (* positions of left and right parens *) and t_or_comment = | Sexp of t | Comment of comment and comment = | Plain_comment of Pos.t * string | Sexp_comment of Pos.t * comment list * t end include T module type S = sig include module type of T val sexp_of_t : t -> Type.t val sexp_of_comment : comment -> Type.t val sexp_of_t_or_comment : t_or_comment -> Type.t end module To_sexp : sig val of_t : t -> Type.t val of_comment : comment -> Type.t val of_t_or_comment : t_or_comment -> Type.t end = struct (* maybe we can actually use conv here, instead of inlining it *) let of_pos = Pos.sexp_of_t let of_string x = Type.Atom x let of_list of_a xs = Type.List (List.map ~f:of_a xs) let of_option of_a = function | Some x -> Type.List [of_a x] | None -> Type.List [] let rec of_t = function | Atom (v1, v2, v3) -> Type.List [Type.Atom "Atom"; of_pos v1; of_string v2; of_option of_string v3] | List (v1, v2, v3) -> Type.List [Type.Atom "List"; of_pos v1; of_list of_t_or_comment v2; of_pos v3] and of_t_or_comment = function | Sexp t -> Type.List [Type.Atom "Sexp"; of_t t] | Comment c -> Type.List [Type.Atom "Comment"; of_comment c] and of_comment = function | Plain_comment (v1, v2) -> Type.List [Type.Atom "Plain_comment"; of_pos v1; of_string v2] | Sexp_comment (v1, v2, v3) -> Type.List [Type.Atom "Sexp_comment"; of_pos v1; of_list of_comment v2; of_t v3] end let sexp_of_t = To_sexp.of_t let sexp_of_comment = To_sexp.of_comment let sexp_of_t_or_comment = To_sexp.of_t_or_comment end include Make (Src_pos.Relative) module Parsed = Make (Src_pos.Absolute) let relativize = let rel ~outer_p p = Src_pos.Absolute.diff p outer_p in let rec aux_t ~outer_p = function | Parsed.Atom (pos, s, sopt) -> Atom (rel pos ~outer_p, s, sopt) | Parsed.List (start_pos, tocs, end_pos) -> List ( rel start_pos ~outer_p , List.map tocs ~f:(fun toc -> aux_toc ~outer_p:start_pos toc) , rel end_pos ~outer_p ) and aux_toc ~outer_p = function | Parsed.Sexp t -> Sexp (aux_t t ~outer_p) | Parsed.Comment c -> Comment (aux_c c ~outer_p) and aux_c ~outer_p = function | Parsed.Plain_comment (pos, txt) -> Plain_comment (rel pos ~outer_p, txt) | Parsed.Sexp_comment (pos, cs, t) -> Sexp_comment ( rel pos ~outer_p , List.map cs ~f:(fun c -> aux_c ~outer_p c) , aux_t t ~outer_p ) in fun toc -> aux_toc toc ~outer_p:Src_pos.Absolute.origin sexplib-0.13.0/src/type_with_layout.mli000066400000000000000000000017671356453040600201650ustar00rootroot00000000000000(** S-expressions annotated with relative source positions and comments *) module Make (Pos : sig type t val sexp_of_t : t -> Type.t end) : sig module type S = sig (** S-expressions annotated with relative source positions and comments *) type t = | Atom of Pos.t * string * string option (* optional quoted representation *) | List of Pos.t * t_or_comment list * Pos.t (* left & right paren positions *) and t_or_comment = | Sexp of t | Comment of comment and comment = | Plain_comment of Pos.t * string (* line or block comment *) | Sexp_comment of Pos.t * comment list * t (* #; position *) val sexp_of_t : t -> Type.t val sexp_of_comment : comment -> Type.t val sexp_of_t_or_comment : t_or_comment -> Type.t end end module Parsed : Make(Src_pos.Absolute).S (** parsing produces absolute positions *) include Make(Src_pos.Relative).S (* the exposed type contains relative positions *) val relativize : Parsed.t_or_comment -> t_or_comment sexplib-0.13.0/test/000077500000000000000000000000001356453040600142265ustar00rootroot00000000000000sexplib-0.13.0/test/dune000066400000000000000000000001601356453040600151010ustar00rootroot00000000000000(library (name sexplib_ounit_tests) (libraries expect_test_helpers_kernel sexplib) (preprocess (pps ppx_jane)))sexplib-0.13.0/test/import.ml000066400000000000000000000000431356453040600160670ustar00rootroot00000000000000include Expect_test_helpers_kernel sexplib-0.13.0/test/io_test.ml000066400000000000000000000022601356453040600162260ustar00rootroot00000000000000open Sexplib let%test_unit _ = let orig_sexps = Random.init 10; let a = Array.init 5 (fun i -> Array.init 10 (fun j -> String.init (i + j) (fun k -> Char.chr (Char.code 'a' + k)))) in let open Sexplib.Conv in match [%sexp_of: string array array] a with | List l -> l | Atom _ -> assert false in let hum_file = Filename.temp_file "hum" ".sexp" in let hum_oc = open_out hum_file in let hum_ppf = Format.formatter_of_out_channel hum_oc in List.iter (fun sexp -> Format.fprintf hum_ppf "%a@\n" Sexp.pp_hum sexp) orig_sexps; Format.pp_print_flush hum_ppf (); close_out hum_oc; let mach_file = Filename.temp_file "mach" ".sexp" in let mach_oc = open_out mach_file in List.iter (fun sexp -> Printf.fprintf mach_oc "%a\n" Sexp.output_mach sexp) orig_sexps; close_out mach_oc; let hum_ic = open_in hum_file in let hum_sexps = Sexp.input_sexps hum_ic in close_in hum_ic; assert (hum_sexps = orig_sexps); Sys.remove hum_file; let mach_ic = open_in mach_file in let mach_sexps = Sexp.input_sexps mach_ic in close_in mach_ic; assert (mach_sexps = orig_sexps); Sys.remove mach_file; ;; sexplib-0.13.0/test/io_test.mli000066400000000000000000000000001356453040600163650ustar00rootroot00000000000000sexplib-0.13.0/test/newlines.ml000066400000000000000000000114141356453040600164050ustar00rootroot00000000000000open StdLabels open Sexplib let windowsify_newlines str = let b = Buffer.create (String.length str * 2) in for i = 0 to String.length str - 1; do match str.[i] with | '\n' -> Buffer.add_string b "\r\n" | c -> Buffer.add_char b c done; Buffer.contents b let display sexp = (* My understanding of newlines on windows is that in memory, a newline is a \n, but when writing to a file with a file handler open in text mode, all the \n are replaced with \r\n. Of course the conversion is undone when reading with a file handler open in text mode. If saving \n in text-mode and reading it in binary mode, we would receive \r\n back. I am testing that serializing + writing in text mode + reading in binary mode + deserializing is the identity (because it was before this newline printing stuff), and all the other cases should just work. *) let reparsed = Sexp.of_string (Sexp.to_string_hum sexp) in let reparsed_after_windows_fiddling = Sexp.of_string (windowsify_newlines (Sexp.to_string_hum sexp)) in let reparsing_result = if reparsed <> sexp then Printf.sprintf "to_string_hum + of_string + to_mach is NOT the identity:\n%s\n" (Sexp.to_string_mach reparsed) else "" in let reparsing_after_windows_fiddling_result = if reparsed_after_windows_fiddling <> sexp then Printf.sprintf "to_string_hum + windowsify + of_string + to_mach is NOT the identity:\n%s\n" (Sexp.to_string_mach reparsed_after_windows_fiddling) else "" in Printf.printf "mach:\n%s\nhum:\n%s\n%s%s\n" (Sexp.to_string_mach sexp) (Sexp.to_string_hum sexp) reparsing_result reparsing_after_windows_fiddling_result ;; let%expect_test _ = (* simple atom *) display (Atom "line1"); [%expect {| mach: line1 hum: line1 |}]; (* one trailing newline *) display (Atom "line1\n"); [%expect {| mach: "line1\n" hum: "line1\n" |}]; (* two lines *) display (Sexp.Atom "line1\nline2"); [%expect {| mach: "line1\nline2" hum: "line1\ \nline2" |}]; (* two lines and trailing newline *) display (Sexp.Atom "line1\nline2\n"); [%expect {| mach: "line1\nline2\n" hum: "line1\ \nline2\ \n" |}]; (* two lines, windows style *) display (Sexp.Atom "line1\r\nline2"); [%expect {| mach: "line1\r\nline2" hum: "line1\r\ \nline2" |}]; (* two lines and trailing windows style *) display (Sexp.Atom "line1\r\nline2\r\n"); [%expect {| mach: "line1\r\nline2\r\n" hum: "line1\r\ \nline2\r\ \n" |}]; (* two lines inside of parens *) display (Sexp.of_string "(\"line1\nline2\")"); [%expect {| mach: ("line1\nline2") hum: ( "line1\ \nline2") |}]; (* many lines and indentation in the atom *) display (Sexp.Atom "line1\n line2\n line3\n line4\n"); [%expect {| mach: "line1\n line2\n line3\n line4\n" hum: "line1\ \n line2\ \n line3\ \n line4\ \n" |}]; (* indentation with tabs in the atom *) display (Sexp.Atom "line1\n\tline2\n\t\tline3\n\t\t\tline4\n"); [%expect {| mach: "line1\n\tline2\n\t\tline3\n\t\t\tline4\n" hum: "line1\ \n\tline2\ \n\t\tline3\ \n\t\t\tline4\ \n" |}]; (* trailing whitespace *) display (Sexp.List [Sexp.List [Sexp.Atom "line1 \n line3 \n "]]); [%expect {| mach: (("line1 \n line3 \n ")) hum: (( "line1 \ \n line3 \ \n ")) |}]; (* catalog snapshot *) display (Sexp.Atom " cancel-buy\n | cancel-sell\n | | local-buy\n | | | local-cancel-buy\n | | | | local-cancel-sell\n | | | | | local-sell\nINDEX buy | | | | | | sell\n| | | | | | | | |\ntest_sym1 10. 10. 9.\ntest_sym3 \n"); [%expect {| mach: " cancel-buy\n | cancel-sell\n | | local-buy\n | | | local-cancel-buy\n | | | | local-cancel-sell\n | | | | | local-sell\nINDEX buy | | | | | | sell\n| | | | | | | | |\ntest_sym1 10. 10. 9.\ntest_sym3 \n" hum: " cancel-buy\ \n | cancel-sell\ \n | | local-buy\ \n | | | local-cancel-buy\ \n | | | | local-cancel-sell\ \n | | | | | local-sell\ \nINDEX buy | | | | | | sell\ \n| | | | | | | | |\ \ntest_sym1 10. 10. 9.\ \ntest_sym3 \ \n" |}]; ;; sexplib-0.13.0/test/newlines.mli000066400000000000000000000000001356453040600165430ustar00rootroot00000000000000sexplib-0.13.0/test/parser_test.ml000066400000000000000000000331641356453040600171220ustar00rootroot00000000000000open Sexplib open Test_common let sexp_of_layout_sexp = Sexp.With_layout.sexp_of_t_or_comment let sexps_of_layout_sexps l = List.map sexp_of_layout_sexp l let sexp_of_layout_sexps_or_something sexps_with_layout = match Sexp.With_layout.Forget.t_or_comments sexps_with_layout with | [s] -> s | [] | _ :: _ :: _ as sexps -> (* this is an error, but returning something is more effective for debug *) Sexp.List ( Sexp.List sexps :: Sexp.List (sexps_of_layout_sexps sexps_with_layout) :: [] ) let parsers = [ Sexp.of_string, "cont"; (fun s -> (* feeding the characters to the parse function one by one to make sure the cont_state machinery is working fine *) let pos = 0 in match Sexp.parse ~len:1 s with | Sexp.Done (t, _) -> t | Sexp.Cont (cont_state, parse_fun) -> let rec aux parse_fun pos = assert (pos < String.length s); match parse_fun ~pos ~len:1 s with | Sexp.Done (t, _) -> if pos + 1 = String.length s then t else failwith "Should have reached the end1" | Sexp.Cont (cont_state, parse_fun) -> aux_cont pos cont_state parse_fun and aux_cont pos cont_state parse_fun = if pos + 1 = String.length s then match cont_state with | Sexp.Cont_state.Parsing_atom -> begin match parse_fun ~pos:0 ~len:1 " " with | Sexp.Done (t, _) -> t | Sexp.Cont (Sexp.Cont_state.Parsing_atom, _) -> failwith "incomplete quoted atom" | Sexp.Cont _ -> failwith "Should have reached the end2" end | Sexp.Cont_state.Parsing_sexp_comment | Sexp.Cont_state.Parsing_block_comment | Sexp.Cont_state.Parsing_toplevel_whitespace -> failwith "string contains no sexp" | Sexp.Cont_state.Parsing_nested_whitespace -> failwith "incomplete" | Sexp.Cont_state.Parsing_list -> failwith "Should have reached the end3" else aux parse_fun (pos + 1) in aux_cont pos cont_state parse_fun ), "cont-incremental"; (fun s -> Sexp.scan_sexp (Lexing.from_string s)), "ocamllex"; (fun s -> Sexp.Annotated.get_sexp (Sexp.Annotated.of_string s)), "annot"; (fun s -> let sexps_with_layout = Sexp.With_layout.Parser.sexps Sexp.With_layout.Lexer.main (Lexing.from_string s) in sexp_of_layout_sexps_or_something sexps_with_layout ), "layout-sexps"; (fun s -> let parse = let lexbuf = Lexing.from_string s in fun () -> Sexp.With_layout.Parser.sexp_opt Sexp.With_layout.Lexer.main lexbuf in let rec aux acc = match parse () with | None -> List.rev acc | Some sexp -> aux (sexp :: acc) in sexp_of_layout_sexps_or_something (aux []) ), "layout-sexp-opt"; ] (* no idea why we can't read multiple sexps from a string directly *) let put_string_in_channel s f = let file, out_channel = Filename.open_temp_file "sexplib_test" "" in output_string out_channel s; close_out out_channel; let in_channel = open_in file in let v = try `Value (f in_channel) with exn -> `Exn exn in close_in in_channel; Sys.remove file; match v with | `Value v -> v | `Exn exn -> raise exn let list_parsers = [ (fun s -> Sexp.List (put_string_in_channel s Sexp.input_sexps)), "cont"; (fun s -> Sexp.List (Sexp.scan_sexps (Lexing.from_string s))), "ocamllex"; (fun s -> Sexp.List (Sexp.scan_sexps_conv ~f:(fun x -> x) (Lexing.from_string s))), "ocamllex_opt"; (fun s -> Sexp.List ( put_string_in_channel s (fun ch -> List.map Sexp.Annotated.get_sexp (Sexp.Annotated.input_sexps ch) ) )), "annot"; (fun s -> let sexps_with_layout = Sexp.With_layout.Parser.sexps Sexp.With_layout.Lexer.main (Lexing.from_string s) in let sexps = Sexp.With_layout.Forget.t_or_comments sexps_with_layout in Sexp.List sexps ), "layout-sexps"; ] let tests = ref 0 let failures = ref 0 let string_of_loc loc = Printf.sprintf "%s:%d:%d" loc.Lexing.pos_fname loc.Lexing.pos_lnum (loc.Lexing.pos_cnum - loc.Lexing.pos_bol) let same_parse_tree ?no_following_sibling ?(use_list_parsers=false) loc string1 string2 = let context_wrappers = wrap_in_context ?no_following_sibling () in List.iter (fun context_wrapper -> let string1 = context_wrapper string1 in let string2 = context_wrapper string2 in List.iter (fun (parser_, parser_name) -> List.iter (fun (adapt_newline, newline_style) -> incr tests; try let string1 = adapt_newline string1 in let string2 = adapt_newline string2 in let tree1 = parser_ string1 in let tree2 = parser_ string2 in if tree1 <> tree2 then ( incr failures; Printf.printf "test failure at %s (%s, %s)\n string1: %S tree1: %s\n string2: %S tree2: %s\n%!" (string_of_loc loc) parser_name newline_style string1 (Sexp.to_string tree1) string2 (Sexp.to_string tree2) ) with e -> incr failures; Printf.printf "test failure at %s (%s, %s, %s) on %S vs %S\n%!" (string_of_loc loc) (Printexc.to_string e) parser_name newline_style string1 string2 ) newline_adapters ) (if use_list_parsers then list_parsers else parsers) ) context_wrappers let same_parse_trees ?no_following_sibling loc string1 string2 = same_parse_tree ?no_following_sibling ~use_list_parsers:true loc string1 string2 let parse_fail ?no_following_sibling ?(use_list_parsers=false) loc string f = let context_wrappers = wrap_in_context ?no_following_sibling () in List.iter (fun context_wrapper -> let string = context_wrapper string in List.iter (fun (parser_, parser_name) -> List.iter (fun (adapt_newline, newline_style) -> incr tests; try let string = adapt_newline string in let tree = parser_ string in incr failures; Printf.printf "test failure at %s (%s, %s): should have thrown an exception\nstring: %S tree: %s\n%!" (string_of_loc loc) parser_name newline_style string (Sexp.to_string tree) with e -> if not (f e) then ( incr failures; Printf.printf "test failure at %s (%s, %s, %s)\n%!" (string_of_loc loc) (Printexc.to_string e) parser_name newline_style ) ) newline_adapters ) (if use_list_parsers then list_parsers else parsers) ) context_wrappers let parse_fail_trees ?no_following_sibling loc string f = parse_fail ?no_following_sibling ~use_list_parsers:true loc string f let grep pattern string = (* hopefully there is no need for escaping *) Sys.command ("echo '" ^ string ^ "' | grep -q '" ^ pattern ^ "'") = 0 let round_trip_all_characters () = let check_string s = let s' = let open Sexplib.Conv in s |> sexp_of_string |> Sexp.to_string |> Sexp.of_string |> string_of_sexp in assert (s = s') in for i = 0 to 255 do check_string (String.make 1 (Char.chr i)) done ;; (* the Sexp.input_sexps function tested below has a loop that uses the continuation mechanism of the parser if the whole thing cannot be loaded at once. (The parser named "cont-incremental" in the variable "parsers" above does exercise the continuation mechanism but its logic is coded in the present file, not in the library functions.) *) let load_large_sexp () = (* note: the file is expected to be larger than the default size of buffers *) let num = 2048 in let items = Buffer.create 8192 in Buffer.add_char items '('; for i = 0 to pred num do Buffer.add_string items (Printf.sprintf "item_%d\n" i) done; Buffer.add_char items ')'; match put_string_in_channel (Buffer.contents items) Sexp.input_sexps with | [ Sexp.List l ] -> assert (List.length l = num); List.iteri (fun i sexp -> match sexp with | Sexp.Atom name -> assert (name = Printf.sprintf "item_%d" i) | Sexp.List _ -> failwith "expected to find bare atom in the list") l | _ -> failwith "load_large_sexp: expected to load a list" let%test_unit _ = round_trip_all_characters (); load_large_sexp (); same_parse_tree [%here] "(a)" "(a;\n)"; (* single line comment in a list *) same_parse_tree [%here] ";\nb" "b"; (* single line comment at toplevel *) same_parse_tree [%here] ";;\nb" "b"; (* single line comment don't nest *) same_parse_tree [%here] ";\"\nb" "b"; (* single line comment ignore quotes *) same_parse_tree [%here] "(a#)" "(a#;\n)"; parse_fail [%here] "a#|" (function | Failure s -> grep "comment tokens in unquoted atom" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail [%here] "a|#" (function | Failure s -> grep "comment tokens in unquoted atom" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail [%here] "##|" (function | Failure s -> grep "comment tokens in unquoted atom" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail [%here] "||#" (function | Failure s -> grep "comment tokens in unquoted atom" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail_trees [%here] "#|" (* not terminated *) (function | Failure s -> grep "incomplete" s || grep "unterminated" s || grep "reached EOF while in state" s | _ -> false); parse_fail_trees [%here] "\"" (* unterminated quoted atom *) (function | Failure s -> grep "incomplete" s || grep "unterminated" s || grep "reached EOF while in state" s | _ -> false); parse_fail_trees ~no_following_sibling:true [%here] "\"\\" (function | Failure s -> grep "incomplete" s || grep "unterminated" s || grep "empty token" s || grep "reached EOF while in state" s | _ -> false); parse_fail_trees ~no_following_sibling:true [%here] "\"\\\n" (function | Failure s -> grep "incomplete" s || grep "unterminated" s || grep "empty token" s || grep "reached EOF while in state" s | _ -> false); parse_fail_trees ~no_following_sibling:true [%here] "\"\\\013" (function | Failure s -> grep "incomplete" s || grep "unterminated" s || grep "empty token" s || grep "reached EOF while in state" s | _ -> false); parse_fail_trees ~no_following_sibling:true [%here] "\"\\0" (function | Failure s -> grep "incomplete" s || grep "unterminated" s || grep "reached EOF while in state" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail_trees ~no_following_sibling:true [%here] "\"\\x" (function | Failure s -> grep "incomplete" s || grep "unterminated" s || grep "reached EOF while in state" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail [%here] "\"hello" (* unterminated quoted atom *) (function | Failure s -> grep "incomplete" s || grep "unterminated" s | _ -> false); parse_fail [%here] "\013x" (* weird newline *) (function | Failure s -> grep "unexpected character" s || grep "empty token" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail_trees [%here] "\013" (* trailing weird newline *) (function | Failure s -> grep "incomplete" s || grep "empty token" s || grep "reached EOF while in state" s || grep "unexpected" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail [%here] "|#" (* not started *) (function | Failure s -> grep "illegal end of comment" s | Sexp.Parse_error _ -> true | _ -> false); parse_fail [%here] ~no_following_sibling:true "#;" (* not followed *) (function | Sexp.Parse_error _ | Failure _ -> true | _ -> false); same_parse_tree [%here] "#;a b" "b"; (* sexp comment + atom *) same_parse_tree [%here] "#;((a)) b" "b"; (* sexp comment + list *) same_parse_tree [%here] "#;\"#;\" b" "b"; (* sexp comment + quoted atom *) same_parse_tree [%here] "#;a;comment\nb" "b"; (* sexp comment + single line commment *) same_parse_tree [%here] "#;#|aa)|#comment b" "b"; (* sexp comment + block commment *) same_parse_tree [%here] "#;a #;(a) #;\"asd\" b" "b"; (* consecutive sexp comment + atom *) same_parse_tree [%here] "(#;a #;(a) #;b)" "()"; (* consecutive sexp comment + nothing *) same_parse_tree [%here] "#; #; #; comment1 comment2 comment3 a" "a"; (* nested sexp comment *) same_parse_tree [%here] "#| ; |# ()" "()"; (* single line comment are not parsed inside of blocks *) same_parse_tree [%here] "#|#||#|#a" "a"; (* consecutive comment opening are not parsed as one invalid atom *) (* why do we need a freaking space at the end?? *) same_parse_trees [%here] "a #; b c " "a c "; (* base case, accepting lists *) same_parse_trees [%here] "#;#;a b c d " "c d "; (* leading comments work alright *) same_parse_trees [%here] "#;#;a b " " "; (* leading comments work alright *) same_parse_trees [%here] "plop #;#;a b " "plop "; (* trailing comments work alright *) same_parse_trees [%here] "#;b " " "; (* leading comments in front of nothing *) (* making sure that '|' is still accepted in literals *) same_parse_tree [%here] "(a|b)" "(\"a|b\")"; same_parse_tree [%here] "(a | b)" "(a \"|\" b)"; same_parse_tree [%here] "((a)|b)" "((a)\"|b\")"; same_parse_tree [%here] "(b|(a))" "(\"b|\"(a))"; same_parse_trees [%here] "a|b " "\"a|b\" "; same_parse_trees [%here] "(a)|b " "(a)\"|b\" "; same_parse_trees [%here] "b|(a)" "\"b|\"(a)"; if !failures <> 0 then failwith (Printf.sprintf "%d / %d tests failed\n%!" !failures !tests) ;; sexplib-0.13.0/test/parser_test.mli000066400000000000000000000000001356453040600172520ustar00rootroot00000000000000sexplib-0.13.0/test/path_test.ml000066400000000000000000000020221356453040600165470ustar00rootroot00000000000000open Sexplib open Conv type foo = A | B of int * float [@@deriving sexp] type 'a t = { x : foo; foo : int; bar : (float * string) list option; } [@@deriving sexp] type u = { t : int t } [@@deriving sexp] let%test_unit _ = let t = { x = B (42, 3.1) ; foo = 3 ; bar = Some [(3.1, "foo")]; } in let u = { t } in let u_sexp = sexp_of_u u in assert (Sexp.to_string u_sexp = "((t((x(B 42 3.1))(foo 3)(bar(((3.1 foo)))))))"); let path_str = ".[0].[1]" in let path = Path.parse path_str in let subst, el = Path.subst_path u_sexp path in assert (Sexp.to_string el = "((x(B 42 3.1))(foo 3)(bar(((3.1 foo)))))"); let dumb_sexp = subst (Atom "SUBST1") in assert (Sexp.to_string dumb_sexp = "((t SUBST1))"); let path_str = ".t.x.B[1]" in let path = Path.parse path_str in let subst, el = Path.subst_path u_sexp path in assert (Sexp.to_string el = "3.1"); let u_sexp = subst (Atom "SUBST2") in assert (Sexp.to_string u_sexp = "((t((x(B 42 SUBST2))(foo 3)(bar(((3.1 foo)))))))"); ;; sexplib-0.13.0/test/path_test.mli000066400000000000000000000000001356453040600167120ustar00rootroot00000000000000sexplib-0.13.0/test/printer_test.ml000066400000000000000000000122211356453040600173000ustar00rootroot00000000000000open Ppx_compare_lib.Builtin open Sexplib open Sexplib.Std module With_layout = Sexp.With_layout open Test_common (* a hack to ignore these tests for now *) let care_about_windows_newlines = false let string_of_sexps_with_layout t_list = let open With_layout.Render in let b = Buffer.create 10 in let m = return () in let m = List.fold_left (fun m t -> bind m ~f:(fun () -> sexp t) ) m t_list in With_layout.Render.run (fun c -> Buffer.add_char b c) m; Buffer.contents b let failures = ref 0 let total = ref 0 let split_newlines s = let acc = ref [] in let b = Buffer.create 10 in let split () = acc := Buffer.contents b :: !acc; Buffer.clear b in for i = 0 to String.length s - 1 do if s.[i] = '\n' then split (); Buffer.add_char b s.[i] done; split (); List.rev !acc let rstrip s = let rec aux i = if i = 0 then "" else match s.[i - 1] with | ' ' | '\t' | '\n' | '\r' -> aux (i - 1) | _ -> String.sub s 0 i in aux (String.length s) let normalize_string s = (* removing the spacing at the end and removing the trailing whitespace on each line except the final carriage return if any so that \r\n in the input stays \r\n in the output *) let s = rstrip s in let l = split_newlines s in let l = List.map (fun s -> let ends_with_cr = s <> "" && s.[String.length s - 1] = '\r' in let s = rstrip s in if ends_with_cr && care_about_windows_newlines then s ^ "\r" else s ) l in String.concat "" l let test_printer () = let tests = [ (* basic things *) "a"; "a b"; "a b "; "\na \n b \n "; "(\na \n) () b \n "; (* single line comments *) ";\n"; ";() b \n "; "(;\n)"; "(a;\nb)"; (* block comments *) "#||#"; "#| ((a((|#"; (* block comments + random contents *) "a\"#|\"b"; (* quoted atom with block comment start *) "a \"|#\" b"; (* quoted atom with block comment end *) "a #|\"|#\" b|#"; (* block comment with quoted atom *) "a \n#|\"\n|#\" b|#\n"; (* block comment with quoted atom and newlines *) (* sexp comment *) "#;out in"; (* standard case *) "#;out#;out-as-well ;still out\n finally-in"; (* consecutive sexp comments *) "#;#;out out-as-well ;still out\n finally-in"; (* nested sexp comments *) "#;#;(\"out\" )out-as-well ;still out\n finally-in"; (* nested sexp comments that comment out more complicated expressions *) "#;;line comment1\n;line comment2\nout in"; ] in List.iter (fun test_str -> List.iter (fun wrapper -> List.iter (fun (newline_adapter, newline_style) -> incr total; let test_str = newline_adapter (wrapper test_str) in let lexbuf = Lexing.from_string test_str in let sexps_opt = try Some (With_layout.Parser.sexps With_layout.Lexer.main lexbuf) with e -> incr failures; let str = Printexc.to_string e in Printf.printf "Failed to parse %S (%s):\n %s\n%!" test_str newline_style str; None in match sexps_opt with | None -> () | Some sexps -> let printed_str_opt = try Some (string_of_sexps_with_layout sexps) with e -> incr failures; let str = Printexc.to_string e in Printf.printf "Failed to print %S (%s):\n %s\n %s\n%!" test_str newline_style (Sexp.to_string (Sexp.List (With_layout.Forget.t_or_comments sexps))) str; None in match printed_str_opt with | None -> () | Some printed_str -> (* trailing whitespace (at the end of lines or at the end of file) is not handled by the parser/printer, except when they are in a comment but that is annoying to check so stripping everything from both strings *) if normalize_string test_str <> normalize_string printed_str then ( incr failures; Printf.printf "Comparison failed %S (%s):\n\ \ got %S after parsing + printing\n\ \ test after normalization: %S\n\ \ printed after normalization: %S\n%!" test_str newline_style printed_str (normalize_string test_str) (normalize_string printed_str); ) ) newline_adapters ) (wrap_in_context ()) ) tests let%test_unit _ = test_printer (); if !failures <> 0 then failwith (Printf.sprintf "%d / %d tests failed\n%!" !failures !total) ;; let%test_unit _ = let sexps = let open With_layout in [ Comment (Plain_comment ({row=0;col=2}, "; c")) ; Sexp (Atom ({row=0;col=6}, "not-a-comment", None))] in let str = string_of_sexps_with_layout sexps in [%test_result: string] ~expect:" ; c\n not-a-comment" str ;; let%test_unit _ = let sexps = let open With_layout in [ Comment (Plain_comment ({row=0;col=2}, "; c")) ; Sexp (Atom ({row=2;col=6}, "not-a-comment", None))] in let str = string_of_sexps_with_layout sexps in [%test_result: string] ~expect:" ; c\n\n not-a-comment" str ;; sexplib-0.13.0/test/printer_test.mli000066400000000000000000000000001356453040600174410ustar00rootroot00000000000000sexplib-0.13.0/test/test_common.ml000066400000000000000000000020721356453040600171100ustar00rootroot00000000000000open Sexplib let () = Printexc.register_printer (function | Sexp.Parse_error {Sexp.err_msg; parse_state=_ } -> Some ( Printf.sprintf "Sexp.parse_error {err_msg = %S}" err_msg ) | _ -> None ) let wrap_in_context ?(no_following_sibling=false) () = [ (fun a -> a); (fun a -> "(" ^ a ^ ")"); (* checking if the spacing around braces changes something *) (fun a -> "( " ^ a ^ ")"); (fun a -> "(" ^ a ^ " )"); (fun a -> "( " ^ a ^ " )"); (fun a -> "( ( ( " ^ a ^ " ) ) )"); ] @ ( if no_following_sibling then [] else [ (fun a -> "( something " ^ a ^ "\"something else\")"); (fun a -> "( \"something else\"" ^ a ^ " something )"); (fun a -> "((\"something else\")" ^ a ^ "(something))"); ] ) let explode s = let acc = ref [] in for i = String.length s - 1 downto 0 do acc := s.[i] :: !acc done; !acc let newline_adapters = [ (fun s -> s), "unix"; (fun s -> String.concat "" (List.map (function '\n' -> "\r\n" | c -> String.make 1 c) (explode s))), "windows"; ] sexplib-0.13.0/test/test_eof.ml000066400000000000000000000015431356453040600163730ustar00rootroot00000000000000open Sexplib.Std let with_temp_file sexp_of_t ~contents ~f = let fname, oc = Filename.open_temp_file "test" ".sexp" in let result = match output_string oc contents; close_out oc; f fname with | x -> `Ok x | exception e -> `Error e in Sys.remove fname; Printf.printf !"%{sexp:[ `Ok of t | `Error of exn ]}" result let%expect_test "file ending with an atom" = with_temp_file [%sexp_of: int] ~contents:"5" ~f:(fun fname -> Sexplib.Sexp.load_sexp_conv_exn fname [%of_sexp: int]); [%expect {| (Ok 5) |}] let%expect_test "file ending with an atom" = with_temp_file [%sexp_of: Sexplib.Sexp.t list] ~contents:"5" ~f:(fun fname -> let ic = open_in fname in (match Sexplib.Sexp.input_sexps ic with | x -> close_in ic; x | exception e -> close_in ic; raise e)); [%expect {| (Ok (5)) |}] sexplib-0.13.0/test/test_eof.mli000066400000000000000000000000001356453040600165270ustar00rootroot00000000000000sexplib-0.13.0/test/test_sexp_of_string.ml000066400000000000000000000016031356453040600206500ustar00rootroot00000000000000open Sexplib let%test_module "tests" = ( module struct let same x y = assert (x = y) let good s = same (Sexp.of_string s) (Atom "foo") let bad s = match Sexp.of_string s with | exception _exn -> () | _sexp -> failwith "should have failed" let%test_unit _ = good "foo" let%test_unit _ = good "foo\n" let%test_unit _ = good "foo;" let%test_unit _ = good "foo #;()" let%test_unit _ = good "foo #|blah|#" let%test_unit _ = good "foo #|blah|#\n" let%test_unit _ = good "foo; blah" let%test_unit _ = good "foo; blah\n" let%test_unit _ = good "foo; blah\n" (* multiple sexps *) let%test_unit _ = bad "foo bar" (* unterminated block comment *) let%test_unit _ = bad "foo #| bar" (* unterminated sexp *) let%test_unit _ = bad "foo (" end) sexplib-0.13.0/test/test_sexp_with_layout.ml000066400000000000000000000034671356453040600212400ustar00rootroot00000000000000(* packaging of annotated sexp functions *) open Sexplib module M = Sexp.With_layout let%test_module "forget" = (module struct (* dummies *) let dumb_pos = {M.row = 0; col = 0} let dumb_comment = M.Plain_comment (dumb_pos, "comment") let atom x = M.Sexp (M.Atom (dumb_pos, x, None)) let list ts = M.Sexp (M.List (dumb_pos, ts, dumb_pos)) let comment = M.Comment dumb_comment let a1 = comment let a2 = atom "hello" let a3 = list [comment; atom "yo"; comment; atom "yo"; comment; atom "ma"; comment] let a4 = list [comment; a1; comment; a2; comment; a3; comment; a3] let a5 = list [comment; a1; comment; a2; comment; a3; comment; a4] let b2 = Sexp.Atom "hello" let b3 = Sexp.List [Sexp.Atom "yo"; Sexp.Atom "yo"; Sexp.Atom "ma"] let b4 = Sexp.List [b2; b3; b3] let b5 = Sexp.List [b2; b3; b4] let%test _ = M.Forget.t_or_comment a1 = None let%test _ = M.Forget.t_or_comment a2 = Some b2 let%test _ = M.Forget.t_or_comment a3 = Some b3 let%test _ = M.Forget.t_or_comment a4 = Some b4 let%test _ = M.Forget.t_or_comment a5 = Some b5 module Simple_forget = struct let rec t = function | M.Atom (_, x, _) -> Sexp.Atom x | M.List (_, ts, _) -> Sexp.List (t_or_comments ts) and t_or_comments = function | [] -> [] | t :: ts -> match t_or_comment t with | None -> t_or_comments ts | Some s -> s :: t_or_comments ts and t_or_comment = function | M.Sexp x -> Some (t x) | M.Comment _ -> None end let same_as_simple x = M.Forget.t_or_comment x = Simple_forget.t_or_comment x let%test _ = same_as_simple a1 let%test _ = same_as_simple a2 let%test _ = same_as_simple a3 let%test _ = same_as_simple a4 let%test _ = same_as_simple a5 end) sexplib-0.13.0/test/test_sexp_with_layout.mli000066400000000000000000000000001356453040600213650ustar00rootroot00000000000000sexplib-0.13.0/top/000077500000000000000000000000001356453040600140515ustar00rootroot00000000000000sexplib-0.13.0/top/sexplib_install_printers.ml000066400000000000000000000011271356453040600215260ustar00rootroot00000000000000let printers = [ "Sexplib.Sexp.pp_hum" ] let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str = let lexbuf = Lexing.from_string str in let phrase = !Toploop.parse_toplevel_phrase lexbuf in Toploop.execute_phrase print_outcome err_formatter phrase let rec install_printers = function | [] -> true | printer :: printers -> let cmd = Printf.sprintf "#install_printer %s;;" printer in eval_string cmd && install_printers printers let () = if not (install_printers printers) then Format.eprintf "Problem installing Sexplib-printers@." sexplib-0.13.0/unix/000077500000000000000000000000001356453040600142325ustar00rootroot00000000000000sexplib-0.13.0/unix/lib/000077500000000000000000000000001356453040600150005ustar00rootroot00000000000000sexplib-0.13.0/unix/lib/dune000066400000000000000000000001601356453040600156530ustar00rootroot00000000000000(library (name sexplib_unix) (public_name sexplib.unix) (libraries sexplib unix) (preprocess no_preprocessing))sexplib-0.13.0/unix/lib/sexplib_unix_conv.ml000066400000000000000000000013251356453040600210710ustar00rootroot00000000000000(** Exception sexp converters that are Unix-specific. Handles [Unix.Unix_error]. Write [let () = Sexplib_unix.Sexplib_unix_conv.linkme] in your program to ensure that the code in this module is run, i.e. the unix-specific exception converters are added. This is already done by [Core], so any application that uses Core need not worry about this module at all. *) open Sexplib.Sexp open Sexplib.Conv let () = Exn_converter.add ~finalise:false [%extension_constructor Unix.Unix_error] (function | Unix.Unix_error (err, loc, arg) -> let err_str = Unix.error_message err in List [Atom "Unix.Unix_error"; Atom err_str; Atom loc; Atom arg] | _ -> assert false) let linkme = () sexplib-0.13.0/vim/000077500000000000000000000000001356453040600140425ustar00rootroot00000000000000sexplib-0.13.0/vim/syntax/000077500000000000000000000000001356453040600153705ustar00rootroot00000000000000sexplib-0.13.0/vim/syntax/sexplib.vim000066400000000000000000000071301356453040600175540ustar00rootroot00000000000000" Vim syntax file " Language: S-expressions as used in Sexplib " Filenames: *.sexp " Maintainers: Markus Mottl " URL: http://www.ocaml.info/vim/syntax/sexplib.vim " Last Change: 2012 Jun 20 - Fixed a block comment highlighting bug (MM) " 2012 Apr 24 - Added support for new comment styles (MM) " 2009 Apr 02 - First release (MM) " For version 5.x: Clear all syntax items " For version 6.x: Quit when a syntax file was already loaded if version < 600 syntax clear elseif exists("b:current_syntax") && b:current_syntax == "sexplib" finish endif " Sexplib is case sensitive. syn case match " Comments syn keyword sexplibTodo contained TODO FIXME XXX NOTE syn region sexplibBlockComment matchgroup=sexplibComment start="#|" matchgroup=sexplibComment end="|#" contains=ALLBUT,sexplibQuotedAtom,sexplibUnquotedAtom,sexplibEncl,sexplibComment syn match sexplibSexpComment "#;" skipwhite skipempty nextgroup=sexplibQuotedAtomComment,sexplibUnquotedAtomComment,sexplibListComment,sexplibComment syn region sexplibQuotedAtomComment start=+"+ skip=+\\\\\|\\"+ end=+"+ contained syn match sexplibUnquotedAtomComment /\([^;()" \t#|]\|#[^;()" \t|]\||[^;()" \t#]\)[^;()" \t]*/ contained syn region sexplibListComment matchgroup=sexplibComment start="(" matchgroup=sexplibComment end=")" contained contains=ALLBUT,sexplibEncl,sexplibString,sexplibQuotedAtom,sexplibUnquotedAtom,sexplibTodo,sexplibNumber,sexplibFloat syn match sexplibComment ";.*" contains=sexplibTodo " Atoms syn match sexplibUnquotedAtom /\([^;()" \t#|]\|#[^;()" \t|]\||[^;()" \t#]\)[^;()" \t]*/ syn region sexplibQuotedAtom start=+"+ skip=+\\\\\|\\"+ end=+"+ syn match sexplibNumber "\<-\=\d\(_\|\d\)*[l|L|n]\?\>" syn match sexplibNumber "\<-\=0[x|X]\(\x\|_\)\+[l|L|n]\?\>" syn match sexplibNumber "\<-\=0[o|O]\(\o\|_\)\+[l|L|n]\?\>" syn match sexplibNumber "\<-\=0[b|B]\([01]\|_\)\+[l|L|n]\?\>" syn match sexplibFloat "\<-\=\d\(_\|\d\)*\.\?\(_\|\d\)*\([eE][-+]\=\d\(_\|\d\)*\)\=\>" " Lists syn region sexplibEncl transparent matchgroup=sexplibEncl start="(" matchgroup=sexplibEncl end=")" contains=ALLBUT,sexplibParenErr " Errors syn match sexplibUnquotedAtomErr /\([^;()" \t#|]\|#[^;()" \t|]\||[^;()" \t#]\)[^;()" \t]*\(#|\||#\)[^;()" \t]*/ syn match sexplibParenErr ")" " Synchronization syn sync minlines=50 syn sync maxlines=500 " Define the default highlighting. " For version 5.7 and earlier: only when not done already " For version 5.8 and later: only when an item doesn't have highlighting yet if version >= 508 || !exists("did_sexplib_syntax_inits") if version < 508 let did_sexplib_syntax_inits = 1 command -nargs=+ HiLink hi link else command -nargs=+ HiLink hi def link endif HiLink sexplibParenErr Error HiLink sexplibUnquotedAtomErr Error HiLink sexplibComment Comment HiLink sexplibSexpComment Comment HiLink sexplibQuotedAtomComment Include HiLink sexplibUnquotedAtomComment Comment HiLink sexplibBlockComment Comment HiLink sexplibListComment Comment HiLink sexplibBoolean Boolean HiLink sexplibCharacter Character HiLink sexplibNumber Number HiLink sexplibFloat Float HiLink sexplibUnquotedAtom Identifier HiLink sexplibEncl Identifier HiLink sexplibQuotedAtom Keyword HiLink sexplibTodo Todo HiLink sexplibEncl Keyword delcommand HiLink endif let b:current_syntax = "sexplib" " vim: ts=8