pax_global_header00006660000000000000000000000064135540477120014522gustar00rootroot0000000000000052 comment=9e26c0a2699b7076cebc04ece59fb354eb84c11c ocp-indent-1.8.2/000077500000000000000000000000001355404771200135725ustar00rootroot00000000000000ocp-indent-1.8.2/.gitignore000066400000000000000000000004411355404771200155610ustar00rootroot00000000000000.hgignore.in Makefile.config jbuild-ignore ocp-build.root* _obuild config.log config.status ocp-indent src/indentVersion.ml *~ version.ocp autom4te.cache aclocal.m4 man/man1/ src/.hgignore.in src/Makefile.extracted-from-jenga src/buildable_targets.list **/.fe.sexp _build .merlin *.installocp-indent-1.8.2/.ocp-indent000066400000000000000000000077501355404771200156440ustar00rootroot00000000000000# -*- conf -*- # This is an example configuration file for ocp-indent # # Copy to the root of your project with name ".ocp-indent", customise, and # transparently get consistent indentation on all your ocaml source files. # Starting the configuration file with a preset ensures you won't fallback to # definitions from "~/.ocp/ocp-indent.conf". # These are `normal`, `apprentice` and `JaneStreet` and set different defaults. normal # # INDENTATION VALUES # # Number of spaces used in all base cases, for example: # let foo = # ^^bar base = 2 # Indent for type definitions: # type t = # ^^int type = 2 # Indent after `let in` (unless followed by another `let`): # let foo = () in # ^^bar in = 0 # Indent after `match/try with` or `function`: # match foo with # ^^| _ -> bar with = 0 # Indent for clauses inside a pattern-match (after the arrow): # match foo with # | _ -> # ^^^^bar # the default is 2, which aligns the pattern and the expression match_clause = 4 # this is non-default # Indentation for items inside extension nodes: # [%% id.id # ^^^^contents ] # [@@id # ^^^^foo # ] ppx_stritem_ext = 2 # When nesting expressions on the same line, their indentation are in # some cases stacked, so that it remains correct if you close them one # at a line. This may lead to large indents in complex code though, so # this parameter can be used to set a maximum value. Note that it only # affects indentation after function arrows and opening parens at end # of line. # # for example (left: `none`; right: `4`) # let f = g (h (i (fun x -> # let f = g (h (i (fun x -> # x) # x) # ) # ) # ) # ) max_indent = 4 # # INDENTATION TOGGLES # # Wether the `with` parameter should be applied even when in a sub-block. # Can be `always`, `never` or `auto`. # if `always`, there are no exceptions # if `auto`, the `with` parameter is superseded when seen fit (most of the time, # but not after `begin match` for example) # if `never`, `with` is only applied if the match block starts a line. # # For example, the following is not indented if set to `always`: # let f = function # ^^| Foo -> bar strict_with = never # Controls indentation after the `else` keyword. `always` indents after the # `else` keyword normally, like after `then`. # If set to `never', the `else` keyword won't indent when followed by a newline. # `auto` indents after `else` unless in a few "unclosable" cases (`let in`, # `match`...). # # For example, with `strict_else=never`: # if cond then # foo # else # bar; # baz # `never` is discouraged if you may encounter code like this example, # because it hides the scoping error (`baz` is always executed) strict_else = always # Ocp-indent will normally try to preserve your in-comment indentation, as long # as it respects the left-margin or starts with `(*\n`. Setting this to `true` # forces alignment within comments. strict_comments = false # Toggles preference of column-alignment over line indentation for most # of the common operators and after mid-line opening parentheses. # # for example (left: `false'; right: `true') # let f x = x # let f x = x # + y # + y align_ops = true # Function parameters are normally indented one level from the line containing # the function. This option can be used to have them align relative to the # column of the function body instead. # if set to `always`, always align below the function # if `auto`, only do that when seen fit (mainly, after arrows) # if `never`, no alignment whatsoever # # for example (left: `never`; right: `always or `auto) # match foo with # match foo with # | _ -> some_fun # | _ -> some_fun # ^^parameter # ^^parameter align_params = auto # # SYNTAX EXTENSIONS # # You can also add syntax extensions (as per the --syntax command-line option): # syntax = mll lwt ocp-indent-1.8.2/CHANGELOG000066400000000000000000000120141355404771200150020ustar00rootroot00000000000000## 1.8.1 * tiny API change to help with the detection of top-level phrase boundaries * fixed a bug with end of comment detection in some cases (esp. related to cinaps) * tweaks for better indentation within cinaps comments * lowered priority of algebraic attributes in expressions (`[@...]`) to better match the actual meaning. ## 1.8.0 * compatibility with OCaml 4.08.0 (new attributes, monadic lets...) * lots of smaller indentation fixes (module types, empty variants...) * more reliable "inplace" mode (preserving symlinks and permissions) * XDG compatibility (e.g. config file below `~/.config`) * support for "cinaps" comments (indent as code comments that start with `(*$`) * API: `IndentBlock.is_at_top` now returns true for top-level expressions ## 1.7.0 * lots of small fixes * better handling of attributes and extension points * better handling of GADT definitions * fixed a stack-overflow on extremely large files * indent the same (1 step) after `let f = fun x ->` and `let f =\n fun x ->` * build using dune ## 1.6.1 * fixes related to ppx extensions * fixed regression on indentation within record types ## 1.6.0 * fixes some cases of comments * supports new cases of ppx * fixed cases of unstable indentation within records * supports local excemtions * fixed handling of polymorphic methods * uses cmdliner 1.0.0 ## 1.5.3 * fixes on nested try-with and some cases of comments * better alignment of stand-alone semicolons in records * improved emacs and vim scripts * better indentation within extension blocks ## 1.5.2 * small emacs binding fix * compatibility with cmdliner 0.9.8 ## 1.5.1 * generic handling of ppx keywords * much improved vim binding * changed installation location of vim bindings (to share/ocp-indent/vim/indent) for easier autoload * don't increase indentation level for sequences of try..with * support for '[@' * restore back-alignment of '&&', '||' after 'if' and 'when' * support for extensible variant types ## 1.5 * new vim binding * support for ppx lwt keywords * fixed indentation at BOF and EOF in some cases * back-alignment of '&&' and '||' disabled * tweaks to functor, struct and module indentation * support for ppx attributes * lots of fixes and tweaks ## 1.4.1 * OCaml 4.01.0 warnings fix * fixed indent of lwt try/finally * sort Jane Street tests by priority * added support for BENCH syntax * added support for the new {xx| |xx} quotation syntax * emacs mode: cleaner loading * emacs mode: fixed the 'syntax' option * emacs mode: workaround an auto-complete.el display bug * emacs and vim modes: install in editor-specific directories * refactored build system. Install through opam-installer, register libs as ocamlfind sub-packages ## 1.4.0 * license change: lessening the GPL to make ocp-indent easier to use as a library * removed indent by default after most common operators (when align_ops is set) * removed extra-indent in some pattern-matching cases * fixed a few bugs related to records, lazy as pattern, "module with" * added support for the cstruct syntax extension * fixed Makefile to properly install all cmi files, working around an ocp-build bug ## 1.3.2 * bug-fix release: object types, module type of, first line, etc. ## 1.3.1 * optimised functional operators on OCaml 4.00 * fixed a bug in phrase boundary detection ## 1.3.0 * Large API rewrite, offering much more flexibility and functionality * Still some bug fixes (comments at end, nested ocamldoc tags, etc.) * Man-page fixes (thanks to Kaustuv Chaudhuri) * Temporarily disabled the non-functional state-marshalling function * Emacs mode: auto-disabling indent-tabs-mode by default, it's not compatible anyways. ## 1.2.2 * Fixed critical bug with the parsing of the --syntax option * a few indent fixes (functor sigs, comments in expressions) ## 1.2.1 * Fixed bugs with GADTs, comments at end of modules * Fixed compilation with OCaml trunk (warnings as errors) * New vim script, contributed by Jonathan Derque * New option "strict_else" to allow unindenting after else ## 1.2.0 * Lots of fixes * Switched most operators and constructs with parentheses to column aligned by default (can be disabled with option align_ops) * Better handling of records * Some code cleanup (record fields with meaningful names) * Documentation and manpage (now relying on cmdliner) * Added an option (max_indent) to limit over-indent in the most annoying cases * Syntax extensions can now be enabled from the configuration files ## 1.1.0 * Small fixes, stabilised ocamldoc indentation * Support for configuration files, either user or project-wide ## 1.0.2 * Supporting indentation of ocamldoc. In particular, code within ocamldoc blocks {[...]} should be automatically indented * Fixed the emacs mode not to set the mark * A few new configuration options (strict_with, strict_comments, align_params) * A few tweaks and improvements (better empty line indent, etc.) * Bugfixes (#43, #47) ## 1.0.1 * Indentation of comments now follows ocamldoc conventions properly * Partial indent adapts more closely to manual indentation * Various small fixes (indent on empty lines, freeform comments...) ocp-indent-1.8.2/LICENSE000066400000000000000000000645711355404771200146140ustar00rootroot00000000000000Ocp-Indent is distributed under the terms of the GNU Lesser General Public License (LGPL) version 2.1 (included below). As a special exception to the GNU Lesser General Public License, you may link, statically or dynamically, a "work that uses ocp-indent" with a publicly distributed version of ocp-indent to produce an executable file containing portions of ocp-indent, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Lesser General Public License. By "a publicly distributed version of ocp-indent", we mean either the unmodified ocp-indent as distributed by OCamlPro, or a modified version of the ocp-indent that is distributed under the conditions defined in clause 2 of the GNU Lesser General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Lesser General Public License. ---------------------------------------------------------------------- GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. one line to give the library's name and an idea of what it does. Copyright (C) year name of author This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. signature of Ty Coon, 1 April 1990 Ty Coon, President of Vice That's all there is to it! -------------------------------------------------- ocp-indent-1.8.2/README.md000066400000000000000000000004361355404771200150540ustar00rootroot00000000000000ocp-indent is a simple tool and library to indent OCaml code. ocp-indent is part of TypeRex, developed and maintained by OCamlPro. Documentation to install and use this tool is available on http://www.typerex.org/ocp-indent.html It is released under LGPL v2.1 with linking exception. ocp-indent-1.8.2/VERSION000066400000000000000000000000061355404771200146360ustar00rootroot000000000000001.8.1 ocp-indent-1.8.2/doc/000077500000000000000000000000001355404771200143375ustar00rootroot00000000000000ocp-indent-1.8.2/doc/dune000066400000000000000000000002401355404771200152110ustar00rootroot00000000000000(rule (targets ocp-indent.1) (action (with-stdout-to %{targets} (run %{bin:ocp-indent} --help=groff))) ) (install (section man) (files ocp-indent.1) ) ocp-indent-1.8.2/doc/ocp-indent.md000066400000000000000000000121141355404771200167200ustar00rootroot00000000000000# ocp-indent A simple tool to indent OCaml programs Authors: Louis Gesbert (OCamlPro), Thomas Gazagnaire (OCamlPro), Jun Furuse License: LGPL 2.1 with linking exception ## Installation ### Using OPAM The simplest way to install `ocp-indent` is using [OPAM](http://opam.ocamlpro.com): ```bash opam install ocp-indent ``` ### By hand You can also compile and install `ocp-indent` from sources. You'll need `ocaml (>= 3.12.1)` and `ocp-build (>= 1.99.6-beta)`: ```bash ./configure make make install ``` If you use opam and want it installed alongside ocaml, you may want to use `./configure --prefix $(opam config var prefix)`. ## Usage The above installation step copies elisp scripts to `/share/emacs/site-lisp/` and vim scripts to `/share/ocp-indent/vim/`. You then need to load them in the editor of your choice to automatically use ocp-indent. Installing OPAM package [`user-setup`](https://opam.ocaml.org/packages/user-setup/user-setup.0.3/) will trigger automatic configuration for popular editors (emacs and vim currently, but more are in the works). If you prefer to handle your configuration manually, read on. ### Emacs Run the following command to setup tuareg-mode or caml-mode to use `ocp-indent` for indentation: ```bash echo '(load-file "'"$(opam config var share)"'/emacs/site-lisp/ocp-indent.el")' >>~/.emacs ``` The `tab` key should now reindent the current line using ocp-indent. ### Vim Use the following command to tell Vim to use `ocp-indent` to indent OCaml code: ```bash echo 'set rtp^="'"$(opam config var ocp-indent:share)"'/vim"' >>~/.vimrc ``` Automatic indentation as you type should take place, depending on your configuration. Use `==` to reindent the current line, and `=G` to reindent until the end of buffer. ### Other editors As `ocp-indent` is a command-line tool, you can easily integrate it with other editors. ```bash ocp-indent > ``` You can also tell it to indent only a subsets of lines, and to output only the indentation level: ```bash ocp-indent --lines - --numeric ``` ## Configuration options By default, `ocp-indent` comes with sensible default parameters. However, you can customize some of the indentation options using command-line arguments. For more details, see: ```bash ocp-indent --help ``` ### Configuration file The same parameters can be defined in a configuration file, allowing for user defaults and per-project parameters. The latter is particularly convenient to transparently ensure consistency in projects with many contributors, without requiring them to change their settings in any way (except that, obviously, they need to use ocp-indent !). If a `.ocp-indent` file is found in the current directory or its ancestors, it overrides definitions from `$XDG_CONFIG_HOME/ocp/ocp-indent.conf`, `~/.ocp/ocp-indent.conf` and the built-in default. The command-line can of course still be used to override parameters defined in the files. Have a look at ocp-indent's own [`.ocp-indent`](.ocp-indent) file for an example. ### In-file configuration There is no built-in support for in-file configuration directives. Yet, some editors already provide that features, and with emacs, starting your file with a line like: ``` (* -*- ocp-indent-config: in=2 -*- *) ``` will enable you to have the indentation after `in` setup to 2 locally on this file. ## How does it compare to tuareg ? We've run some benchmarks on real code-bases and the result is quite conclusive. Keep in mind than most of existing source files are either indented manually or following tuareg standards. You can see the results [here](http://htmlpreview.github.com/?https://github.com/AltGr/ocp-indent-tests/blob/master/status.html). Moreover, as `ocp-indent` has a deep understanding of the OCaml syntax it shines on specific cases. See for instance the collection of unit-tests [here](https://github.com/OCamlPro/ocp-indent/tree/master/tests/passing). The currently failing tests can be seen [here](http://htmlpreview.github.com/?https://github.com/OCamlPro/ocp-indent/blob/master/tests/failing.html). ## Testing It's hard to deliver a great indenter without tests. We've built `ocp-indent` based on a growing collection of unit-tests. If you find an indentation bug, feel free to send us a code snippet that we will incorporate into our test suite. The tests are organized as follows: * `tests/passing` contains tests that are properly indented and should be left unchanged by ocp-indent. * `tests/failing` contains tests for which ocp-indent currently returns the results in `tests/failing-output`, hence `meld tests/failing{,-output}` should give an overview of currently known bugs (also available online [here](http://htmlpreview.github.com/?https://github.com/OCamlPro/ocp-indent/blob/master/tests/failing.html)). * `tests/test.sh` checks the current state against the reference state (checked into git). * `tests/test.sh --[git-]update` updates the current reference state. * See `tests/test.sh --help` for more Please make sure tu run `make && tests/test.sh --git-update` before any commit, so that the repo always reflects the state of the program. ocp-indent-1.8.2/dune-project000066400000000000000000000000621355404771200161120ustar00rootroot00000000000000(lang dune 1.0) (name ocp-indent) (version 1.8.1) ocp-indent-1.8.2/ocp-indent.opam000066400000000000000000000031301355404771200165050ustar00rootroot00000000000000opam-version: "2.0" maintainer: "contact@ocamlpro.com" synopsis: "A simple tool to indent OCaml programs" description: """ Ocp-indent is based on an approximate, tolerant OCaml parser and a simple stack machine ; this is much faster and more reliable than using regexps. Presets and configuration options available, with the possibility to set them project-wide. Supports most common syntax extensions, and extensible for others. Includes: - An indentor program, callable from the command-line or from within editors - Bindings for popular editors - A library that can be directly used by editor writers, or just for fault-tolerant/approximate parsing. """ authors: [ "Louis Gesbert " "Thomas Gazagnaire " "Jun Furuse" ] homepage: "http://www.typerex.org/ocp-indent.html" bug-reports: "https://github.com/OCamlPro/ocp-indent/issues" license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" tags: ["org:ocamlpro" "org:typerex"] dev-repo: "git+https://github.com/OCamlPro/ocp-indent.git" build: [ ["dune" "build" "-p" name "-j" jobs] ] run-test: [ ["dune" "runtest" "-p" name "-j" jobs] ] depends: [ "ocaml" "dune" {>= "1.0"} "cmdliner" {>= "1.0.0"} "ocamlfind" "base-bytes" ] post-messages: [ "This package requires additional configuration for use in editors. Install package 'user-setup', or manually: * for Emacs, add these lines to ~/.emacs: (add-to-list 'load-path \"%{share}%/emacs/site-lisp\") (require 'ocp-indent) * for Vim, add this line to ~/.vimrc: set rtp^=\"%{share}%/ocp-indent/vim\" " {success & !user-setup:installed} ] ocp-indent-1.8.2/src/000077500000000000000000000000001355404771200143615ustar00rootroot00000000000000ocp-indent-1.8.2/src/approx_lexer.mll000066400000000000000000000577501355404771200176150ustar00rootroot00000000000000(**************************************************************************) (* *) (* TypeRex OCaml Studio *) (* Thomas Gazagnaire, Fabrice Le Fessant, Louis Gesbert *) (* *) (* OCaml *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2011-2013 OCamlPro *) (* Copyright 1996-2011 INRIA. *) (* All rights reserved. This file is distributed under the terms of *) (* the Q Public License version 1.0. *) (* *) (**************************************************************************) { open Lexing include Approx_tokens let list_last l = List.hd (List.rev l) let lines_starts = ref [] (* The table of keywords *) let keywords = [ "and", AND; "as", AS; "assert", ASSERT; "begin", BEGIN; "class", CLASS; "constraint", CONSTRAINT; "do", DO; "done", DONE; "downto", DOWNTO; "else", ELSE; "end", END; "exception", EXCEPTION; "external", EXTERNAL; "false", FALSE; "for", FOR; "fun", FUN; "function", FUNCTION; "functor", FUNCTOR; "if", IF; "in", IN; "include", INCLUDE; "inherit", INHERIT; "initializer", INITIALIZER; "lazy", LAZY; "let", LET; "match", MATCH; "method", METHOD; "module", MODULE; "mutable", MUTABLE; "new", NEW; "object", OBJECT; "of", OF; "open", OPEN; "or", OR; "private", PRIVATE; "rec", REC; "sig", SIG; "struct", STRUCT; "then", THEN; "to", TO; "true", TRUE; "try", TRY; "type", TYPE; "val", VAL; "virtual", VIRTUAL; "when", WHEN; "while", WHILE; "with", WITH; "mod", INFIXOP3("mod"); "land", INFIXOP3("land"); "lor", INFIXOP3("lor"); "lxor", INFIXOP3("lxor"); "lsl", INFIXOP4("lsl"); "lsr", INFIXOP4("lsr"); "asr", INFIXOP4("asr"); ] let keyword_table = let t = Hashtbl.create 149 in List.iter (fun (x,y) -> Hashtbl.add t x y) keywords; t let lexer_extensions : (Lexing.lexbuf -> Approx_tokens.token) list ref = ref [] let enable_extension name = let t = IndentExtend.find name in List.iter (fun (x,y) -> Hashtbl.add keyword_table x y) t.IndentExtend.keywords; match t.IndentExtend.lexer with | None -> () | Some f -> lexer_extensions := f :: !lexer_extensions let disable_extensions () = Hashtbl.clear keyword_table; lexer_extensions := []; List.iter (fun (x,y) -> Hashtbl.add keyword_table x y) keywords (* To buffer string literals *) let initial_string_buffer = Bytes.create 256 let string_buff = ref initial_string_buffer let string_index = ref 0 let reset_string_buffer () = string_buff := initial_string_buffer; string_index := 0 let store_string_char c = if !string_index >= Bytes.length (!string_buff) then begin let new_buff = Bytes.create (Bytes.length (!string_buff) * 2) in Bytes.blit (!string_buff) 0 new_buff 0 (Bytes.length (!string_buff)); string_buff := new_buff end; Bytes.unsafe_set (!string_buff) (!string_index) c; incr string_index let get_stored_string () = let s = Bytes.sub (!string_buff) 0 (!string_index) in string_buff := initial_string_buffer; Bytes.to_string s (* To store the position of the beginning of a string and comment *) let string_start_loc = ref (-1);; let quotation_start_loc = ref (-1);; let quotation_kind = ref (`Camlp4 "<:<": [ `Camlp4 of string | `Ppx of string ]);; type in_comment = Comment | Code | Cinaps (* Like code, but started / ended with "(*$" / "$*)" rather than "{[" / "]}" *) | Verbatim | CommentCont let comment_stack : in_comment list ref = ref [] ;; let entering_inline_code_block = ref false;; let rec close_comment () = match !comment_stack with | Comment :: r -> comment_stack := r; COMMENT | CommentCont :: r -> comment_stack := r; COMMENTCONT | (Code | Cinaps | Verbatim) :: r -> comment_stack := r; ignore (close_comment ()); COMMENTCONT | [] -> assert false ;; let in_comment () = match !comment_stack with | (Comment | CommentCont | Verbatim) :: _ -> true | (Code | Cinaps) :: _ | [] -> false ;; let in_verbatim () = List.mem Verbatim !comment_stack ;; let rewind lexbuf n = lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - n; let curpos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - n } ;; let check_commentclose lexbuf f = let s = Lexing.lexeme lexbuf in let len = String.length s in if s.[len - 1] <> ')' then f s else let rollback = if len >= 2 && !comment_stack <> [] && s.[len - 2] = '*' then 2 (* this is a comment end, unparse it *) else 1 (* only unparse the closing paren *) in let op = String.sub s 0 (len - rollback) in rewind lexbuf rollback; f op ;; let init () = lines_starts := []; (* disable_extensions(); *) reset_string_buffer(); string_start_loc := -1; quotation_start_loc := -1; quotation_kind := `Camlp4 "<:<"; comment_stack := []; entering_inline_code_block := false ;; (* To translate escape sequences *) let char_for_backslash = function | 'n' -> '\010' | 'r' -> '\013' | 'b' -> '\008' | 't' -> '\009' | c -> c let can_overflow f lexbuf = let s = Lexing.lexeme lexbuf in try InRange (f s) with Failure _ -> Overflow s let char_for_decimal_code i s = let c = 100 * (Char.code(s.[i]) - 48) + 10 * (Char.code(s.[i+1]) - 48) + (Char.code(s.[i+2]) - 48) in if (c < 0 || c > 255) then failwith "Bad escaped decimal char" else Char.chr c let char_for_hexadecimal_code lexbuf i = let d1 = Char.code (Lexing.lexeme_char lexbuf i) in let val1 = if d1 >= 97 then d1 - 87 else if d1 >= 65 then d1 - 55 else d1 - 48 in let d2 = Char.code (Lexing.lexeme_char lexbuf (i+1)) in let val2 = if d2 >= 97 then d2 - 87 else if d2 >= 65 then d2 - 55 else d2 - 48 in Char.chr (val1 * 16 + val2) (* To convert integer literals, allowing max_int + 1 (PR#4210) *) let cvt_int_literal s = - int_of_string ("-" ^ s) let cvt_int32_literal s = Int32.neg (Int32.of_string ("-" ^ String.sub s 0 (String.length s - 1))) let cvt_int64_literal s = Int64.neg (Int64.of_string ("-" ^ String.sub s 0 (String.length s - 1))) let cvt_nativeint_literal s = Nativeint.neg (Nativeint.of_string ("-" ^ String.sub s 0 (String.length s - 1))) (* Remove underscores from float literals *) let remove_underscores s = let s = Bytes.of_string s in let l = Bytes.length s in let rec remove src dst = if src >= l then if dst >= l then s else Bytes.sub s 0 dst else match Bytes.get s src with '_' -> remove (src + 1) dst | c -> Bytes.set s dst c; remove (src + 1) (dst + 1) in Bytes.to_string (remove 0 0) (* Update the current location with file name and line number. *) let update_loc lexbuf file line absolute chars = let pos = lexbuf.lex_curr_p in let new_file = match file with | None -> pos.pos_fname | Some s -> s in lexbuf.lex_curr_p <- { pos with pos_fname = new_file; pos_lnum = if absolute then line else pos.pos_lnum + line; pos_bol = pos.pos_cnum - chars; }; lines_starts := (lexbuf.lex_curr_p.pos_lnum, lexbuf.lex_curr_p.pos_bol) :: !lines_starts; ;; } let newline = ('\010' | '\013' | "\013\010") let blank = [' ' '\009' '\012'] let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_' '\''] let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222' '`'] let identchar = ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] let symbolchar = ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] let bindingopchar = ['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|'] let decimal_literal = (['0'-'9'] ['0'-'9' '_']*) let hex_literal = ('0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']['0'-'9' 'A'-'F' 'a'-'f' '_']*) let oct_literal = ('0' ['o' 'O'] ['0'-'7'] ['0'-'7' '_']*) let bin_literal = ('0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']*) let int_literal = (decimal_literal | hex_literal | oct_literal | bin_literal) let float_literal = ['0'-'9'] ['0'-'9' '_']* ('.' ['0'-'9' '_']* )? (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)? rule parse_token = parse | newline { update_loc lexbuf None 1 false 0; EOL } | blank + { SPACES } | "_" { UNDERSCORE } | "~" { TILDE } | "~" lowercase identchar * ':' { let s = Lexing.lexeme lexbuf in let name = String.sub s 1 (String.length s - 2) in (* if Hashtbl.mem keyword_table name then raise (Error(Keyword_as_label name, Location.curr lexbuf)); *) LABEL name } | "?" { QUESTION } | "??" { QUESTIONQUESTION } | "?" lowercase identchar * ':' { let s = Lexing.lexeme lexbuf in let name = String.sub s 1 (String.length s - 2) in (* if Hashtbl.mem keyword_table name then raise (Error(Keyword_as_label name, Location.curr lexbuf)); *) OPTLABEL name } | lowercase identchar * ( '%' identchar + ('.' identchar +) * ) ? { let s = Lexing.lexeme lexbuf in try let i = String.index_from s 1 '%' in let kw = String.sub s 0 i in try Hashtbl.find keyword_table kw with Not_found -> rewind lexbuf (String.length s - i); LIDENT s with Not_found -> try Hashtbl.find keyword_table s with Not_found -> LIDENT s } | uppercase identchar * { UIDENT(Lexing.lexeme lexbuf) } (* No capitalized keywords *) | int_literal { INT (can_overflow cvt_int_literal lexbuf) } | float_literal { FLOAT (remove_underscores(Lexing.lexeme lexbuf)) } | int_literal "l" { INT32 (can_overflow cvt_int32_literal lexbuf) } | int_literal "L" { INT64 (can_overflow cvt_int64_literal lexbuf) } | int_literal "n" { NATIVEINT (can_overflow cvt_nativeint_literal lexbuf) } | "\"" { reset_string_buffer(); let string_start = lexbuf.lex_start_p in string_start_loc := Lexing.lexeme_start lexbuf; let token = string lexbuf in lexbuf.lex_start_p <- string_start; token } | "'" newline "'" { update_loc lexbuf None 1 false 1; CHAR (InRange (Lexing.lexeme_char lexbuf 1)) } | "'" [^ '\\' '\'' '\010' '\013'] "'" { CHAR( InRange (Lexing.lexeme_char lexbuf 1)) } | "'\\" ['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] "'" { CHAR( InRange (char_for_backslash (Lexing.lexeme_char lexbuf 2))) } | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" { CHAR(can_overflow (char_for_decimal_code 2) lexbuf) } | "'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "'" { CHAR( InRange (char_for_hexadecimal_code lexbuf 3)) } | "'\\" _ { let l = Lexing.lexeme lexbuf in CHAR ( Overflow l ) } | "(*$" { entering_inline_code_block := true; comment_stack := Comment :: !comment_stack; rewind lexbuf 1; COMMENT } | "(*" { let comment_start = lexbuf.lex_start_p in comment_stack := Comment :: !comment_stack; let token = comment lexbuf in lexbuf.lex_start_p <- comment_start; token } | "*)" { match !comment_stack with | _ :: _ -> close_comment () | [] -> rewind lexbuf 1; STAR } | '{' [ '[' 'v' ] { if !entering_inline_code_block then begin entering_inline_code_block := false; match !comment_stack with | Code :: _ -> OCAMLDOC_CODE | Verbatim :: _ -> let verb_start = lexbuf.lex_start_p in let token = verbatim lexbuf in lexbuf.lex_start_p <- verb_start; token | _ -> assert false end else begin rewind lexbuf 1; LBRACE end } | [ ']' 'v' ] '}' { match !comment_stack with | (Code|Verbatim)::r -> comment_stack := r; let comment_start = lexbuf.lex_start_p in let token = comment lexbuf in lexbuf.lex_start_p <- comment_start; token | _ -> rewind lexbuf 1; match Bytes.get lexbuf.lex_buffer (lexbuf.lex_curr_pos - 1) with | ']' -> RBRACKET | 'v' -> LIDENT "v" | _ -> assert false } | "]}" { match !comment_stack with | Code::r -> comment_stack := r; let comment_start = lexbuf.lex_start_p in let token = comment lexbuf in lexbuf.lex_start_p <- comment_start; token | _ -> rewind lexbuf 1; RBRACKET } | "v}" { match !comment_stack with | Verbatim::r -> comment_stack := r; let comment_start = lexbuf.lex_start_p in let token = comment lexbuf in lexbuf.lex_start_p <- comment_start; token | _ -> rewind lexbuf 1; LIDENT "v" } | "<:" identchar * "<" { let start = lexbuf.lex_start_p in quotation_start_loc := Lexing.lexeme_start lexbuf; let s = Lexing.lexeme lexbuf in let tag = String.sub s 2 (String.length s - 3) in quotation_kind := `Camlp4 tag; let token = quotation lexbuf in lexbuf.lex_start_p <- start; token } | "{" identchar * "|" { let start = lexbuf.lex_start_p in quotation_start_loc := Lexing.lexeme_start lexbuf; let s = Lexing.lexeme lexbuf in let delim = String.sub s 1 (String.length s - 2) in quotation_kind := `Ppx delim; let token = quotation lexbuf in lexbuf.lex_start_p <- start; token } | "#" [' ' '\t']* (['0'-'9']+ as _num) [' ' '\t']* ("\"" ([^ '\010' '\013' '"' ] * as _name) "\"")? [^ '\010' '\013'] * newline { update_loc lexbuf None 1 false 0; LINE_DIRECTIVE } | "#" { SHARP } | "&" { AMPERSAND } | "&&" { AMPERAMPER } | "`" { BACKQUOTE } | "'" { QUOTE } | "(" { LPAREN } | ")" { RPAREN } | "*" { STAR } | "," { COMMA } | "->" { MINUSGREATER } | "." { DOT } | ".." { DOTDOT } | ":" { COLON } | "::" { COLONCOLON } | ":=" { COLONEQUAL } | ":>" { COLONGREATER } | ";" ( '%' identchar + ('.' identchar +) * ) ? { SEMI } | ";;" { SEMISEMI } | "<" { LESS } | "<-" { LESSMINUS } | "=" { EQUAL } | "[" { LBRACKET } | "[|" { LBRACKETBAR } | "[<" { LBRACKETLESS } | "[>" { LBRACKETGREATER } | "]" { RBRACKET } | "{" { LBRACE } | "{<" { LBRACELESS } | "|" { BAR } | "||" { BARBAR } | "|]" { BARRBRACKET } | ">" { GREATER } | ">]" { GREATERRBRACKET } | "}" { RBRACE } | ">}" { GREATERRBRACE } | "[%" { LBRACKETPERCENT } | "[%%" { LBRACKETPERCENTPERCENT } | "[@" { LBRACKETAT } | "[@@" { LBRACKETATAT } | "[@@@" { LBRACKETATATAT } | "!" { BANG } | "!=" { INFIXOP0 "!=" } | "+" { PLUS } | "+." { PLUSDOT } | "-" { MINUS } | "-." { MINUSDOT } | "!" symbolchar + ')'? { check_commentclose lexbuf (fun s -> PREFIXOP s) } | ['~' '?'] symbolchar + ')'? { check_commentclose lexbuf (fun s -> PREFIXOP s) } | '$' symbolchar * ')'? { if !entering_inline_code_block then begin entering_inline_code_block := false; comment_stack := Cinaps :: !comment_stack; rewind lexbuf (Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf - 1); OCAMLDOC_CODE end else check_commentclose lexbuf (fun s -> INFIXOP0 s) } | ['=' '<' '>' '|' '&'] symbolchar * ')'? { check_commentclose lexbuf (fun s -> INFIXOP0 s) } | ['@' '^'] symbolchar * ')'? { check_commentclose lexbuf (fun s -> INFIXOP1 s) } | ['+' '-'] symbolchar * ')'? { check_commentclose lexbuf (fun s -> INFIXOP2 s) } | "**" symbolchar * ')'? { check_commentclose lexbuf (fun s -> INFIXOP4 s) } | ['*' '/' '%'] symbolchar * ')'? { check_commentclose lexbuf (fun s -> INFIXOP3 s) } | "let" bindingopchar symbolchar* ')'? { check_commentclose lexbuf (fun _ -> LET) } | "and" bindingopchar symbolchar* ')'? { check_commentclose lexbuf (fun _ -> AND) } | eof { EOF } | _ { ILLEGAL_CHAR (Lexing.lexeme_char lexbuf 0) } and quotation = parse ">>" { match !quotation_kind with | `Camlp4 tag -> QUOTATION ("<:"^tag^"<") | `Ppx _ -> quotation lexbuf } | "|" identchar * "}" { match !quotation_kind with | `Ppx delim -> let s = Lexing.lexeme lexbuf in let ndelim = String.sub s 1 (String.length s - 2) in if ndelim = delim then QUOTATION ("{"^delim^"|") else quotation lexbuf | `Camlp4 _ -> quotation lexbuf } | newline { update_loc lexbuf None 1 false 0; quotation lexbuf } | eof { match !quotation_kind with | `Camlp4 tag -> QUOTATION ("<:"^tag^"<") | `Ppx delim -> QUOTATION ("{"^delim^"|") } | _ { quotation lexbuf } and comment = parse | "(*" { comment_stack := Comment :: !comment_stack; comment lexbuf } | "*)" | eof { let tok = close_comment () in if in_verbatim () then verbatim lexbuf else match !comment_stack with | (Comment | CommentCont) :: _ -> comment lexbuf | _ -> tok } | (newline blank*)? '{' [ '[' 'v' ] { if in_verbatim() then comment lexbuf else let tok = match !comment_stack with | CommentCont::_ -> COMMENTCONT | Comment::r -> comment_stack := CommentCont::r; COMMENT | _s -> assert false in let block = match Bytes.get lexbuf.lex_buffer (lexbuf.lex_curr_pos - 1) with | '[' -> Code | 'v' -> Verbatim | _ -> assert false in comment_stack := block :: !comment_stack; entering_inline_code_block := true; (* unparse the token, to be parsed again as code *) lexbuf.Lexing.lex_curr_p <- lexbuf.Lexing.lex_start_p; lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_start_pos; tok } | '"' { reset_string_buffer(); string_start_loc := Lexing.lexeme_start lexbuf; ignore (string lexbuf); reset_string_buffer (); comment lexbuf } | "{" identchar * "|" { quotation_start_loc := Lexing.lexeme_start lexbuf; let s = Lexing.lexeme lexbuf in let delim = String.sub s 1 (String.length s - 2) in quotation_kind := `Ppx delim; ignore (quotation lexbuf); comment lexbuf } | "''" { comment lexbuf } | "'" newline "'" { update_loc lexbuf None 1 false 1; comment lexbuf } | "'" [^ '\\' '\'' '\010' '\013' ] "'" { comment lexbuf } | "'\\" ['\\' '"' '\'' 'n' 't' 'b' 'r' ' '] "'" { comment lexbuf } | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" { comment lexbuf } | "'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "'" { comment lexbuf } | newline { update_loc lexbuf None 1 false 0; comment lexbuf } | _ { comment lexbuf } (* Ocamldoc verbatim, inside comments ; mostly the same as the comment rule *) and verbatim = parse | "(*" { comment_stack := Comment :: !comment_stack; comment lexbuf } | "*)" { (* leave the verbatim block and unparse the token *) comment_stack := (match !comment_stack with | Verbatim :: s -> s | _ -> assert false); lexbuf.Lexing.lex_curr_p <- lexbuf.Lexing.lex_start_p; lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_start_pos; (* let the surrounding comments close themselves *) match !comment_stack with | Comment :: _ -> comment lexbuf | CommentCont :: r -> comment_stack := Comment :: r; comment lexbuf | _ -> OCAMLDOC_VERB } | "v}" { (* Unparse the token but leave the comment stack. The token rule will reparse, detect it, pop the verbatim and return to the comment rule. *) rewind lexbuf 2; OCAMLDOC_VERB } | "\"" { reset_string_buffer(); string_start_loc := Lexing.lexeme_start lexbuf; ignore (string lexbuf); reset_string_buffer (); verbatim lexbuf } | "''" { verbatim lexbuf } | "'" newline "'" { update_loc lexbuf None 1 false 1; verbatim lexbuf } | "'" [^ '\\' '\'' '\010' '\013' ] "'" { verbatim lexbuf } | "'\\" ['\\' '"' '\'' 'n' 't' 'b' 'r' ' '] "'" { verbatim lexbuf } | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" { verbatim lexbuf } | "'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "'" { verbatim lexbuf } | newline { update_loc lexbuf None 1 false 0; verbatim lexbuf } | eof { OCAMLDOC_VERB } | _ { verbatim lexbuf } and string = parse '"' | eof { STRING (get_stored_string ()) } | '\\' newline ([' ' '\t'] * as space) { update_loc lexbuf None 1 false (String.length space); string lexbuf } | '\\' ['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); string lexbuf } | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] { (match can_overflow (char_for_decimal_code 1) lexbuf with | Overflow _ -> let s = Lexing.lexeme lexbuf in for i = 0 to String.length s - 1 do store_string_char s.[i] done | InRange c -> store_string_char c); string lexbuf } | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] { store_string_char(char_for_hexadecimal_code lexbuf 2); string lexbuf } | '\\' _ { if in_comment () then string lexbuf else begin (* Should be an error, but we are very lax. raise (Error (Illegal_escape (Lexing.lexeme lexbuf), Location.curr lexbuf)) *) store_string_char (Lexing.lexeme_char lexbuf 0); store_string_char (Lexing.lexeme_char lexbuf 1); string lexbuf end } | newline { update_loc lexbuf None 1 false 0; let s = Lexing.lexeme lexbuf in for i = 0 to String.length s - 1 do store_string_char s.[i]; done; string lexbuf } | _ { store_string_char(Lexing.lexeme_char lexbuf 0); string lexbuf } { let token = let rec tok lexbuf = function | [] -> parse_token lexbuf | x::xs -> begin try x lexbuf with | _ -> tok lexbuf xs end in fun lexbuf -> tok lexbuf !lexer_extensions let rec token_locs lexbuf = match token lexbuf with COMMENT -> token_locs lexbuf | token -> token, ( lexbuf.lex_start_p, lexbuf.lex_curr_p) let rec token_pos lexbuf = match token lexbuf with COMMENT -> token_pos lexbuf | token -> token, ( lexbuf.lex_start_p.pos_cnum, lexbuf.lex_curr_p.pos_cnum) let token_locs_and_comments lexbuf = let token = token lexbuf in token, ( lexbuf.lex_start_p, lexbuf.lex_curr_p) let get_token = token let token_with_comments = get_token let rec token lexbuf = match get_token lexbuf with COMMENT -> token lexbuf | tok -> tok let tokens_of_file filename = let ic = open_in filename in try init (); let lexbuf = Lexing.from_channel ic in let rec iter tokens = let token = token_pos lexbuf in match token with (EOF, _) -> List.rev tokens | _ -> iter (token :: tokens) in let tokens = iter [] in close_in ic; tokens with e -> close_in ic; raise e let tokens_with_loc_of_string s = init (); let lexbuf = Lexing.from_string s in let rec iter tokens = let token = token_pos lexbuf in match token with (EOF, _) -> List.rev tokens | _ -> iter (token :: tokens) in let tokens = iter [] in tokens let tokens_of_string s = init (); let lexbuf = Lexing.from_string s in let rec iter tokens = let token = token lexbuf in match token with (EOF) -> List.rev tokens | _ -> iter (token :: tokens) in let tokens = iter [] in tokens let lines () = List.rev ( !lines_starts ) } ocp-indent-1.8.2/src/approx_tokens.ml000066400000000000000000000147761355404771200176260ustar00rootroot00000000000000(**************************************************************************) (* *) (* TypeRex OCaml Studio *) (* Thomas Gazagnaire, Fabrice Le Fessant, Louis Gesbert *) (* *) (* OCaml *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2011-2013 OCamlPro *) (* Copyright 1996-2011 INRIA. *) (* All rights reserved. This file is distributed under the terms of *) (* the Q Public License version 1.0. *) (* *) (**************************************************************************) (* ADMIN: fabrice *) (* Instead of raising an error when a CHAR, INT, INT32, INT64 or NATIVEINT overflows, we just changed the returned value to take that into account. *) type 'a overflow = | InRange of 'a | Overflow of string type token = | AMPERAMPER | AMPERSAND | AND | AS | ASSERT | BACKQUOTE | BANG | BAR | BARBAR | BARRBRACKET | BEGIN | CHAR of (char overflow) | CLASS | COLON | COLONCOLON | COLONEQUAL | COLONGREATER | COMMA (* Start of comment from code *) | COMMENT (* Start of inline code section within comment: "{[" *) | OCAMLDOC_CODE (* Start of verbatim section within comment: "{v" *) | OCAMLDOC_VERB (* Continuation of comment after a closed ocamldoc code or verb section *) | COMMENTCONT | CONSTRAINT | DO | DONE | DOT | DOTDOT | DOWNTO | ELSE | END | EOF | EQUAL | EXCEPTION | EXTERNAL | FALSE | FLOAT of (string) | FOR | FUN | FUNCTION | FUNCTOR | GREATER | GREATERRBRACE | GREATERRBRACKET | IF | ILLEGAL_CHAR of (char) | IN | INCLUDE | INFIXOP0 of (string) | INFIXOP1 of (string) | INFIXOP2 of (string) | INFIXOP3 of (string) | INFIXOP4 of (string) | INHERIT | INITIALIZER | INT of (int overflow) | INT32 of (int32 overflow) | INT64 of (int64 overflow) | LABEL of (string) | LAZY | LBRACE | LBRACELESS | LBRACKET | LBRACKETBAR | LBRACKETLESS | LBRACKETGREATER | LBRACKETPERCENT | LBRACKETPERCENTPERCENT | LBRACKETAT | LBRACKETATAT | LBRACKETATATAT | LESS | LESSMINUS | LET | LIDENT of (string) | LINE_DIRECTIVE | LPAREN | MATCH | METHOD | MINUS | MINUSDOT | MINUSGREATER | MODULE | MUTABLE | NATIVEINT of (nativeint overflow) | NEW | OBJECT | OF | OPEN | OPTLABEL of (string) | OR | PLUS | PLUSDOT | PREFIXOP of (string) | PRIVATE | QUESTION | QUESTIONQUESTION | QUOTATION of (string) | QUOTE | RBRACE | RBRACKET | REC | RPAREN | SEMI | SEMISEMI | SHARP | SIG | STAR | STRING of (string) | STRUCT | THEN | TILDE | TO | TRUE | TRY | TYPE | UIDENT of (string) | UNDERSCORE | VAL | VIRTUAL | WHEN | WHILE | WITH | EOL | SPACES let to_string = function | AMPERAMPER -> "AMPERAMPER" | AMPERSAND -> "AMPERSAND" | AND -> "AND" | AS -> "AS" | ASSERT -> "ASSERT" | BACKQUOTE -> "BACKQUOTE" | BANG -> "BANG" | BAR -> "BAR" | BARBAR -> "BARBAR" | BARRBRACKET -> "BARRBRACKET" | BEGIN -> "BEGIN" | CHAR _ -> "CHAR" | CLASS -> "CLASS" | COLON -> "COLON" | COLONCOLON -> "COLONCOLON" | COLONEQUAL -> "COLONEQUAL" | COLONGREATER -> "COLONGREATER" | COMMA -> "COMMA" (* Start of comment from code *) | COMMENT -> "COMMENT" (* Start of inline code section within comment: "{[" *) | OCAMLDOC_CODE -> "OCAMLDOC_CODE" (* Start of verbatim section within comment: "{v" *) | OCAMLDOC_VERB -> "OCAMLDOC_VERB" (* Continuation of comment after a closed ocamldoc code or verb section *) | COMMENTCONT -> "COMMENTCONT" | CONSTRAINT -> "CONSTRAINT" | DO -> "DO" | DONE -> "DONE" | DOT -> "DOT" | DOTDOT -> "DOTDOT" | DOWNTO -> "DOWNTO" | ELSE -> "ELSE" | END -> "END" | EOF -> "EOF" | EQUAL -> "EQUAL" | EXCEPTION -> "EXCEPTION" | EXTERNAL -> "EXTERNAL" | FALSE -> "FALSE" | FLOAT _ -> "FLOAT" | FOR -> "FOR" | FUN -> "FUN" | FUNCTION -> "FUNCTION" | FUNCTOR -> "FUNCTOR" | GREATER -> "GREATER" | GREATERRBRACE -> "GREATERRBRACE" | GREATERRBRACKET -> "GREATERRBRACKET" | IF -> "IF" | ILLEGAL_CHAR _ -> "ILLEGAL_CHAR" | IN -> "IN" | INCLUDE -> "INCLUDE" | INFIXOP0 _ -> "INFIXOP0" | INFIXOP1 _ -> "INFIXOP1" | INFIXOP2 _ -> "INFIXOP2" | INFIXOP3 _ -> "INFIXOP3" | INFIXOP4 _ -> "INFIXOP4" | INHERIT -> "INHERIT" | INITIALIZER -> "INITIALIZER" | INT _ -> "INT" | INT32 _ -> "INT32" | INT64 _ -> "INT64" | LABEL _ -> "LABEL" | LAZY -> "LAZY" | LBRACE -> "LBRACE" | LBRACELESS -> "LBRACELESS" | LBRACKET -> "LBRACKET" | LBRACKETBAR -> "LBRACKETBAR" | LBRACKETLESS -> "LBRACKETLESS" | LBRACKETGREATER -> "LBRACKETGREATER" | LBRACKETPERCENT -> "LBRACKETPERCENT" | LBRACKETPERCENTPERCENT -> "LBRACKETPERCENTPERCENT" | LBRACKETAT -> "LBRACKETAT" | LBRACKETATAT -> "LBRACKETATAT" | LBRACKETATATAT -> "LBRACKETATATAT" | LESS -> "LESS" | LESSMINUS -> "LESSMINUS" | LET -> "LET" | LIDENT _ -> "LIDENT" | LINE_DIRECTIVE -> "LINE_DIRECTIVE" | LPAREN -> "LPAREN" | MATCH -> "MATCH" | METHOD -> "METHOD" | MINUS -> "MINUS" | MINUSDOT -> "MINUSDOT" | MINUSGREATER -> "MINUSGREATER" | MODULE -> "MODULE" | MUTABLE -> "MUTABLE" | NATIVEINT _ -> "NATIVEINT" | NEW -> "NEW" | OBJECT -> "OBJECT" | OF -> "OF" | OPEN -> "OPEN" | OPTLABEL _ -> "OPTLABEL" | OR -> "OR" | PLUS -> "PLUS" | PLUSDOT -> "PLUSDOT" | PREFIXOP _ -> "PREFIXOP" | PRIVATE -> "PRIVATE" | QUESTION -> "QUESTION" | QUESTIONQUESTION -> "QUESTIONQUESTION" | QUOTATION _ -> "QUOTATION" | QUOTE -> "QUOTE" | RBRACE -> "RBRACE" | RBRACKET -> "RBRACKET" | REC -> "REC" | RPAREN -> "RPAREN" | SEMI -> "SEMI" | SEMISEMI -> "SEMISEMI" | SHARP -> "SHARP" | SIG -> "SIG" | STAR -> "STAR" | STRING _ -> "STRING" | STRUCT -> "STRUCT" | THEN -> "THEN" | TILDE -> "TILDE" | TO -> "TO" | TRUE -> "TRUE" | TRY -> "TRY" | TYPE -> "TYPE" | UIDENT _ -> "UIDENT" | UNDERSCORE -> "UNDERSCORE" | VAL -> "VAL" | VIRTUAL -> "VIRTUAL" | WHEN -> "WHEN" | WHILE -> "WHILE" | WITH -> "WITH" | EOL -> "EOL" | SPACES -> "SPACES" ocp-indent-1.8.2/src/compat.ml000066400000000000000000000003651355404771200162020ustar00rootroot00000000000000external ( @* ) : ('a -> 'b) -> 'a -> 'b = "%apply" external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply" module String = struct include String let is_space = function | ' ' | '\012' | '\n' | '\r' | '\t' -> true | _ -> false end ocp-indent-1.8.2/src/dune000066400000000000000000000020101355404771200152300ustar00rootroot00000000000000(rule (targets indentVersion.ml) (action (with-stdout-to %{targets} (echo "let version = \"%{version:ocp-indent}\""))) ) (ocamllex approx_lexer) (library (name ocp_indent_lexer) (public_name ocp-indent.lexer) (wrapped false) (modules indentExtend approx_tokens approx_lexer) ) (library (name ocp_indent_lib) (wrapped false) (public_name ocp-indent.lib) (libraries ocp-indent.utils) (modules indentConfig indentBlock indentPrinter) (flags :standard -w -9 -warn-error -57) ) (library (name ocp_indent_utils) (public_name ocp-indent.utils) (wrapped false) (libraries bytes ocp-indent.lexer) (modules compat pos util nstream) ) (library (name ocp_indent_dynlink) (public_name ocp-indent.dynlink) (wrapped false) (modules indentLoader) (libraries findlib dynlink ocp-indent.lexer ocp-indent.utils) ) (executable (name indentMain) (public_name ocp-indent) (modules indentVersion indentArgs indentMain) (libraries cmdliner ocp-indent.lexer ocp-indent.lib ocp-indent.dynlink unix) (flags :standard -w -9) ) ocp-indent-1.8.2/src/indentArgs.ml000066400000000000000000000223411355404771200170130ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) open Cmdliner type input = InChannel of in_channel | File of string type t = { file_out : string option; numeric: bool; (* [indent_config] Stores the config strings, because different files may have different defaults if located in different directories *) indent_config: string list; debug: bool; inplace : bool; indent_empty: bool; in_lines: int -> bool; indent_printer: out_channel -> unit IndentPrinter.output_kind; syntax_exts: string list; dynlink : [`Mod of string | `Pkg of string] list; } let options = let config = let doc = "Configure the indentation parameters. See section \ $(b,CONFIGURATION) for more information." in let config_converter = (fun str -> try (* just check syntax *) ignore (IndentConfig.update_from_string IndentConfig.default str); `Ok str with Invalid_argument s -> `Error s), (Format.pp_print_string) in Arg.(value & opt_all config_converter [] & info ["c";"config"] ~docv:"CONFIG" ~doc) in let debug = let doc = "Enable debug output to stderr." in Arg.(value & flag & info ["d";"debug"] ~doc) in let inplace = let doc = "Re-indent files in-place." in Arg.(value & flag & info ["i";"inplace"] ~doc) in let indent_empty = let doc = "Return indent for empty lines, too. Especially usefull \ with $(b,--numeric)." in Arg.(value & flag & info ["indent-empty"] ~doc) in let lines = let doc = "Only re-indent the lines in $(docv) (eg. 10-12), \ adapting to the current indentation of surrounding lines. \ Lines start at 1." in let range_converter = (fun str -> try match Util.string_split '-' str with | [s] -> let li = int_of_string s in `Ok(Some li, Some li) | [s1;s2] -> let f = function "" -> None | s -> Some (int_of_string s) in `Ok (f s1, f s2) | _ -> failwith "range_converter" with Failure _ -> `Error "invalid range specification."), (fun fmt -> function | Some n1, Some n2 when n1 = n2 -> Format.pp_print_int fmt n1 | o1, o2 -> let f fmt = function None -> () | Some n -> Format.pp_print_int fmt n in Format.fprintf fmt "%a-%a" f o1 f o2) in Arg.(value & opt range_converter (None,None) & info ["l";"lines"] ~docv:"RANGE" ~doc) in let numeric = let doc = "Instead of re-indenting the file, output one integer per line \ representing the indentation value. When specified together \ with $(i,--lines), only print as many values as lines in the \ range." in Arg.(value & flag & info ["numeric"] ~doc) in let output = let doc = "Output to $(docv). The default is to print to stdout." in Arg.(value & opt (some string) None & info ["o";"output"] ~docv:"FILE" ~doc) in let print_config = let doc = "Print the current parameters to stdout and exit. \ (See section $(b,CONFIGURATION) for more information.)" in Arg.(value & flag & info ["print-config"] ~doc) in let syntax = let doc = "Extend the handled syntax for OCaml syntax extensions." in let arg = Arg.(value & opt_all (list string) [] & info ["syntax"] ~doc) in Term.(pure List.flatten $ arg) in let load_pkgs = let doc = "Load plugins." in let arg = Arg.(value & opt_all (list string) [] & info ["load-pkgs"] ~doc) in Term.(pure List.flatten $ arg) in let load_mods = let doc = "Load plugins." in let arg = Arg.(value & opt_all (list string) [] & info ["load-mods"] ~doc) in Term.(pure List.flatten $ arg) in let files = let arg = Arg.(value & pos_all file [] & info [] ~docv:"FILE") in let f = function | [] -> [InChannel stdin] | l -> List.map (function "-" -> InChannel stdin | s -> File s) l in Term.(pure f $ arg) in let build_t indent_config debug inplace indent_empty lines numeric file_out print_config syntax_exts load_pkgs load_mods files = if inplace && (file_out <> None || numeric) then `Error (false, "incompatible options used with --inplace") else if print_config then (let conf, synt,dlink = IndentConfig.local_default () in let conf = List.fold_left IndentConfig.update_from_string conf indent_config in print_endline (IndentConfig.to_string ~sep:"\n" conf); if synt <> [] then Printf.printf "syntax = %s\n" (String.concat " " synt); if dlink <> [] then Printf.printf "load = %s\n" (String.concat " " ( List.map (function `Pkg s -> s | `Mod s -> s) dlink)); exit 0) else `Ok ( { file_out; numeric; indent_config; debug; inplace; indent_empty = indent_empty || (match lines with | Some fst, Some lst when fst = lst -> true | _ -> false); in_lines = (match lines with | None, None -> fun _ -> true | Some first, Some last -> fun l -> first <= l && l <= last | Some first, None -> fun l -> first <= l | None, Some last -> fun l -> l <= last); indent_printer = (fun oc -> if numeric then IndentPrinter.Numeric (fun n () -> output_string oc (string_of_int n); output_string oc "\n") else IndentPrinter.Print (if debug then (fun s () -> output_string oc s; try let _ = String.index s '\n' in flush stdout with Not_found -> ()) else (fun s () -> output_string oc s))); syntax_exts; dynlink = (List.map (fun s -> `Mod s) load_mods) @ (List.map (fun s -> `Pkg s) load_pkgs) }, files ) in let t = Term.(pure build_t $ config $ debug $ inplace $ indent_empty $ lines $ numeric $ output $ print_config $ syntax $ load_pkgs $ load_mods $ files) in Term.ret t let info = let doc = "Automatic indentation of OCaml source files" in let man = [ `S "DESCRIPTION"; `P "Indent OCaml source files according to the official conventions, with \ a small number of tunable parameters."; `P "Outputs the indented version of each FILE given in the command line to \ standard output, unless invoked with the `--inplace' option (see \ $(b,OPTIONS) below). If no FILE is provided, reads from standard \ input."; `S "CONFIGURATION"; `P "Parameters can be defined on the command-line via the $(i,--config) \ option, or as a configuration definition in one of the following, \ searched in order: a file named `.ocp-indent' in the current directory \ or its parents (which allows for per-project indentation settings), \ the file `\\$XDG_CONFIG_HOME/ocp/ocp-indent.conf', the file \ `\\$HOME/.ocp/ocp-indent.conf', or the environment variable \ \\$OCP_INDENT_CONFIG." ] @ IndentConfig.man @ [ `S "BUGS"; `P "Bugs are tracked on github at \ $(i,https://github.com/OCamlPro/ocp-indent/issues). The $(i,tests) \ directory of the source distribution is a good snapshot of the current \ status, and can be checked online at \ $(i,http://htmlpreview.github.io/?\ https://github.com/OCamlPro/ocp-indent/blob/master/tests/failing.html)"; `S "SEE ALSO"; `P "ocaml(1), ocp-index(1)"; `S "AUTHORS"; `P "Louis Gesbert and Thomas Gazagnaire from OCamlPro, from an original \ prototype by Jun Furuse."; `S "LICENSE"; `P "Copyright (C) 2013 OCamlPro."; `P "ocp-indent is free software, released under the terms of the GNU General \ Public License version 3, the text of which can be found in the file \ `LICENSE' distributed with the sources." ] in Term.info "ocp-indent" ~version:IndentVersion.version ~doc ~man ocp-indent-1.8.2/src/indentArgs.mli000066400000000000000000000032211355404771200171600ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) type input = InChannel of in_channel | File of string (* Type of parameters obtained from command-line options *) type t = private { file_out : string option; numeric: bool; indent_config: string list; debug: bool; inplace : bool; indent_empty: bool; in_lines: int -> bool; indent_printer: out_channel -> unit IndentPrinter.output_kind; syntax_exts: string list; dynlink : [`Pkg of string | `Mod of string ] list; } val options: (t * input list) Cmdliner.Term.t val info: Cmdliner.Term.info ocp-indent-1.8.2/src/indentBlock.ml000066400000000000000000001703531355404771200171600ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012,2015 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) open Pos open Nstream open Approx_lexer open Util module Node = struct type extension_kind = ExtNode | Attr (* Node kind *) type kind = | KParen | KBrace | KBracket | KBracketBar | KLet | KAnd of kind | KLetIn | KIn | KExpr of int (* actually handles also patterns / types / ... *) (* Parameter:Priority - next expression is deindented if the op has lower priority *) | KBody of kind | KArrow of kind | KColon | KType | KConstraint | KException | KOpen | KInclude | KVal | KBar of kind (* Stores the original token and line offset for alignment of comment continuations *) | KComment of Nstream.token * int (* ocamldoc verbatim block *) | KVerbatim of Nstream.token * int | KUnknown | KStruct | KSig | KModule | KBegin | KObject | KMatch | KTry | KWith of kind | KLoop | KIf | KThen | KElse | KDo | KFun | KWhen | KExternal | KCodeInComment | KExtendedExpr of string list * extension_kind | KExtendedItem of string list * extension_kind | KAttrId of string list * bool (* Priority of open expression constructs (see below for operators) *) let prio = function | KIn | KArrow _ -> 0 | KThen | KElse -> 10 | KExpr i -> i | _ -> -10 let prio_max = 200 let prio_dot = 160 let prio_apply = 140 let expr_atom = KExpr prio_max let expr_apply = KExpr 140 let prio_lbracketat = 30 (* Special operators that should break arrow indentation have this prio (eg monad operators, >>=) *) let prio_flatop = 59 let prio_colon = 35 let prio_arrow = 32 let prio_semi = 5 let rec follow = function | KAnd k | KBody k | KWith k -> follow k | k -> k let rec string_of_kind = function | KExpr i -> Printf.sprintf "KExpr(%d)" i | KParen -> "KParen" | KBrace -> "KBrace" | KBracket -> "KBracket" | KBracketBar -> "KBracketBar" (* | KField -> "KField" *) | KLet -> "KLet" | KIn -> "KIn" | KAnd k -> aux "KAnd" k | KLetIn -> "KLetIn" | KBody k -> aux "KBody" k | KArrow k -> aux "KArrow" k | KColon -> "KColon" | KVal -> "KVal" | KBar k -> aux "KBar" k | KOpen -> "KOpen" | KInclude -> "KInclude" | KComment _ -> "KComment" | KVerbatim _ -> "KVerbatim" | KUnknown -> "KUnknown" | KType -> "Ktype" | KConstraint -> "KConstraint" | KException -> "KException" | KStruct -> "KStruct" | KSig -> "KSig" | KModule -> "KModule" | KBegin -> "KBegin" | KObject -> "KObject" | KMatch -> "KMatch" | KTry -> "KTry" | KWith k -> aux "KWith" k | KLoop -> "KLoop" | KIf -> "KIf" | KThen -> "Kthen" | KElse -> "KElse" | KDo -> "KDo" | KFun -> "KFun" | KWhen -> "KWhen" | KExternal -> "KExternal" | KCodeInComment -> "KCodeInComment" | KExtendedExpr (name, kind) -> Printf.sprintf "KExtendedExpr(%s,%s)" (String.concat "." (List.rev name)) (match kind with ExtNode -> "node" | Attr -> "attr") | KExtendedItem (name, kind) -> Printf.sprintf "KExtendedItem(%s,%s)" (String.concat "." (List.rev name)) (match kind with ExtNode -> "node" | Attr -> "attr") | KAttrId(name, dotted) -> Printf.sprintf "KAttrId(%s,%B)" (String.concat "." (List.rev name)) dotted and aux str k = Printf.sprintf "%s(%s)" str (string_of_kind k) (* A node: - has a kind - has the current line offset [indent] - has the current token offset [column] - has a inner padding [pad] - has a line count [count] XXX XXX XXX [ XXX ] XXX XXX XXX [ XXX ] <----------x--------> <-pad-> <-pad-> *) type t = { kind: kind; indent: int; (* expression starting column *) column: int; (* starting column of the token*) pad: int; (* padding: how much children should be indented from current line *) line_indent: int; (* starting column of the current line *) line: int; (* starting line of the expression *) } let to_string i t = Printf.sprintf "%s%s %d|%d-%d-%d(%d)" (String.make i ' ') (string_of_kind t.kind) t.line t.line_indent t.indent t.column t.pad let default = { kind = KUnknown; indent = 0; column = 0; pad = 0; line = 0; line_indent = 0; } let shift node n = let n = max n (- node.indent) in { node with indent = node.indent + n; column = node.column + n } end module Path = struct open Node type t = Node.t list let to_string t = String.concat " \027[35m/\027[m " (List.map (fun n -> Node.to_string 0 n) (List.rev t)) let top = function | [] -> Node.default | t :: _ -> t let indent = function | [] -> 0 | t :: _ -> t.indent let pad = function | [] -> 0 | t :: _ -> t.pad let maptop f = function | [] | {kind=KCodeInComment}::_ as l -> l | t::l -> f t :: l let shift path n = maptop (fun t -> Node.shift t n) path end open Node (* A block is: - a node path to go to this block - the last token of this block (when a comment, it is stacked to keep the last meaningful token) - the last token offset - the original starting column for this block *) type t = { path: Path.t; last: Nstream.token list; toff: int; orig: int; } let shift t n = { t with path = Path.shift t.path n } let to_string t = Path.to_string t.path (* Printf.sprintf "%s\n%d %b" (Path.to_string t.path) t.toff *) let empty = { path = []; last = []; toff = 0; orig = 0; } (* (* Does the token close a top LET construct ? *) (* NB: we do this with another way below, but this one might be more robust *) let rec close_top_let = function | None -> true | Some t -> match t.token with | COMMENT _ -> assert false (* COMMENT must be skipped *) (* Tokens that allow a let-in after them *) | AMPERSAND | AMPERAMPER | BARBAR | BEGIN | COLONCOLON | COLONEQUAL | COMMA | DO | DOWNTO | ELSE | EQUAL | GREATER | IF | IN | INFIXOP0 _ | INFIXOP1 _ | INFIXOP2 _ | INFIXOP3 _ | INFIXOP4 _ | LBRACE | LBRACELESS | LBRACKET | LBRACKETBAR | LBRACKETLESS | LBRACKETGREATER | LESS | LESSMINUS | LPAREN | MATCH | MINUS | MINUSDOT | MINUSGREATER | OR | PLUS | PLUSDOT | QUESTION | QUESTIONQUESTION | SEMI | STAR | THEN | TO | TRY | WHEN | WHILE | TILDE -> false | _ -> true *) (* Go back to the node path path until [f] holds *) let rec unwind f path = match path with | { kind } :: _ when f kind -> path | { kind=KCodeInComment } :: _ -> path | _ :: path -> unwind f path | [] -> [] (* Unwinds the path while [f] holds, returning the last step for which it does *) let unwind_while f path = let rec aux acc = function | { kind=KCodeInComment } :: _ as p -> acc :: p | { kind } as h :: p when f kind -> aux h p | p -> acc :: p in match path with | { kind=KCodeInComment } :: _ -> None | { kind } as h :: p when f kind -> Some (aux h p) | _ -> None let top_kind = function | KStruct|KSig|KParen|KBegin|KObject|KExtendedItem _|KAttrId _|KExtendedExpr _ -> true | _ -> false let stritem_kind = function | KModule|KVal|KLet|KExternal|KType|KException|KOpen|KInclude -> true | _ -> false (* Unwind the struct/sig top *) let unwind_top = unwind top_kind (* Get the parent node *) let parent = function | [] | {kind=KCodeInComment}::_ as t -> t | _ :: t -> t (* Get the next token, skipping comments (and in-comment tokens) *) let next_token_full = let rec skip depth stream = match Nstream.next stream with | None -> None | Some (tok,stream) -> match tok.token with | COMMENT -> skip depth stream | OCAMLDOC_VERB | OCAMLDOC_CODE -> skip (depth + 1) stream | COMMENTCONT -> if depth = 0 then None else skip (depth-1) stream | _ when depth = 0 -> Some (tok,stream) | _ -> skip depth stream in skip 0 let next_token stream = match next_token_full stream with | None -> None | Some (t,_) -> Some t.token let next_2_tokens stream = match next_token_full stream with | None -> None | Some (t1,s) -> match next_token s with | None -> None | Some t2 -> Some (t1.token, t2) let last_token t = let rec aux = function | [] -> None | {token = COMMENT | COMMENTCONT} :: r -> aux r | t :: _ -> Some t.token in aux t.last (* a more efficient way to do this would be to store a "context-type" in the stack *) let rec is_inside_type path = match unwind (function | KParen | KBegin | KBracket | KBrace | KBracketBar | KVal | KLet | KLetIn | KBody (KVal | KLet | KLetIn) | KBody(KType|KExternal) | KColon | KStruct | KSig | KObject -> true | _ -> false) path with | {kind=KBody(KVal|KType|KExternal) | KColon}::_ -> true | {kind=KParen | KBegin | KBracket | KBrace}::p -> is_inside_type p | _ -> false (* Returns None if the current token ends a line, the offset of the next token otherwise *) let next_offset tok stream = match next_token_full stream with | None -> None | Some (next,_) -> if Region.end_line tok.region < Region.start_line next.region then None else Some next.offset let reset_padding ?(pad=0) path = Path.maptop (fun n -> {n with pad}) path let reset_line_indent config current_line path = let limit_overindent = match config.IndentConfig.i_max_indent with | Some m -> let m = max 0 (m - config.IndentConfig.i_base) in fun i -> min i m | None -> fun i -> i in let rec aux acc = function | {line} as t :: r when line = current_line -> aux (t::acc) r | p -> let p, acc, extra = match acc with | {kind = KParen|KBracket|KBrace|KBracketBar} as acc1 :: acc when acc1.line_indent = acc1.column -> (* ignore those if at start of line *) acc1 :: p, acc, acc1.pad | _ -> p, acc, 0 in List.fold_left (fun p t -> {t with indent = t.line_indent + limit_overindent (t.indent - t.line_indent) + extra} ::p) p acc in aux [] path let dump t = Printf.eprintf "\027[35m# \027[32m%8s\027[m %s\n%!" (match t.last with tok::_ -> shorten_string 30 (Lazy.force tok.substr) | _ -> "") (to_string t) (* different kinds of position: [T]: token aligned: the child is aligned with the token position [L]: line aligned: the child is aligned with the begining of line [A]: absolute position *) type pos = L | T | A of int (* position *) (* indent configuration of the infix operators *) let op_prio_align_indent config = let open IndentConfig in let align, indent = match config.i_align_ops with | true -> T, 0 | false -> L, config.i_base in let is_monadop s = match String.sub s 0 (min 2 (String.length s)) with | ">>" | ">|" | "@@" | "@>" -> true | _ -> false in let is_monadop s = is_monadop s (* "*>>=", "+>>>", "/>>|", etc. *) || (String.length s > 3 && is_monadop (String.sub s 1 2)) in function (* anything else : -10 *) (* in -> : 0 *) | SEMI -> prio_semi,L,-2 (* special negative indent is only honored at beginning of line *) (* then else : 10 *) | BAR -> 10,T,-2 | OF -> 20,L,2 | LESSMINUS | COLONEQUAL -> 20,L,config.i_base | COMMA -> 30,align,-2 | MINUSGREATER -> prio_arrow,L,0 (* is an operator only in types *) | COLON -> prio_colon,T,config.i_base | COLONGREATER -> prio_colon,L,config.i_base | OR | BARBAR -> 40,T,0 | AMPERSAND | AMPERAMPER -> 50,T,0 | (INFIXOP0 s | INFIXOP1 s | INFIXOP2 s | INFIXOP3 s | INFIXOP4 s) (* these should deindent fun -> *) when is_monadop s -> prio_flatop,L,0 | INFIXOP0 s -> (match String.sub s 0 (min 2 (String.length s)) with | "|!" | "|>" -> prio_flatop,T,0 | _ -> 60,align,indent) | EQUAL | LESS | GREATER -> 60,align,0 | INFIXOP1 _ -> 70,align,indent | LBRACKETAT -> prio_lbracketat,align,indent | COLONCOLON -> 80,align,indent | INFIXOP2 _ | PLUSDOT | PLUS | MINUSDOT | MINUS -> 90,align,indent | INFIXOP3 _ | STAR -> 100,align,indent | INFIXOP4 _ -> 110,align,indent (* apply: 140 *) | AS -> prio_apply,L,0 | TILDE | QUESTION -> prio_apply,L,config.i_base | LABEL _ | OPTLABEL _ -> if config.i_align_params = Always then 145,T,config.i_base else 145,L,config.i_base | SHARP -> 150,align,config.i_base | DOT -> prio_dot,align,config.i_base | _ -> assert false let handle_dotted block tok = let starts_line = tok.newlines > 0 in let current_line = Region.start_line tok.region in let is_attr_id = function | { kind = KAttrId (_, dotted) } :: _ -> not dotted | _ -> false in let make_dotted_attr_id = function | { kind = KAttrId (names, _) } as node :: ({ kind = (KExtendedItem ([],_) | KExtendedExpr ([],_))} :: _ as path) -> { node with kind = KAttrId (names, true) } :: path | _ -> assert false in let is_dotted_attr_id = function | { kind = KExtendedExpr ([],_) } :: _ -> true | { kind = KExtendedItem ([],_) } :: _ -> true | { kind = KAttrId (_, dotted) } :: _ -> dotted | _ -> false in let make_attr_id name = function | ({ kind = (KExtendedItem ([],_) | KExtendedExpr ([],_)); indent; pad; } :: _ as path) -> let indent = if starts_line then indent + pad else indent + pad + String.length (Lazy.force tok.between) - 1 in let column = if starts_line then indent else block.toff + tok.offset in { kind = (KAttrId ([name], false)); indent; line_indent = indent; column; line = current_line; pad = 0 } :: path | ({ kind = KAttrId (names, _)} as node) :: path -> { node with kind = KAttrId (name :: names, false); } :: path | _ -> assert false in if is_dotted_attr_id block.path then match tok.token with | LIDENT s | UIDENT s -> Some (make_attr_id s block.path) | AND | AS | ASSERT | BEGIN | CLASS | CONSTRAINT | DO | DONE | DOWNTO | ELSE | END | EXCEPTION | EXTERNAL | FALSE | FOR | FUN | FUNCTION | FUNCTOR | IF | IN | INCLUDE | INHERIT | INITIALIZER | LAZY | LET | MATCH | METHOD | MODULE | MUTABLE | NEW | OBJECT | OF | OPEN | OR | PRIVATE | REC | SIG | STRUCT | THEN | TO | TRUE | TRY | TYPE | VAL | VIRTUAL | WHEN | WHILE | WITH -> Some (make_attr_id (Lazy.force tok.substr) block.path) | _ -> None else if is_attr_id block.path then match tok.token with | DOT -> Some (make_dotted_attr_id block.path) | _ -> None else None let ext_kind = function | LBRACKETPERCENT | LBRACKETPERCENTPERCENT -> ExtNode | LBRACKETAT | LBRACKETATAT | LBRACKETATATAT -> Attr | _ -> invalid_arg "ext_kind" (* Take a block, a token stream and a token. Return the new block stack. *) let rec update_path config block stream tok = let open IndentConfig in let starts_line = tok.newlines > 0 in let current_line = Region.start_line tok.region in let node replace kind pos pad path = let parent = Path.top path in if starts_line then let indent = match pos with | A p -> p | L -> parent.indent + if replace then 0 else parent.pad | T -> parent.column + if replace then 0 else parent.pad in { kind; indent; line_indent=indent; column=indent; pad; line = current_line } else let column = block.toff + tok.offset in { kind; indent = parent.indent; line_indent=parent.line_indent; column; pad; line = current_line } in (* Add a new child block *) let append kind pos ?(pad=config.i_base) = function | {kind = KAttrId (names, _)} :: ({kind = KExtendedItem ([],_) | KExtendedExpr ([],_) } as n) :: path -> let n = { n with kind = match n.kind with | KExtendedItem ([],k) -> KExtendedItem (List.rev names,k) | KExtendedExpr ([],k) -> KExtendedExpr (List.rev names,k) | _ -> assert false } in let path = {n with pad = config.i_ppx_stritem_ext } :: path in node false kind pos pad path :: path | path -> node false kind pos pad path :: path in (* replace the current block with a new one *) let replace kind pos ?(pad=config.i_base) path = match path with | [] | {kind=KCodeInComment} :: _ -> node true kind pos pad path :: path | _::t -> node true kind pos pad path :: t in (* Used when expressions are merged together (for example in "3 +" the "+" extends the lower-priority expression "3") *) let extend kind pos ?(pad=config.i_base) = function | [] | {kind=KCodeInComment} :: _ as path -> node true kind pos pad path :: path | h::p -> let negative_indent () = (* Special negative indent: relative, only at beginning of line, and when prio is changed or there is a paren to back-align to *) if pad >= 0 || not starts_line then None else match p with | {kind=KParen|KBracket|KBracketBar |KBrace|KBar _|KWith KBrace|KBody _} as paren :: _ when paren.line = h.line -> let paren_len = match paren.kind with | KParen | KBracket | KBrace | KBar _ | KBody _ -> 1 | KBracketBar -> 2 | KWith KBrace -> 4 | _ -> assert false in let indent = paren.column + paren_len + 1 (* usually 1 space *) + pad in Some ({ h with kind; indent; column=indent; line_indent = indent-pad; pad = max h.pad (h.indent-indent)} :: p) | _ -> match kind,h.kind with | KExpr pk, KExpr ph when ph = pk -> (* respect the indent of the above same-priority term, we assume it was already back-indented *) Some ({ h with kind; indent=h.column; column=h.column; line_indent = h.column; pad = h.pad } :: p) | _ -> let indent = h.column + pad in if indent < 0 then None else Some ({ h with kind; indent; column=indent; line_indent = indent-pad; pad = -pad } :: p) in match negative_indent () with | Some p -> p | None -> (* normal case *) (* change indent to set the starting column of the expression *) let pad = max 0 pad in let indent,pad = if pos = T then h.column, pad else (* set indent of the whole expr accoring to its parent *) Path.indent p + Path.pad p, pad in let line_indent = if starts_line then indent else h.line_indent in { h with kind; indent; line_indent; pad } :: p in (* use before appending a new expr_atom: checks if that may cause an apply and folds parent exprs accordingly *) let fold_expr path = match path with | {kind=KExpr _} as e :: ({kind=KFun} as fn) :: p -> {fn with line_indent = e.line_indent} :: p | {kind=KExpr i} as e :: _ when i = prio_max -> (* we are appending two expr_atom next to each other: this is an apply. *) (* this "folds" the left-side of the apply *) let p = match unwind_while (fun kind -> prio kind >= prio_apply) path with | Some({kind=KExpr i} as e1 :: p) when i = prio_apply -> {e1 with line_indent = e.line_indent} :: p | Some({kind=KExpr _; line} :: {kind=KModule|KInclude|KOpen|KBody KModule} :: _ as p) -> (* ignore align_params for functor application *) extend (KExpr prio_apply) L (reset_line_indent config line p) | Some({kind=KExpr _; line} :: {kind=KArrow (KMatch|KTry) | KTry | KMatch; line=arrow_line}::_ as p) when config.i_align_params = Auto && line = arrow_line -> (* Special case: switch to token-aligned (see test js-args) *) extend (KExpr prio_apply) T p | Some p -> extend (KExpr prio_apply) (if config.i_align_params = Always then T else L) p | None -> assert false in p | _ -> path in let before_append_atom = function | {kind=KWith(KTry|KMatch as m)}::parent as path -> (* Special case: 'match with' and no bar for the 1st case: we append a virtual bar for alignment *) let path = match parent with | {kind = KExpr i} :: _ when i = prio_flatop -> reset_padding path | _ -> path in let p = append (KBar m) L ~pad:2 path in if not starts_line then let column = max 0 (block.toff + tok.offset - 2) in Path.maptop (fun h -> {h with column}) p else p | path -> fold_expr path in let atom path = let path = before_append_atom path in let pad = match path with {kind=KExpr _; pad}::_ -> pad | _ -> config.i_base in append expr_atom L ~pad path in let open_paren kind path = let path = before_append_atom path in let path = if config.i_align_params = Never || next_offset tok stream = None then reset_line_indent config current_line path else path in let p = append kind L path in let p = match p with (* Special case: paren after arrow has extra indent (see test js-begin) *) | {kind=KParen|KBegin|KBracket|KBracketBar|KBrace} :: {kind=KArrow _} :: _ when not starts_line -> Path.shift p config.i_base | p -> p in match p with | [] -> [] | h::p as path -> if config.i_align_params = Never then path else match kind with | KBegin -> path | KParen when if not config.i_align_ops then not starts_line else match next_token_full stream with | Some({token = SIG|STRUCT|OBJECT}, _) -> true | Some({token = MODULE}, stream) when next_token stream = Some STRUCT -> true | _ -> false -> path | _ -> (* set alignment for next lines relative to [ *) (match next_offset tok stream with | Some pad -> let indent = if starts_line then h.indent else block.toff + tok.offset in { h with indent; column=indent; pad } :: p | None -> if starts_line then path else {h with column = h.indent + h.pad} :: p) in let close f path = (* Remove the padding for the closing brace/bracket/paren/etc. *) Path.maptop (fun h -> {h with kind=expr_atom; pad=0}) (unwind f path) in let make_infix tok path = let op_prio, align, indent = op_prio_align_indent config tok.token in let in_delim_block () = match unwind_while (fun kind -> prio kind >= op_prio) path with | Some ({ kind = KExpr _; line } :: { kind = (KBrace|KParen|KBracket|KBracketBar); line = bline } :: _) -> line = bline | _ -> false in (* special cases *) let indent = (* don't back-indent operators when alone on their line (except BAR because that would disrupt typing) *) if indent < 0 && tok.token <> BAR && not (tok.token = SEMI && in_delim_block ()) && next_offset tok stream = None then 0 else indent in match path with | {kind=KExpr prio}::_ when prio >= op_prio && prio < prio_max -> (* we are just after another operator (should be an atom). handle as unary (eg. x + -y) : indented but no effect on following expressions *) (* append KUnknown L path *) append (KExpr prio) L ~pad:(max 0 indent) path | _ -> match unwind_while (fun kind -> prio kind >= op_prio) path with | Some p -> extend (KExpr op_prio) align ~pad:indent p | None -> (* used as prefix ? Don't apply T indent *) append (KExpr op_prio) L ~pad:(max 0 indent) path in (* KComment/KUnknown nodes correspond to comments or top-level stuff, they shouldn't be taken into account when indenting the next token *) let block0 = block in let block = match block.path with | {kind=KComment _|KVerbatim _|KUnknown}::path -> {block with path} | _ -> block in let (>>!) opt f = match opt with Some x -> x | None -> f () in handle_dotted block tok >>! fun () -> match tok.token with | SEMISEMI -> append KUnknown L ~pad:0 (unwind_top block.path) | INCLUDE -> append KInclude L (unwind_top block.path) | EXCEPTION -> (match last_token block with | Some LET -> append KUnknown L block.path (* let exception *) | _ -> let p = unwind (function KExpr _ -> false | _ -> true) block.path in (match p with | {kind=KWith KMatch|KBar KMatch}::_ -> append expr_atom L block.path | _ -> append KException L (unwind_top block.path))) | BEGIN -> open_paren KBegin block.path | OBJECT -> append KObject L block.path | VAL -> append KVal L (unwind_top block.path) | MATCH | TRY -> let k = match tok.token with | MATCH -> KMatch | TRY -> KTry | _ -> assert false in let p = fold_expr block.path in if starts_line then append k L p else let enforce_strict = config.i_strict_with = Always || config.i_strict_with = Auto && match p with | {kind=KBegin; indent; column} :: _ -> column = indent | _ -> false in if enforce_strict then let p = reset_line_indent config current_line p in append k L (reset_padding p) else append k L ~pad:(Path.pad p + config.i_base) p | LPAREN -> open_paren KParen block.path | LBRACKET | LBRACKETGREATER | LBRACKETLESS -> open_paren KBracket block.path | LBRACKETPERCENT -> let path = before_append_atom block.path in append ~pad:4 (KExtendedExpr ([], ExtNode)) L path | LBRACKETAT -> let p = match block.path with | {kind=KExpr _} :: _ as p -> make_infix tok p | p -> p in append ~pad:4 (KExtendedExpr ([], Attr)) L p | LBRACKETATAT -> (* Indented as below parent, but we actually keep the stack (this is turned into a KUnknown when closed, causing the next token to be indented as if it was absent) *) let parent_path = unwind (function KBody KLetIn | KLetIn -> true | KBody k | k -> top_kind k || stritem_kind k) block.path in node false (KExtendedItem ([], ext_kind tok.token)) L 4 (parent parent_path) :: block.path | LBRACKETPERCENTPERCENT | LBRACKETATATAT -> append ~pad:4 (KExtendedItem ([], ext_kind tok.token)) L (unwind_top block.path) | LBRACKETBAR -> open_paren KBracketBar block.path | LBRACE | LBRACELESS -> open_paren KBrace block.path | FUNCTION -> (match fold_expr block.path with | l :: _ as p when not starts_line && l.kind <> KExpr 0 && (config.i_strict_with = Never || config.i_strict_with = Auto && l.kind <> KBegin) -> let p = reset_line_indent config current_line p in append (KWith KMatch) L ~pad:(max (max l.pad config.i_base) config.i_with) p | p -> let p = reset_line_indent config current_line p in append (KWith KMatch) L ~pad:config.i_with p) | FUN | FUNCTOR -> (match block.path with | {kind=KArrow KFun}::path -> let path = unwind (function KFun -> true | _ -> false) path in (match path with | {line; column; line_indent}::_ when line = current_line || column = line_indent -> replace KFun L path | _ -> append KFun L block.path) | p -> append KFun L (fold_expr p)) | STRUCT | SIG -> let k = match tok.token with | STRUCT -> KStruct | SIG -> KSig | _ -> assert false in let expr_start = unwind (function | KParen | KBegin | KLet | KLetIn | KBody _ | KInclude | KOpen -> true | _ -> false) block.path in let indent, path = match expr_start with | {kind=KParen|KBegin}::{kind=KExpr prio}:: {kind=KBody KLet; line; indent; pad}::_ when prio = prio_apply && line = current_line -> (* reset indent due to align_params for functor application within [let module in] *) indent + pad, reset_padding block.path | {kind=KParen|KBegin}::{kind=KExpr prio; line; indent}::_ when prio = prio_apply && line = current_line -> indent, reset_padding block.path | {kind=KInclude; line; indent; pad}::_ when line < current_line -> indent + pad, block.path | _ -> Path.indent block.path, reset_padding block.path in Path.maptop (fun n -> {n with indent}) (append k L path) | WHEN -> append KWhen L ~pad:(config.i_base + if starts_line then 0 else 2) (unwind (function | KWith(KTry|KMatch) | KBar(KTry|KMatch) | KFun | KExtendedExpr _ -> true | _ -> false) block.path) | OPEN -> if last_token block = Some LET then append KOpen L block.path else append KOpen L (unwind_top block.path) | LET -> (* Two ways to detect let vs letin ; both seem to work, but need to check which one is the most robust (for example w.r.t. unfinished expressions) *) (* - it's a top Let if it is after a closed expression *) (match block.path with | {kind=KExpr i}::p when i = prio_max -> append KLet L (unwind_top p) | [] | {kind=KCodeInComment}::_ | {kind=KBar KType}::_ as p-> append KLet L (unwind_top p) | _ -> append KLetIn L (fold_expr block.path)) (* - or if after a specific token *) (* if close_top_let block.last then *) (* append KLet L config.i_base (unwind_top block.path) *) (* else *) (* append KLetIn L config.i_base (fold_expr block.path) *) | CLASS -> append KLet L (unwind_top block.path) | METHOD -> append KLet L (unwind_top block.path) | INITIALIZER -> append (KBody KLet) L (unwind_top block.path) | CONSTRAINT -> let path = unwind (function KType | KBody KType | KObject -> true | _ -> false) block.path in append KConstraint L path | AND -> let unwind_to = function | KLet | KLetIn | KType | KModule | KParen -> true | _ -> false in let path = unwind (unwind_to @* follow) block.path in (match path with | [] | {kind=KCodeInComment}::_ -> append (KAnd KUnknown) L path | {kind=KType|KModule|KBody (KType|KModule)} :: ({kind=KWith _} as m) :: p -> (* hack to align "and" with the 'i' of "with": consider "with" was 1 column further to the right *) let m = if starts_line then {m with column = m.column+1} else m in replace (KAnd m.kind) T ~pad:0 (m :: p) | {kind=KType|KModule|KBody (KType|KModule)} :: ({kind=KAnd (KWith _)} as m) :: p -> replace m.kind T ~pad:0 (m :: p) | {kind=KParen} :: _ -> (* e.g. let (and+) = ... *) append expr_atom L path | h::_ -> append (KAnd (follow h.kind)) L (parent path)) | IN -> let path = unwind ((function KLetIn | KLet -> true | _ -> false) @* follow) block.path in let pad = match next_token stream with | Some LET -> 0 | _ -> config.i_in in (match unwind_while ((=) KIn) (parent path) with | Some p -> extend KIn L ~pad p | None -> extend KIn L ~pad path) | TYPE -> (match last_token block with | Some (MODULE | CLASS) -> append KUnknown L block.path (* module type *) | Some (WITH|AND) | Some COLON (* 'type' inside type decl, for GADTs *) -> append KType L block.path | _ -> append KType L (unwind_top block.path)) | MODULE -> (match last_token block with | Some LET -> append KUnknown L block.path (* let module *) | Some (COLON|EQUAL|INCLUDE) when next_2_tokens stream = Some (TYPE, OF) -> append KUnknown L block.path (* : module type of *) | Some (WITH|AND) -> append KType L block.path | Some INCLUDE -> append KModule L (reset_padding block.path) | _ -> append KModule L (unwind_top block.path)) | END -> close (function KStruct|KSig|KBegin|KObject -> true | _ -> false) block.path | WITH -> (match next_token_full stream with | Some ({token = TYPE|MODULE as tm}, _) -> let path = unwind (function | KModule | KOpen | KInclude | KParen | KBegin | KColon | KBody KModule -> true | _ -> false) block.path in let kind = match tm with TYPE -> KType | MODULE -> KModule | _ -> assert false in append (KWith kind) L path | next -> let path = unwind (function |KTry|KMatch |KVal|KType|KBody KType|KException (* type-conv *) |KColon |KBrace -> true |KWith KTry -> (* useful for lwt's try-finally *) Lazy.force tok.substr = "finally" | _ -> false ) block.path in match path with | {kind=KBrace; pad} :: _ -> (match next with | Some (next, _) when Region.start_line next.region = Region.end_line tok.region -> Path.maptop (fun n -> {n with indent=n.column}) (append (KWith KBrace) L ~pad:next.offset path) | _ -> append (KWith KBrace) L ~pad:(pad + config.i_with) path) | {kind=KVal|KType|KException as kind}::_ -> replace (KWith kind) L path | {kind=KTry|KMatch as kind} as n :: parent :: _ when n.line = current_line && n.column <> n.line_indent && config.i_strict_with <> Always -> let path,pad = if parent.line_indent = parent.column then path, max parent.pad config.i_with else reset_line_indent config n.line path, max config.i_with (if parent.pad > 0 then config.i_base else 0) in replace (KWith kind) L ~pad path | {kind=(KTry|KMatch as kind)}::p -> if starts_line then append (KWith kind) L ~pad:config.i_with p else replace (KWith kind) L ~pad:config.i_with (reset_line_indent config current_line path) | {kind=KColon}::_ as p -> (* may happen with sexp extension, 'with default' *) append expr_atom L p | _ -> path) | IF -> (match last_token block with | Some ELSE -> replace KIf L block.path | _ -> append KIf L (fold_expr block.path)) | THEN -> extend KThen L (unwind ((=) KIf) block.path) | ELSE -> let pad = match config.i_strict_else with | Always -> config.i_base | Never -> if next_offset tok stream <> None then config.i_base else 0 | Auto -> if next_offset tok stream <> None then config.i_base else match next_token stream with | Some (LET|MATCH|TRY|FUN|FUNCTION) -> 0 | _ -> config.i_base in extend KElse L ~pad (unwind ((=) KThen) block.path) | WHILE | FOR -> append KLoop L (fold_expr block.path) | TO | DOWNTO -> let p = Path.maptop (fun n -> { n with indent = n.indent + config.i_base }) (unwind ((=) KLoop) block.path) in replace KLoop L p | DO -> extend KDo L (unwind ((=) KLoop) block.path) | DONE -> close ((=) KDo) block.path | BARRBRACKET -> close ((=) KBracketBar) block.path | RPAREN -> close ((=) KParen) block.path | RBRACE | GREATERRBRACE -> close ((=) KBrace) block.path | RBRACKET -> let p = unwind (function | KBracket | KExtendedItem _ | KExtendedExpr _ -> true | _ -> false) block.path in (match p with | {kind=KExtendedExpr (_, Attr)} :: ({kind=KExpr _} :: _ as p) -> extend expr_atom L ~pad:0 p | {kind=KExtendedItem (_, Attr)|KExtendedExpr (_, Attr)} :: _ -> extend KUnknown L ~pad:0 p | p -> close (fun _ -> true) p) | GREATERRBRACKET -> close ((=) KBracket) block.path | BAR -> let path = unwind (function | KParen | KBegin | KBracket | KBrace | KBracketBar | KWith(KMatch|KTry) | KBar(KMatch|KTry) | KArrow(KMatch|KTry) | KLet | KLetIn | KBody(KType) -> true | _ -> false) block.path in (match path with | {kind=KWith m} :: {kind=KExpr i} :: _ when i = prio_flatop -> append (KBar m) L (reset_padding path) | {kind=KWith m} :: _ -> append (KBar m) L path | {kind=KArrow (KMatch|KTry as m)} :: ({kind=KBar _} as h:: _ as p) -> Path.maptop (fun x -> {x with column = h.column}) (replace (KBar m) (A h.column) p) | {kind=KArrow m} :: p -> append (KBar m) L p | _ -> match block.path with | {kind = KExpr _}::_ -> make_infix tok block.path | _ -> append (KBar KType) L block.path) | MINUSGREATER -> let rec find_parent path = let path = unwind (function | KParen | KBegin | KBracket | KBrace | KBracketBar | KWith(KMatch|KTry) | KBar(KMatch|KTry) | KArrow(KMatch|KTry) | KFun | KBody(KType|KExternal) | KColon | KStruct | KSig | KObject | KExtendedItem _ | KExtendedExpr _ -> true | _ -> false) path in match path with | {kind=KFun} :: ({kind=KExpr i} as e) :: path when i = prio_flatop -> (* eg '>>= fun x ->': indent like the top of the expression *) {e with kind = KExpr 0} :: path | {kind=KFun; line } :: {kind=KBody KLet; line=letline} :: _ when next_offset tok stream = None && line = current_line && line <> letline -> append (KArrow KFun) L ~pad:0 (reset_line_indent config line path) | {kind=KFun; line; _ } :: _ when next_offset tok stream = None && line = current_line -> (* Special case: [fun ->] at eol, this should be strictly indented wrt the above line, independently of the structure *) append (KArrow KFun) L (reset_line_indent config line path) | {kind=KFun} :: _ -> append (KArrow KFun) L path | {kind=KBar m}::{kind=KWith _; line}::_ when line = current_line -> (* Special case: don't respect match_clause when 'with X ->' is on a single line *) let pad = if next_offset tok stream <> None then config.i_base else match next_token stream with | Some (MATCH|TRY|FUN|FUNCTION) -> 0 | _ -> config.i_base in append (KArrow m) L ~pad (reset_line_indent config line path) | {kind=KWith m | KBar m} :: _ -> let pad = config.i_match_clause - if starts_line then config.i_base else 0 in append (KArrow m) L ~pad path | {kind=KArrow(KMatch|KTry)} :: p -> (* might happen if doing 'when match' for example *) (match unwind (function | KParen | KBegin | KBracket | KBrace | KBracketBar | KWith(KMatch|KTry) | KFun | KBody(KType|KExternal) | KColon | KStruct | KSig | KObject -> true | _ -> false) p with | {kind=KWith(_)}::p -> find_parent p | _ -> make_infix tok block.path) | _ -> make_infix tok block.path in find_parent block.path | EQUAL -> let unwind_to = function | KParen | KBegin | KBrace | KBracket | KBracketBar | KBody _ | KExternal | KModule | KType | KLet | KLetIn | KException | KVal | KBar KType | KStruct | KSig | KObject | KAnd(KModule|KType|KLet|KLetIn) | KConstraint | KExtendedItem _ | KExtendedExpr _ -> true | _ -> false in let rec find_parent path = let path = unwind unwind_to path in (match path with | [] | {kind=KCodeInComment|KExtendedItem _|KExtendedExpr _}::_ -> make_infix tok block.path | {kind=KBody KType}::p -> (* type t = t' = ... *) (match p with | {kind = KWith (KType|KModule) | KAnd KWith (KType|KModule)}::_ -> find_parent p | _ -> replace (KBody KType) L ~pad:config.i_type path) | {kind=KBrace}::_ -> (match unwind_while (fun kind -> kind = KColon || prio kind > prio_semi) block.path with | Some ({kind=KExpr prio}::_) when prio = prio_semi + 1 -> (* already after a field binding: this '=' must be the normal operator *) make_infix tok block.path | Some p -> extend (KExpr (prio_semi+1)) T ~pad:config.i_base p | None -> make_infix tok block.path) | {kind=KParen|KBegin|KBracket|KBracketBar|KBody _|KBar KType}::_ -> make_infix tok block.path | {kind=KAnd kind | kind} as h::p -> let indent = match next_token stream, kind with | Some (STRUCT|SIG), _ -> 0 | Some BAR, KType when config.i_strict_with = Always -> config.i_with | _, (KType | KBody KType) -> config.i_type | _ -> config.i_base in if starts_line then let h = {h with indent = h.indent + indent; pad = 0} in replace (KBody kind) L ~pad:0 (h :: p) else let h = {h with indent = h.column} in replace (KBody kind) T ~pad:indent (h :: p)) in find_parent block.path | COLONEQUAL | INFIXOP2 "+=" -> (match unwind_while (function KExpr _ | KType -> true | _ -> false) block.path with | Some ({kind=KType}::_ as p) -> (* type t := t' *) replace (KBody KType) L p | _ -> make_infix tok block.path) | COLON -> let path = unwind (function | KParen | KBegin | KBrace | KBracket | KBracketBar | KBody _ | KModule | KLet | KLetIn | KExternal | KVal | KColon | KAnd(KModule|KLet|KLetIn) | KBar KType -> true | _ -> false) block.path in (match path with | {kind = KBody(KVal|KType|KExternal) | KColon} :: _ -> (match unwind_while (fun kind -> prio kind > prio_arrow) block.path with | Some path -> extend (KExpr prio_colon) (if config.i_align_params = Never then L else T) path | None -> make_infix tok block.path) | {kind = KModule|KLet|KLetIn | KAnd(KModule|KLet|KLetIn)} :: _ -> append KColon L path | {kind = KExternal} :: _ as path -> append KColon L ~pad:(if starts_line then 0 else config.i_base) path | {kind=KVal} :: {kind=KObject} :: _ -> make_infix tok path | {kind=KVal} as h :: p -> let indent = config.i_base in if starts_line then let h = {h with indent = h.indent + indent; pad = 0} in replace (KBody h.kind) L ~pad:0 (h :: p) else replace (KBody h.kind) L ~pad:indent (h :: p) | {kind=KBrace}::_ -> (* record type *) (match block.path with | {kind=KExpr i}::{kind=KBrace}::_ as p when i = prio_max -> extend KColon L p | {kind=KExpr i}::({kind=KExpr j}::{kind=KBrace}::_ as p) when i = prio_max && j = prio_apply -> (* "mutable" *) extend KColon L p | _ -> make_infix tok block.path) | {kind = KBar KType} :: _ -> make_infix {tok with token = OF} block.path | _ -> make_infix tok block.path) | SEMI -> (match unwind (fun kind -> prio kind < prio_semi) block.path with | {kind=KColon}::({kind=KBrace}::_ as p) -> p | _ -> make_infix tok block.path) (* Some commom preprocessor directives *) | UIDENT ("INCLUDE"|"IFDEF"|"THEN"|"ELSE"|"ENDIF" |"TEST"|"TEST_UNIT"|"TEST_MODULE" |"BENCH"|"BENCH_FUN"|"BENCH_MODULE"|"BENCH_INDEXED" as s) when starts_line -> if String.sub s 0 4 = "TEST" || (String.length s > 4 && String.sub s 0 5 = "BENCH") then append KLet L ~pad:(2 * config.i_base) (unwind_top block.path) else replace KUnknown L (unwind_top block.path) | EXTERNAL -> append KExternal L (unwind_top block.path) | DOT -> (match block.path with | {kind = KArrow KMatch} :: _ -> append expr_atom L block.path | _ -> let last_expr = unwind_while (function KExpr _ -> true | _ -> false) block.path in match last_expr with | Some ({kind=KExpr _} :: {kind=KType} :: ({kind=KColon} :: _ as p)) -> (* let f: type t. t -> t = ... *) p | Some ({kind=KExpr 200} :: ({kind=KColon} :: {kind=KLet|KLetIn} :: _ as p))-> (* method m : 'x 'y . ... = (KLet is actually "method") *) (* let m : 'x 'y . ... = (in) *) (match last_token block with | Some (UIDENT _) -> make_infix tok block.path | _ -> p) | Some ({kind=KExpr i} :: ({kind=KBrace|KWith KBrace} as h :: p)) when (i = prio_max || i = prio_dot) && next_offset tok stream = None -> (* special case: distributive { Module. field; field } *) { h with pad = config.i_base } :: p | _ -> make_infix tok block.path) | AMPERAMPER | BARBAR -> (* back-indented when after if or when and not alone *) let op_prio, _align, _indent = op_prio_align_indent config tok.token in (match unwind_while (fun kind -> prio kind >= op_prio) block.path with | Some ({kind=KExpr _; line}::{kind=KWhen|KIf; line=line_if}::_ as p) when line = line_if && next_offset tok stream <> None -> extend (KExpr op_prio) T ~pad:(-3) p | _ -> make_infix tok block.path) | LESS -> if is_inside_type block.path then (* object type *) open_paren KBrace block.path else make_infix tok block.path | GREATER -> if is_inside_type block.path then match unwind (function | KParen | KBegin | KBracket | KBrace | KBracketBar | KBody(KType|KExternal) -> true | _ -> false) block.path with | {kind=KBrace}::_ as p -> close (fun _ -> true) p | _ -> append expr_apply L (fold_expr block.path) else make_infix tok block.path | OF -> (match last_token block with | Some TYPE -> append KUnknown L block.path | _ -> make_infix tok block.path) | LESSMINUS | COMMA | OR | AMPERSAND | INFIXOP0 _ | INFIXOP1 _ | COLONCOLON | INFIXOP2 _ | PLUSDOT | PLUS | MINUSDOT | MINUS | INFIXOP3 _ | STAR | INFIXOP4 _ | SHARP | AS | COLONGREATER -> make_infix tok block.path | LABEL _ | OPTLABEL _ -> (match unwind_while (function | KExpr _ | KLet | KLetIn | KFun | KAnd(KLet|KLetIn) -> true | _ -> false) block.path with | Some ( (* (opt)labels in types *) {kind = KExpr 32 (* prio_arrow *)} :: ({kind = KBody(KVal|KType|KExternal) | KColon} :: _) | ({kind = KBody(KVal|KType|KExternal) | KColon} :: _) ) -> (* this is for the case [?foo:], parsed as OPTLABEL, but make sure we are consistent with [foo:] or [? foo:], which are parsed as 2 or 3 tokens *) extend (KExpr prio_colon) (if config.i_align_params = Never then L else T) (append expr_atom L block.path) | Some ({kind=KExpr _}::_) | None -> (* considered as infix, but forcing function application *) make_infix tok (fold_expr block.path) | _ -> (* in function definition *) atom block.path) | UIDENT _ -> (match block.path with | {kind=KBody KType}::_ when starts_line && next_token stream <> Some DOT -> (* type =\nA\n| B : append a virtual bar before A for alignment *) let path = append (KBar KType) L ~pad:2 block.path in atom path | {kind=KBracket} as br::({kind=KBody KType; line}::_ as p) when starts_line -> (* type = [\n`A\n| `B ]: append a virtual bar before `A *) let path = if br.line > line then {br with pad = 0} :: p else block.path in let path = append (KBar KType) L ~pad:2 path in atom path | {kind=KModule | KInclude | KOpen}::_ when not starts_line -> (* indent functor parameters as if indent was flushed (like after a newline) *) Path.maptop (fun n -> let indent = n.indent + n.pad in {n with indent; line_indent = indent; pad = config.i_base} ) (atom block.path) | _ -> atom block.path) | LIDENT s when String.length s > 0 && s.[0] = '\'' -> append (KExpr prio_max) L ~pad:0 block.path | INT64 _ | INT32 _ | INT _ | LIDENT _ | FLOAT _ | CHAR _ | STRING _ | TRUE | FALSE | NATIVEINT _ | UNDERSCORE | TILDE | QUESTION | QUOTE | QUOTATION _ -> atom block.path | PREFIXOP _ | BANG | QUESTIONQUESTION -> (* FIXME: should be highest priority, > atom ( append is not right for atoms ) *) atom block.path | ASSERT | LAZY | NEW | MUTABLE -> append expr_apply L (before_append_atom block.path) | INHERIT -> append (KExpr 0) L (unwind_top block.path) | OCAMLDOC_CODE -> let indent = Path.indent block0.path + if Lazy.force tok.substr = "$" then 0 (* cinaps comment (*$ code *) *) else Path.pad block0.path in { kind = KCodeInComment; line = Region.start_line tok.region; indent = indent; line_indent = indent; column = indent; pad = config.i_base } :: block0.path | OCAMLDOC_VERB -> (match block0.path with | {kind=KComment (tok,toff);indent;pad}::_ -> { kind = KVerbatim (tok,toff); line = Region.start_line tok.region; indent = indent + pad; line_indent = indent + pad; column = indent + pad; pad = 0 } :: block0.path | _ -> dump block0; assert false) | COMMENTCONT -> (match unwind (function KCodeInComment | KVerbatim _ -> true | _ -> false) block0.path with | {kind=KCodeInComment|KVerbatim _} :: p -> p | _ -> block.path) | COMMENT -> let s = Lazy.force tok.substr in let pad = let len = String.length s in let i = ref 2 in while !i < len && s.[!i] = '*' do incr i done; while !i < len && s.[!i] = ' ' do incr i done; if !i >= len || s.[!i] = '\n' || s.[!i] = '\r' then 3 else !i in if not starts_line then let col = block.toff + tok.offset in Path.maptop (fun n -> {n with indent = col}) (append (KComment (tok, col)) L ~pad block.path) else (match block.path with | {kind=KExpr i}::_ when i = prio_max -> let blocklevel () = let p = unwind_top block.path in let col = Path.indent p + Path.pad p in append (KComment (tok, col)) (A col) ~pad block.path in (* if we are directly after a case in a sum-type, use that for alignment *) let align_bar = if tok.newlines > 1 || not (is_inside_type block0.path) then None else let find_bar = unwind_while (function KBar _ | KExpr _ -> true | _ -> false) block0.path in match find_bar with | Some ({kind=KBar _; column}::_) -> Some column | _ -> None in (* after a closed expr: look-ahead *) (match next_token_full stream, align_bar with | None, None -> blocklevel () | Some ((* full block-closing tokens + newline *) {token = SEMISEMI | DONE | END | GREATERRBRACE | GREATERRBRACKET | RBRACE | RBRACKET | RPAREN } , _), _ when tok.newlines > 1 -> blocklevel () | Some ((* semi block-closing tokens *) {token = SEMISEMI | DONE | END | GREATERRBRACE | GREATERRBRACKET | RBRACE | RBRACKET | RPAREN | THEN | ELSE | IN | EQUAL } , _), None when tok.newlines <= 1 -> (* indent as above *) let col = (Path.top block0.path).line_indent in append (KComment (tok, col)) (A col) ~pad block.path | _, Some indent -> append (KComment (tok,indent)) (A indent) ~pad block.path | next, None -> (* recursive call to indent like next line *) let path = match next with | Some ({token = EOF }, _) | None -> [] | Some (next,stream) -> update_path config block stream { next with newlines = tok.newlines } in let col = Path.indent path in append (KComment (tok,col)) (A col) ~pad block.path) | _ -> let col = Path.indent block.path + Path.pad block.path in append (KComment (tok,col)) (A col) ~pad block.path) |DOTDOT -> (match block.path with | {kind = KBody KType} :: p -> p | _ -> append KUnknown L block.path) |VIRTUAL |REC |PRIVATE|EOF |BACKQUOTE|ILLEGAL_CHAR _ -> (* indent the token, but otherwise ignored *) append KUnknown L block.path | LINE_DIRECTIVE -> append KUnknown (A 0) ~pad:0 block.path | EOL | SPACES -> assert false let update config block stream tok = let path = update_path config block stream tok in let last = match tok.token with | COMMENT | COMMENTCONT | OCAMLDOC_VERB | EOF -> tok :: block.last | _ -> [tok] in let toff = if tok.newlines > 0 then Path.indent path else block.toff + tok.offset in let orig = Region.start_column tok.region in { path; last; toff; orig } let indent t = Path.indent t.path let original_column t = match t.path with | {kind=KComment (tok,_)|KVerbatim (tok,_)} :: _ -> Region.start_column tok.region | _ -> t.orig let offset t = match t.path with | {kind=KComment (_,toff)|KVerbatim(_,toff)} :: _ -> toff | _ -> t.toff let padding t = Path.pad t.path let set_column t col = { t with path = Path.maptop (fun n -> {n with indent = col}) t.path; toff = col } let reverse t = let col = t.orig in let expected = t.toff in if col = expected then t else match t.last with | {token=COMMENTCONT}::_ -> (* don't adapt indent on the ']}' because there is a hack with its padding *) t | tok :: _ when tok.newlines > 0 -> let diff = col - expected in let path = match t.path with | n::[] -> { n with indent = col; column = col } :: [] | ({kind=KComment (tok,_)} as n)::r -> { n with kind=KComment (tok,col); indent = col; column = col } :: r | ({kind=KVerbatim (tok,_)} as n)::r -> { n with kind=KVerbatim (tok,col); indent = col; column = col } :: r | n1::n2::p -> { n1 with indent = col; column = col } :: { n2 with indent = n2.indent + diff } :: p | [] -> [] in { t with path; toff = col } | _ -> { t with toff = col } let guess_indent line t = let path = unwind (function KUnknown | KComment _ | KVerbatim _ -> false | _ -> true) t.path in match path, t.last with | _, ({token = COMMENT | COMMENTCONT} as tok :: _) when line <= Region.end_line tok.region -> (* Inside comment *) Path.indent t.path + Path.pad t.path | {kind=KExpr i}::p, ({token=EOF} :: tok :: _ (* spurious warning 57 here *) | tok::_) when i = prio_max && line > Region.end_line tok.region + 1 -> (* closed expr and newline: we probably want a toplevel block *) let p = unwind_top p in Path.indent p + Path.pad p | path, _ -> (* we probably want to write a child of the current node *) let path = match unwind_while (function KExpr p -> p >= prio_apply | _ -> false) path with Some p -> p | None -> path in match path with | {indent;pad}::_ -> indent + pad | [] -> 0 let is_clean t = List.for_all (fun node -> match node.kind with | KCodeInComment -> false | KVerbatim _ -> false | KComment _ -> false (* we need the next token to decide, because that may be "(* *)" but also "(* {[". In the last case, it will be followed by OCAMLDOC_* or COMMENTCONT, and until then the lexer stores a state *) (* **tuareg hack** "*)" (who says we want ocp-indent to handle coloration too ?) *) | _ -> true) t.path let is_at_top t = match t.path with | [] -> true | [{kind}] -> stritem_kind kind | _ -> false let no_parents t = match t.path with | [_] -> true | _ -> false let is_declaration t = is_clean t && match t.path with | [] -> true | {kind=KStruct|KSig|KBegin|KObject} :: _ -> true | _ -> false let is_in_comment t = match t.path with | {kind = KComment _ | KVerbatim _}::_ -> true | p -> List.exists (fun n -> n.kind = KCodeInComment) p (* (* for syntax highlighting: returns kind of construct at point *) type construct_kind = | CK_paren (* parens and begin/end *) | CK_block (* struct/end sig/end etc. *) | CK_toplevel let construct_kind t token = *) ocp-indent-1.8.2/src/indentBlock.mli000066400000000000000000000063051355404771200173240ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012,2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) (** Indenter block *) type t (** Shift a block by a given offset *) val shift: t -> int -> t (** Set the start column of the given block to [column] *) val set_column: t -> int -> t (** [reverse block] updates the stack to account for the original indentation, assumed as correct. Useful for partial indentation *) val reverse: t -> t (** Return the current line offset *) val offset: t -> int (** Return the padding of the block, ie expected relative indentation of sub-blocks *) val padding: t -> int (** Return the block indentation *) val indent: t -> int (** Return the block original starting column *) val original_column: t -> int (** The empty block *) val empty: t (** [update t str tok] computes the new block state after processing the token [tok] in block [t]. The next tokens can be observed in the stream [str]. *) val update : IndentConfig.t -> t -> Nstream.t -> Nstream.token -> t (** Display token and stack of the block *) val dump: t -> unit (** [guess_indent line block] For indenting empty lines: attempt to guess what the most probable indent at this point would be *) val guess_indent: int -> t -> int (** A block is considered clean when it is not linked to any parser state (ie it's not within a comment, string, or ocamldoc stuff). This is not enough for a safe checkpoint: lots of rules depend on the previous/next token to decide indentation. *) val is_clean: t -> bool (** True only when the block is at the root of the file (the stack is empty, the block isn't included in any syntactical construct), and for top-level constructs. Implies is_clean *) val is_at_top: t -> bool (** True for any block that is alone on its stack *) val no_parents: t -> bool (** Returns true if the given block is at a top-level declaration level, ie not within any expression or type definition, but possibly inside a module, signature or class definition. Implies is_clean. Should be safe for checkpoints *) val is_declaration: t -> bool (** Either we are at a comment, or within an ocamldoc block *) val is_in_comment: t -> bool ocp-indent-1.8.2/src/indentConfig.ml000066400000000000000000000374731355404771200173400ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) open Compat type threechoices = Always | Never | Auto type t = { i_base: int; i_type: int; i_in: int; i_with: int; i_match_clause: int; i_ppx_stritem_ext: int; i_max_indent: int option; i_strict_with: threechoices; i_strict_else: threechoices; i_strict_comments: bool; i_align_ops: bool; i_align_params: threechoices; } let default = { i_base = 2; i_type = 2; i_in = 0; i_with = 0; i_match_clause = 2; i_ppx_stritem_ext = 2; i_max_indent = Some 4; i_strict_with = Never; i_strict_else = Always; i_strict_comments = false; i_align_ops = true; i_align_params = Auto; } let presets = [ "apprentice", { i_base = 2; i_type = 4; i_in = 2; i_with = 2; i_match_clause = 4; i_ppx_stritem_ext = 2; i_max_indent = None; i_strict_with = Never; i_strict_else = Always; i_strict_comments = false; i_align_ops = true; i_align_params = Always }; "normal", default; "JaneStreet", { i_base = 2; i_type = 2; i_in = 0; i_with = 0; i_match_clause = 2; i_ppx_stritem_ext = 2; i_max_indent = Some 2; i_strict_with = Auto; i_strict_else = Always; i_strict_comments = true; i_align_ops = true; i_align_params = Always }; ] let threechoices_of_string = function | "always" -> Always | "never" -> Never | "auto" -> Auto | _ -> failwith "threechoices_of_string" let string_of_threechoices = function | Always -> "always" | Never -> "never" | Auto -> "auto" let intoption_of_string = function | "none" | "None" -> None | n -> try Some (int_of_string n) with Failure _ -> failwith "intoption_of_string" let string_of_intoption = function | Some n -> string_of_int n | None -> "none" let to_string ?(sep=",") indent = Printf.sprintf "base = %d%s\ type = %d%s\ in = %d%s\ with = %d%s\ match_clause = %d%s\ ppx_stritem_ext = %d%s\ max_indent = %s%s\ strict_with = %s%s\ strict_else = %s%s\ strict_comments = %b%s\ align_ops = %b%s\ align_params = %s" indent.i_base sep indent.i_type sep indent.i_in sep indent.i_with sep indent.i_match_clause sep indent.i_ppx_stritem_ext sep (string_of_intoption indent.i_max_indent) sep (string_of_threechoices indent.i_strict_with) sep (string_of_threechoices indent.i_strict_else) sep indent.i_strict_comments sep indent.i_align_ops sep (string_of_threechoices indent.i_align_params) exception Fail_of_string of [`Int | `Bool | `Threechoices | `Intoption ] let set ?(extra=fun _ -> None) t var_name value = let parse: 'a. 'k -> (string -> 'a) -> 'a = fun err f -> try f value with Failure _ -> raise (Fail_of_string err) in try match var_name with | "base" -> {t with i_base = parse `Int int_of_string} | "type" -> {t with i_type = parse `Int int_of_string} | "in" -> {t with i_in = parse `Int int_of_string} | "with" -> {t with i_with = parse `Int int_of_string} | "match_clause" -> {t with i_match_clause = parse `Int int_of_string} | "ppx_stritem_ext" -> {t with i_ppx_stritem_ext = parse `Int int_of_string} | "max_indent" -> {t with i_max_indent = parse `Intoption intoption_of_string} | "strict_with" -> {t with i_strict_with = parse `Threechoices threechoices_of_string} | "strict_else" -> {t with i_strict_else = parse `Threechoices threechoices_of_string} | "with_never" -> (* backwards compat, don't document *) {t with i_strict_with = if parse `Bool bool_of_string then Always else Never} | "strict_comments" -> {t with i_strict_comments = parse `Bool bool_of_string} | "align_ops" -> {t with i_align_ops = parse `Bool bool_of_string} | "align_params" -> {t with i_align_params = parse `Threechoices threechoices_of_string} | var_name -> match extra var_name with | Some f -> f value; t | None -> let e = Printf.sprintf "unknown configuration key %S" var_name in raise (Invalid_argument e) with | Fail_of_string kind -> Printf.ksprintf (fun msg -> raise (Invalid_argument msg)) (match kind with | `Int -> "%s should be an integer, not %S" | `Bool -> "%s should be either \"true\" or \"false\", not %S" | `Threechoices -> "%s should be either \"always\", \"never\" or \"auto\", not %S" | `Intoption -> "%s should be either an integer or \"none\", not %S") var_name value let update_from_string ?extra indent s = List.fold_left (fun indent s -> match Util.string_split '=' s with | [] | [""] -> indent | [var;value] -> set ?extra indent (String.trim var) (String.trim value) | [preset] -> (try List.assoc (String.trim preset) presets with Not_found -> let e = Printf.sprintf "unknown preset %S" preset in raise (Invalid_argument e)) | _ -> let e = Printf.sprintf "wrong \"param=value\" pair in %S" s in raise (Invalid_argument e)) indent (Util.string_split_chars ",\n" s) (* Remember to also document the template configuration file ../.ocp-indent *) type man_block = [ `S of string | `P of string | `Pre of string | `I of string * string | `Noblank | `Blocks of man_block list ] let man = let option_name name kind default = Printf.sprintf "$(b,%s)=%s (default=%s)" name kind default in let pre s = List.fold_right (fun line acc -> let i = ref 0 and line = Bytes.copy line in while !i < Bytes.length line && Bytes.get line (!i) = ' ' do Bytes.set line (!i) '\xa0'; incr i done; let line = Bytes.to_string line in `P line :: (if acc = [] then [] else `Noblank :: acc)) (List.map Bytes.of_string (Util.string_split '\n' s)) [] in [ `P "A configuration definition is a list of bindings in the form \ $(i,NAME=VALUE) or of $(i,PRESET), separated by commas or newlines"; `P "Syntax: $(b,[PRESET,]VAR=VALUE[,VAR=VALUE...])" ] @ `I (option_name "base" "INT" (string_of_int default.i_base), "Indentation used when none of the following options applies.") :: pre " let foo =\n\ \ $(b,..)bar" @ `I (option_name "type" "INT" (string_of_int default.i_type), "Indentation for type definitions.") :: pre " type t =\n\ \ $(b,..)int" @ `I (option_name "in" "INT" (string_of_int default.i_in), "Indentation after `let ... in', unless followed by another `let'.") :: pre " let foo = () in\n\ \ $(b,..)bar" @ `I (option_name "with" "INT" (string_of_int default.i_with), "Indentation after `match ... with', `try ... with' or `function'.") :: pre " match foo with\n\ \ $(b,..)| _ -> bar" @ `I (option_name "match_clause" "INT" (string_of_int default.i_match_clause), "Indentation for clauses inside a pattern-match (after arrows).") :: pre " match foo with\n\ \ | _ ->\n\ \ $(b,..)bar" @ `I (option_name "ppx_stritem_ext" "INT" (string_of_int default.i_ppx_stritem_ext), "Indentation for items inside a [%%id ... ] extension node).") :: pre " [%% id.id\n\ \ $(b,..)let x = 3\ \ ]" @ `I (option_name "max_indent" "" (string_of_intoption default.i_max_indent), "When nesting expressions on the same line, their indentations are \ stacked in some cases so that they remain correct if you close them \ one per line. However, this can lead to large indentations in complex \ code, so this parameter sets a maximum indentation. Note that it \ only affects indentation after function arrows and opening parens at \ the ends of lines.") :: pre " let f = g (h (i (fun x ->\n\ \ $(b,....)x)\n\ \ )\n\ \ )" @ `I (option_name "strict_with" "" (string_of_threechoices default.i_strict_with), "If `never', match bars are indented, superseding `with', \ whenever `match with' doesn't start its line.\n\ If `auto', there are exceptions for constructs like \ `begin match with'.\n\ If `always', `with' is always strictly respected, and additionally \ applies to variant types definition, for consistency.") :: pre " Example with `strict_with=$(b,never),with=0':\n\ \ begin match foo with\n\ \ $(b,..)| _ -> bar\n\ \ end" @ `I (option_name "strict_else" "" (string_of_threechoices default.i_strict_else), "If `always', indent after the `else' keyword normally, like after \ `then'.\n\ If `auto', indent after `else' unless in a few \ \"unclosable\" cases (`let .... in', `match', etc.).\n\ If `never', the `else' keyword won't indent when followed \ by a newline.") :: pre " Example with `strict_else=$(b,auto)':\n\ \ if cond then\n\ \ foo\n\ \ else\n\ \ $(b,let) x = bar in\n\ \ baz" @ `I (option_name "strict_comments" "BOOL" (string_of_bool default.i_strict_comments), "In-comment indentation is normally preserved, as long as it respects \ the left margin or the comments starts with a newline. Setting this \ to `true' forces alignment within comments. Lines starting with `*' \ are always aligned") :: [] @ `I (option_name "align_ops" "BOOL" (string_of_bool default.i_align_ops), "Toggles preference of column-alignment over line indentation for most \ of the common operators and after mid-line opening parentheses.") :: pre " Example with `align_ops=$(b,true)':\n\ \ let f x = x\n\ \ + y\n\ \ \n\ \ Example with `align_ops=$(b,false)':\n\ \ let f x = x\n\ \ + y" @ `I (option_name "align_params" "" (string_of_threechoices default.i_align_params), "If `never', function parameters are indented one level from the \ line of the function. \ If `always', they are aligned from the column of the function. \ if `auto', alignment is chosen over indentation in a few cases, e.g. \ after match arrows") :: pre " Example with `align_params=$(b,never)':\n\ \ match foo with\n\ \ | _ -> some_fun\n\ \ $(b,..)parameter\n\ \ \n\ \ Example with `align_params=$(b,always)' or `$(b,auto)':\n\ \ match foo with\n\ \ | _ -> some_fun\n\ \ $(b,..)parameter" @ [ `P "Available presets are `normal', the default, `apprentice' which may \ make some aspects of the syntax more obvious for beginners, and \ `JaneStreet'." ] let save t file = try let oc = open_out file in output_string oc (to_string ~sep:"\n" t); output_char oc '\n'; true with Sys_error _ -> Printf.eprintf "ocp-indent warning: could not open %S for writing configuration.\n%!" file; false let syntax_ext syntax_list_ref dynlink_list_ref = function | "syntax" -> Some (fun syntaxes -> List.iter (fun syn -> (* if List.mem syn (IndentExt.available ()) then *) syntax_list_ref := syn :: !syntax_list_ref (* else *) (* let e = Printf.sprintf "unknown syntax extension %S" syn in *) (* raise (Invalid_argument e) *) ) (Util.string_split ' ' syntaxes)) | "load" -> Some (fun pkgs -> List.iter (fun s -> let dl = if Filename.check_suffix s ".cmo" || Filename.check_suffix s ".cma" || Filename.check_suffix s ".cmxs" then `Mod s else `Pkg s in dynlink_list_ref := dl :: !dynlink_list_ref) (Util.string_split ' ' pkgs)) | _ -> None let load ?(indent=default) file = try let ic = open_in file in let contents = let b = Buffer.create 512 in try while true do let s = input_line ic in let n = try String.index s '#' with Not_found -> String.length s in Buffer.add_substring b s 0 n; Buffer.add_char b '\n' done; assert false with End_of_file -> close_in ic; Buffer.contents b in let exts = ref [] in let dynlink = ref [] in let t = update_from_string ~extra:(syntax_ext exts dynlink) indent contents in t, !exts, !dynlink with | Sys_error _ -> Printf.eprintf "ocp-indent warning: could not open %S for reading configuration.\n%!" file; indent, [], [] | Invalid_argument err -> Printf.eprintf "ocp-indent warning: error in configuration file %S:\n%s\n%!" file err; default, [], [] let conf_file_name = ".ocp-indent" let rec find_conf_file path = let (/) = Filename.concat in if Sys.file_exists (path / conf_file_name) then Some (path / conf_file_name) else let path = if Filename.is_relative path then Sys.getcwd () / path else path in let parent = Filename.dirname path in if parent <> path then find_conf_file parent else None let local_default ?(path=Sys.getcwd()) () = let conf = default in let conf, syn, dlink = try let (/) = Filename.concat in let xdg_path = ( match Sys.getenv "XDG_CONFIG_HOME" with | "" -> (Sys.getenv "HOME") / ".config" | exception Not_found -> (Sys.getenv "HOME") / ".config" | x -> x ) / "ocp" / "ocp-indent.conf" in if Sys.file_exists xdg_path then load ~indent:conf xdg_path else let legacy_path = (Sys.getenv "HOME") / ".ocp" / "ocp-indent.conf" in if Sys.file_exists legacy_path then load ~indent:conf legacy_path else conf, [], [] with Not_found -> conf, [], [] in let conf, syn, dlink = match find_conf_file path with | Some c -> let conf, syn1, dlink1 = load ~indent:conf c in conf, syn1@syn, dlink1@dlink | None -> conf, syn, dlink in let conf = try update_from_string conf (Sys.getenv ("OCP_INDENT_CONFIG")) with | Not_found -> conf | Invalid_argument _ -> prerr_endline "Warning: invalid $OCP_INDENT_CONFIG"; conf in conf, syn, dlink ocp-indent-1.8.2/src/indentConfig.mli000066400000000000000000000064401355404771200174770ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) type threechoices = Always | Never | Auto (** See the [man] function to get the details of what the options are supposed to do (or the template .ocp-indent) *) type t = { i_base: int; (** indentation values *) i_type: int; i_in: int; i_with: int; i_match_clause: int; i_ppx_stritem_ext: int; i_max_indent: int option; (** indentation toggles *) i_strict_with: threechoices; i_strict_else: threechoices; i_strict_comments: bool; i_align_ops: bool; i_align_params: threechoices; } (** Documentation of the indentation options, in the Cmdliner 'Manpage.block' format *) type man_block = [ `S of string | `P of string | `Pre of string | `I of string * string | `Noblank | `Blocks of man_block list ] val man: man_block list val default: t (** String format is ["option=value,option2=value,..."]. Commas can be replaced by newlines. Use [?extra] to handle extra options (by side-effects only) *) val update_from_string : ?extra:(string -> (string -> unit) option) -> t -> string -> t (** sep should be comma or newline if you want to reparse. Comma by default *) val to_string : ?sep:string -> t -> string (** Load from the given filename, optionally updating from the given indent instead of the default one. On error, returns the original indent config unchanged and prints a message to stderr. The file may also contain bindings of the form 'syntax=SYNTAX_EXTENSION[,...]', that are returned as a the list of their names *) val load: ?indent:t -> string -> t * string list * [`Mod of string | `Pkg of string] list (** Save the given indent config to the given filename; returns true on success *) val save: t -> string -> bool (** Looks in given and parent directories for a [.ocp-indent] configuration file *) val find_conf_file: string -> string option (** Returns the local default configuration, obtained from (in order), the built-in [default], the file [~/.ocp/ocp-indent.conf], a file [.ocp-indent] in the current directory or any parent, and the environment variable [OCP_INDENT_CONFIG]. Returns the list of syntax extensions that may have been activated in conf-files as well *) val local_default: ?path:string -> unit -> t * string list * [`Mod of string | `Pkg of string] list ocp-indent-1.8.2/src/indentExtend.ml000066400000000000000000000036421355404771200173510ustar00rootroot00000000000000(**************************************************************************) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) exception Syntax_not_found of string type t = { keywords : (string * Approx_tokens.token) list; lexer : (Lexing.lexbuf -> Approx_tokens.token) option } let extensions = Hashtbl.create 17 let register name ?(keywords=[]) ?lexer () = Hashtbl.add extensions name {keywords;lexer} let available () = Hashtbl.fold (fun name _ acc -> name::acc) extensions [] let find (name : string) = try Hashtbl.find extensions name with Not_found -> raise (Syntax_not_found name) (* predefined extensions *) open Approx_tokens let _ = register "lwt" ~keywords:[ "for_lwt", FOR; "lwt", LET; "match_lwt", MATCH; "try_lwt", TRY; "while_lwt", WHILE; "finally", WITH; (* -- no equivalence for this one, this is a hack ! *) ] (); register "mll" ~keywords:[ "rule", LET; "parse", FUNCTION; ] (); register "stream" ~keywords:[ "parser", FUNCTION; ] (); register "cstruct" ~keywords:[ "cstruct", TYPE; ] (); register "bitstring" ~keywords:[ "bitmatch", MATCH; ] (); ocp-indent-1.8.2/src/indentExtend.mli000066400000000000000000000025531355404771200175220ustar00rootroot00000000000000(**************************************************************************) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) exception Syntax_not_found of string type t = { keywords : (string * Approx_tokens.token) list; lexer : (Lexing.lexbuf -> Approx_tokens.token) option } (** Register lexer extension.*) val register : string -> ?keywords:(string * Approx_tokens.token) list -> ?lexer:(Lexing.lexbuf -> Approx_tokens.token) -> unit -> unit (** Get available extensions *) val available : unit -> string list (** Find an extension by its name *) val find : string -> t ocp-indent-1.8.2/src/indentLoader.ml000066400000000000000000000042651355404771200173320ustar00rootroot00000000000000(**************************************************************************) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) module SS = Set.Make(String) let loaded = ref SS.empty let predicates = if Dynlink.is_native then [ "plugin" ; "native" ] else [ "plugin" ; "byte" ] let dynlink debug s = if debug then Format.eprintf "loading archive %s..@." s; try Dynlink.loadfile s with exc -> Format.eprintf "Error while linking %s : %s@." s (Printexc.to_string exc); raise exc let load_pkg debug pkg = if not (SS.mem pkg !loaded) then begin let d = Findlib.package_directory pkg in let archive = try Findlib.package_property predicates pkg "archive" with Not_found -> "" in let archives = Util.string_split ' ' archive in List.iter (fun arch -> if arch <> "" then let arch' = Findlib.resolve_path ~base:d arch in dynlink debug arch') archives; loaded:=SS.add pkg !loaded end let rec partition mods pkgs = function | [] -> List.rev pkgs, List.rev mods | `Mod m :: rest -> partition (m::mods) pkgs rest | `Pkg p :: rest -> partition mods (p::pkgs) rest let load ?(debug=false) l = let pkglist,mods = partition [] [] l in List.iter (dynlink debug) mods; let eff_pkglist = Findlib.package_deep_ancestors predicates pkglist in List.iter (load_pkg debug) eff_pkglist ocp-indent-1.8.2/src/indentLoader.mli000066400000000000000000000020251355404771200174730ustar00rootroot00000000000000(**************************************************************************) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) (** Dynlink of modules and finlib packages *) val load : ?debug:bool -> [`Mod of string | `Pkg of string ] list -> unit ocp-indent-1.8.2/src/indentMain.ml000066400000000000000000000075631355404771200170140ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012,2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) module Args = IndentArgs let indent_channel ic args config out perm = let oc, need_close = match out with | None | Some "-" -> stdout, false | Some file -> open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_text] perm file, true in let output = { IndentPrinter. debug = args.Args.debug; config = config; in_lines = args.Args.in_lines; indent_empty = args.Args.indent_empty; adaptive = true; kind = args.Args.indent_printer oc; } in let stream = Nstream.of_channel ic in IndentPrinter.proceed output stream IndentBlock.empty (); flush oc; if need_close then close_out oc let config_syntaxes syntaxes = Approx_lexer.disable_extensions (); List.iter (fun stx -> try Approx_lexer.enable_extension stx with IndentExtend.Syntax_not_found name -> Format.eprintf "Warning: unknown syntax extension %S@." name) syntaxes let indent_file args = function | Args.InChannel ic -> let config, syntaxes, dlink = IndentConfig.local_default () in IndentLoader.load ~debug:args.Args.debug (dlink @ args.Args.dynlink); config_syntaxes (syntaxes @ args.Args.syntax_exts); let config = List.fold_left IndentConfig.update_from_string config args.Args.indent_config in indent_channel ic args config args.Args.file_out 0o644 (* won't be used *) | Args.File path -> let config, syntaxes, dlink = IndentConfig.local_default ~path:(Filename.dirname path) () in IndentLoader.load ~debug:args.Args.debug (dlink @ args.Args.dynlink); config_syntaxes (syntaxes @ args.Args.syntax_exts); let config = List.fold_left IndentConfig.update_from_string config args.Args.indent_config in let out, perm, need_move = if args.Args.inplace then let tmp_file = path ^ ".ocp-indent-tmp" in let rec get_true_file path = let open Unix in match lstat path with | { st_kind = S_REG ; st_perm } -> Some tmp_file, st_perm, Some path | { st_kind = S_LNK ; } -> get_true_file @@ readlink path | { st_kind = _ ; } -> failwith "invalid file type" in get_true_file path else args.Args.file_out, 0o644, None in let ic = open_in path in try indent_channel ic args config out perm; match out, need_move with | Some src, Some dst -> Sys.rename src dst | _, _ -> () with e -> close_in ic; raise e let main = Cmdliner.Term.( pure (fun (args,files) -> List.iter (indent_file args) files) $ Args.options ), Args.info let _ = match Cmdliner.Term.eval main with | `Error _ -> exit 1 | _ -> exit 0 ocp-indent-1.8.2/src/indentPrinter.ml000066400000000000000000000241641355404771200175470ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2012,2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) open Compat open Pos open Nstream open Approx_lexer open Util type output_elt = Newline | Indent of int | Whitespace of string | Text of string type 'a output_kind = | Numeric of (int -> 'a -> 'a) | Print of (string -> 'a -> 'a) | Extended of (IndentBlock.t -> output_elt -> 'a -> 'a) type 'a output = { debug: bool; config: IndentConfig.t; (* Returns true on the lines that should be reindented *) in_lines: int -> bool; adaptive: bool; indent_empty: bool; kind: 'a output_kind; } let std_output = { debug = false; config = IndentConfig.default; in_lines = (fun _ -> true); adaptive = true; indent_empty = false; kind = Print (fun s () -> print_endline s); } (* utility functions *) let pr_string output block text usr = match output.kind with | Numeric _ -> usr | Print f -> f text usr | Extended f -> f block (Text text) usr let pr_whitespace output block text usr = match output.kind with | Numeric _ -> usr | Print f -> f text usr | Extended f -> f block (Whitespace text) usr let pr_nl output block usr = match output.kind with | Numeric _ -> usr | Print pr -> pr "\n" usr | Extended pr -> pr block Newline usr (* indent functions *) type indentKind = Normal | Empty (* empty line: depending on options, don't indent or try to guess expected indent. *) | Padded (* for comment continuations: indent the first line as the following ones*) | Fixed of int (* indent to this value, ignoring the block *) let warn_tabs = ref true (* must be called exactly once for each line, in order *) (* let line_debug_counter = ref 0 *) let print_indent output line blank ?(kind=Normal) block usr = (* assert (incr line_debug_counter; line = !line_debug_counter); *) if output.in_lines line then let indent = match kind with | Normal -> IndentBlock.indent block | Empty -> if output.indent_empty then IndentBlock.guess_indent line block else 0 | Padded -> IndentBlock.indent block + IndentBlock.padding block | Fixed n -> n in match output.kind with | Numeric pr -> pr indent usr | Print pr -> pr (String.make indent ' ') usr | Extended pr -> pr block (Indent indent) usr else ( if !warn_tabs && String.contains blank '\t' then ( warn_tabs := false; prerr_endline "Warning: ocp-indent input contains indentation by tabs, \ partial indent will be unreliable." ); match output.kind with | Numeric _ -> usr | Print pr -> pr blank usr | Extended pr -> pr block (Whitespace blank) usr ) let print_token output block tok usr = let orig_start_column = IndentBlock.original_column block in let start_column = IndentBlock.offset block in (* Handle multi-line tokens (strings, comments) *) let rec print_extra_lines line pad last ?(item_cont=false) lines usr = match lines with | [] -> usr | text::next_lines -> let usr = usr |> pr_nl output block in if not (output.in_lines line) then usr |> print_indent output line "" block |> pr_string output block text |> print_extra_lines (line+1) pad text next_lines else if String.trim text = "" && tok.token <> OCAMLDOC_VERB then usr |> print_indent output line "" ~kind:Empty block |> print_extra_lines (line+1) pad text next_lines else let orig_line_indent = count_leading_spaces text in let orig_offset = orig_line_indent - orig_start_column in let text = String.sub text orig_line_indent (String.length text - orig_line_indent) in let indent_value, item_cont = match pad with | None -> orig_line_indent, false | Some pad -> match tok.token with | STRING _ -> if ends_with_escape last then if is_prefix "\"" text || is_prefix "\\ " text then start_column, item_cont else start_column + pad, item_cont else orig_line_indent, item_cont | COMMENT | COMMENTCONT -> let is_item = is_prefix "- " text && not (is_prefix "- :" text) in let n = if is_prefix "*" text then 1 else if not is_item && item_cont then pad + 2 else pad in let item_cont = is_item || item_cont && text <> "" in let n = if output.config.IndentConfig.i_strict_comments || is_item then n else max orig_offset n in let n = if next_lines = [] && text = "*)" then 0 else n in start_column + n, item_cont | QUOTATION opening -> if is_prefix "{" opening then orig_line_indent, item_cont else (start_column + if next_lines = [] && text = ">>" then 0 else max orig_offset pad), item_cont | _ -> start_column + max orig_offset pad, item_cont in usr |> print_indent output line "" ~kind:(Fixed indent_value) block |> pr_string output block text |> print_extra_lines (line+1) pad ~item_cont text next_lines in let line = Region.start_line tok.region in let text, next_lines = if line = Region.end_line tok.region then (Lazy.force tok.substr), [] else match string_split '\n' (Lazy.force tok.substr) with | [] -> assert false | hd::tl -> hd,tl in let pad = if next_lines = [] then None else match tok.token with | STRING _ -> (match String.trim text with | "\"" | "\"\\" -> None | _ -> Some 1 (* length of '"' *)) | COMMENT -> (match String.trim text with | "(*" when not output.config.IndentConfig.i_strict_comments -> None | _ -> Some (IndentBlock.padding block)) | COMMENTCONT -> Some (IndentBlock.padding block) | OCAMLDOC_VERB -> None | QUOTATION opening -> let oplen = String.length opening in let textlen = String.length text in if oplen = textlen then None else Some (oplen + count_leading_spaces (String.sub text oplen (textlen - oplen - 1))) | _ -> Some 2 in usr |> pr_string output block text |> print_extra_lines (line+1) pad text next_lines (* [block] is the current indentation block [stream] is the token stream *) let rec loop output block stream usr = match Nstream.next stream with | None -> usr (* End of file *) | Some (t, stream) -> let line = Region.start_line t.region in let last_line = line - t.newlines in (* handle leading blanks (output other lines right now, whitespace in front of the current token and on the same line is handled later) *) let blank, usr = let rec indent_between line blanks usr = match blanks with | [] -> assert false | bl::[] -> bl, usr |> pr_nl output block | bl::blanks -> usr |> pr_nl output block |> print_indent output line bl ~kind:Empty block |> indent_between (line + 1) blanks in let blanks = string_split '\n' (Lazy.force t.between) in match blanks with | [] -> assert false | bl::[] -> bl, usr (* no newline *) | bl::blanks -> usr |> (if last_line = 0 then print_indent output 1 "" ~kind:Empty block else fun usr -> usr) |> pr_whitespace output block bl |> indent_between (last_line + 1) blanks in (* Compute block and indent *) let block = IndentBlock.update output.config block stream t in (* Update block according to the indent in the file if before the handled region *) let block = if output.adaptive && not (output.in_lines line) then IndentBlock.reverse block else block in if output.debug then IndentBlock.dump block; (* Handle token *) let at_line_start = t.newlines > 0 in let usr = if at_line_start then let kind = match t.token with | COMMENT when is_prefix "(*\n" (Lazy.force t.substr) -> Fixed (String.length blank) | OCAMLDOC_VERB -> Padded | EOF -> Empty | COMMENTCONT when (Lazy.force t.substr <> "*)") -> Padded | _ -> Normal in usr |> print_indent output line blank ~kind block else usr |> pr_whitespace output block blank in let usr = usr |> print_token output block t in match t.token with EOF -> usr | _ -> usr |> loop output block stream let proceed output stream block usr = usr |> loop output block stream ocp-indent-1.8.2/src/indentPrinter.mli000066400000000000000000000045621355404771200177200ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) (** Passed to the function specified with the [Extended] output_kind *) type output_elt = Newline | Indent of int | Whitespace of string | Text of string (** * If [Print f], the whole input is fed as strings through f, with expected lines reindented (with spaces). * If [Numeric f], the indentation values (i.e. total number of leading spaces) for each lines on which [in_lines] is true are passed through the function. * If [Extended f], every element is fed to [f] with arguments [state element]. There is at least an element for each token, but there may be more (whitespace, multiline tokens...). You may safely raise an exception from [f] to stop further processing. This version can be used for syntax highlighting or storing checkpoints. *) type 'a output_kind = | Numeric of (int -> 'a -> 'a) | Print of (string -> 'a -> 'a) | Extended of (IndentBlock.t -> output_elt -> 'a -> 'a) type 'a output = { debug: bool; config: IndentConfig.t; (** Returns true on the lines that should be reindented (lines start at 1) *) in_lines: int -> bool; (** if true, partial indent will adapt to the current indent of the file *) adaptive: bool; indent_empty: bool; kind: 'a output_kind; } val std_output : unit output val proceed : 'a output -> Nstream.t -> IndentBlock.t -> 'a -> 'a ocp-indent-1.8.2/src/nstream.ml000066400000000000000000000113301355404771200163620ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012-2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) open Pos open Approx_lexer type token = { region : Region.t; token : Approx_lexer.token; newlines: int; between : string Lazy.t; substr : string Lazy.t; offset : int; } type cons = | Cons of token * t | Null and t = cons lazy_t let of_string ?(start_pos=Position.zero) ?(start_offset=0) string = let lexbuf = { Lexing. refill_buff = (fun lexbuf -> lexbuf.Lexing.lex_eof_reached <- true); lex_buffer = Bytes.of_string string; lex_buffer_len = String.length string; lex_abs_pos = start_offset; lex_start_pos = start_offset; lex_curr_pos = start_offset; lex_last_pos = start_offset; lex_last_action = 0; lex_mem = [||]; lex_eof_reached = true; lex_start_p = start_pos; lex_curr_p = start_pos; } in Approx_lexer.init (); let rec loop last = let open Lexing in match Approx_lexer.token_with_comments lexbuf with | EOL | SPACES -> loop last | token -> let pos_last = Region.snd last and pos_start = lexbuf.lex_start_p and pos_end = lexbuf.lex_curr_p in let region = Region.create pos_start pos_end in let offset = Region.start_column region - Region.start_column last in let spaces = pos_start.pos_cnum - pos_last.pos_cnum in let len = pos_end.pos_cnum - pos_start.pos_cnum in let newlines = pos_start.pos_lnum - pos_last.pos_lnum in let between = lazy (String.sub string pos_last.pos_cnum spaces) in let substr = lazy (String.sub string pos_start.pos_cnum len) in Cons ({ region; token; newlines; between; substr; offset }, lazy (match token with | EOF -> Null | _ -> loop region) ) in let init_region = let pos_above = {start_pos with Lexing.pos_lnum = start_pos.Lexing.pos_lnum - 1} in Region.create pos_above pos_above in lazy (loop init_region) let of_channel ?(start_pos=Position.zero) ic = (* add some caching to the reader function, so that we can get back the original strings *) let buf = Buffer.create 511 in let reader str count = let n = input ic str 0 count in Buffer.add_substring buf (Bytes.to_string str) 0 n; n in let lexbuf = Lexing.from_function reader in let lexbuf = { lexbuf with Lexing.lex_start_p = start_pos; Lexing.lex_curr_p = start_pos; } in Approx_lexer.init (); let rec loop last = let open Lexing in match Approx_lexer.token_with_comments lexbuf with | EOL | SPACES -> loop last | token -> let pos_last = Region.snd last and pos_start = lexbuf.lex_start_p and pos_end = lexbuf.lex_curr_p in let spaces = pos_start.pos_cnum - pos_last.pos_cnum in let len = pos_end.pos_cnum - pos_start.pos_cnum in let newlines = pos_start.pos_lnum - pos_last.pos_lnum in let between = let s = Buffer.sub buf 0 spaces in lazy s in let substr = let s = Buffer.sub buf spaces len in lazy s in let total = pos_end.pos_cnum - pos_last.pos_cnum in let more = Buffer.sub buf total (Buffer.length buf - total) in Buffer.clear buf; Buffer.add_string buf more; let region = Region.create pos_start pos_end in let offset = Region.start_column region - Region.start_column last in Cons ({ region; token; newlines; between; substr; offset }, lazy (match token with | EOF -> Null | _ -> loop region) ) in let init_region = let pos_above = {start_pos with Lexing.pos_lnum = start_pos.Lexing.pos_lnum - 1} in Region.create pos_above pos_above in lazy (loop init_region) let next = function | lazy Null -> None | lazy (Cons (car, cdr)) -> Some (car, cdr) ocp-indent-1.8.2/src/nstream.mli000066400000000000000000000035101355404771200165340ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012-2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) (** Stream with efficient n-lookup *) open Pos (** Enhanced tokens *) type token = { region : Region.t; token : Approx_lexer.token; newlines: int; between : string Lazy.t; substr : string Lazy.t; offset : int; } type t (** Creates a stream from a string. Make sure you don't change the string in-place after calling [of_string], or anything could happen *) val of_string: ?start_pos:Position.t -> ?start_offset:int -> string -> t (** Creates a stream from a channel. Better if you don't want to block, but less efficient *) val of_channel: ?start_pos:Position.t -> in_channel -> t (** Get next token from the filter. Returns None after EOF *) val next: t -> (token * t) option ocp-indent-1.8.2/src/pos.ml000066400000000000000000000042101355404771200155110ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) module Position = struct type t = Lexing.position = { pos_fname : string; pos_lnum : int; pos_bol : int; pos_cnum : int; } let to_string t = Printf.sprintf "%s%d:%d" (if t.pos_fname = "" then "" else t.pos_fname ^ ":") t.pos_lnum (t.pos_cnum - t.pos_bol) let zero = { pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 0 } let column p = p.pos_cnum - p.pos_bol end module Region = struct open Position type t = Position.t * Position.t let fst = fst let snd = snd let create p1 p2 = (p1,p2) let start_column (p,_) = column p let end_column (_,p) = column p let start_line (p,_) = p.pos_lnum let end_line (_,p) = p.pos_lnum let char_offset (p, _) = p.pos_cnum let length (p1, p2) = p2.Position.pos_cnum - p1.Position.pos_cnum let zero = (Position.zero, Position.zero) let translate (p,p') diff = { p with pos_cnum = p .pos_cnum + diff }, { p' with pos_cnum = p'.pos_cnum + diff } end ocp-indent-1.8.2/src/pos.mli000066400000000000000000000045221355404771200156700ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) (** Lexer positions & regions *) (** Lexer positions *) module Position : sig (** A position in a lexer stream *) type t = Lexing.position (** Pretty-print a position *) val to_string: t -> string (** Initial position *) val zero: t (** Get the coloumn offset associated to a lexing position *) val column: t -> int end (** Lexer regions *) module Region : sig (** A region in a lexer stream *) type t (** Create a region from a starting and an ending position *) val create: Position.t -> Position.t -> t val fst: t -> Position.t val snd: t -> Position.t (** Return the column where the region starts *) val start_column: t -> int (** Return the column where the region ends *) val end_column: t -> int (** Get the region offset (number of characters from the beginning of the file *) val char_offset: t -> int (** Get the lenght of a region *) val length: t -> int (** Return the line number where the region starts *) val start_line: t -> int (** Return the line number where the region ends *) val end_line: t -> int (** The empty region *) val zero: t (** [translate t x] shifts a region by [x] characters *) val translate: t -> int -> t end ocp-indent-1.8.2/src/util.ml000066400000000000000000000061521355404771200156740ustar00rootroot00000000000000(**************************************************************************) (* *) (* Copyright 2011 Jun Furuse *) (* Copyright 2012,2013 OCamlPro *) (* *) (* All rights reserved.This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1 with linking *) (* exception. *) (* *) (* TypeRex is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* Lesser GNU General Public License for more details. *) (* *) (**************************************************************************) let compose : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c = fun f g x -> f (g (x)) let ( @* ) = compose let default d = function Some x -> x | None -> d let string_split char str = let rec aux acc pos = let i = try Some (String.rindex_from str pos char) with Not_found | Invalid_argument _ -> None in match i with | Some i -> aux (String.sub str (i + 1) (pos - i) :: acc) (pred i) | None -> String.sub str 0 (pos + 1) :: acc in aux [] (String.length str - 1) let string_split_chars chars str = let len = String.length str in let rec split pos = let rec lookup i = if i >= len then raise Not_found else if String.contains chars str.[i] then i else lookup (succ i) in try let i = lookup pos in if i > pos then String.sub str pos (i - pos) :: split (succ i) else split (succ i) with Not_found | Invalid_argument _ -> [ String.sub str pos (len - pos) ] in split 0 let is_prefix pfx str = let pfxlen = String.length pfx in let rec check i = i >= pfxlen || pfx.[i] = str.[i] && check (i+1) in String.length str >= pfxlen && check 0 let ends_with_escape s = let rec aux n = n >= 0 && s.[n] = '\\' && not (aux (n-1)) in aux (String.length s - 1) let count_leading_spaces s = let rec aux i = if i >= String.length s || s.[i] <> ' ' then i else aux (i+1) in aux 0 let shorten_string n s = match string_split '\n' s with | [] -> "" | [s] -> if String.length s <= n then s else let n1 = (n - 3) / 2 in let n2 = n - 3 - n1 in String.sub s 0 n1 ^ "..." ^ String.sub s (String.length s - n2) n2 | s1::r1::r -> let s2 = let rec last x = function x::r -> last x r | [] -> x in last r1 r in let l1 = String.length s1 and l2 = String.length s2 in let n1 = min l1 (max ((n-3) / 2) (n-3 - l2)) in let n2 = min l2 (n - 3 - n1) in String.sub s1 0 n1 ^ "..." ^ String.sub s2 (l2 - n2) n2 ocp-indent-1.8.2/tests/000077500000000000000000000000001355404771200147345ustar00rootroot00000000000000ocp-indent-1.8.2/tests/.ocp-indent000066400000000000000000000000071355404771200167720ustar00rootroot00000000000000normal ocp-indent-1.8.2/tests/failing-output/000077500000000000000000000000001355404771200177035ustar00rootroot00000000000000ocp-indent-1.8.2/tests/failing-output/escaped-nl.ml000066400000000000000000000012301355404771200222440ustar00rootroot00000000000000let s1 = "No field 'install', but a field 'remove': install instructions \ probably part of 'build'. Use the 'install' field or a .install \ file" let x = cond 40 `Warning "Package uses flags that aren't recognised by earlier versions in \ OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \ instead for compatibility" ~detail:alpha_flags (alpha_flags <> []) let s2 = "bla bla bli bli \ blo" let s3 = "\ " let s4 = " \ " let s5 = " \ \ " let s6 = " " let s7 = " " let c1 = ' ' let x1 = f x ' ' y z let zz = "\ s \ \ " ocp-indent-1.8.2/tests/failing-output/indent-empty-numeric.ml000066400000000000000000000000251355404771200243070ustar00rootroot000000000000000 0 2 2 0 0 0 0 2 15 ocp-indent-1.8.2/tests/failing-output/js-args.ml000066400000000000000000000074201355404771200216060ustar00rootroot00000000000000let () = foo.bar <- f x y z let should_check_can_sell_and_marking regulatory_regime = match z with | `foo -> some_function argument (* The above typically occurs in a multi-pattern match clause, so the clause expression is on a line by itself. This is the more typical way a long single-pattern match clause would be written: *) let should_check_can_sell_and_marking regulatory_regime = match z with | `foo -> some_function argument let f = fun x -> ghi x (* common *) let x = try x with | a -> b | c -> d let x = try x with | a -> b | c -> d let x = try x with | a -> b | c -> d let z = some_function argument let () = f a b ~c:c d let () = f a b ~c:1. d let () = My_module.f a b ~c:c d (* This last case is where Tuareg is inconsistent with the others. *) let () = My_module.f a b ~c:1. d let () = messages := Message_store.create (Session_id.of_string "") (* Tuareg indents these lines too far to the left. *) "herd-retransmitter" Message_store.Message_size.Byte let () = raise (Bug ("foo" (* In this and similar cases, we want the subsequent lines to align with the first expression. *) ^ "bar")); raise (Bug ("foo" ^ "quux" ^ "bar")); raise (Bug (foo + quux ^ "bar")); raise (Bug ((foo + quux) ^ "bar")) (* Except in specific cases, we want the argument indented relative to the function being called. (Exceptions include "fun" arguments where the line ends with "->" and subsequent lines beginning with operators, like above.) *) let () = Some (Message_store.create s "herd-retransmitter" ~unlink:true Message_store.Message_size.Byte) (* We like the indentation of most arguments, but want to get back towards the left margin in a few special cases: *) let _ = foo (bar (fun x -> (* special: "fun _ ->" at EOL *) baz)) (* assume no more arguments to "bar" *) let _ = foo ~a_long_field_name:(check (fun bar -> baz)) let _ = foo ~a_long_field_name:(check (fun bar -> baz)) let _ = foo (bar (quux (fnord (fun x -> (* any depth *) baz)))) (* We also wanted to tweak the operator indentation, making operators like <= not special cases in contexts like this: *) let _ = assert (foo (bar + baz <= quux)) (* lined up under left argument to op, sim. to ^ above *) (* Sim. indentation of if conditions: *) let _ = if (a <= b) then () let _ = (* Comparisons are different than conditionals; we don't regard them as conceptually part of the [if] expression. *) if a <= b then () let _ = (* We regard the outermost condition terms as conceptually part of the [if] expression and indent accordingly. Whether [&&] or [||], conditionals effectively state lists of conditions for [then]. *) if Edge_adjustment.is_zero arb.cfg.extra_edge && 0. = sys.plugs.edge_backoff && 0. = zero_acvol_edge_backoff then 0. else 1. let _ = if Edge_adjustment.is_zero arb.cfg.extra_edge && 0. = sys.plugs.edge_backoff && 0. = zero_acvol_edge_backoff then 0. else 1. let _ = let entries = List.filter (Lazy.force transferstati) ~f:(fun ts -> Pcre.pmatch ~pat ts.RQ.description ) in x (* combination of operator at BOL and -> at EOL: *) let _ = Shell.ssh_lines x |! List.map ~f:(f (g (fun x -> let name, path = String.lsplit2_exn ~on:'|' x in String.strip name, String.strip path))) (* open paren ending line like begin *) let _ = if a (p ^/ "s") [ e ] = Ok () then `S ( let label count = sprintf "%d s" c ^ if c = 1 then ":" else "s" in x ) ocp-indent-1.8.2/tests/failing-output/js-begin.ml000066400000000000000000000002711355404771200217330ustar00rootroot00000000000000let f = function | zoo -> begin foo; bar; end ;; let g = function | zoo -> ( foo; bar; ) ;; let () = begin match foo with | Bar -> snoo end ;; ocp-indent-1.8.2/tests/failing-output/js-fun.ml000066400000000000000000000023111355404771200214340ustar00rootroot00000000000000(* preferred list style *) let z = f [ y ; foo ~f:(fun () -> arg) ] ;; let z = f [ y ; foo ~f:(fun () -> arg ) ] ;; (* legacy list style *) let _ = [ f (fun x -> x); f (fun x -> x); f (fun x -> x); ] let _ = [ f (fun x -> x ); f (fun x -> x ); f (fun x -> x ); ] ;; let _ = [f (fun x -> x ); f (fun x -> x ); f (fun x -> x ); ] ;; let _ = x >>= fun x -> (try x with _ -> ()) >>= fun x -> try x with _ -> () >>= fun x -> x ;; let () = expr >>| function | x -> 3 | y -> 4 ;; let () = expr >>| fun z -> match z with | x -> 3 | y -> 4 ;; let () = expr >>| fun z -> function | x -> 3 | y -> 4 ;; let () = my_func () >>= function | A -> 0 | B -> 0 ;; let () = my_func () >>= (function | A -> 0 | B -> 0) ;; let () = expr >>| function | x -> 3 | y -> 4 ;; let () = expr >>| (function | x -> 3 | y -> 4) ;; let f = f >>= m (fun f -> fun x -> y); z ;; let f = f |> m (fun f -> fun x -> y ); z ;; let f = f |> m (fun f -> fun x -> y); z ;; ocp-indent-1.8.2/tests/failing-output/js-functor.ml000066400000000000000000000024331355404771200223310ustar00rootroot00000000000000module M = Foo (G) (H) module M = Foo (G) (struct let x end) (H) (* To me, this looks fine as it is. The rule seems fine as "indent arguments by 2". To illustrate, with a case where the functor name is longer: *) module M = Functor (G) (H) (I) include Foo (struct let x end) (struct let y end) include Foo (struct let x end) (struct let y end) include Foo (struct let x end) (struct let y end) include Persistent.Make (struct let version = 1 end) (Stable.Cr_soons_or_pending.V1) include Persistent.Make (struct let version = 1 end) (Stable.Cr_soons_or_pending.V1) include Persistent.Make (struct let version = 1 end) (Stable.Cr_soons_or_pending.V1) include Persistent.Make (struct let version = 1 end) (Stable.Cr_soons_or_pending.V1) module M = Foo (struct let x end) (struct let y end) module M : S = Make (M) module M : S with type t := int = Make (M) module Simple_command(Arg:sig end) = struct end module Simple_command(Arg : sig end) = struct end module Simple_command (Arg:sig end) = struct end module Simple_command (Arg : sig end) = struct end module Simple_command (Arg : sig end) = struct end ocp-indent-1.8.2/tests/failing-output/js-pattern.ml000066400000000000000000000012271355404771200223260ustar00rootroot00000000000000let f = function | _ -> 0 ;; let f x = match x with | _ -> 0 ;; let f = function | _ -> 0 ;; let f x = match x with | _ -> 0 ;; let f x = begin match x with | _ -> 0 end ;; let check_price t = function | { Exec. trade_at_settlement = (None | Some false); } -> () let check_price t = function | simpler -> () | other -> () (* Sometimes we like to write big alternations like this, in which case the comment should typically align with the following clause. *) let 0 = match x with | A (* a *) -> a let 0 = match x with A (* a *) -> a let _ = a || match a with | a -> true | b -> false ocp-indent-1.8.2/tests/failing-output/js-record.ml000066400000000000000000000017661355404771200221370ustar00rootroot00000000000000type x = { foo : int ; bar : int } let x = { x with foo = 3 ; bar = 5 } let x = { (* blah blah blah *) foo = 3 ; bar = 5 } ;; let x = [{ x with foo = 3 ; bar = 5 }] let x = [{ (* blah blah blah *) foo = 3 ; bar = 5 }] ;; let x = { M.x with M. foo = 3 } ;; let x = { x with M. foo = 3 } ;; let x = { M. foo = 3 } ;; let _ = { foo with Bar. field1 = value1 ; field2 = value2 } ;; let _ = { foo with Bar. field1 = value1 ; field2 = value2 } ;; (* multicomponent record module pathname *) let _ = { A.B. a = b ; c = d } ;; type t = { a : something_lengthy list list [@default String.Map.empty] } type t = { a : Something_lengthy.t list list [@default String.Map.empty] } type t = { a : something_lengthy list list } type t = { a : Something_lengthy.t list list } type t = { a : Something_lengthy.t list } ocp-indent-1.8.2/tests/failing-output/js-syntax.ml000066400000000000000000000006611355404771200222000ustar00rootroot00000000000000(* s *) let _ = [%raise_structural_sexp "feature's tip is already an ancestor of new base" { feature_tip = (old_tip : Rev.t) ; new_base = (new_base : Rev.t) }] let _ = [%raise_structural_sexp "feature's tip is already an ancestor of new base" { feature_tip = (old_tip : Rev.t) ; new_base = (new_base : Rev.t) } ] ocp-indent-1.8.2/tests/failing-output/js-to-do.ml000066400000000000000000000042701355404771200216740ustar00rootroot00000000000000(* Indentation that Jane Street needs to think about and make precise. These are long term ideas, possibly even conflicting with other tests. *) (* js-args *) let _ = let min_closing_backoff = -. ( Hidden_float.expose (arb.cfg.base_edge @! Buy) +. Hidden_float.expose (arb.cfg.base_edge @! Sell)) in 0 (* js-type *) (* The following tests incorporate several subtle and different indentation ideas. Please consider this only a proposal for discussion, for now. First, notice the display treatment of "(,)" tuples, analogous to "[;]" lists. While "(,)" is an intensional combination of "()" and ",", unlike "[;]" lists, we believe "(,)" isn't too big a departure. Value expression analogies are included in js-type.ml, (meant to be) consistent with the proposed type indentation. Second, and more divergently, the proposed indentation of function types is based on the idea of aligning the arguments, even the first argument, even where that means automatically inserting spaces within lines. This applies to the extra spaces in ":__unit" and "(____Config.Network.t" below. We believe this fits into a more general incorporation of alignment into ocp-indent, to replace our internal alignment tool with a syntax-aware one. We like to align things for readability, like big records, record types, lists used to build tables, etc. The proposal also includes indenting "->" in the circumstances below relative to the enclosing "()", by two spaces. In a sense, this happens first, and then the first argument is aligned accordingly. So, there's no manual indentation or spacing below. *) val instances : unit -> ( Config.Network.t -> (App.t * Config.instance * Config.app) list -> verbose:bool -> 'm , 'm ) Command.Spec.t val instances : unit -> ( Config.Network.t -> (App.t * Config.instance * Config.app) list -> verbose:bool -> 'm , 'm ) Command.Spec.t (* presumed analog with stars *) val instances : unit * ( Config.Network.t * (App.t * Config.instance * Config.app) list * bool * 'm , 'm ) Command.Spec.t ocp-indent-1.8.2/tests/failing-output/js-upon.ml000066400000000000000000000005271355404771200216340ustar00rootroot00000000000000let f x = stop (* We don't do this as a matter of style, but the indentation reveals a common mistake. *) >>> fun () -> don't_wait_for (close fd); bind fd let f x = stop (* This is what was intended, which is indented correctly, although it's bad style on my part. *) >>> (fun () -> don't_wait_for (close fd)); bind ocp-indent-1.8.2/tests/failing-output/list_of_funs.ml000066400000000000000000000010131355404771200227220ustar00rootroot00000000000000let f x = (fun x -> x [ (fun () -> 3) ; (fun () -> 4) ]) let f x = (fun x -> x [ (fun () -> 3) ; (fun () -> 4) ]) let f x = x [ (fun () -> 3) ; (fun () -> 4) ] let f x = [ (fun () -> 3) ; (fun () -> 4) ] let f x = (fun x -> x [ (fun () -> 3) ; (fun () -> 4) ]) let f x = (fun x -> x [ (fun () -> 3) ; (fun () -> 4) ]) let f x = x [ (fun () -> 3) ; (fun () -> 4) ] let f x = [ (fun () -> 3) ; (fun () -> 4) ] ocp-indent-1.8.2/tests/failing.html000066400000000000000000003201301355404771200172320ustar00rootroot00000000000000 Failing tests, ocp-indent version 1.8.1+5 (2019-10-23)

Failing tests, ocp-indent version 1.8.1+5 (2019-10-23)

Differences in escaped-nl.ml.ref

ExpectedOcp-indent output
0
let s1 = "No field 'install', but a field 'remove': install instructions \
let s1 = "No field 'install', but a field 'remove': install instructions \
1
          probably part of 'build'. Use the 'install' field or a .install \
          probably part of 'build'. Use the 'install' field or a .install \
2
          file"
          file"
3


4
let x =
let x =


5
  cond 40 `Warning
  cond 40 `Warning


6
    "Package uses flags that aren't recognised by earlier versions in \
    "Package uses flags that aren't recognised by earlier versions in \


7
     OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \
     OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \


8
     instead for compatibility"
     instead for compatibility"


9
    ~detail:alpha_flags
    ~detail:alpha_flags


10
    (alpha_flags <> [])
    (alpha_flags <> [])


11


12
let s2 = "bla bla
let s2 = "bla bla


13
 bli bli \
 bli bli \


14
          blo"
          blo"


15


16
let s3 = "\
let s3 = "\


17
"
"


18


19
let s4 = " \
let s4 = " \


20
         "
         "


21


22
let s5 = "  \
let s5 = "  \


23
          \
          \


24
         "
         "


25


26
let s6 = "
let s6 = "


27
"
"


28


29
let s7 = "  
let s7 = "  


30
"
"


31


32
let c1 = '
let c1 = '


33
'
···········'


34


35
let x1 = f x '
let x1 = f x '


36
'·y
···············'·y


37
    z
    z


38


39
let zz = "\
let zz = "\


40


41
s \
s \


42
 \
 \


43
 "
 "








Differences in js-args.ml




ExpectedOcp-indent output


0
let () =
let () =


1
  foo.bar <-
  foo.bar <-


2
    f x
    f x


3
      y z
      y z


4


5
let should_check_can_sell_and_marking regulatory_regime =
let should_check_can_sell_and_marking regulatory_regime =


6
  match z with
  match z with


7
  | `foo
  | `foo


8
    -> some_function
    -> some_function


9
         argument
         argument


10
(* The above typically occurs in a multi-pattern match clause, so the clause
(* The above typically occurs in a multi-pattern match clause, so the clause


11
   expression is on a line by itself.  This is the more typical way a long
   expression is on a line by itself.  This is the more typical way a long


12
   single-pattern match clause would be written: *)
   single-pattern match clause would be written: *)


13
let should_check_can_sell_and_marking regulatory_regime =
let should_check_can_sell_and_marking regulatory_regime =


14
  match z with
  match z with


15
  | `foo ->
  | `foo ->


16
    some_function
    some_function


17
      argument
      argument


18


19
let f = fun x ->
let f = fun x ->


20
  ghi
  ghi


21
    x
    x


22


23
(* common *)
(* common *)


24
let x =
let x =


25
  try x with
  try x with


26
  | a -> b
  | a -> b


27
  | c -> d
  | c -> d


28
let x = try x with
let x = try x with


29
  | a -> b
  | a -> b


30
  | c -> d
  | c -> d


31
let x =
let x =


32
  try x
  try x


33
  with
  with


34
  | a -> b
  | a -> b


35
  | c -> d
  | c -> d


36


37
let z =
let z =


38
  some_function
  some_function


39
    argument
    argument


40


41


42


43
let () =
let () =


44
  f a b ~c:c
  f a b ~c:c


45
    d
    d


46


47
let () =
let () =


48
  f a b ~c:1.
  f a b ~c:1.


49
    d
    d


50


51
let () =
let () =


52
  My_module.f a b ~c:c
  My_module.f a b ~c:c


53
    d
    d


54


55
(* This last case is where Tuareg is inconsistent with the others. *)
(* This last case is where Tuareg is inconsistent with the others. *)


56
let () =
let () =


57
  My_module.f a b ~c:1.
  My_module.f a b ~c:1.


58
    d
    d


59


60


61


62
let () =
let () =


63
  messages :=
  messages :=


64
    Message_store.create (Session_id.of_string "")
    Message_store.create (Session_id.of_string "")


65
      (* Tuareg indents these lines too far to the left. *)
      (* Tuareg indents these lines too far to the left. *)


66
      "herd-retransmitter"
      "herd-retransmitter"


67
      Message_store.Message_size.Byte
      Message_store.Message_size.Byte


68


69


70


71
let () =
let () =


72
  raise (Bug ("foo"
  raise (Bug ("foo"


73
              (* In this and similar cases, we want the subsequent lines to
              (* In this and similar cases, we want the subsequent lines to


74
                 align with the first expression. *)
                 align with the first expression. *)


75
              ^ "bar"));
              ^ "bar"));


76
  raise (Bug ("foo" ^ "quux"
  raise (Bug ("foo" ^ "quux"


77
              ^ "bar"));
              ^ "bar"));


78
  raise (Bug (foo + quux
  raise (Bug (foo + quux


79
              ^ "bar"));
              ^ "bar"));


80
  raise (Bug ((foo + quux)
  raise (Bug ((foo + quux)


81
              ^ "bar"))
              ^ "bar"))


82


83
(* Except in specific cases, we want the argument indented relative to the
(* Except in specific cases, we want the argument indented relative to the


84
   function being called.  (Exceptions include "fun" arguments where the line
   function being called.  (Exceptions include "fun" arguments where the line


85
   ends with "->" and subsequent lines beginning with operators, like above.) *)
   ends with "->" and subsequent lines beginning with operators, like above.) *)


86
let () =
let () =


87
  Some (Message_store.create s
  Some (Message_store.create s


88
          "herd-retransmitter" ~unlink:true Message_store.Message_size.Byte)
          "herd-retransmitter" ~unlink:true Message_store.Message_size.Byte)


89


90


91


92
(* We like the indentation of most arguments, but want to get back towards the
(* We like the indentation of most arguments, but want to get back towards the


93
   left margin in a few special cases: *)
   left margin in a few special cases: *)


94
let _ =
let _ =


95
  foo (bar (fun x ->                    (* special: "fun _ ->" at EOL *)
  foo (bar (fun x ->                    (* special: "fun _ ->" at EOL *)


96
    baz))                               (* assume no more arguments to "bar" *)
    baz))                               (* assume no more arguments to "bar" *)


97
let _ =
let _ =


98
  foo
  foo


99
    ~a_long_field_name:(check (fun bar ->
    ~a_long_field_name:(check (fun bar ->


100
      baz))
      baz))


101
let _ =
let _ =


102
  foo ~a_long_field_name:(check (fun bar ->
  foo ~a_long_field_name:(check (fun bar ->


103
    baz))
    baz))


104
let _ =
let _ =


105
  foo (bar (quux (fnord (fun x ->       (* any depth *)
  foo (bar (quux (fnord (fun x ->       (* any depth *)


106
    baz))))
    baz))))


107


108
(* We also wanted to tweak the operator indentation, making operators like <=
(* We also wanted to tweak the operator indentation, making operators like <=


109
   not special cases in contexts like this:  *)
   not special cases in contexts like this:  *)


110
let _ =
let _ =


111
  assert (foo (bar + baz
  assert (foo (bar + baz


112
               <= quux))                (* lined up under left argument to op,
               <= quux))                (* lined up under left argument to op,


113
                                           sim. to ^ above *)
                                           sim. to ^ above *)


114
(* Sim. indentation of if conditions: *)
(* Sim. indentation of if conditions: *)


115
let _ =
let _ =


116
  if (a
  if (a


117
      <= b)
      <= b)


118
  then ()
  then ()


119
let _ =
let _ =


120
  (* Comparisons are different than conditionals; we don't regard them as
  (* Comparisons are different than conditionals; we don't regard them as


121
     conceptually part of the [if] expression. *)
     conceptually part of the [if] expression. *)


122
  if a
  if a


123
     <= b
     <= b


124
  then ()
  then ()


125
let _ =
let _ =


126
  (* We regard the outermost condition terms as conceptually part of the [if]
  (* We regard the outermost condition terms as conceptually part of the [if]


127
     expression and indent accordingly.  Whether [&&] or [||], conditionals
     expression and indent accordingly.  Whether [&&] or [||], conditionals


128
     effectively state lists of conditions for [then]. *)
     effectively state lists of conditions for [then]. *)


129
  if Edge_adjustment.is_zero arb.cfg.extra_edge
  if Edge_adjustment.is_zero arb.cfg.extra_edge


130
  && 0. = sys.plugs.edge_backoff
  && 0. = sys.plugs.edge_backoff


131
  && 0. = zero_acvol_edge_backoff
  && 0. = zero_acvol_edge_backoff


132
  then 0.
  then 0.


133
  else 1.
  else 1.


134
let _ =
let _ =


135
  if
  if


136
    Edge_adjustment.is_zero arb.cfg.extra_edge
    Edge_adjustment.is_zero arb.cfg.extra_edge


137
    && 0. = sys.plugs.edge_backoff
    && 0. = sys.plugs.edge_backoff


138
    && 0. = zero_acvol_edge_backoff
    && 0. = zero_acvol_edge_backoff


139
  then 0.
  then 0.


140
  else 1.
  else 1.


141
let _ =
let _ =


142
  let entries = List.filter (Lazy.force transferstati) ~f:(fun ts ->
  let entries = List.filter (Lazy.force transferstati) ~f:(fun ts ->


143
    Pcre.pmatch ~pat ts.RQ.description
    Pcre.pmatch ~pat ts.RQ.description


144
  ) in
  ) in


145
  x
  x


146


147
(* combination of operator at BOL and -> at EOL: *)
(* combination of operator at BOL and -> at EOL: *)


148
let _ =
let _ =


149
  Shell.ssh_lines x
  Shell.ssh_lines x


150
  |! List.map ~f:(f (g (fun x ->
  |! List.map ~f:(f (g (fun x ->


151
·······let·name,·path·=·String.lsplit2_exn·~on:'|'·x·in
····let·name,·path·=·String.lsplit2_exn·~on:'|'·x·in


152
·······String.strip·name,·String.strip·path)))
····String.strip·name,·String.strip·path)))


153


154
(* open paren ending line like begin *)
(* open paren ending line like begin *)


155
let _ =
let _ =


156
  if a (p ^/ "s") [ e ] = Ok () then `S (
  if a (p ^/ "s") [ e ] = Ok () then `S (


157
    let label count =
    let label count =


158
      sprintf "%d s" c ^ if c = 1 then ":" else "s"
      sprintf "%d s" c ^ if c = 1 then ":" else "s"


159
    in
    in


160
    x
    x


161
  )
  )








Differences in js-begin.ml




ExpectedOcp-indent output


0
let f = function
let f = function


1
  | zoo -> begin
  | zoo -> begin


2
      foo;
      foo;


3
      bar;
      bar;


4
    end
    end


5
;;
;;


6
let g = function
let g = function


7
  | zoo -> (
  | zoo -> (


8
      foo;
      foo;


9
      bar;
      bar;


10
    )
    )


11
;;
;;


12
let () =
let () =


13
  begin match foo with
  begin match foo with


14
········|·Bar·->·snoo
··|·Bar·->·snoo


15
  end
  end


16
;;
;;








Differences in js-fun.ml




ExpectedOcp-indent output


0
(* preferred list style *)
(* preferred list style *)


1
let z =
let z =


2
  f
  f


3
    [ y
    [ y


4
    ; foo ~f:(fun () ->
    ; foo ~f:(fun () ->


5
        arg)
        arg)


6
    ]
    ]


7
;;
;;


8
let z =
let z =


9
  f
  f


10
    [ y
    [ y


11
    ; foo ~f:(fun () ->
    ; foo ~f:(fun () ->


12
        arg
        arg


13
      )
      )


14
    ]
    ]


15
;;
;;


16


17
(* legacy list style *)
(* legacy list style *)


18
let _ =
let _ =


19
  [ f (fun x ->
  [ f (fun x ->


20
      x);
      x);


21
    f (fun x ->
    f (fun x ->


22
      x);
      x);


23
    f (fun x ->
    f (fun x ->


24
      x);
      x);


25
  ]
  ]


26
let _ =
let _ =


27
  [ f (fun x ->
  [ f (fun x ->


28
      x
      x


29
    );
    );


30
    f (fun x ->
    f (fun x ->


31
      x
      x


32
    );
    );


33
    f (fun x ->
    f (fun x ->


34
      x
      x


35
    );
    );


36
  ]
  ]


37
;;
;;


38
let _ =
let _ =


39
  [f (fun x ->
  [f (fun x ->


40
     x
     x


41
   );
   );


42
   f (fun x ->
   f (fun x ->


43
     x
     x


44
   );
   );


45
   f (fun x ->
   f (fun x ->


46
     x
     x


47
   );
   );


48
  ]
  ]


49
;;
;;


50


51
let _ =
let _ =


52
  x
  x


53
  >>= fun x ->
  >>= fun x ->


54
  (try x with _ -> ())
  (try x with _ -> ())


55
  >>= fun x ->
  >>= fun x ->


56
  try x with _ -> ()
  try x with _ -> ()


57
    >>= fun x ->
    >>= fun x ->


58
    x
    x


59
;;
;;


60


61
let () =
let () =


62
  expr
  expr


63
  >>| function
  >>| function


64
  | x -> 3
  | x -> 3


65
  | y -> 4
  | y -> 4


66
;;
;;


67


68
let () =
let () =


69
  expr
  expr


70
  >>| fun z -> match z with
  >>| fun z -> match z with


71
···············|·x·->·3
··|·x·->·3


72
···············|·y·->·4
··|·y·->·4


73
;;
;;


74


75
let () =
let () =


76
  expr
  expr


77
  >>| fun z -> function
  >>| fun z -> function


78
  | x -> 3
  | x -> 3


79
  | y -> 4
  | y -> 4


80
;;
;;


81


82
let () =
let () =


83
  my_func () >>= function
  my_func () >>= function


84
  | A -> 0
  | A -> 0


85
  | B -> 0
  | B -> 0


86
;;
;;


87


88
let () =
let () =


89
  my_func () >>= (function
  my_func () >>= (function


90
    | A -> 0
    | A -> 0


91
    | B -> 0)
    | B -> 0)


92
;;
;;


93


94
let () =
let () =


95
  expr
  expr


96
  >>| function
  >>| function


97
  | x -> 3
  | x -> 3


98
  | y -> 4
  | y -> 4


99
;;
;;


100


101
let () =
let () =


102
  expr
  expr


103
  >>| (function
  >>| (function


104
    | x -> 3
    | x -> 3


105
    | y -> 4)
    | y -> 4)


106
;;
;;


107


108


109


110
let f =
let f =


111
  f >>= m (fun f ->
  f >>= m (fun f ->


112
    fun x ->
    fun x ->


113
      y);
      y);


114
  z
  z


115
;;
;;


116


117
let f =
let f =


118
  f
  f


119
  |> m (fun f ->
  |> m (fun f ->


120
    fun x ->
    fun x ->


121
      y
      y


122
  );
  );


123
  z
  z


124
;;
;;


125
let f =
let f =


126
  f
  f


127
  |> m (fun f ->
  |> m (fun f ->


128
    fun x ->
    fun x ->


129
      y);
      y);


130
  z
  z


131
;;
;;








Differences in js-functor.ml




ExpectedOcp-indent output


0
module M =
module M =


1
  Foo (G)
  Foo (G)


2
    (H)
    (H)


3


4
module M =
module M =


5
  Foo
  Foo


6
    (G)
    (G)


7
    (struct
    (struct


8
      let x
      let x


9
    end)
    end)


10
    (H)
    (H)


11


12
(* To me, this looks fine as it is.  The rule seems fine as "indent arguments by
(* To me, this looks fine as it is.  The rule seems fine as "indent arguments by


13
   2".  To illustrate, with a case where the functor name is longer: *)
   2".  To illustrate, with a case where the functor name is longer: *)


14
module M =
module M =


15
  Functor (G)
  Functor (G)


16
    (H)
    (H)


17
    (I)
    (I)


18


19


20


21
include Foo (struct
include Foo (struct


22
    let x
    let x


23
  end) (struct
  end) (struct


24
    let y
    let y


25
  end)
  end)


26


27
include
include


28
  Foo (struct
  Foo (struct


29
······let·x
····let·x


30
····end)·(struct
··end)·(struct


31
······let·y
····let·y


32
····end)
··end)


33


34
include
include


35
  Foo
  Foo


36
    (struct
    (struct


37
      let x
      let x


38
    end) (struct
    end) (struct


39
······let·y
····let·y


40
····end)
··end)


41


42
include Persistent.Make
include Persistent.Make


43
··(struct·let·version·=·1·end)
····(struct·let·version·=·1·end)


44
··(Stable.Cr_soons_or_pending.V1)
····(Stable.Cr_soons_or_pending.V1)


45


46
include Persistent.Make
include Persistent.Make


47
··(struct
····(struct


48
····let·version·=·1
······let·version·=·1


49
··end)
····end)


50
··(Stable.Cr_soons_or_pending.V1)
····(Stable.Cr_soons_or_pending.V1)


51


52
include
include


53
  Persistent.Make
  Persistent.Make


54
    (struct let version = 1 end)
    (struct let version = 1 end)


55
    (Stable.Cr_soons_or_pending.V1)
    (Stable.Cr_soons_or_pending.V1)


56


57
include
include


58
  Persistent.Make
  Persistent.Make


59
    (struct
    (struct


60
      let version = 1
      let version = 1


61
    end)
    end)


62
    (Stable.Cr_soons_or_pending.V1)
    (Stable.Cr_soons_or_pending.V1)


63


64
module M =
module M =


65
  Foo (struct
  Foo (struct


66
······let·x
····let·x


67
····end)·(struct
··end)·(struct


68
······let·y
····let·y


69
····end)
··end)


70


71
module M : S =
module M : S =


72
  Make (M)
  Make (M)


73
module M : S with type t := int =
module M : S with type t := int =


74
  Make (M)
  Make (M)


75


76


77


78
module Simple_command(Arg:sig
module Simple_command(Arg:sig


79
  end) = struct end
  end) = struct end


80


81
module Simple_command(Arg : sig
module Simple_command(Arg : sig


82
  end) = struct end
  end) = struct end


83


84
module Simple_command (Arg:sig
module Simple_command (Arg:sig


85
  end) = struct end
  end) = struct end


86


87
module Simple_command (Arg : sig
module Simple_command (Arg : sig


88
  end) = struct end
  end) = struct end


89


90
module Simple_command
module Simple_command


91
··(Arg·:·sig
····(Arg·:·sig


92
···end)·=·struct·end
·····end)·=·struct·end








Differences in js-pattern.ml




ExpectedOcp-indent output


0
let f = function
let f = function


1
  | _ -> 0
  | _ -> 0


2
;;
;;


3


4
let f x = match x with
let f x = match x with


5
··········|·_·->·0
··|·_·->·0


6
;;
;;


7


8
let f =
let f =


9
  function
  function


10
  | _ -> 0
  | _ -> 0


11
;;
;;


12


13
let f x =
let f x =


14
  match x with
  match x with


15
  | _ -> 0
  | _ -> 0


16
;;
;;


17


18
let f x =
let f x =


19
  begin match x with
  begin match x with


20
········|·_·->·0
··|·_·->·0


21
  end
  end


22
;;
;;


23


24
let check_price t = function
let check_price t = function


25
  | { Exec.
  | { Exec.


26
      trade_at_settlement = (None | Some false);
      trade_at_settlement = (None | Some false);


27
    } -> ()
    } -> ()


28


29
let check_price t = function
let check_price t = function


30
  | simpler -> ()
  | simpler -> ()


31
  | other -> ()
  | other -> ()


32


33
(* Sometimes we like to write big alternations like this, in which case the
(* Sometimes we like to write big alternations like this, in which case the


34
   comment should typically align with the following clause. *)
   comment should typically align with the following clause. *)


35
let 0 =
let 0 =


36
  match x with
  match x with


37
  | A
  | A


38
    (* a *)
    (* a *)


39
    -> a
    -> a


40
let 0 =
let 0 =


41
  match x with
  match x with


42
    A
    A


43
    (* a *)
    (* a *)


44
    -> a
    -> a


45


46
let _ =
let _ =


47
  a
  a


48
  || match a with
  || match a with


49
·····|·a·->·true
··|·a·->·true


50
·····|·b·->·false
··|·b·->·false








Differences in js-record.ml




ExpectedOcp-indent output


0
type x =
type x =


1
  { foo : int
  { foo : int


2
  ; bar : int
  ; bar : int


3
  }
  }


4


5
let x =
let x =


6
  { x with
  { x with


7
    foo = 3
    foo = 3


8
  ; bar = 5
  ; bar = 5


9
  }
  }


10


11
let x =
let x =


12
  { (* blah blah blah *)
  { (* blah blah blah *)


13
    foo = 3
    foo = 3


14
  ; bar = 5
  ; bar = 5


15
  }
  }


16
;;
;;


17


18
let x =
let x =


19
  [{ x with
  [{ x with


20
     foo = 3
     foo = 3


21
   ; bar = 5
   ; bar = 5


22
   }]
   }]


23


24
let x =
let x =


25
  [{ (* blah blah blah *)
  [{ (* blah blah blah *)


26
·····foo·=·3
····foo·=·3


27
···;·bar·=·5
··;·bar·=·5


28
···}]
··}]


29
;;
;;


30


31
let x =
let x =


32
  { M.x with
  { M.x with


33
    M.
    M.


34
    foo = 3
    foo = 3


35
  }
  }


36
;;
;;


37


38
let x =
let x =


39
  { x with
  { x with


40
    M.
    M.


41
    foo = 3
    foo = 3


42
  }
  }


43
;;
;;


44


45
let x =
let x =


46
  { M.
  { M.


47
    foo = 3
    foo = 3


48
  }
  }


49
;;
;;


50


51
let _ =
let _ =


52
  { foo with
  { foo with


53
    Bar.
    Bar.


54
    field1 = value1
    field1 = value1


55
  ; field2 = value2
  ; field2 = value2


56
  }
  }


57
;;
;;


58
let _ =
let _ =


59
  { foo
  { foo


60
    with Bar.
    with Bar.


61
····field1·=·value1
······field1·=·value1


62
··;·field2·=·value2
····;·field2·=·value2


63
  }
  }


64
;;
;;


65


66
(* multicomponent record module pathname *)
(* multicomponent record module pathname *)


67
let _ =
let _ =


68
  { A.B.
  { A.B.


69
    a = b
    a = b


70
  ; c = d
  ; c = d


71
  }
  }


72
;;
;;


73


74
type t =
type t =


75
  { a
  { a


76
    : something_lengthy list list
    : something_lengthy list list


77
      [@default String.Map.empty]
      [@default String.Map.empty]


78
  }
  }


79


80
type t =
type t =


81
  { a
  { a


82
    : Something_lengthy.t list list
    : Something_lengthy.t list list


83
      [@default String.Map.empty]
      [@default String.Map.empty]


84
  }
  }


85


86
type t =
type t =


87
  { a
  { a


88
    : something_lengthy list
    : something_lengthy list


89
        list
        list


90
  }
  }


91


92
type t =
type t =


93
  { a
  { a


94
    : Something_lengthy.t list
    : Something_lengthy.t list


95
        list
        list


96
  }
  }


97


98
type t =
type t =


99
  { a
  { a


100
    : Something_lengthy.t
    : Something_lengthy.t


101
        list
        list


102
  }
  }








Differences in js-syntax.ml




ExpectedOcp-indent output


0
(* s *)
(* s *)


1


2
let _ =
let _ =


3
  [%raise_structural_sexp
  [%raise_structural_sexp


4
    "feature's tip is already an ancestor of new base"
    "feature's tip is already an ancestor of new base"


5
····{·feature_tip·=·(old_tip·:·Rev.t)
······{·feature_tip·=·(old_tip·:·Rev.t)


6
····;·new_base····=·(new_base·:·Rev.t)
······;·new_base····=·(new_base·:·Rev.t)


7
····}]
······}]


8


9
let _ =
let _ =


10
  [%raise_structural_sexp "feature's tip is already an ancestor of new base"
  [%raise_structural_sexp "feature's tip is already an ancestor of new base"


11
····{·feature_tip·=·(old_tip·:·Rev.t)
····························{·feature_tip·=·(old_tip·:·Rev.t)


12
····;·new_base····=·(new_base·:·Rev.t)
····························;·new_base····=·(new_base·:·Rev.t)


13
····}
····························}


14
  ]
  ]








Differences in js-to-do.ml




ExpectedOcp-indent output


0
(* Indentation that Jane Street needs to think about and make precise.
(* Indentation that Jane Street needs to think about and make precise.


1


2
   These are long term ideas, possibly even conflicting with other tests. *)
   These are long term ideas, possibly even conflicting with other tests. *)


3


4


5


6
(* js-args *)
(* js-args *)


7


8
let _ =
let _ =


9
  let min_closing_backoff =
  let min_closing_backoff =


10
    -. (   Hidden_float.expose (arb.cfg.base_edge @! Buy)
    -. (   Hidden_float.expose (arb.cfg.base_edge @! Buy)


11
········+.·Hidden_float.expose·(arb.cfg.base_edge·@!·Sell))
···········+.·Hidden_float.expose·(arb.cfg.base_edge·@!·Sell))


12
  in
  in


13
  0
  0


14


15


16


17
(* js-type *)
(* js-type *)


18


19
(* The following tests incorporate several subtle and different indentation
(* The following tests incorporate several subtle and different indentation


20
   ideas.  Please consider this only a proposal for discussion, for now.
   ideas.  Please consider this only a proposal for discussion, for now.


21


22
   First, notice the display treatment of "(,)" tuples, analogous to "[;]"
   First, notice the display treatment of "(,)" tuples, analogous to "[;]"


23
   lists.  While "(,)" is an intensional combination of "()" and ",", unlike
   lists.  While "(,)" is an intensional combination of "()" and ",", unlike


24
   "[;]" lists, we believe "(,)" isn't too big a departure.  Value expression
   "[;]" lists, we believe "(,)" isn't too big a departure.  Value expression


25
   analogies are included in js-type.ml, (meant to be) consistent with the
   analogies are included in js-type.ml, (meant to be) consistent with the


26
   proposed type indentation.
   proposed type indentation.


27


28
   Second, and more divergently, the proposed indentation of function types is
   Second, and more divergently, the proposed indentation of function types is


29
   based on the idea of aligning the arguments, even the first argument, even
   based on the idea of aligning the arguments, even the first argument, even


30
   where that means automatically inserting spaces within lines.  This applies
   where that means automatically inserting spaces within lines.  This applies


31
   to the extra spaces in ":__unit" and "(____Config.Network.t" below.
   to the extra spaces in ":__unit" and "(____Config.Network.t" below.


32


33
   We believe this fits into a more general incorporation of alignment into
   We believe this fits into a more general incorporation of alignment into


34
   ocp-indent, to replace our internal alignment tool with a syntax-aware one.
   ocp-indent, to replace our internal alignment tool with a syntax-aware one.


35
   We like to align things for readability, like big records, record types,
   We like to align things for readability, like big records, record types,


36
   lists used to build tables, etc.
   lists used to build tables, etc.


37


38
   The proposal also includes indenting "->" in the circumstances below relative
   The proposal also includes indenting "->" in the circumstances below relative


39
   to the enclosing "()", by two spaces.  In a sense, this happens first, and
   to the enclosing "()", by two spaces.  In a sense, this happens first, and


40
   then the first argument is aligned accordingly.  So, there's no manual
   then the first argument is aligned accordingly.  So, there's no manual


41
   indentation or spacing below. *)
   indentation or spacing below. *)


42


43
val instances
val instances


44
  :  unit
  :  unit


45
  -> (    Config.Network.t
  -> (    Config.Network.t


46
·······->·(App.t·*·Config.instance·*·Config.app)·list
··········->·(App.t·*·Config.instance·*·Config.app)·list


47
·······->·verbose:bool
··········->·verbose:bool


48
·······->·'m
··········->·'m


49
     , 'm
     , 'm


50
     ) Command.Spec.t
     ) Command.Spec.t


51


52
val instances
val instances


53
  :  unit
  :  unit


54
  -> (    Config.Network.t
  -> (    Config.Network.t


55
·······->·(App.t·*·Config.instance·*·Config.app)·list
··········->·(App.t·*·Config.instance·*·Config.app)·list


56
·······->·verbose:bool·->·'m
··········->·verbose:bool·->·'m


57
     , 'm
     , 'm


58
     ) Command.Spec.t
     ) Command.Spec.t


59


60
(* presumed analog with stars *)
(* presumed analog with stars *)


61
val instances :
val instances :


62
  unit
  unit


63
  * (   Config.Network.t
  * (   Config.Network.t


64
······*·(App.t·*·Config.instance·*·Config.app)·list
········*·(App.t·*·Config.instance·*·Config.app)·list


65
······*·bool
········*·bool


66
······*·'m
········*·'m


67
    , 'm
    , 'm


68
    ) Command.Spec.t
    ) Command.Spec.t








Differences in js-upon.ml




ExpectedOcp-indent output


0
let f x =
let f x =


1
  stop
  stop


2
  (* We don't do this as a matter of style, but the indentation reveals a common
  (* We don't do this as a matter of style, but the indentation reveals a common


3
     mistake. *)
     mistake. *)


4
  >>> fun () -> don't_wait_for (close fd);
  >>> fun () -> don't_wait_for (close fd);


5
················bind·fd
··bind·fd


6


7
let f x =
let f x =


8
  stop
  stop


9
  (* This is what was intended, which is indented correctly, although it's bad
  (* This is what was intended, which is indented correctly, although it's bad


10
     style on my part. *)
     style on my part. *)


11
  >>> (fun () -> don't_wait_for (close fd));
  >>> (fun () -> don't_wait_for (close fd));


12
  bind
  bind








Differences in list_of_funs.ml




ExpectedOcp-indent output


0
let f x =
let f x =


1
  (fun x -> x [ (fun () -> 3) ;
  (fun x -> x [ (fun () -> 3) ;


2
                (fun () -> 4) ])
                (fun () -> 4) ])


3


4
let f x = (fun x -> x [ (fun () -> 3) ;
let f x = (fun x -> x [ (fun () -> 3) ;


5
                        (fun () -> 4) ])
                        (fun () -> 4) ])


6


7
let f x =
let f x =


8
  x [ (fun () -> 3) ;
  x [ (fun () -> 3) ;


9
      (fun () -> 4) ]
      (fun () -> 4) ]


10


11
let f x =
let f x =


12
  [ (fun () -> 3) ;
  [ (fun () -> 3) ;


13
    (fun () -> 4) ]
    (fun () -> 4) ]


14


15
let f x =
let f x =


16
  (fun x -> x [ (fun () ->
  (fun x -> x [ (fun () ->


17
···················3)·;
·······3)·;


18
················(fun·()·->·4)·])
·······(fun·()·->·4)·])


19


20
let f x = (fun x -> x [ (fun () ->
let f x = (fun x -> x [ (fun () ->


21
···························3)·;
····3)·;


22
························(fun·()·->·4)·])
····(fun·()·->·4)·])


23


24
let f x =
let f x =


25
  x [ (fun () ->
  x [ (fun () ->


26
·········3)·;
······3)·;


27
      (fun () -> 4) ]
      (fun () -> 4) ]


28


29
let f x =
let f x =


30
  [ (fun () ->
  [ (fun () ->


31
·······3)·;
········3)·;


32
    (fun () -> 4) ]
    (fun () -> 4) ]







ocp-indent-1.8.2/tests/failing/000077500000000000000000000000001355404771200163455ustar00rootroot00000000000000ocp-indent-1.8.2/tests/failing/#js-default.ml#000066400000000000000000000004751355404771200210510ustar00rootroot00000000000000type t =
  { last_trading : Week_date.Spec.t;
    first_notice : Week_date.Spec.t option;
    first_notice_exceptions : Date.t Year_month.Map.t
      with default(Year_month.Map.empty);
    offset       : Week_date.Offset.t;
    (* n > 0 *)
    new_contract_expires_in_n_months : int
  }
  [@@deriving sexp, compare]
ocp-indent-1.8.2/tests/failing/escaped-nl.ml000066400000000000000000000011241355404771200207100ustar00rootroot00000000000000let s1 = "No field 'install', but a field 'remove': install instructions \
          probably part of 'build'. Use the 'install' field or a .install \
          file"

let x =
  cond 40 `Warning
    "Package uses flags that aren't recognised by earlier versions in \
     OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \
     instead for compatibility"
    ~detail:alpha_flags
    (alpha_flags <> [])

let s2 = "bla bla
 bli bli \
blo"

let s3 = "\
"

let s4 = " \
"

let s5 = "  \
\
"

let s6 = "
"

let s7 = "  
"

let c1 = '
'

let x1 = f x '
' y
z

let zz = "\

s \
 \
 "
ocp-indent-1.8.2/tests/failing/escaped-nl.ml.ref000066400000000000000000000011761355404771200214720ustar00rootroot00000000000000let s1 = "No field 'install', but a field 'remove': install instructions \
          probably part of 'build'. Use the 'install' field or a .install \
          file"

let x =
  cond 40 `Warning
    "Package uses flags that aren't recognised by earlier versions in \
     OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \
     instead for compatibility"
    ~detail:alpha_flags
    (alpha_flags <> [])

let s2 = "bla bla
 bli bli \
          blo"

let s3 = "\
"

let s4 = " \
         "

let s5 = "  \
          \
         "

let s6 = "
"

let s7 = "  
"

let c1 = '
'

let x1 = f x '
' y
    z

let zz = "\

s \
 \
 "
ocp-indent-1.8.2/tests/failing/js-args.ml000066400000000000000000000074261355404771200202560ustar00rootroot00000000000000let () =
  foo.bar <-
    f x
      y z

let should_check_can_sell_and_marking regulatory_regime =
  match z with
  | `foo
    -> some_function
         argument
(* The above typically occurs in a multi-pattern match clause, so the clause
   expression is on a line by itself.  This is the more typical way a long
   single-pattern match clause would be written: *)
let should_check_can_sell_and_marking regulatory_regime =
  match z with
  | `foo ->
    some_function
      argument

let f = fun x ->
  ghi
    x

(* common *)
let x =
  try x with
  | a -> b
  | c -> d
let x = try x with
  | a -> b
  | c -> d
let x =
  try x
  with
  | a -> b
  | c -> d

let z =
  some_function
    argument



let () =
  f a b ~c:c
    d

let () =
  f a b ~c:1.
    d

let () =
  My_module.f a b ~c:c
    d

(* This last case is where Tuareg is inconsistent with the others. *)
let () =
  My_module.f a b ~c:1.
    d



let () =
  messages :=
    Message_store.create (Session_id.of_string "")
      (* Tuareg indents these lines too far to the left. *)
      "herd-retransmitter"
      Message_store.Message_size.Byte



let () =
  raise (Bug ("foo"
              (* In this and similar cases, we want the subsequent lines to
                 align with the first expression. *)
              ^ "bar"));
  raise (Bug ("foo" ^ "quux"
              ^ "bar"));
  raise (Bug (foo + quux
              ^ "bar"));
  raise (Bug ((foo + quux)
              ^ "bar"))

(* Except in specific cases, we want the argument indented relative to the
   function being called.  (Exceptions include "fun" arguments where the line
   ends with "->" and subsequent lines beginning with operators, like above.) *)
let () =
  Some (Message_store.create s
          "herd-retransmitter" ~unlink:true Message_store.Message_size.Byte)



(* We like the indentation of most arguments, but want to get back towards the
   left margin in a few special cases: *)
let _ =
  foo (bar (fun x ->                    (* special: "fun _ ->" at EOL *)
    baz))                               (* assume no more arguments to "bar" *)
let _ =
  foo
    ~a_long_field_name:(check (fun bar ->
      baz))
let _ =
  foo ~a_long_field_name:(check (fun bar ->
    baz))
let _ =
  foo (bar (quux (fnord (fun x ->       (* any depth *)
    baz))))

(* We also wanted to tweak the operator indentation, making operators like <=
   not special cases in contexts like this:  *)
let _ =
  assert (foo (bar + baz
               <= quux))                (* lined up under left argument to op,
                                           sim. to ^ above *)
(* Sim. indentation of if conditions: *)
let _ =
  if (a
      <= b)
  then ()
let _ =
  (* Comparisons are different than conditionals; we don't regard them as
     conceptually part of the [if] expression. *)
  if a
     <= b
  then ()
let _ =
  (* We regard the outermost condition terms as conceptually part of the [if]
     expression and indent accordingly.  Whether [&&] or [||], conditionals
     effectively state lists of conditions for [then]. *)
  if Edge_adjustment.is_zero arb.cfg.extra_edge
  && 0. = sys.plugs.edge_backoff
  && 0. = zero_acvol_edge_backoff
  then 0.
  else 1.
let _ =
  if
    Edge_adjustment.is_zero arb.cfg.extra_edge
    && 0. = sys.plugs.edge_backoff
    && 0. = zero_acvol_edge_backoff
  then 0.
  else 1.
let _ =
  let entries = List.filter (Lazy.force transferstati) ~f:(fun ts ->
    Pcre.pmatch ~pat ts.RQ.description
  ) in
  x

(* combination of operator at BOL and -> at EOL: *)
let _ =
  Shell.ssh_lines x
  |! List.map ~f:(f (g (fun x ->
       let name, path = String.lsplit2_exn ~on:'|' x in
       String.strip name, String.strip path)))

(* open paren ending line like begin *)
let _ =
  if a (p ^/ "s") [ e ] = Ok () then `S (
    let label count =
      sprintf "%d s" c ^ if c = 1 then ":" else "s"
    in
    x
  )
ocp-indent-1.8.2/tests/failing/js-args.ml.opts000066400000000000000000000000161355404771200212260ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-begin.ml000066400000000000000000000002771355404771200204030ustar00rootroot00000000000000let f = function
  | zoo -> begin
      foo;
      bar;
    end
;;
let g = function
  | zoo -> (
      foo;
      bar;
    )
;;
let () =
  begin match foo with
        | Bar -> snoo
  end
;;
ocp-indent-1.8.2/tests/failing/js-begin.ml.opts000066400000000000000000000000161355404771200213560ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-fun.ml000066400000000000000000000023431355404771200201030ustar00rootroot00000000000000(* preferred list style *)
let z =
  f
    [ y
    ; foo ~f:(fun () ->
        arg)
    ]
;;
let z =
  f
    [ y
    ; foo ~f:(fun () ->
        arg
      )
    ]
;;

(* legacy list style *)
let _ =
  [ f (fun x ->
      x);
    f (fun x ->
      x);
    f (fun x ->
      x);
  ]
let _ =
  [ f (fun x ->
      x
    );
    f (fun x ->
      x
    );
    f (fun x ->
      x
    );
  ]
;;
let _ =
  [f (fun x ->
     x
   );
   f (fun x ->
     x
   );
   f (fun x ->
     x
   );
  ]
;;

let _ =
  x
  >>= fun x ->
  (try x with _ -> ())
  >>= fun x ->
  try x with _ -> ()
    >>= fun x ->
    x
;;

let () =
  expr
  >>| function
  | x -> 3
  | y -> 4
;;

let () =
  expr
  >>| fun z -> match z with
               | x -> 3
               | y -> 4
;;

let () =
  expr
  >>| fun z -> function
  | x -> 3
  | y -> 4
;;

let () =
  my_func () >>= function
  | A -> 0
  | B -> 0
;;

let () =
  my_func () >>= (function
    | A -> 0
    | B -> 0)
;;

let () =
  expr
  >>| function
  | x -> 3
  | y -> 4
;;

let () =
  expr
  >>| (function
    | x -> 3
    | y -> 4)
;;



let f =
  f >>= m (fun f ->
    fun x ->
      y);
  z
;;

let f =
  f
  |> m (fun f ->
    fun x ->
      y
  );
  z
;;
let f =
  f
  |> m (fun f ->
    fun x ->
      y);
  z
;;
ocp-indent-1.8.2/tests/failing/js-fun.ml.opts000066400000000000000000000000161355404771200210620ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-functor.ml000066400000000000000000000024371355404771200207770ustar00rootroot00000000000000module M =
  Foo (G)
    (H)

module M =
  Foo
    (G)
    (struct
      let x
    end)
    (H)

(* To me, this looks fine as it is.  The rule seems fine as "indent arguments by
   2".  To illustrate, with a case where the functor name is longer: *)
module M =
  Functor (G)
    (H)
    (I)



include Foo (struct
    let x
  end) (struct
    let y
  end)

include
  Foo (struct
      let x
    end) (struct
      let y
    end)

include
  Foo
    (struct
      let x
    end) (struct
      let y
    end)

include Persistent.Make
  (struct let version = 1 end)
  (Stable.Cr_soons_or_pending.V1)

include Persistent.Make
  (struct
    let version = 1
  end)
  (Stable.Cr_soons_or_pending.V1)

include
  Persistent.Make
    (struct let version = 1 end)
    (Stable.Cr_soons_or_pending.V1)

include
  Persistent.Make
    (struct
      let version = 1
    end)
    (Stable.Cr_soons_or_pending.V1)

module M =
  Foo (struct
      let x
    end) (struct
      let y
    end)

module M : S =
  Make (M)
module M : S with type t := int =
  Make (M)



module Simple_command(Arg:sig
  end) = struct end

module Simple_command(Arg : sig
  end) = struct end

module Simple_command (Arg:sig
  end) = struct end

module Simple_command (Arg : sig
  end) = struct end

module Simple_command
  (Arg : sig
   end) = struct end
ocp-indent-1.8.2/tests/failing/js-functor.ml.opts000066400000000000000000000000161355404771200217520ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-pattern.ml000066400000000000000000000012531355404771200207670ustar00rootroot00000000000000let f = function
  | _ -> 0
;;

let f x = match x with
          | _ -> 0
;;

let f =
  function
  | _ -> 0
;;

let f x =
  match x with
  | _ -> 0
;;

let f x =
  begin match x with
        | _ -> 0
  end
;;

let check_price t = function
  | { Exec.
      trade_at_settlement = (None | Some false);
    } -> ()

let check_price t = function
  | simpler -> ()
  | other -> ()

(* Sometimes we like to write big alternations like this, in which case the
   comment should typically align with the following clause. *)
let 0 =
  match x with
  | A
    (* a *)
    -> a
let 0 =
  match x with
    A
    (* a *)
    -> a

let _ =
  a
  || match a with
     | a -> true
     | b -> false
ocp-indent-1.8.2/tests/failing/js-pattern.ml.opts000066400000000000000000000000161355404771200217470ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-record.ml000066400000000000000000000017651355404771200206000ustar00rootroot00000000000000type x =
  { foo : int
  ; bar : int
  }

let x =
  { x with
    foo = 3
  ; bar = 5
  }

let x =
  { (* blah blah blah *)
    foo = 3
  ; bar = 5
  }
;;

let x =
  [{ x with
     foo = 3
   ; bar = 5
   }]

let x =
  [{ (* blah blah blah *)
     foo = 3
   ; bar = 5
   }]
;;

let x =
  { M.x with
    M.
    foo = 3
  }
;;

let x =
  { x with
    M.
    foo = 3
  }
;;

let x =
  { M.
    foo = 3
  }
;;

let _ =
  { foo with
    Bar.
    field1 = value1
  ; field2 = value2
  }
;;
let _ =
  { foo
    with Bar.
    field1 = value1
  ; field2 = value2
  }
;;

(* multicomponent record module pathname *)
let _ =
  { A.B.
    a = b
  ; c = d
  }
;;

type t =
  { a
    : something_lengthy list list
      [@default String.Map.empty]
  }

type t =
  { a
    : Something_lengthy.t list list
      [@default String.Map.empty]
  }

type t =
  { a
    : something_lengthy list
        list
  }

type t =
  { a
    : Something_lengthy.t list
        list
  }

type t =
  { a
    : Something_lengthy.t
        list
  }
ocp-indent-1.8.2/tests/failing/js-record.ml.opts000066400000000000000000000000161355404771200215500ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-syntax.ml000066400000000000000000000005431355404771200206410ustar00rootroot00000000000000(* s *)

let _ =
  [%raise_structural_sexp
    "feature's tip is already an ancestor of new base"
    { feature_tip = (old_tip : Rev.t)
    ; new_base    = (new_base : Rev.t)
    }]

let _ =
  [%raise_structural_sexp "feature's tip is already an ancestor of new base"
    { feature_tip = (old_tip : Rev.t)
    ; new_base    = (new_base : Rev.t)
    }
  ]
ocp-indent-1.8.2/tests/failing/js-syntax.ml.opts000066400000000000000000000000161355404771200216200ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-to-do.ml000066400000000000000000000042401355404771200203330ustar00rootroot00000000000000(* Indentation that Jane Street needs to think about and make precise.

   These are long term ideas, possibly even conflicting with other tests. *)



(* js-args *)

let _ =
  let min_closing_backoff =
    -. (   Hidden_float.expose (arb.cfg.base_edge @! Buy)
        +. Hidden_float.expose (arb.cfg.base_edge @! Sell))
  in
  0



(* js-type *)

(* The following tests incorporate several subtle and different indentation
   ideas.  Please consider this only a proposal for discussion, for now.

   First, notice the display treatment of "(,)" tuples, analogous to "[;]"
   lists.  While "(,)" is an intensional combination of "()" and ",", unlike
   "[;]" lists, we believe "(,)" isn't too big a departure.  Value expression
   analogies are included in js-type.ml, (meant to be) consistent with the
   proposed type indentation.

   Second, and more divergently, the proposed indentation of function types is
   based on the idea of aligning the arguments, even the first argument, even
   where that means automatically inserting spaces within lines.  This applies
   to the extra spaces in ":__unit" and "(____Config.Network.t" below.

   We believe this fits into a more general incorporation of alignment into
   ocp-indent, to replace our internal alignment tool with a syntax-aware one.
   We like to align things for readability, like big records, record types,
   lists used to build tables, etc.

   The proposal also includes indenting "->" in the circumstances below relative
   to the enclosing "()", by two spaces.  In a sense, this happens first, and
   then the first argument is aligned accordingly.  So, there's no manual
   indentation or spacing below. *)

val instances
  :  unit
  -> (    Config.Network.t
       -> (App.t * Config.instance * Config.app) list
       -> verbose:bool
       -> 'm
     , 'm
     ) Command.Spec.t

val instances
  :  unit
  -> (    Config.Network.t
       -> (App.t * Config.instance * Config.app) list
       -> verbose:bool -> 'm
     , 'm
     ) Command.Spec.t

(* presumed analog with stars *)
val instances :
  unit
  * (   Config.Network.t
      * (App.t * Config.instance * Config.app) list
      * bool
      * 'm
    , 'm
    ) Command.Spec.t
ocp-indent-1.8.2/tests/failing/js-to-do.ml.opts000066400000000000000000000000161355404771200213140ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/js-upon.ml000066400000000000000000000005451355404771200202760ustar00rootroot00000000000000let f x =
  stop
  (* We don't do this as a matter of style, but the indentation reveals a common
     mistake. *)
  >>> fun () -> don't_wait_for (close fd);
                bind fd

let f x =
  stop
  (* This is what was intended, which is indented correctly, although it's bad
     style on my part. *)
  >>> (fun () -> don't_wait_for (close fd));
  bind
ocp-indent-1.8.2/tests/failing/js-upon.ml.opts000066400000000000000000000000161355404771200212530ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/failing/list_of_funs.ml000066400000000000000000000011151355404771200213670ustar00rootroot00000000000000let f x =
  (fun x -> x [ (fun () -> 3) ;
                (fun () -> 4) ])

let f x = (fun x -> x [ (fun () -> 3) ;
                        (fun () -> 4) ])

let f x =
  x [ (fun () -> 3) ;
      (fun () -> 4) ]

let f x =
  [ (fun () -> 3) ;
    (fun () -> 4) ]

let f x =
  (fun x -> x [ (fun () ->
                   3) ;
                (fun () -> 4) ])

let f x = (fun x -> x [ (fun () ->
                           3) ;
                        (fun () -> 4) ])

let f x =
  x [ (fun () ->
         3) ;
      (fun () -> 4) ]

let f x =
  [ (fun () ->
       3) ;
    (fun () -> 4) ]
ocp-indent-1.8.2/tests/inplace/000077500000000000000000000000001355404771200163475ustar00rootroot00000000000000ocp-indent-1.8.2/tests/inplace/executable.ml000077500000000000000000000000001355404771200210130ustar00rootroot00000000000000ocp-indent-1.8.2/tests/inplace/link.ml000077700000000000000000000000001355404771200221442otherfile.mlustar00rootroot00000000000000ocp-indent-1.8.2/tests/inplace/link2.ml000077700000000000000000000000001355404771200212022link.mlustar00rootroot00000000000000ocp-indent-1.8.2/tests/inplace/otherfile.ml000066400000000000000000000000001355404771200206500ustar00rootroot00000000000000ocp-indent-1.8.2/tests/passing/000077500000000000000000000000001355404771200164005ustar00rootroot00000000000000ocp-indent-1.8.2/tests/passing/alignment.ml000066400000000000000000000007221355404771200207110ustar00rootroot00000000000000let file_contents = [
]
  @ [
    foo
  ] @ [
    bar
  ]

let _ =
  match s.src with
  | None   -> [
      zz
    ] + 2
  | Some s -> [ Variable (
      s_src,
      OpamFormat.make_string (OpamFilename.to_string s)
    );
      yy ];
    foo
  | Some s -> {
      fww =
        s_src,
        OpamFormat.make_string (OpamFilename.to_string s)
    ; gdd =
        yy
    }

let _ =
  [ x;
    y ]
  @ z

let _ =
  [
    x;
    y ]
  @ z

let _ = [
  x;
  y
]
  @ z
ocp-indent-1.8.2/tests/passing/bracket.ml000066400000000000000000000002241355404771200203430ustar00rootroot00000000000000let _ =
  match a with
  | b ->
    cccccc [
      d [
        e
      ]
    ]
  | b' ->
    (ccccc' [
        d' [
          e'
        ]
      ])
ocp-indent-1.8.2/tests/passing/cinaps.ml000066400000000000000000000057521355404771200202200ustar00rootroot00000000000000(*$ open Bin_prot_cinaps $*)

let bin_read_nat0 buf ~pos_ref =
  let pos = safe_get_pos buf pos_ref in
  assert_pos pos;
  match unsafe_get buf pos with
  | '\x00'..'\x7f' as ch ->
    pos_ref := pos + 1;
    Nat0.unsafe_of_int (Char.code ch)
  | (*$ Code.char INT16 *)'\xfe'(*$*) ->
    safe_bin_read_nat0_16 buf ~pos_ref ~pos:(pos + 1)
  | (*$ Code.char INT32 *)'\xfd'(*$*) ->
    safe_bin_read_nat0_32 buf ~pos_ref ~pos:(pos + 1)
  | (*$ Code.char INT64 *)'\xfc'(*$*) ->
    if arch_sixtyfour then
      safe_bin_read_nat0_64 buf ~pos_ref ~pos:(pos + 1)
    else
      raise_read_error ReadError.Nat0_overflow pos
  | _ ->
    raise_read_error ReadError.Nat0_code pos
[@@ocamlformat "disable"]

let bin_read_int buf ~pos_ref =
  let pos = safe_get_pos buf pos_ref in
  assert_pos pos;
  match unsafe_get buf pos with
  | '\x00'..'\x7f' as ch ->
    pos_ref := pos + 1;
    Char.code ch
  | (*$ Code.char NEG_INT8 *)'\xff'(*$*) ->
    safe_bin_read_neg_int8 buf ~pos_ref ~pos:(pos + 1)
  | (*$ Code.char INT16 *)'\xfe'(*$*) ->
    safe_bin_read_int16 buf ~pos_ref ~pos:(pos + 1)
  | (*$ Code.char INT32 *)'\xfd'(*$*) ->
    safe_bin_read_int32_as_int buf ~pos_ref ~pos:(pos + 1)
  | (*$ Code.char INT64 *)'\xfc'(*$*) ->
    if arch_sixtyfour then
      safe_bin_read_int64_as_int buf ~pos_ref ~pos:(pos + 1)
    else
      raise_read_error ReadError.Int_overflow pos
  | _ ->
    raise_read_error ReadError.Int_code pos
[@@ocamlformat "disable"]

let bin_read_float buf ~pos_ref =
  let pos = safe_get_pos buf pos_ref in
  assert_pos pos;
  let next = pos + 8 in
  check_next buf next;
  pos_ref := next;
  (* No error possible either. *)
  Int64.float_of_bits (unsafe_get64le buf pos)
;;

let bin_read_int32 buf ~pos_ref =
  let pos = safe_get_pos buf pos_ref in
  assert_pos pos;
  match unsafe_get buf pos with
  | '\x00'..'\x7f' as ch ->
    pos_ref := pos + 1;
    Int32.of_int (Char.code ch)
  | (*$ Code.char NEG_INT8 *)'\xff'(*$*) ->
    Int32.of_int (safe_bin_read_neg_int8 buf ~pos_ref ~pos:(pos + 1))
  | (*$ Code.char INT16 *)'\xfe'(*$*) ->
    Int32.of_int (safe_bin_read_int16 buf ~pos_ref ~pos:(pos + 1))
  | (*$ Code.char INT32 *)'\xfd'(*$*) ->
    safe_bin_read_int32 buf ~pos_ref ~pos:(pos + 1)
  | _ ->
    raise_read_error ReadError.Int32_code pos
[@@ocamlformat "disable"]

let bin_read_int64 buf ~pos_ref =
  let pos = safe_get_pos buf pos_ref in
  assert_pos pos;
  match unsafe_get buf pos with
  | '\x00'..'\x7f' as ch ->
    pos_ref := pos + 1;
    Int64.of_int (Char.code ch)
  | (*$ Code.char NEG_INT8 *)'\xff'(*$*) ->
    Int64.of_int (safe_bin_read_neg_int8 buf ~pos_ref ~pos:(pos + 1))
  | (*$ Code.char INT16 *)'\xfe'(*$*) ->
    Int64.of_int (safe_bin_read_int16 buf ~pos_ref ~pos:(pos + 1))
  | (*$ Code.char INT32 *)'\xfd'(*$*) ->
    safe_bin_read_int32_as_int64 buf ~pos_ref ~pos:(pos + 1)
  | (*$ Code.char INT64 *)'\xfc'(*$*) ->
    safe_bin_read_int64 buf ~pos_ref ~pos:(pos + 1)
  | _ ->
    raise_read_error ReadError.Int64_code pos
[@@ocamlformat "disable"]

let _ =
  (*$
    {x=[]};
    ()
  *)
  (*$*)
ocp-indent-1.8.2/tests/passing/comments.ml000066400000000000000000000023771355404771200205700ustar00rootroot00000000000000(* A *)

type x = 
  (* A *)
  | Foo

  (* B *)

  | Bar

(* AA *)

(* D *)
let x = 3

module M = struct
  (* M1 *)
  let x =
    a
  (* M2 *)
  let y =
    b

  (* M3 *)
  (* M4 *)
end

let f x =
  if true then
    0
    (* comment *)
  else if false then
    1

let g x =
  if true then
    0

  (* comment *)
  else if false then
    1

let _ =
  f x
    (* bla *) y
    (* bla *) (z)

module M_bad : sig
  type _ t =
    | A : a -> a t
    | B : b -> b t
    (** Indented correctly *)

  type 'a t =
    | A of 'a
    (** Indented correctly *)

  type 'a t =
    | A of 'a
    | B of 'a
    (** Indented too far *)
end

module M_ok : sig
  type _ t =
    | A : a -> a t
    | B : b -> b t
    (** Indented correctly *)

  type 'a t =
    | A of 'a
    (** Indented correctly *)

  type 'a t =
    | A of 'a
    | B of 'a
    (** Indented correctly! *)

  val x : int
end

module M = struct
  type _ t =
    | A : a -> a t
    | B : b -> b t
    (** Indented too far *)
end

module type M = sig
  type _ t =
    | A : a -> a t
    | B : b -> b t
    (** Indented correctly! *)

  val x : int
end

module M : sig
  type _ t =
    | A : a -> a t
    (** Indented correctly *)
end

type _ t =
  | A : a -> a t
  | B : b -> b t
  (** Indented correctly *)

(* ending comments *)

ocp-indent-1.8.2/tests/passing/core-failing.ml000066400000000000000000000005751355404771200213000ustar00rootroot00000000000000exception IOError of
    int *
    exn

module type S = S
  with type ('a, 'b, 'c) map := ('a, 'b, 'c) t

let _ =
  let start_finaliser_thread () =
    ignore (Thread.create (fun () -> Fn.forever (fun () ->
        match read_finaliser_queue () with
        | None -> Thread.delay 1.0
        | Some f -> Exn.handle_uncaught ~exit:false f)) ())
  in
  ()

module F
    (A)
    (B)
ocp-indent-1.8.2/tests/passing/core-passing.ml000066400000000000000000000060431355404771200213270ustar00rootroot00000000000000type t1 =
  {
    a: int;
    b: int -> int;
    c: int;
  }

let try_lock t =
  wrap_mutex a.b (fun () ->
      was_locked)

let blit_string_bigstring ~src ?src_pos ?src_len ~dst ?dst_pos () =
  blit_common
    ~get_src_len:String.length ~get_dst_len:length
    ~blit:unsafe_blit_string_bigstring
    ~src ?src_pos ?src_len ~dst ?dst_pos
    ()

let f =
  test bla Int32.to_string
    pack_signed_32

module S : S1
  with type t = S1.t
  with type comparator = S.comparator

let error_string message = error message () <:sexp_of< unit >>
let unimplemented s = ()

let () =
  StdLabels.List.iter
    ~f:(fun (exc, handler) ->
        Conv.Exn_converter.add_auto ~finalise:false exc handler)
    ()

let _ =
  Date.to_string date
  :: " "
  :: (if is_utc then ["Z"]
      else bla)

val v
  : t

let _ =
  let module M = (val m : S with type t = t') in
  x

let a,b,c =
  d

type t = t0 = {
  a: int;
}

type t2 = [
  | `a
  | `b
]

type t = private
  | A
  | B

module Make : (S with type t = t') =
struct
  type contents = C.t
end

module Map_and_set_binable = struct
  module C : (S with type t = t)
  val v
end

type compare =
  [`no_polymorphic_compare]
  -> [`no_polymorphic_compare]

let _ =
  {Parts.
    sign = sign;
    hr   = hr;
  }

module M (A) : sig
  val bla : bla
end = struct
end

val marshal_blit :
  ?flags : Marshal.extern_flags list -> 'a ->
  ?pos : int -> ?len : int -> t -> int

let daemonize ?(redirect_stdout=`Dev_null) ?(redirect_stderr=`Dev_null)
    ?(cd = "/") ?umask:(umask_value = default_umask) () =
  bla

val add :
  t ->
  (event -> Time.t -> unit) ->
  a

let _ = match a with
  | A
    when b -> c
  | A b
    when b -> c

module S : S1
  with type t = S1.t
  with type comparator = S.comparator

let _ =
  let f x =
    bla
  and g x =
    bli

include struct
  exception Break = Break
  let y = 2
end

let should_check_can_sell_and_marking regulatory_regime =
  match z with
  | `foo
    -> some_function
         argument;
    flu
  | `foo -> some_function
              argument;
    flu

let _ =
  invalid_arg
    (sprintf "Dequeue.%s: index %i is not in [%d, %d]"
       fname i (front_index buf) (back_index buf))

let mem { ar; cmp } el =
  let len = Array.length ar in
  len > 0 &&
  let rec loop pos =
    bla
  in
  blu

let blit_to (type a) (blit : (Base.t, a) Blit.t) =
  (); fun t ~dst ~dst_pos ->
    blit ~src:t.base ~src_pos:t.pos ~src_len:t.len ~dst ~dst_pos ()

type 'a t = 'a Bin_prot.Type_class.writer
= { size : 'a Size.sizer;
    write : 'a Write_ml.writer;
    unsafe_write : 'a Unsafe_write_c.writer;
  }

let create
    ?(message = Pid.to_string (Unix.getpid ()))
    ?(close_on_exec=true)
  =
  xx

module Make_using_comparator (Elt : Comparator.S)
  : S with type Elt.t = Elt.t
    with type Elt.comparator = Elt.comparator

let _ =
  find_thread_count
    (In_channel.read_lines
       ("/proc/" ^ string_of_int (Unix.getpid ()) ^ "/status"))

type variant = [ `Jan | `Feb | `Mar | `Apr | `May | `Jun
               | `Jul | `Aug | `Sep | `Oct | `Nov | `Dec ]

let _ =
  let exception E in
  ()

let _ =
  let exception E of string in
  ()
ocp-indent-1.8.2/tests/passing/edge-cases.ml000066400000000000000000000030111355404771200207250ustar00rootroot00000000000000
(* this could be fixed, but we actually want to handle the first case
   differently for when there is only one case (see next examples) *)
let f x = function A -> x;
  2
                 | B -> y;
                   3

(* if we were to fix to the case above, the second >>= would be below the _
   (test taken from js-fun) *)
let _ =
  x
  >>= fun x ->
  try x with _ -> ()
    >>= fun x ->
    x

(* (and also: the some_handling here would be below Not_found) *)
let _ =
  try
    _
  with Not_found ->
    some_handling

let f = fun x ->
  x

let f = (fun x ->
    x
  )

let f g = g @@ fun x ->
  x

let f g = g @@ (fun x ->
    x
  )


(* the above should probably be consistent with: *)
let f x y = y + match x with A ->
    0

let f x y = y + (match x with A ->
    0
  )

(* wich means we may over-indent even when the block is non-closable *)

let f x y = y + match x with
  | A -> 0

let f x y = y + (match x with
    | A -> 0
  )

let f x y = y + match x with
  | A -> 0

let _ =
  somefun
    (fun x ->
       x);
  somefun
    (if
      bla
     then
       bli);
  somefun
    (if bla then
       bli
     else
       blu)

let _ =
  a
  ;
  b

(* Surprisingly, this is the indentation correpsonding to OCaml's interpretation
   of this code.  Indenting this accordingly may help users notice that they're
   doing something dubious.
   EDIT Louis/2019: [function] used to be unindented. Not sure what the above
   meant since this is a parse error anyway ?
*)
let b = `b
let d = `d
;;
let a = b
    function (_ : [ `c ]) -> d
;;
ocp-indent-1.8.2/tests/passing/embedded-match.ml000066400000000000000000000007311355404771200215560ustar00rootroot00000000000000let f x = function
  | A when match x with A | B -> true | _ -> false
    ->
    B
  | A -> x
  | _ -> B

let f x =
  if
    match x with
    | A -> true
  then
    1
  else
    0

let f x =
  match x with
  | A -> true
  | B ->
    false
  | exception
      Not_found ->
    false
  | C -> true
  | exception (Failure _ | Invalid_argument _) ->
    true
  | exception (A | B) | exception B.Err
  | exception C.Types.Xxx "someparam" ->
    false

exception MyExn of string
ocp-indent-1.8.2/tests/passing/exprs.ml000066400000000000000000000020151355404771200200710ustar00rootroot00000000000000f "foo"
  g
  [   1;
      2]
;;

let x =
  f 1 ((x 3)
       || (x f)
          lor (g lsl k)
          lor g
          && g
             lsr g)

let f x =
  g
    (fun x -> x)
    []
    x:x
      ?y:z
      ()
      0

let f
    ~p
    ~g
    ()
    ?k
    () =
  let x = 0 in
  p

let f =
  for i = 0 to 1; do
    a;
    b;
  done;
  x

external f :
  'a -> x : int -> t  
  = "b"

external g :
  x : t -> s : i -> d : t -> unit
  = "b2"

let f ?(g = []) v ?(x = 0) ?l b =
  let l = g b ~p l in
  c ~l:"foo" b ~p ~l;
  u v ~p ~l b f

let f () =
  g x y
    ?x:y ?y:w
    ~a:b

let f () =
  f (fun () ->
      for i = 0 to 10 do
        g
      done;
      x
    )

external f: int -> int = "foo"

let f () =
  for i = 0 to 10 do
    g
  done

let f () =
  { x = 1;
    y = 2;
  }

let f () = {
  x = 1;
  y = 2;
}

let f () =
  {
    x = 1;
    y = 2;
  }

let f () =
  { x = 1
  ; y = 2 }

let f x =
  if x then
    x
  else
    f @@ fun () ->
    g;
    h

let funct param
  : A_very_long_module_name.t t1
    * t2
  =
  something
ocp-indent-1.8.2/tests/passing/extensible.ml000066400000000000000000000006331355404771200210760ustar00rootroot00000000000000(* Simple declaration : OK *)
type t = ..
type t +=
    A
  | B

(* But : *)
type t = ..
type t +=
  | A
  | B

(* Inside modules :  same pb *)
module P = struct
  type t = ..
  type t +=
    | A
    | B
end

module Q = struct
  type P.t +=
    | C
    | D
end

(* another one *)
module Q' = struct
  type P.t +=
    | C = P.A
    | D
end

(* also *)
module M = struct
  type t = ..
  let a = 1
  let b = 2
end
ocp-indent-1.8.2/tests/passing/gadt.ml000066400000000000000000000035621355404771200176570ustar00rootroot00000000000000type _ term =
  | Int : int -> int term
  | Add : (int -> int -> int) term
  | App : ('b -> 'a) term * 'b term -> 'a term

let rec eval : type a. a term -> a = function
  | Int n    -> n                 (* a = int *)
  | Add      -> (fun x y -> x+y)  (* a = int -> int -> int *)
  | App(f,x) -> (eval f) (eval x)
(* eval called at types (b->a) and b for fresh b *)

let two = eval (App (App (Add, Int 1), Int 1))

let rec sum : type a. a term -> _ = fun x ->
  let y =
    match x with
    | Int n -> n
    | Add   -> 0
    | App(f,x) -> sum f + sum x
  in y + 1

type _ typ =
  | Int : int typ
  | String : string typ
  | Pair : 'a typ * 'b typ -> ('a * 'b) typ

let rec to_string: type t. t typ -> t -> string =
  fun t x ->
  match t with
  | Int -> string_of_int x
  | String -> Printf.sprintf "%S" x
  | Pair(t1,t2) ->
    let (x1, x2) = x in
    Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2)

type (_,_) eq = Eq : ('a,'a) eq

let cast : type a b. (a,b) eq -> a -> b = fun Eq x -> x

let rec eq_type : type a b. a typ -> b typ -> (a,b) eq option =
  fun a b ->
  match a, b with
  | Int, Int -> Some Eq
  | String, String -> Some Eq
  | Pair(a1,a2), Pair(b1,b2) ->
    begin match eq_type a1 b1, eq_type a2 b2 with
      | Some Eq, Some Eq -> Some Eq
      | _ -> None
    end
  | _ -> None

type dyn = Dyn : 'a typ * 'a -> dyn

let get_dyn : type a. a typ -> dyn -> a option =
  fun a (Dyn(b,x)) ->
  match eq_type a b with
  | None -> None
  | Some Eq -> Some x

let _ =
  let f: type a. a list -> int =
    fun _x -> 42
  in
  f []

let nth t n =
  if n < 0 then None else
    let rec nth_aux: type b. ('a, b) t -> int -> 'a option = fun t n ->
      match t with
      | Empty -> None
      | Node (a, t) -> if n = 0 then Some a else nth_aux t (n-1)
    in
    nth_aux t n

let rec f : type a b. a = function
  | _ -> assert false
and g : type a. a = function
  | _ -> assert false
ocp-indent-1.8.2/tests/passing/ifand.ml000066400000000000000000000002611355404771200200120ustar00rootroot00000000000000let _ =
  if cond1
  && cond2
  then _

let _ = function
  | _ when x = 2
        && y = 3 ->
    begin if a = b
          || b = c
             && c = d then
        _
    end
ocp-indent-1.8.2/tests/passing/indent-empty-1.ml000066400000000000000000000000771355404771200215110ustar00rootroot00000000000000module M = struct

  let f =

end

let g =

  fun x -> 3 + 4 *
ocp-indent-1.8.2/tests/passing/indent-empty-1.ml.opts000066400000000000000000000000241355404771200224650ustar00rootroot00000000000000--lines 4 --numeric
ocp-indent-1.8.2/tests/passing/indent-empty-1.ml.ref000066400000000000000000000000021355404771200222500ustar00rootroot000000000000004
ocp-indent-1.8.2/tests/passing/indent-empty-nm.ml000066400000000000000000000000771355404771200217630ustar00rootroot00000000000000module M = struct

  let f =

end

let g =

  fun x -> 3 + 4 *
ocp-indent-1.8.2/tests/passing/indent-empty-nm.ml.opts000066400000000000000000000000311355404771200227350ustar00rootroot00000000000000--indent-empty --numeric
ocp-indent-1.8.2/tests/passing/indent-empty-nm.ml.ref000066400000000000000000000000251355404771200225270ustar00rootroot000000000000000
2
2
4
0
0
0
2
2
15
ocp-indent-1.8.2/tests/passing/indent-empty.ml000066400000000000000000000000771355404771200213530ustar00rootroot00000000000000module M = struct

  let f =

end

let g =

  fun x -> 3 + 4 *
ocp-indent-1.8.2/tests/passing/indent-empty.ml.opts000066400000000000000000000000171355404771200223310ustar00rootroot00000000000000--indent-empty
ocp-indent-1.8.2/tests/passing/indent-empty.ml.ref000066400000000000000000000001261355404771200221210ustar00rootroot00000000000000module M = struct
  
  let f =
    
end

let g =
  
  fun x -> 3 + 4 *
               ocp-indent-1.8.2/tests/passing/js-2018.ml000066400000000000000000000026071355404771200177430ustar00rootroot00000000000000(* New issues reported as of 2018 *)

(* include.ml *)

module M : sig
  include module type of struct
    include I
  end

  val f : unit -> unit
end

(* record.ml *)
let _ =
  { a_field : int =
      3
  ; another_field : int =
      3
  }

let _ =
  { a_field =
      3
  ; another_field =
      3
  }

(* polyvariant.mli *)
module type S = sig
  val a :
    something:int
    -> non_optional:
         int list
           list
           list
    -> ?optional:
         int
    -> int
end

module type S = sig
  val a
    :  something:int
    -> non_optional:
         [ `A
         | `B
         ]
    -> ?optional:
         [ `A
         | `B
         ]
    -> int
end

(* type_annot_ext.ml *)
let x =
  let v : [%ext : int] = w in
  "hello"

let f a =
  match (a : Nothing.t) with
  | _ -> .

let g () =
  1

;;

(* let_module_functor_application.ml *)
let module X = Make (struct
    let i = 10
  end)

(* gadts.ml *)
type 'a t =
  | Foo :
      int list list list list
      * string list
      * float list
      * bool list
      * 'a option list list
      -> 'a option list list t

(* inline_record_indentation.ml *)
type t =
  | Clause of {
    field : ty;
  }
  | Clause of {
      field : ty;
    }
  | Clause of {
      field : ty;
    }

(* constraint.ml *)
type 'a t = 'b constraint 'a = < foo : 'b >

let x = 8

(* custom_delim_in_comments.ml *)
(* some comment {|"|} *)
let f x = x
(* {|"|} *)
ocp-indent-1.8.2/tests/passing/js-2018.ml.opts000066400000000000000000000000161355404771200207170ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-and.ml000066400000000000000000000001321355404771200201020ustar00rootroot00000000000000module M : S with type a = b
              and type c = d
              and type e = f
;;
ocp-indent-1.8.2/tests/passing/js-and.ml.opts000066400000000000000000000000161355404771200210670ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-andand.ml000066400000000000000000000003421355404771200205700ustar00rootroot00000000000000let all_equal =
  a = b
  && c = d
  && e = f (* this && should line up with previous one *)
;;

(* '=' seems to be relevant here *)
let _ =
  x
  && t.entity = entity
  && t.clearing_firm = clearing_firm
  && t.type_ = type_
ocp-indent-1.8.2/tests/passing/js-andand.ml.opts000066400000000000000000000000161355404771200215520ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-applicative.ml000066400000000000000000000001771355404771200216520ustar00rootroot00000000000000(* applicative_intf.ml *)

let args =
  bar "A"
  @> baz "B"
  @> nil

let args =
  bar "A"
  @> baz_qux
  @@ zap "D"
  @> nil
ocp-indent-1.8.2/tests/passing/js-applicative.ml.opts000066400000000000000000000000161355404771200226260ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-bench.ml000066400000000000000000000023211355404771200204210ustar00rootroot00000000000000BENCH_FUN "Array.get (tuple)" =
  (* This is mis-indented only when BENCH_FUN is on the first line. *)
  let len = 300 in
  let arr = create ~len (1,2) in
  (fun () -> ignore(arr.(len-1)))

BENCH_FUN "Array.set (tuple)" =
  let len = 300 in
  let arr = create ~len (1,2) in
  (fun () -> arr.(len-1) <- (3,4))

(* Some benchmarks of the blit operations *)
BENCH_MODULE "Blit tests" = struct
  let lengths = [0; 10; 100; 1000; 10_000]

  BENCH_MODULE "Int" = struct
    BENCH_INDEXED "blit" len lengths  =
      let src = create ~len 0 in
      let dst = create ~len 0 in
      (fun () -> Int.blit ~src ~src_pos:0 ~dst ~dst_pos:0 ~len)

    BENCH_INDEXED "blito" len lengths  =
      let src = create ~len 0 in
      let dst = create ~len 0 in
      (fun () -> Int.blito ~src ~src_pos:0 ~dst ~dst_pos:0 ~src_len:len ())
  end

  BENCH_MODULE "Float" = struct
    BENCH_INDEXED "blit" len lengths  =
      let src = create ~len 0.0 in
      let dst = create ~len 0.0 in
      (fun () -> Float.blit ~src ~src_pos:0 ~dst ~dst_pos:0 ~len)

    BENCH_INDEXED "blito" len lengths  =
      let src = create ~len 0.0 in
      let dst = create ~len 0.0 in
      (fun () -> Float.blito ~src ~src_pos:0 ~dst ~dst_pos:0 ~src_len:len ())
  end
end
ocp-indent-1.8.2/tests/passing/js-bench.ml.opts000066400000000000000000000000161355404771200214040ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-bind.ml000066400000000000000000000011141355404771200202550ustar00rootroot00000000000000let assigned_to u =
  Deferred.List.filter (Request_util.requests ()) ~f:(fun request ->
    if _
    then _
    else
      status_request ~request () ~msg_client:no_msg >>= fun status ->
      not (up_to_date_user status u))



let old_good =
  foo bar qaz *>>= fun x ->
  hey ho lala *>>= fun y ->
  return (x,y)

let old_good =
  foo bar qaz +>>= fun x ->
  hey ho lala +>>= fun y ->
  return (x,y)

(* generalizations based on Tuareg code *)
let old_good =
  foo bar qaz *>>| fun x ->
  hey ho lala *>>> fun y ->
  foo bar qaz +>>| fun x ->
  hey ho lala +>>> fun y ->
  return (x,y)
ocp-indent-1.8.2/tests/passing/js-bind.ml.opts000066400000000000000000000000161355404771200212410ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-comment.ml000066400000000000000000000064401355404771200210120ustar00rootroot00000000000000(* ocp-indent is not going to be confused by comment-embedded tokens. *)



type t = {
  (* This is a comment *)
  a: int;
}

type t = {
  (* This is a comment : with a colon. *)
  a: int;
}

type t = {
  a: int;
  (* with the :     second field *)
  b: int;
}

type t = {
  a: int;
  b: int;
  (* and : the third... *)
  c: int;
}



(* colon in CR comment messes Tuareg up *)
type cfg = {
  foo : int; (* ignore-CR someone: float? *)
  bar : string;
}

(* To be more precise about the Tuareg bug, it is the fact that the colon in the comment
is the first or second colon after the start of the record definition.  If the comment
occurs after the first 2 fields in the record everything is fine.

For example, this is OK: *)
type t= {
  foo : int;
  bar : string; (* ignore-CR someone: float? *)
  baz : string;
}

(* but Tuareg messes this up *)
type t= {
  foo : int;
  (* ignore-CR someone: float? *)
  bar : string;
}



(* Now that we have support for {v v} and {[ ]}, reindent inside comments,
   unless they are explicitly delimited as code or pre-formatted text.  These
   three all end up flattened to the same level. *)
(*
type t = {
  (* This is a comment *)
  a: int;
}
*)
(*
   type t = {
   (* This is a comment *)
   a: int;
   }
*)
(*
       type t = {
         (* This is a comment *)
         a: int;
       }
*)



(* Possible to-do warning: Star-prefixed lines are allowed and indented a little
   less, to line up with the star in the opening comment parenthesis.  Maybe we
   don't care enough about them to worry about it, though. *)



(** Doc comment text should be aligned with the first line, so indented more
than otherwise. *)

(* We're now using some ocamldoc block syntax to control indentation, and sweeks
and the rest of us have been relying on it, in and out of doc comments.

{[
let code =
should be reindented like code
so as to work also with vim
]}

    {v g
   This is totally verbatim text and shouldn't be reindented.  It
 probably doesn't matter what the indentation of the first line of a
verbatim block is.  But how will this be done in vim?
 xx
  yy
   zz
    c  v}

Does this even confront ocp-indent?  I think, when reindenting whole files,
source code blocks do confront ocp-indent.
*)



(* {v

(* comments embedded in verbatim sections *)
(* want to be able to verbatim-out big chunks of code *)

v} *)



(* {v

non-comments in verbatim sections
duh

v} *)



module M = struct
  let x = 0

  (* reference *)
end

module M = struct
  let () =
    ()

    (* If there's a blank line before this, at least, shouldn't it revert to the
       block-level indentation, even if it doesn't precede a declaration?  As
       long as the prior declaration is complete, I mean.  If there isn't a
       blank line, I can see associating the comment with the line before. *)
end

module M = struct
  let () = ()

           (* sim. *)
end

module M = struct
  let () =
    ()

  (* no problem *)
  let () =
    ()
end



val f : foo : int ->
  -> bar_snoo : a b
                (* this comment is in the wrong place *)
  -> unit

val f : foo : int ->
  -> bar_snoo : a
  (* this comment is in the right place [under discussion] *)
  -> unit

(* The only difference is the type "a b" instead of "a" for the labeled value
   bar_snoo. *)



module M : sig
  val v : 'a t -> s -> 'a t
                       (* ... *)
end
ocp-indent-1.8.2/tests/passing/js-comment.ml.opts000066400000000000000000000000161355404771200217670ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-comment.ml.ref000066400000000000000000000064201355404771200215630ustar00rootroot00000000000000(* ocp-indent is not going to be confused by comment-embedded tokens. *)



type t = {
  (* This is a comment *)
  a: int;
}

type t = {
  (* This is a comment : with a colon. *)
  a: int;
}

type t = {
  a: int;
  (* with the :     second field *)
  b: int;
}

type t = {
  a: int;
  b: int;
  (* and : the third... *)
  c: int;
}



(* colon in CR comment messes Tuareg up *)
type cfg = {
  foo : int; (* ignore-CR someone: float? *)
  bar : string;
}

(* To be more precise about the Tuareg bug, it is the fact that the colon in the comment
   is the first or second colon after the start of the record definition.  If the comment
   occurs after the first 2 fields in the record everything is fine.

   For example, this is OK: *)
type t= {
  foo : int;
  bar : string; (* ignore-CR someone: float? *)
  baz : string;
}

(* but Tuareg messes this up *)
type t= {
  foo : int;
  (* ignore-CR someone: float? *)
  bar : string;
}



(* Now that we have support for {v v} and {[ ]}, reindent inside comments,
   unless they are explicitly delimited as code or pre-formatted text.  These
   three all end up flattened to the same level. *)
(*
   type t = {
   (* This is a comment *)
   a: int;
   }
*)
(*
   type t = {
   (* This is a comment *)
   a: int;
   }
*)
(*
   type t = {
   (* This is a comment *)
   a: int;
   }
*)



(* Possible to-do warning: Star-prefixed lines are allowed and indented a little
   less, to line up with the star in the opening comment parenthesis.  Maybe we
   don't care enough about them to worry about it, though. *)



(** Doc comment text should be aligned with the first line, so indented more
    than otherwise. *)

(* We're now using some ocamldoc block syntax to control indentation, and sweeks
   and the rest of us have been relying on it, in and out of doc comments.

   {[
     let code =
       should be reindented like code
         so as to work also with vim
   ]}

   {v g
   This is totally verbatim text and shouldn't be reindented.  It
 probably doesn't matter what the indentation of the first line of a
verbatim block is.  But how will this be done in vim?
 xx
  yy
   zz
    c  v}

   Does this even confront ocp-indent?  I think, when reindenting whole files,
   source code blocks do confront ocp-indent.
*)



(* {v

(* comments embedded in verbatim sections *)
(* want to be able to verbatim-out big chunks of code *)

v} *)



(* {v

non-comments in verbatim sections
duh

v} *)



module M = struct
  let x = 0

  (* reference *)
end

module M = struct
  let () =
    ()

  (* If there's a blank line before this, at least, shouldn't it revert to the
     block-level indentation, even if it doesn't precede a declaration?  As
     long as the prior declaration is complete, I mean.  If there isn't a
     blank line, I can see associating the comment with the line before. *)
end

module M = struct
  let () = ()

  (* sim. *)
end

module M = struct
  let () =
    ()

  (* no problem *)
  let () =
    ()
end



val f : foo : int ->
  -> bar_snoo : a b
  (* this comment is in the wrong place *)
  -> unit

val f : foo : int ->
  -> bar_snoo : a
  (* this comment is in the right place [under discussion] *)
  -> unit

(* The only difference is the type "a b" instead of "a" for the labeled value
   bar_snoo. *)



module M : sig
  val v : 'a t -> s -> 'a t
  (* ... *)
end
ocp-indent-1.8.2/tests/passing/js-comment1.ml000066400000000000000000000033141355404771200210700ustar00rootroot00000000000000type foo = int                          (* just in case *)



(* These two shouldn't be indented differently, but are. *)

type z =
  [ `Bar of foo
    (* a comment [expected to apply to `Foo as below] *)
  | `Foo ]

type z =
  [ `Bar
  (* a comment *)
  | `Foo ]



(* On second thought, I kind of like this way of thinking about this
indentation, even though it is kind of parasyntactic: *)

type z =
  (* Applies to "[" or `Bar. *)
  [ `Bar of foo
    (* Applies to "|" or `Foo.  Indented too much. *)
  | `Foo ]

type z =
  (* Applies to "[" or `Bar. *)
  [ `Bar
  (* Applies to "|" or `Foo. *)
  | `Foo ]

(* The way we write code, that will line up more nicely. *)



let _ =
  (foo
     (* This is indented too far to the left *)
     (bar))

(* It looks to me like we generally want the comment to apply to the
     following line in most circumstances, including this one.  The default indent
for an empty line after a function application that isn't terminated with a
     ";" or something would probably also be in a bit, in anticipation of an
argument, although I don't think that's crucial. *)
let _ =
  foo quux
(* about bar *)
    bar
(* about baz *)
    baz

(** Trying lists within comments:
    - this is a
    multi-line element of a list.
    - and this is a one-liner
    - this
    has
  many
         more
    lines
      - and this is indented like a sub-list
      - but isn't one at
        -all

    this is outside of the list though.
    
    - and this is
    - another
    list

    - and another
one

the end
*)

(* There is an issue with toplevel sessions:
     # expr1;;
     - : type1 = value1
     # expr2;;
     - : type2 = value2

     Comment. *)

(* Comment:

        - [code];
      - {[ code ]} *)
ocp-indent-1.8.2/tests/passing/js-comment1.ml.opts000066400000000000000000000000161355404771200220500ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-comment1.ml.ref000066400000000000000000000033141355404771200216430ustar00rootroot00000000000000type foo = int                          (* just in case *)



(* These two shouldn't be indented differently, but are. *)

type z =
  [ `Bar of foo
  (* a comment [expected to apply to `Foo as below] *)
  | `Foo ]

type z =
  [ `Bar
  (* a comment *)
  | `Foo ]



(* On second thought, I kind of like this way of thinking about this
   indentation, even though it is kind of parasyntactic: *)

type z =
  (* Applies to "[" or `Bar. *)
  [ `Bar of foo
  (* Applies to "|" or `Foo.  Indented too much. *)
  | `Foo ]

type z =
  (* Applies to "[" or `Bar. *)
  [ `Bar
  (* Applies to "|" or `Foo. *)
  | `Foo ]

(* The way we write code, that will line up more nicely. *)



let _ =
  (foo
     (* This is indented too far to the left *)
     (bar))

(* It looks to me like we generally want the comment to apply to the
   following line in most circumstances, including this one.  The default indent
   for an empty line after a function application that isn't terminated with a
   ";" or something would probably also be in a bit, in anticipation of an
   argument, although I don't think that's crucial. *)
let _ =
  foo quux
    (* about bar *)
    bar
    (* about baz *)
    baz

(** Trying lists within comments:
    - this is a
      multi-line element of a list.
    - and this is a one-liner
    - this
      has
      many
      more
      lines
    - and this is indented like a sub-list
    - but isn't one at
      -all

    this is outside of the list though.

    - and this is
    - another
      list

    - and another
      one

    the end
*)

(* There is an issue with toplevel sessions:
   # expr1;;
   - : type1 = value1
   # expr2;;
   - : type2 = value2

   Comment. *)

(* Comment:

   - [code];
   - {[ code ]} *)
ocp-indent-1.8.2/tests/passing/js-default.ml000066400000000000000000000005741355404771200207760ustar00rootroot00000000000000type t =
  { last_trading : Week_date.Spec.t;
    first_notice : Week_date.Spec.t option;
    first_notice_exceptions : Date.t Year_month.Map.t
      with default(Year_month.Map.empty);
    offset       : Week_date.Offset.t;
    (* n > 0 *)
    new_contract_expires_in_n_months : int
  }
[@@deriving sexp, compare]

module M = struct
  type t = { x: int }
  [@@deriving sexp]
end
ocp-indent-1.8.2/tests/passing/js-default.ml.opts000066400000000000000000000000161355404771200217510ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-fun-rec.ml000066400000000000000000000007641355404771200207120ustar00rootroot00000000000000let rec check_header t =
  if Iobuf.length t.buf < header_length then failwiths "Short packet" t !sexp_of_t;
and session t =
  check_header t;
  Session_id.of_int_exn id_int
and length t =
  let len = raw_length t in
  if len = eos_marker then 0 else len
and sexp_of_t t =                       (* something pretty for debugging *)
  let lo, len = Iobuf.snapshot t.buf, Iobuf.length t.buf in
  protect ~finally:(fun () -> Iobuf.Snapshot.rewind lo t.buf; Iobuf.resize t.buf len)
    (fun () -> ())
;;
ocp-indent-1.8.2/tests/passing/js-fun-rec.ml.opts000066400000000000000000000000161355404771200216640ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-label.ml000066400000000000000000000004551355404771200204270ustar00rootroot00000000000000(* Get C.t and (r : S.t -> T.t) indented two chars right of their labels. *)
type t
  =  A.t
  -> bbb :
       C.t
  -> D.t
  -> e : (f : G.t -> H.t)
  -> I.t
  -> jjj : [ `K
           | `L
           ]
  -> M.t
  -> nnn :
       [ `O
       | `P
       ]
  -> qqq :
       (r : S.t -> T.t)
  -> U.t
ocp-indent-1.8.2/tests/passing/js-label.ml.opts000066400000000000000000000000161355404771200214040ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-let.ml000066400000000000000000000020521355404771200201270ustar00rootroot00000000000000let foo
      some very long arguments that we break onto the next line
  =
  bar ();
  baz
(* The [some] above is indented less when [let foo] is the first line.  The
   problem goes away if there's anything on the line before [let foo]. *)

(* The picture shows where we want the `=' to be.  However, Tuareg currently moves it over
   to line up with the arguments.

   Perhaps this is merely a personal preference, but that seems ugly to me.

   pszilagyi: It's consistent with other infix operators (although this is syntax) for it
   to be where you prefer. *)

let foo arguments
  = bar

let foo
      arguments
  = bar

(* This program parses, but the [let] is indented incorrectly. *)
module M = struct
  module M : module type of M = struct
    let x = ()
  end
end
(* Removing the [: module type of M] removes the bug. *)

let parenthesized_let_tweak =
  (let sub value n l f =
     case ~value (message ("fix_sending_" ^ n) ~length:(35 + 29 + l) f)
   in
   x)

let parenthesized_let_tweak =
  f ~x:(let n =
          S.S.g s.S.s ~s
        in
        y)
ocp-indent-1.8.2/tests/passing/js-let.ml.opts000066400000000000000000000000161355404771200211110ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-list.ml000066400000000000000000000004241355404771200203170ustar00rootroot00000000000000(* mixed list styles *)
let cases =
  [ Group ("publishing", [
      basic_pre2
        ~name;
    ]); (* I think this line and the 2 preceding ones are indented one space too
           few by ocp-indent *)
    Group ("recovery", [
      basic_pre2
        ~name
    ]);
  ]
ocp-indent-1.8.2/tests/passing/js-list.ml.opts000066400000000000000000000000161355404771200213000ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-low-priority.ml000066400000000000000000000013331355404771200220240ustar00rootroot00000000000000(* Relatively low priority Jane Street indentation bugs. *)



(* js-args *)

(* uncommon *)
let x =
  try x with a -> b
           | c -> d
let x =
  try x
  with a -> b
     | c -> d



(* js-comment *)

let mk_cont_parser cont_parse = (); fun _state str ~max_pos ~pos ->
  let len = max_pos - pos + 1 in
  cont_parse ~pos ~len str

(* sexp parser is sensitive to
   absent newlines at the end of files. *)



(* It would be nice if a partially completed ocamldoc code fragment inside a
   comment had the closing delimiter "]}" indented nicely before the comment is
   closed.  (This has to be the last comment in the file, to be partial.) *)
(* Maybe add:
   {[
     val state : t -> [ `Unstarted | `Running | `Stopped ]
   ]}
ocp-indent-1.8.2/tests/passing/js-low-priority.ml.opts000066400000000000000000000000161355404771200230050ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-map.ml000066400000000000000000000001351355404771200201200ustar00rootroot00000000000000let projection_files =
  Deferred.List.map x ~f:(fun p ->
    _)
  >>| String.split ~on:'\n'
ocp-indent-1.8.2/tests/passing/js-map.ml.opts000066400000000000000000000000161355404771200211020ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-model.ml000066400000000000000000000002721355404771200204450ustar00rootroot00000000000000val f
  :  int
  -> int

type t =
  | A
  | B

let height = function
  | A -> 0
  | B -> 1

let _ =
  if x then begin
    y
  end else if x then
    y
  else z

type t
  =  int
  -> int
ocp-indent-1.8.2/tests/passing/js-model.ml.opts000066400000000000000000000000161355404771200214250ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-pipebang.ml000066400000000000000000000030541355404771200211330ustar00rootroot00000000000000let f x =
  x
  >>| fun x ->
  g x
  >>| fun x ->
  h x
;;

let f x =
  x >>| fun x ->
  g x >>| fun x ->
  h x
;;

let f x =
  x
  |! fun x ->
  g x
  |! fun x ->
  h x
;;

let f x =
  x |! fun x ->
  g x |! fun x ->
  h x
;;

let _ =
  (z (fun x -> x)
   |! Validate.of_list)			(* Tuareg indents this line too far. *)

let _ =
  (* Tuareg works correctly on this (if you drop the fun). *)
  (z x
   |! Validate.of_list)

(* jli found this great one.  Tuareg gets confused by the paren before List.map and
   indents |! way too far, under "k ^".  ocp-indent should shine, since it understands the
   syntax better. *)
let _ =
  List.filter_opt [
    format old (fun old -> "removed: "
                           ^ (List.map old ~f:(fun (k, v) -> k ^ "=" ^ acl_to_string v)
                              |! String.concat ~sep:", "))
  ]



(* (|>) = (|!) *)

let f x =
  x
  |> fun x ->
  g x
  |> fun x ->
  h x
;;

let f x =
  x |> fun x ->
  g x |> fun x ->
  h x
;;

let _ =
  (z (fun x -> x)
   |> Validate.of_list)			(* Tuareg indents this line too far. *)

let _ =
  (* Tuareg works correctly on this (if you drop the fun). *)
  (z x
   |> Validate.of_list)

(* jli found this great one.  Tuareg gets confused by the paren before List.map and
   indents |> way too far, under "k ^".  ocp-indent should shine, since it understands the
   syntax better. *)
let _ =
  List.filter_opt [
    format old (fun old -> "removed: "
                           ^ (List.map old ~f:(fun (k, v) -> k ^ "=" ^ acl_to_string v)
                              |> String.concat ~sep:", "))
  ]
ocp-indent-1.8.2/tests/passing/js-pipebang.ml.opts000066400000000000000000000000161355404771200221120ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-poly.ml000066400000000000000000000003531355404771200203300ustar00rootroot00000000000000let handle_query qs ~msg_client:_ =
  try_with (fun () ->
    if _ then
      f >>| fun () ->
      `Done ()
    else
      _
  )
;;

if _ then
  _
else
  assert_branch_has_node branch node >>| fun () ->
  { t with node; floating }
;;
ocp-indent-1.8.2/tests/passing/js-poly.ml.opts000066400000000000000000000000161355404771200213100ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-ppx-struct.ml000066400000000000000000000012021355404771200214700ustar00rootroot00000000000000open! Base
open  Ppxlib
open  Ast_builder.Default

let loc = location ~start:[%here] ~end_:[%here] ~ghost:true

(* These three are okay: *)

include struct
  let _ = [%expr `x]
  let _ = ()
end

include struct
  let _ = [%type: [`x]]
  let _ = ()
end

include struct
  let _ = [%pat? `x]
  let _ = ()
end

(* These four cause the following line to jump back all the way to the left: *)

include struct
  let _ = [%stri let () = ();;]
  let _ = ()
end

include struct
  let _ = [%str let () = ();;]
  let _ = ()
end

include struct
  let _ = [%sigi: val x : int]
  let _ = ()
end

include struct
  let _ = [%sig: val x : int]
  let _ = ()
end
ocp-indent-1.8.2/tests/passing/js-sexp.ml000066400000000000000000000002751355404771200203270ustar00rootroot00000000000000let () =
  f
    x
    [%sexp_of int]
    y
;;

(* y *)
let z =
  some_function
    [%sexp_of foo]
;;

let z =
  some_function
    argument

let d =
  print_sexp
    [%sexp_of unit]
    ()
ocp-indent-1.8.2/tests/passing/js-sexp.ml.opts000066400000000000000000000000161355404771200213040ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-str.ml000066400000000000000000000023301355404771200201520ustar00rootroot00000000000000(* gigantic string with weird characters that causes trouble *)
TEST_UNIT =
  eprintf "%s\n"
    (remove_progress_bar "[============================================================  ] 04840 / 04841
                                                                               
[============================================================  ] 04841 / 04842
[=======================================                       ] 05010 / 07826
[========================                                      ] 05053 / 13052
[=============================                                 ] 06807 / 14348
[===============================                               ] 08203 / 16405
[=================================                             ] 09418 / 17458
[=================================                             ] 09566 / 17458
[==================================                            ] 09631 / 17458
[=================================                             ] 10200 / 18846
[===========================                                   ] 10221 / 23043
[=============================                                 ] 11016 / 23098
make[1]: Leaving directory `/mnt/local/sda1/mstanojevic/repos/live/submissions'")

let _ =
x
ocp-indent-1.8.2/tests/passing/js-str.ml.opts000066400000000000000000000000161355404771200211350ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-str.ml.ref000066400000000000000000000023321355404771200207270ustar00rootroot00000000000000(* gigantic string with weird characters that causes trouble *)
TEST_UNIT =
  eprintf "%s\n"
    (remove_progress_bar "[============================================================  ] 04840 / 04841
                                                                               
[============================================================  ] 04841 / 04842
[=======================================                       ] 05010 / 07826
[========================                                      ] 05053 / 13052
[=============================                                 ] 06807 / 14348
[===============================                               ] 08203 / 16405
[=================================                             ] 09418 / 17458
[=================================                             ] 09566 / 17458
[==================================                            ] 09631 / 17458
[=================================                             ] 10200 / 18846
[===========================                                   ] 10221 / 23043
[=============================                                 ] 11016 / 23098
make[1]: Leaving directory `/mnt/local/sda1/mstanojevic/repos/live/submissions'")

let _ =
  x
ocp-indent-1.8.2/tests/passing/js-test.ml000066400000000000000000000014111355404771200203200ustar00rootroot00000000000000let%test =
  let b = true in
  b
(* Above, a multi-line TEST (likewise BENCH) was indented wrong only when it
   started on the first line.  (That wasn't really a big problem.) *)

(* oUnit *)

module E = Example

let%test_module =
  (module struct
    let%test = false
    let%test =
      let b = true in
      b
    let%test "Name_test" =
      let b = true in                   (* tricky for Tuareg *)
      b
  end)

let%test_module "Name" =
  (module struct
    let%test_unit = ()
    let%test_unit =
      let () = () in
      ()
    let%test_unit "Name_unit" =
      let () = () in                    (* tricky for Tuareg *)
      ()

    let%test_unit =
      let msgcount = 10_000 in          (* tricky for Tuareg *)
      ()
  end)

let _ = printf "Hello, world!\n"
ocp-indent-1.8.2/tests/passing/js-test.ml.opts000066400000000000000000000000161355404771200213040ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-try.ml000066400000000000000000000001201355404771200201530ustar00rootroot00000000000000(* nested "try" *)
try
  try x
  with e -> e
with e -> e (* indented too far *)
ocp-indent-1.8.2/tests/passing/js-try.ml.opts000066400000000000000000000000161355404771200211430ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-type.ml000066400000000000000000000012461355404771200203300ustar00rootroot00000000000000type t =
  S.s        (* looks like a constructor to ocp-indent, which indents too far *)
type t =
  s    (* correct, because this doesn't look like a constructor to ocp-indent *)
type t =
    S                         (* correctly indented a little more, because... *)
type t =
  | S                                   (* we leave room for the vertical bar *)



(* analogous value expressions, analogous to lists, some different from now *)
let _ =
  [ x
  ; y
  ]
let _ =
  [ x;
    y
  ]
let _ =
  ( x
  , y
  )
let _ =
  ( x,
    y
  )
let _ =
  (
    x
  , y
  )
let _ =
  [
    x
  ; y
  ]
let _ = (
  x,
  y
)
let _ = [
  x;
  y
]
let _ = (
  x
, y
)
let _ = [
  x
; y
]
ocp-indent-1.8.2/tests/passing/js-type.ml.opts000066400000000000000000000000161355404771200213060ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/js-var.ml000066400000000000000000000000421355404771200201300ustar00rootroot00000000000000type t =
  | A
  | B of int
  | C
ocp-indent-1.8.2/tests/passing/js-var.ml.opts000066400000000000000000000000161355404771200211150ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/let-and.ml000066400000000000000000000002661355404771200202620ustar00rootroot00000000000000let f
  = fun x -> x
and g
  = fun x -> x
and h
  = fun x -> x

let rec f : 'a. 'a -> 'a
  = fun x -> g x
and g : 'a. 'a -> 'a
  = fun x -> h x
and h : 'a. 'a -> 'a
  = fun x -> f x
ocp-indent-1.8.2/tests/passing/let-open.ml000066400000000000000000000000721355404771200204540ustar00rootroot00000000000000
let _ =
  (* ... *)
  let open Option in
  indented_line
ocp-indent-1.8.2/tests/passing/lwt.ml000066400000000000000000000004761355404771200175470ustar00rootroot00000000000000let f () =
  lwt x = g () in
  Lwt.return x

let f x = match_lwt x with
  | A -> A
  | B -> B

let g x = try_lwt
    f x
  finally
    g x

let a f x =
  try_lwt f x
  with Failure _ -> ()
  finally ()

(* should'nt break normal try/with imbrication *)
let z f x =
  try
    try f x
    with Exit -> ()
  with _ -> ()
ocp-indent-1.8.2/tests/passing/lwt.ml.opts000066400000000000000000000000151355404771200205200ustar00rootroot00000000000000--syntax lwt
ocp-indent-1.8.2/tests/passing/macro.ml000066400000000000000000000001121355404771200200250ustar00rootroot00000000000000open Foo

INCLUDE "bar"

IFDEF "foo"
let f x = 3
ENDIF

TEST foo
TEST bar
ocp-indent-1.8.2/tests/passing/match_fun.ml000066400000000000000000000001561355404771200207000ustar00rootroot00000000000000let reset_cond =
  match states with
  | [ _ ] -> fun _ v _   -> e_id v
  |   _   -> fun s v clk -> (* … *)
ocp-indent-1.8.2/tests/passing/misc-2018.ml000066400000000000000000000023541355404771200202610ustar00rootroot00000000000000(* #183 *)

type 'a repr =
| Bytes of ('a -> string)
| Int of ('a -> int)
| Int32 of ('a -> int32)
| Int64 of ('a -> int64)
| Float of ('a -> float)

let bytes_of_repr = function
| Bytes b -> fun v -> b v
| Int i -> fun v -> R_byte_sort.of_int (i v)
| Int32 i -> fun v -> R_byte_sort.of_int32 (i v)
| Int64 i -> fun v -> R_byte_sort.of_int64 (i v)
| Float f -> fun v -> R_byte_sort.of_float (f v)

(* #265 *)

let _ = ( a
        ;
          b
        )

let _ = {
  a
  ;
  b
}

let f x =
  ( foo
  ;
    bar )

let _ = ( a
        ; (* foo *)
          b
        )

let _ = {
  a
  ; (* foo *)
  b
}

let f x =
  ( foo
  ; (* foo *)
    bar )

(* #224 *)
let () =
  begin [@attribute]
    print_endline "hello";
    print_endline "world";
  end

(* #188 *)
let f : t1 -> t2 -> t3 =
  fun x y z ->
  x + y + z

(* #257 *)
module M = struct
  type a = A of b [@@deriving compare]
  and b = B of a
end

(* #275 *)
let g x =
  (x * x
   [@ocaml.ppwarning "TODO: blabla"])

let h = "I am well indented"

let i x =
  x * x
  [@ocaml.ppwarning "TODO: blabla"]

let j = "I am NOT well indented"

(* #277 *)
module V = struct
  type t =
  | A of A.t [@blah "a"]
  | B of B.t [@blah "b"]
  | C of C.t [@blah "c"]
end

let foo =
  let f x =
    foo bar [@@bla] in
  zz
ocp-indent-1.8.2/tests/passing/misc-2018.ml.opts000066400000000000000000000000351355404771200212370ustar00rootroot00000000000000-c strict_with=always,with=0
ocp-indent-1.8.2/tests/passing/misc-2019.ml000066400000000000000000000034521355404771200202620ustar00rootroot00000000000000module Unsafe_blit = struct
  external unsafe_blit
    :  src:t_
    -> src_pos:int
    -> dst:t_
    -> dst_pos:int
    -> len:int
    -> unit
    = "core_array_unsafe_int_blit"
  [@@noalloc]
end

(** @open *)
include
  module type of struct
    include Base.Array
  end
  with type 'a t := 'a t

(** Return the class of the given floating-point number:
    normal, subnormal, zero, infinite, or not a number. *)
external classify_float
  :  (float[@unboxed])
  -> fpclass
  = "caml_classify_float" "caml_classify_float_unboxed"
[@@noalloc] [@@deprecated "[since 2014-10] Use [Float.classify]"]

(** {6 String operations}

    More string operations are provided in module {!String}.
*)

(** String concatenation. *)
val ( ^ ) : string -> string -> string

module V1 = struct
  type t = Xxxxxxxxxxxxxxxx.t =
    { xxxxxxxxxxxxxxxxxxxx : Xxxxxxxxxxxxxx.t
                             [@default Xxxxxxxxxxxxxx.empty]
                             [@sexp_drop_if Xxxxxxxxxxxxxx.is_empty]
    }
  [@@deriving bin_io, sexp]
end

module M = struct

  include Validate (struct type nonrec t = t [@@deriving_inline compare, sexp_of]
      let compare : t -> t -> int = compare
      let sexp_of_t : t -> Ppx_sexp_conv_lib.Sexp.t = sexp_of_t
      [@@@end] end)
end

type t = |
let x = ()

(* nested [open struct] (#300) *)
include struct
  open struct
    include String
  end
  let get = get
end

(* cinaps comments (#299) *)
let _ =
  (*$
    let f = function
      | Some x -> x
      | None -> 0
    in
    print_endline
      ";;"
  *)
  ()

(* and+ mis-indented (#292) *)
let (and+) x y =
  match x,y with
  | Some x, Some y -> Some (x, y)
  | _ -> None

module Infix : sig
  val (and+) : ('a, 'error) result -> ('b, 'error) result -> ('a * 'b, 'error) result
  val (let+) : ('a, 'error) result -> ('a -> 'b) -> ('b, 'error) result
end
ocp-indent-1.8.2/tests/passing/misc-2019.ml.opts000066400000000000000000000000161355404771200212370ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/module.ml000066400000000000000000000020561355404771200202220ustar00rootroot00000000000000module M (S : S) =
  F.Make(struct
    module G = struct
      type t
      include Foo with type t := t
      include Bar with type t := t
    end
  end)

module M =
struct
  type t
end

module Update : sig
  val f : ('a, 'b) t -> 'a -> unit
  val g : ('a, 'b) t -> 'a -> unit
  module M : C with type k = t
  module G : C with type k := f
  type t
end = struct
  type t = int
end

module M : S
  with type t = x
   and type t' = y
   and type t' = y
=
struct
  type t = int
end

module M : S with type t = x
              and type t' = y
              and type t' = y
= struct
  type t = int
end

module Make: functor (M : T) -> sig
  val f : int -> int
  val g : int -> int
end

let _ = (module struct
end)

let _ =
  let _ = (module struct
    foo
  end)

include (Bad : (module type of M
                 with module N = O))

val debatable : (module Module.Sub
                  with type t1 = t1'
                   and type t2 = t2')

module Store (K: API.KEY) (V: API.VALUE) :
  API.STORE with module K = K
             and module V = V =
struct

  module K = K
ocp-indent-1.8.2/tests/passing/multiline.ml000066400000000000000000000006661355404771200207440ustar00rootroot00000000000000let _ =
  (* multiline-comments
     can be troublesome:
      let x =
        let y =
          f z
        in y
      indented code should be kept as is *)
  ()

let _ = (* what about multi-line
           comments that don't start a line ?
        *)
  w

let s1 = "a b c d
         e f g h
  i j k"

let s2 = "a b c d \
          e f g h \
          i j k\
         \ l"

let s3 = "a b c d \
          e f g h
 i j k \
          l m"
ocp-indent-1.8.2/tests/passing/nested_variants.ml000066400000000000000000000003441355404771200221240ustar00rootroot00000000000000type tt =
  | A of
      int
  | B of
      string
  | C of
      float
  | D of
      char

type tt = [
  | `a of int
  | `blskdjf of
      float
  | `problem_cause of [ `more_brackets ]
  | `problematic_case of
      string
]
ocp-indent-1.8.2/tests/passing/nesting.ml000066400000000000000000000004171355404771200204030ustar00rootroot00000000000000module M = struct
  let a = ((((((
    )
    )
    )
    )
    )
    )

  let a = (ff(ff(ff(ff(ff(ff(
    )
    )
    )
    )
    )
    )
    )

  let a = [[[[[[
    ]
    ]
    ]
    ]
    ]
    ]

  let a = [ff[ff[ff[ff[ff[ff[
    ]
    ]
    ]
    ]
    ]
    ]
    ]
ocp-indent-1.8.2/tests/passing/never_align.ml000066400000000000000000000001551355404771200212240ustar00rootroot00000000000000let _ = (
  a
    b
    c
)

let _ = (a
    b
    c)

let _ = {
  a
    b
    b
}

let _ = { a
    b
    c
}
ocp-indent-1.8.2/tests/passing/never_align.ml.opts000066400000000000000000000000261355404771200222050ustar00rootroot00000000000000-c align_params=never
ocp-indent-1.8.2/tests/passing/object.ml000066400000000000000000000005511355404771200202010ustar00rootroot00000000000000let x =
  object
    inherit foo
    method bar = _
  end

class foo =
  object
    method x = 2
    inherit bar
  end

class foo =
  object(this)
    inherit bar
  end

class virtual map = object
  method visit_expr_node :
    'env 'info_0 'info_1 .
    ('env -> 'info_0 -> 'info_1) ->
    'env -> 'info_0 expr_node -> 'info_1 expr_node =
    assert false
end
ocp-indent-1.8.2/tests/passing/obuild.ml000066400000000000000000000002731355404771200202120ustar00rootroot00000000000000type predicate =
    Pred_Byte
  | Pred_Native
  | Pred_Toploop

let _ =
  { pkg with
      package_version = projFile.version
    ; package_description = _
    ; package_requires = [] }
ocp-indent-1.8.2/tests/passing/obuild.ml.opts000066400000000000000000000000471355404771200211750ustar00rootroot00000000000000-c base=2,type=2,match_clause=4,with=2
ocp-indent-1.8.2/tests/passing/ocamldoc.ml000066400000000000000000000111011355404771200205050ustar00rootroot00000000000000(** From http://caml.inria.fr/pub/docs/manual-ocaml-4.00/manual029.html#htoc172
    The first special comment of the file is the comment associated
    with the whole module.*)


(** Special comments can be placed between elements and are kept
    by the OCamldoc tool, but are not associated to any element.
    @-tags in these comments are ignored.*)

(*******************************************************************)
(** Comments like the one above, with more than two asterisks,
    are ignored. *)

(** The comment for function f. *)
val f : int -> int -> int
(** The continuation of the comment for function f. *)

(** Comment for exception My_exception, even with a simple comment
    between the special comment and the exception.*)
(* Hello, I'm a simple comment :-) *)
exception My_exception of (int -> int) * int

(** Comment for type weather  *)
type weather =
  | Rain of int (** The comment for construtor Rain *)
  | Sun (** The comment for constructor Sun *)

(** Comment for type weather2  *)
type weather2 =
  | Rain of int (** The comment for construtor Rain *)
  | Sun (** The comment for constructor Sun *)
(** I can continue the comment for type weather2 here
    because there is already a comment associated to the last constructor.*)

(** The comment for type my_record *)
type my_record =
  {
    foo : int ;    (** Comment for field foo *)
    bar : string ; (** Comment for field bar *)
  }
(** Continuation of comment for type my_record *)

(** Comment for foo *)
val foo : string
(** This comment is associated to foo and not to bar. *)
val bar : string
(** This comment is assciated to bar. *)

(** The comment for class my_class *)
class my_class :
  object
    (** A comment to describe inheritance from cl *)
    inherit cl

    (** The comment for attribute tutu *)
    val mutable tutu : string

    (** The comment for attribute toto. *)
    val toto : int

    (** This comment is not attached to titi since
        there is a blank line before titi, but is kept
        as a comment in the class. *)

    val titi : string

    (** Comment for method toto *)
    method toto : string

    (** Comment for method m *)
    method m : float -> int
  end

(** The comment for the class type my_class_type *)
class type my_class_type =
  object
    (** The comment for variable x. *)
    val mutable x : int

    (** The commend for method m. *)
    method m : int -> int
  end

(** The comment for module Foo *)
module Foo =
struct
  (** The comment for x *)
  val x : int

  (** A special comment that is kept but not associated to any element *)
end

(** The comment for module type my_module_type. *)
module type my_module_type =
sig
  (** The comment for value x. *)
  val x : int

  (** The comment for module M. *)
  module M =
  struct
    (** The comment for value y. *)
    val y : int

    (* ... *)
  end

end

(** The comment for class my_class *)
class my_class =
  object
    (** A comment to describe inheritance from cl *)
    inherit cl

    (** The comment for the instance variable tutu *)
    val mutable tutu = "tutu"
    (** The comment for toto *)
    val toto = 1
    val titi = "titi"
    (** Comment for method toto *)
    method toto = tutu ^ "!"
    (** Comment for method m *)
    method m (f : float) = 1
  end

(** The comment for class type my_class_type *)
class type my_class_type =
  object
    (** The comment for the instance variable x. *)
    val mutable x : int
    (** The commend for method m. *)
    method m : int -> int
  end

(** The comment for module Foo *)
module Foo =
struct
  (** The comment for x *)
  val x : int
  (** A special comment in the class, but not associated to any element. *)
end

(** The comment for module type my_module_type. *)
module type my_module_type =
sig
  (* Comment for value x. *)
  val x : int
  (* ... *)
end

(** Starting bla doc *)
type bla =
  | Hup (** The hup case *)
  | Hap (** The hap case *)
(** Ending bla doc *)

(** Starting bla doc *)
type bla =
  | Hup
  (** The hup case *)
  | Hap
  (** The hap case *)
(** Ending bla doc *)

type hop
(** Hop's documentation *)

type mip =
  { fup : int; (** fup field *)
    fip : int; (** fip field *) }
(** Mip's documentation *)

type t = Hey | Ho
(** Let's go. *)

type tp = [ `Hey | `Ho ]
(** Tp doc.
    Second line. *)

(** Starting function f doc *)
val f : 'a -> 'b
(** Ending function f doc. *)

val g : 'a -> t
(** Function g doc.
    Second line. *)

val g : 'a -> [`Hey | `Ho ]
(** Let's go
    Second line. *)

val x : unit -> unit
(** Here are a couple examples of some of its many uses

    {v step (fun m v -> m ~foo:v)
       +> flag "-foo" no_arg : (foo:bool -> 'm, 'm) t
    v}
*)
ocp-indent-1.8.2/tests/passing/ocamldoc2.ml000066400000000000000000000002371355404771200205770ustar00rootroot00000000000000a
  (* {[ (* {v *) ]} {v v} *)
  b

let _ =
  (*
     {[
       while true do
         xx
       done
       (* this is totally crazy !!! *)
     ]}
  *)
  ()
ocp-indent-1.8.2/tests/passing/partial-match.ml000066400000000000000000000001071355404771200214560ustar00rootroot00000000000000let () = match x with 
            | `A -> "A"
            | `B -> "B"
ocp-indent-1.8.2/tests/passing/partial-match.ml.opts000066400000000000000000000000131355404771200224360ustar00rootroot00000000000000--lines 3-
ocp-indent-1.8.2/tests/passing/partial.ml000066400000000000000000000004231355404771200203650ustar00rootroot00000000000000   let () =
 ffff;
     hhhhhh;
        fff;
 let (quot, _rem) =
   let quot_rem n k =
     let (d, m) = (n / k, n mod k) in
     if d < 0 && m > 0 then (d+1, m-k)
else (d, m)
    in
    let quot n k = fst (quot_rem n k) in
    let rem n k = snd (quot_rem n k) in

quot, rem
ocp-indent-1.8.2/tests/passing/partial.ml.opts000066400000000000000000000000141355404771200213450ustar00rootroot00000000000000--lines 5-8
ocp-indent-1.8.2/tests/passing/partial2.ml000066400000000000000000000000611355404771200204450ustar00rootroot00000000000000if () then () else
    match () with
    | () ->
ocp-indent-1.8.2/tests/passing/partial2.ml.opts000066400000000000000000000000361355404771200214330ustar00rootroot00000000000000--lines 3 -c strict_else=auto
ocp-indent-1.8.2/tests/passing/pattern.ml000066400000000000000000000015361355404771200204140ustar00rootroot00000000000000let f = match x with
  | { x = 3 } ->
    let x = 4 in
    ()

let f = match x with
  | (X|Y) | (Z|U) -> 1
  | K -> 2

let f = match x with
  | X when foo = bar ->
    fff
  | Y when f = x
        && g = 3 ->
    z

let f () =
  match s with
  (* Parenthesized ident ? *)
  | x -> x, d
  (* Regular ident *)
  | _ -> g
;;

match x with
| X | Y -> 1
| X     ->
  2;
  3
| A -> 2
;;

let f g =
  (* haha *)
  match z with
  | Z | B _ -> x
  | A (a, _, _, b) as x ->
    let x = f a and hr = f b in
    f

let unwind_to =
  match t with KType | KModule -> true | Kblob -> false
             | _ -> true

let f x = match x with
  | A | B
  | C ->
    x
  | z -> match z with
    | _ -> function
      | x ->
        x

let fun_dep ulam = function
  | A
  | B
  | C ->
    ()

let fun_dep ulam = function
  |A
  |B|C
  |D ->
    ()

let _ =
  (match bla
   with bli)
ocp-indent-1.8.2/tests/passing/ppx-string.ml000066400000000000000000000004261355404771200210470ustar00rootroot00000000000000let s = {|
|}

let s = {xx|
xx|}

let s =
  {xx|
|}
|xx}

let s = {| foo
bar
|}

let s = {| foo
    bar
|}

let s = {| foo
bar
   |}

let s =
  {|
|}

let s =
  {|
  |}

let s =
  {| foo
|}

let s =
  {xx| foo
  bar
        |yy}
baz
|xx}

let s =
  {|
foo bar
    baz
       |}
ocp-indent-1.8.2/tests/passing/ppx_expr_ext.ml000066400000000000000000000044151355404771200214630ustar00rootroot00000000000000let x =
  [%x f 3 ]

let x =
  [%x (f
         3
         5) ]

let x =
  [%x f
        3
        5 ]

let x =
  [%xy f
         3
         5 ]

let x =
  [%x fg
        3
        5 ]

let x =
  [%x   f
          3
          5 ]

let x =
  [%x
    f
      3
      5
  ]

let x =
  3 +
  [%f f ]

let x =
  [%f f ] * [%f f ]
  +
  [%f f ]

let x =
  [%f f
        4
        2 ]
  *
  [%f f
        3
        4 ]

let x =
  [%f f
        2
        3 ] * [%f f
                    3
                    4 ] +
  [%f f
        2
        3 ]

let x =
  [%f f
        2
        3 ] * [%f f
                    3
                    4 ]
  + [%f f
          2
          3 ]

let x =
  [%f f
        2
        3 ] + [%f f
                    3
                    4 ] *
              [%f f
                    2
                    3 ]

let x =
  [%f f
        2
        3 ] + [%f f
                    3
                    4 ]
              * [%f f
                      2
                      3 ]

let x =
  [%f f
        2
        3 ] + [%f f
                    3
                    4 ]
  + [%f f
          2
          3 ]


let x =
  [%
      f f
          4
          2 ]
  *
  [%
      f
    f
      3
      4 ]

let x =
  [%
      f
      .u f
           4
           2 ]
  *
  [%
      f
      .u
    f
      3
      4 ]

let invariant invariant_a t =
  Invariant.invariant [%here] t [%sexp_of: _ t] (fun () ->
    let check f = Invariant.check_field t f in
    Fields.iter
      ~has_any_waiters:(check (fun has_any_waiters ->
        if Ivar.has_handlers t.ivar
        then (assert has_any_waiters)))
      ~ivar:(check (fun ivar ->
        Ivar.invariant invariant_a ivar;
        assert (Ivar.is_empty ivar))))
;;

let core_type_of_decl ~options ~path type_decl =
  let typ = Ppx_deriving.core_type_of_type_decl type_decl in
  Ppx_deriving.poly_arrow_of_type_decl
    (fun var -> [%type: [%t var] -> [%t var] -> Ppx_deriving_runtime.bool])
    type_decl
    [%type: [%t typ] -> [%t typ] -> Ppx_deriving_runtime.bool]

module A = struct
  let x = 1

  let%bench_fun "now" [@indexed i = List.range 0 (List.length zones)] =
    let time = now () in
    fun () -> of_time time ~zone

  let x = 2
end

[%%sig:
  module type M = sig
    val x : int
  end

  module S : module type of
  struct
    let x = 12
  end
]
ocp-indent-1.8.2/tests/passing/ppx_expr_ext.ml.opts000066400000000000000000000000161355404771200224400ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.8.2/tests/passing/ppx_stritem_ext.ml000066400000000000000000000014101355404771200221640ustar00rootroot00000000000000let x = 3

[%% a
  let x = [
    3;
    2;
  ]
]

module S = sig

  let x = 3

  [%% b
    let x = [
      3;
      2;
    ]
  ]

end

[%% c
  let x = [
    3;
    2;
  ]

  [%% d
    let x = [
      3;
      2;
    ]
  ]

]

[%% x
  2 * 3
  +
  x
]

[%% x
  2 + 3
      *
      x
]

[%% x
  2
]

[%% x
    .
    y
  2
]


[%%   x
      .y
  2
]

[%% x .
    y
  2
]

[%%
    x
  2
]

module S = sig

  let x = 3

  [%% x
      .y
    2
  ]

  [%%   x
        .y
    2
  ]

  [%%
      x
      .y
    2
  ]

end

[%% client

  open M
  let  x = 3
  module M = struct end

]

[%% client

  let  x = 3
  open M
  module M = struct end

]

[%% client

  module M = struct end
  open M
  let  x = 3
]

module M = struct
  type a = A of b [@@deriving compare]
  and b = B of a
end
ocp-indent-1.8.2/tests/passing/quotations2.ml000066400000000000000000000034641355404771200212310ustar00rootroot00000000000000open Util

let header current categories pages =
  let aux short =
    let long = match Category.find short with
      | None -> failwith ("cannot find category " ^ short)
      | Some c -> c in
    let url =
      try
        let first = List.find
            (fun p -> p.Page.category = Some short && p.Page.id = 1)
            pages in
        first.Page.permalink
      with Not_found ->
        (* we are processing a blog entry
           or an index page *)
        Config.url short / "index.html" in
    if short = current then
      <:xhtml<
  • $str:long$
    • &>>
    else
      <:xhtml<
  • $str:long$
    • &>> in
  <:xhtml<
    
    
      
    
        
    
          
        
    
        
    
          
      $list:List.map aux categories$
    
        
    
      
    
    
    
  >>

let footer current categories pages =
  let categories =
    List.map (fun short ->
        let long = match Category.find short with
          | None -> failwith ("cannot find category " ^ short)
          | Some c -> c in
        short,
        long,
        List.sort Page.compare (List.filter (fun p -> p.Page.category = Some short) pages)
      ) categories in
  let aux (short, long, pages) =
    let pages = List.map (fun p ->
        if p.Page.footer then
          <:xhtml<
            
  • $str:p.Page.title$
    • 
          >> else
          Xhtml.empty
      ) pages in
    <:xhtml<
      
      
      
    • $str:long$
      • 
      $list:pages$
      
    
    >> in
  <:xhtml<
    
    
      
    
        $list:List.map aux categories$
      
    
    
    
  >>
ocp-indent-1.8.2/tests/passing/record-with.ml000066400000000000000000000013361355404771200211640ustar00rootroot00000000000000let a =
  {
    somerecord
    with
      a = b;
      c = d;
  }

let a =
  {
    somerecord
    with a = b;
         c = d;
  }

let z =
  { recofzfzfzrd   with a = bli; bzeefe =
                                   k
                      ; efgeg = a
  }

let b =
  let z =
    {           reczfzrd                  with a = bli;
                                               bzeefe = _;
    }

let b =
  let z =
    { reczfzrd with a = bli;
                    bzeefe
    }

let lexbuf = { lexbuf with Lexing.lex_start_p = start_pos;
                           Lexing.lex_curr_p = start_pos; }

let () =
  { Foo.
    foo
  ; bar = (fun () ->
        if a then b)
  }

let () =
  { foo
  ; bar = (fun () ->
        if a then b)
  }
ocp-indent-1.8.2/tests/passing/record_comments.ml000066400000000000000000000003151355404771200221140ustar00rootroot00000000000000type t = {
  a : int ;
  (** blablabla *)
  b : int ;
  (** blublublu *)

  c : int ;
  (** ccc *)
}

let _ =
  [ A ;
    (* A *)
    B ;
    (* B *)
  ]

type t = {
  x : t1; (* c1 *)(* c2 *)
  y : t2;
}
ocp-indent-1.8.2/tests/passing/records.ml000066400000000000000000000017201355404771200203730ustar00rootroot00000000000000let read_raw_gen_ic read_pixel ic l c max =
  let img = Index8.create c l in
  let greymap =
    { Color.max = max;
      Color.map =
        let make_grey i = {r = i; g = i; b = i} in
        Array.init (max + 1) make_grey} in
  img.Index8.colormap <- greymap;
  for i = 0 to l - 1 do
    for j = 0 to c - 1 do
      Index8.set img j i (read_pixel ic)
    done
  done;
  img;;

let func_darken_only org level =
  let level = 255 - level in
  { r = if org.r > level then level else org.r;
    g = if org.g > level then level else org.g;
    b = if org.b > level then level else org.b };;

let f = function
  | { f1 = Foo
         | Bar;
      f2 = _; f3 = Foo
                 | Bar }
    -> { f1 = Foo,
              Bar;
         f2 = xxx
              = yyy; f3 = Foo,
                          Bar }

let _ =
  match a with
  | { kind =
        x } -> ()
  | { LibIndex.kind =
        x } -> ()

let x = { kind =
            x },
        { LibIndex.kind =
            x }
ocp-indent-1.8.2/tests/passing/semi.ml000066400000000000000000000003121355404771200176630ustar00rootroot00000000000000let f () =
  print_endline "a"
  ;
  print_endline "b"

let f () = toto
         ; blah

let f () =
  { a = 3
  ; b = 4
  ;
  }

module A = struct

  type x =
    { a: int
    ; b: int
    ;
    }

end
ocp-indent-1.8.2/tests/passing/semisemi.ml000066400000000000000000000001301355404771200205370ustar00rootroot00000000000000module M = struct
  let () = ()
  ;;
  let f x = 3;;
  let () = ()
end

;;

let () = ()
ocp-indent-1.8.2/tests/passing/sequence.ml000066400000000000000000000011451355404771200205430ustar00rootroot00000000000000let f = fun x ->
  x

let f x =
  x

let f g = fun x -> g
    x

let f g x = g
    x

let l1 = (a ::
          b ::
          [])

let l1 = (
  a ::
  b ::
  [])

let l1 =
  a ::
  b ::
  []

let l1 = a ::
         b ::
         []

let l1 = [a;
          b;
         ]

let l1 = [
  a;
  b;
]

let l1 =
  [ a;
    b;
  ]

let l1 =
  [ a
  ; b
  ]

let l1 = [
  a
; b
]

let l1 =
  [     a;
        b
  ; c
  ]

let f1 = function
  | {k=A|B} -> true
  | {k=C} -> false

let overflow_small =
  4611686018427387904 (* max_int (63) + 1 *)
let overflow_big =
  46116860184273879030

let ppx_sequence =
  ();%ext
  ()
ocp-indent-1.8.2/tests/passing/str_else_always.ml000066400000000000000000000012001355404771200221230ustar00rootroot00000000000000let () =
  if true then "bla" else
  if true then "bli" else
    "blo"

let () =
  if true then "bla" else
  if true then "bli" else
    begin
      "hop"
    end

let () =
  if true then "hop" else
  if true then "hap" else
    ((); "bla")

let () =
  if
    x
  then
    y
  else k,
       w;
  z

let () =
  if x then a
  else
    let y = x / 42 in
    y

let () =
  if x then a
  else if y
  then b
  else begin
    blabla
  end;
  x

let () =
  if x then
    a
  else match y with
    | A -> x
    | B -> y

let () =
  if x then
    a
  else
    match y with
    | A -> x
    | B -> y

let () =
  if x then a else
    fun x ->
      y
ocp-indent-1.8.2/tests/passing/str_else_always.ml.opts000066400000000000000000000000261355404771200231140ustar00rootroot00000000000000-c strict_else=always
ocp-indent-1.8.2/tests/passing/str_else_auto.ml000066400000000000000000000011621355404771200216020ustar00rootroot00000000000000let () =
  if true then "bla" else
  if true then "bli" else
    "blo"

let () =
  if true then "bla" else
  if true then "bli" else
    begin
      "hop"
    end

let () =
  if true then "hop" else
  if true then "hap" else
    ((); "bla")

let () =
  if
    x
  then
    y
  else k,
       w;
  z

let () =
  if x then a
  else
  let y = x / 42 in
  y

let () =
  if x then a
  else if y
  then b
  else begin
    blabla
  end;
  x

let () =
  if x then
    a
  else match y with
    | A -> x
    | B -> y

let () =
  if x then
    a
  else
  match y with
  | A -> x
  | B -> y

let () =
  if x then a else
  fun x ->
    y
ocp-indent-1.8.2/tests/passing/str_else_auto.ml.opts000066400000000000000000000000241355404771200225620ustar00rootroot00000000000000-c strict_else=auto
ocp-indent-1.8.2/tests/passing/str_else_never.ml000066400000000000000000000011501355404771200217460ustar00rootroot00000000000000let () =
  if true then "bla" else
  if true then "bli" else
  "blo"

let () =
  if true then "bla" else
  if true then "bli" else
  begin
    "hop"
  end

let () =
  if true then "hop" else
  if true then "hap" else
  ((); "bla")

let () =
  if
    x
  then
    y
  else k,
       w;
  z

let () =
  if x then a
  else
  let y = x / 42 in
  y

let () =
  if x then a
  else if y
  then b
  else begin
    blabla
  end;
  x

let () =
  if x then
    a
  else match y with
    | A -> x
    | B -> y

let () =
  if x then
    a
  else
  match y with
  | A -> x
  | B -> y

let () =
  if x then a else
  fun x ->
    y
ocp-indent-1.8.2/tests/passing/str_else_never.ml.opts000066400000000000000000000000251355404771200227320ustar00rootroot00000000000000-c strict_else=never
ocp-indent-1.8.2/tests/passing/traverse.mli000066400000000000000000000224611355404771200207430ustar00rootroot00000000000000(*
    Copyright © 2011 MLstate

    This file is part of OPA.

    OPA is free software: you can redistribute it and/or modify it under the
    terms of the GNU Affero General Public License, version 3, as published by
    the Free Software Foundation.

    OPA is distributed in the hope that it will be useful, but WITHOUT ANY
    WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
    FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
    more details.

    You should have received a copy of the GNU Affero General Public License
    along with OPA. If not, see .
*)
(**
   Generic Ast Rewriter API.

   This module provides all usual traverse functions and some higher-level ones
   on any tree structure as long as we consider only one type of nodes

   @author Louis Gesbert
   @author Valentin Gatien-Baron
   @author Mathieu Barbin
*)

open TraverseInterface

(* module type TRAVERSE_LIFT = *)
(* sig *)
(*   val foldmap : ('acc -> 'expr -> 'acc * 'expr) -> 'acc -> 'code_elt -> 'acc * 'code_elt  *)
(* end *)


(** Some Extensions *)
module Utils : sig

  (** A generalisation of the type needed in S
      ('a, 'at, 'bt ,'b) sub
      'a may be expressions where identifiers are strings
      'b an expressions where identfiers are uniq
      In that case, ('a,'a,'b,'b) represents a function that deconstruct a string expression
      into a
      - list of string expression
      - a function that expects an ident expression list and build you the the 'original' ident expression

      DON'T LOOK at the types, it's too scary
      Instead take a look at the following example, where you build the subs_cons function for the expressions
      of some ast:
      let subs_cons e =
        match e with
        | Apply (e1,e2) ->
          (* (e1,e2) is a pair of expression and you are currently treating
           * expressions, you write exactly that: *)
          wrap (fun x -> Apply x) ((sub_2 sub_current sub_current) (e1,e2))
        | Match pel ->
          (* pel is a list of pattern * expr
           * we just ignore the pattern since there is no expression inside them
           * we stop the deconstruction on the expression, since it is was we are currently deconstructing *)
          wrap (fun x -> Match x) (sub_list (sub_2 sub_ignore sub_current) pel)
        | _ -> ...

  *)

  type ('a, 'at, 'bt, 'b) sub = 'a -> ('bt list -> 'b) * 'at list

  val sub_2 : ('a1, 'at, 'bt, 'b1) sub -> ('a2, 'at, 'bt, 'b2) sub -> ('a1 * 'a2, 'at, 'bt, 'b1 * 'b2) sub
  val sub_3 : ('a1, 'at, 'bt, 'b1) sub -> ('a2, 'at, 'bt, 'b2) sub -> ('a3, 'at, 'bt, 'b3) sub -> ('a1 * 'a2 * 'a3, 'at, 'bt, 'b1 * 'b2 * 'b3) sub
  val sub_4 : ('a1, 'at, 'bt, 'b1) sub -> ('a2, 'at, 'bt, 'b2) sub -> ('a3, 'at, 'bt, 'b3) sub -> ('a4, 'at, 'bt, 'b4) sub -> ('a1 * 'a2 * 'a3 * 'a4, 'at, 'bt, 'b1 * 'b2 * 'b3 * 'b4) sub
  val sub_list : ('a, 'at, 'bt, 'b) sub -> ('a list, 'at, 'bt, 'b list) sub
  val sub_option : ('a, 'at, 'bt, 'b) sub -> ('a option, 'at, 'bt, 'b option) sub
  val sub_current : ('a, 'a, 'b, 'b) sub
  val sub_ignore : ('a, _, _, 'a) sub

  val wrap : ('a -> 'b) -> ('at list -> 'a) * 't list -> ('at list -> 'b) * 't list
end

(* HACK: tmp until we merge it into TRAVERSE_CORE for TraverseInterface,
   and rename it into TRAVERSE *)
module type OLD_TRAVERSE =
sig

  type 'p t constraint 'p = _ * _ * _
  val traverse_iter : (('p t -> unit) -> 'p t -> unit) -> 'p t -> unit
  val traverse_map : (('p t -> 'p t) -> 'p t -> 'p t) -> 'p t -> 'p t
  val traverse_fold : (('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
  val traverse_foldmap : (('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
  val traverse_exists : (('p t -> bool) -> 'p t -> bool) -> 'p t -> bool
  val traverse_forall : (('p t -> bool) -> 'p t -> bool) -> 'p t -> bool
  val traverse_fold_context_down : (('env -> 'a -> 'p t -> 'a) -> 'env -> 'a -> 'p t -> 'a) -> 'env -> 'a -> 'p t -> 'a
  val iter : ('p t -> unit) -> 'p t -> unit
  val iter_up : ('p t -> unit) -> 'p t -> unit
  val iter_down : ('p t -> unit) -> 'p t -> unit
  val map : ('p t -> 'p t) -> 'p t -> 'p t
  val map_up : ('p t -> 'p t) -> 'p t -> 'p t
  val map_down : ('p t -> 'p t) -> 'p t -> 'p t
  val fold : ('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
  val fold_up : ('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
  val fold_down : ('a -> 'p t -> 'a) -> 'a -> 'p t -> 'a
  val foldmap : ('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
  val foldmap_up : ('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
  val foldmap_down : ('a -> 'p t -> 'a * 'p t) -> 'a -> 'p t -> 'a * 'p t
  val exists : ('p t -> bool) -> 'p t -> bool
  val exists_up : ('p t -> bool) -> 'p t -> bool
  val exists_down : ('p t -> bool) -> 'p t -> bool
  val find : ('p t -> bool) -> 'p t -> 'p t option
  val find_up : ('p t -> bool) -> 'p t -> 'p t option
  val find_down : ('p t -> bool) -> 'p t -> 'p t option
  val findmap : ('p t -> 'a option) -> 'p t -> 'a option
  val findmap_up : ('p t -> 'a option) -> 'p t -> 'a option
  val findmap_down : ('p t -> 'a option) -> 'p t -> 'a option


  (** traverse all the nodes of the tree in an unspecified order *)
  val traverse_fold_right :  (('b t -> 'a -> 'a) -> 'b t -> 'a -> 'a) -> 'b t -> 'a -> 'a

  (** [fold_up_combine ?combine f acc0 t] folds [f] from leaves with [acc0], combining
      accumulators from sub-trees with [combine] before calling [f].
      Default value for combine is (fun _ b -> b)
       Be carefull be using this function without combine, lots of accs are lost *)
  val fold_up_combine : ?combine:('a -> 'a -> 'a) -> ('a -> 'b t -> 'a) -> 'a -> 'b t -> 'a

  (** Folds all the nodes of the tree in an unspecified order *)
  val fold_right_down : ('b t -> 'a -> 'a) -> 'b t -> 'a -> 'a
  val foldmap_up_combine : ?combine:('a -> 'a -> 'a) -> ('a -> 'b t -> 'a * 'b t) -> 'a -> 'b t -> 'a * 'b t

  (** Non-recursive versions, e.g. if you want to handle recursion yourself and have a default case *)
  val map_nonrec : ('b t -> 'b t) -> 'b t -> 'b t
  val fold_nonrec : ('a -> 'b t -> 'a) -> 'a -> 'b t -> 'a
  val foldmap_nonrec : ('a -> 'b t -> 'a * 'b t) -> 'a -> 'b t -> 'a * 'b t

  (** Just because we had fun writing it. Don't use as is, it's probably very slow.
      Applies the rewriting until fixpoint reached *)
  val map_down_fix : ('b t -> 'b t) -> 'b t -> 'b t

  (** Additional functions that let you traverse the type 'c t when they are deep into an arbitrary structure 'b
      as long as you provide the functions to unbuild/rebuild 'b into t lists *)
  type ('b, 'c) sub = ('b, 'c t, 'c t , 'b) Utils.sub

  val lift_iter_up : ('b,'c) sub -> ('c t -> unit) -> ('b -> unit)
  val lift_iter_down : ('b,'c) sub -> ('c t -> unit) -> ('b -> unit)
  val lift_map_up : ('b,'c) sub -> ('c t -> 'c t) -> ('b -> 'b)
  val lift_map_down : ('b,'c) sub -> ('c t -> 'c t) -> ('b -> 'b)
  (* like fold_map_up_for_real *)
  val lift_fold_up_combine : ('b,'c) sub -> ?combine:('a -> 'a -> 'a) -> ('a -> 'c t -> 'a) -> ('a -> 'b -> 'a)
  val lift_fold : ('b,'c) sub -> ('a -> 'c t -> 'a) -> ('a -> 'b -> 'a)
  val lift_fold_right_down : ('b,'c) sub -> ('c t -> 'a -> 'a) -> ('b -> 'a -> 'a)
  val lift_foldmap_up : ('b,'c) sub -> ('a -> 'c t -> 'a * 'c t) -> ('a -> 'b -> 'a * 'b)
  val lift_foldmap_down : ('b,'c) sub -> ('a -> 'c t -> 'a * 'c t) -> ('a -> 'b -> 'a * 'b)
  val lift_exists : ('b,'c) sub -> ('c t -> bool) -> ('b -> bool)
end


(** {6 First implementation} *)


(** Functor giving you the usual traverse functions *)
module Make (X : S) : OLD_TRAVERSE with type 'a t = 'a X.t

(** Functor for map2, fold2, etc. *)
module MakePair (Fst : S) (Snd : S) : OLD_TRAVERSE with type 'a t = 'a Fst.t * 'a Snd.t

(** {6 Second implementation} *)

(** For the second version (S2), you may do not want to write the optimised version of fold, map, iter
    in this case you can use this unoptimzed constructors, to get them from the foldmap_children function *)
module Unoptimized :
sig
  (** Simple recursion *)
  type ('acc, 't, 't2) foldmap = ('acc -> 't -> 'acc * 't) -> 'acc -> 't2 -> 'acc * 't2
  val iter : (unit, 't, 't2) foldmap -> ('t -> unit) -> 't2 -> unit
  val map : (unit, 't, 't2) foldmap -> ('t -> 't) -> 't2 -> 't2
  val fold : ('acc, 't, 't2) foldmap -> ('acc -> 't -> 'acc) -> 'acc -> 't2 -> 'acc

  (** Mutual recursion *)
  type ('acc, 'tA, 'tB) foldmapAB =
    ('acc -> 'tA -> 'acc * 'tA) ->
    ('acc -> 'tB -> 'acc * 'tB) ->
    'acc -> 'tA -> 'acc * 'tA
  val iterAB : (unit, 'tA, 'tB) foldmapAB -> ('tA -> unit) -> ('tB -> unit) -> 'tA -> unit
  val mapAB : (unit, 'tA, 'tB) foldmapAB -> ('tA -> 'tA) -> ('tB -> 'tB) -> 'tA -> 'tA
  val foldAB : ('acc, 'tA, 'tB) foldmapAB -> ('acc -> 'tA -> 'acc) -> ('acc -> 'tB -> 'acc) -> 'acc -> 'tA -> 'acc
end

open TraverseInterface
module Make2 (X : S2) : TRAVERSE with type 'a t = 'a X.t and type 'a container = 'a X.t

module MakeLift1
    (Y : LIFT2)
    (X : TRAVERSE with type 'a container = 'a Y.t and type 'a t = 'a Y.t)
  : TRAVERSE with type 'a t = 'a X.t and type 'a container = 'a Y.container

module MakeLift2
    (Y : LIFT2)
    (X : TRAVERSE with type 'a container = 'a Y.t)
  : TRAVERSE with type 'a t = 'a X.t and type 'a container = 'a Y.container

(* From there, you can build Box of Boxes with MakeBox *)
(* for example, for rewriting rules on a tuple of code, etc...*)

(** {6 Mutual Recursive Trees} *)

module MakeAB (AB : AB) : TRAVERSE_AB with type 'a tA = 'a AB.tA and type 'a tB = 'a AB.tB
ocp-indent-1.8.2/tests/passing/traverse.mli.opts000066400000000000000000000000271355404771200217210ustar00rootroot00000000000000-c in=2,match_clause=4
ocp-indent-1.8.2/tests/passing/type-and.ml000066400000000000000000000001321355404771200204470ustar00rootroot00000000000000type a =
  | A
and b = int

module M = struct
  type s = t and t = {
    foo : s;
  }
end
ocp-indent-1.8.2/tests/passing/types.ml000066400000000000000000000027361355404771200201060ustar00rootroot00000000000000type ('a, 'b) t
  = a : 'a
  -> ?b : b
  -> unit

type ('a, 'b) t =
  | A
  | B of ('a, 'b) t * 'k
  | C of 'a * 'b

type t = Foo
       | Bar
       | Baz

type t =
  | Foo
  | Bar
  | Baz

type t =
    Foo
  | Bar
  | Baz

type t = | Foo
         | Bar
         | Baz

type t = Foo | Bar
       | Baz

type t = {
  foo: int -> int;
  bar: 'a;
}

type t = {
  x: int;
}

type t = {
  x: int;
  y: int -> a:string -> ?b:(int -> string) -> unit;
  mutable
    z: int;
  mutable a:
    string -> unit A.t;
}

type t = {
  x: int
; y: int -> a:string -> ?b:(int -> string) -> unit
; mutable
  z: int;
  a: string ->
    unit A.t;
}

type t =
  {
    x: int
  ; y: int -> a:string -> ?b:(int -> string) -> unit
  ; mutable
    z: int;
    a: string ->
      unit A.t;
  }

type t =
  { x: int
  ; y: int -> a:string -> ?b:(int -> string) -> unit
  ; mutable
    z: int
  ; mutable a: string
      -> unit A.t
  }

type t = { x: int
         ; y: int -> a:string -> ?b:(int -> string) -> unit
         ; mutable
           z: int
         ; mutable a: string -> unit A.t
         }

type t = [
  | `a | `b
  | `c
]

type t =
  [
    `a
  | `b
  | `c
  ]

type t =
  [
    | `a
    | `b
    | `c
  ]

type t =
  [ `a
  | `b
  | `c
  ]

type t = [ `a
         | `b
         | `c
         ]

type t = [ `a | `b
         | `c
         ]

module M = struct
  type t = t0
  and t'
  and t'' = t
  val v: t
end

module Regression = struct
  let f : 'a.
    'a t * some_other_type
    -> result_type
    = body
end
ocp-indent-1.8.2/tests/passing/unit-classes.ml000066400000000000000000000041751355404771200213530ustar00rootroot00000000000000(** ocaml classes
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual017.html)
*)

(* class types *)

class type c =
  object
  end

class type c =
  M.cl

class type c =
  ['a, 'b] M.cl

class type c =
  object
    ('ty)
    inherit cl
    val mutable virtual
      var : bool
    method private bar1 x ~y : bool
    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t
    constraint
      'a = 'b
  end

(* class expressions *)

class c =
  ['a, 'b]
    M.cl

class c =
  fun a b ->
  object
  end

class c = object
  val x = true
end

class c =
  object
    (_ :
       'a)
    inherit Something.someclass
      as v
    val mutable
      var : bool
      = true
    val mutable virtual var2
      : string
    method private bar1 x ~y : bool =
      false
    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t
    constraint
      'a = 'b
    initializer
      z
  end

(* method specific expressions *)

let e =
  var <- true

let e =
  {< var = false;
     var2 = true;
  >}


(* class definitions *)

class cl =
  object
    val x = true
  end
and
  virtual ['a, 'b]
    cl2 x y :
  object
    val x : bool
  end = fun x y ->
  object
    val x : bool = true
  end

class cl
  : object end

class type virtual ['a] clty = object
  method x : int
end

(* objects *)
val a :
  < >
let () = ()

val a :
  < .. >
let () = ()

val a :
  < meth: int option;
    meth2: 'a. 'a option;
    meth3: 'a 'b. ('a,'b) Hashtbl.t >
let () = ()

val a :
  < meth: int option;
    meth2: 'a. 'a option;
    meth3: 'a 'b. ('a,'b) Hashtbl.t;
    .. >
let () = ()

(* #-types *)
val a :
  #M.meth

val a :
  'a#M.meth

val a :
  ('a,'b*'c)
  #M.meth

(* object types *)
type a =
  < >
let () = ()

type a =
  < .. >
let () = ()

type a =
  < meth: int option;
    meth2: 'a. 'a option;
    meth3: 'a 'b. ('a,'b) Hashtbl.t >
let () = ()

type a =
  < meth: int option;
    meth2: 'a. 'a option;
    meth3: 'a 'b. ('a,'b) Hashtbl.t;
    .. >
let () = ()

type t =
  < a : int; b:
      < a: int; b: < c:int > >
  >
let () = ()

type t =
  < a : int; b:
      < a: int; b: < c: int -> int> >;
    c: int
  >
let () = ()

type 'a t =
  | Bla : < x : int > t
  | Blo : < y : int > t
ocp-indent-1.8.2/tests/passing/unit-expr.ml000066400000000000000000000042421355404771200206670ustar00rootroot00000000000000(** ocaml expressions
    (http://caml.inria.fr/pub/docs/manual-ocaml/expr.html)
*)

let e =
  Array.make

let e =
  true

let e =
  (true)

let e =
  begin
    true
  end

let e =
  (true:
     bool)

let e =
  true,
  false,
  true

let e =
  Some
    true

let e =
  `_
    true

let e =
  true ::
  false ::
  true

let e =
  [ true;
    false;
    true;
  ]

let e =
  [| true;
     false;
     true
  |]

let e =
  { f1 = true;
    f2 = false;
    f3 = true;
  }

let e =
  { e with f1 = true;
           f2 = false;
  }

let e =
  f
    true
    false
    true

let e =
  !?
    true

let e =
  true
  || false
     && true

let e =
  1
  mod 1
  land 1
  lor 1
  lxor 1
       lsl 1
       lsr 1
       asr 1

let e =
  re.f1

let e =
  re.f1 <-
    true

let e =
  a.(0) <-
    true

let e =
  a.[0] <-
    true

let e =
  if
    true
  then
    false
  else
    true

let e =
  while
    true
  do
    ()
  done

let e =
  for x =
      a
    to
      b
  do
    ()
  done

let e =
  true;
  false;
  true

let e =
  match
    true
  with
  | true ->
    false
  | false
    ->
    true

let e = match
    true
  with
  | true ->
    false
  | false
    ->
    true

let e =
  function
  | true ->
    false
  | false
    ->
    true

let e =
  fun
    x
    ~ lbl1
    ~ ( lbl2 : int )
    ~lbl3: _a
    ? olbl1
    ? (olbl2 : 'a list = [])
    ?olbl3: _c
    ?olbl4: ( _d : bool = false )
    ()
    when
      true
    ->
      true

let e =
  fun x ->
  fun ~ lbl1 ->
  fun ~ ( lbl2 : int ) ->
  fun ~lbl3: _a ->
  fun ? olbl1 ->
  fun ? (olbl2 : 'a list = []) ->
  fun ?olbl3: _c
    when true
    ->
  fun ?olbl4: ( _d : bool = false ) ->
  fun ()
    when
      true
    ->
      true

let e
    x
    ~ lbl1
    ~ ( lbl2 : int )
    ~lbl3: _a
    ? olbl1
    ? (olbl2 : 'a list = [])
    ?olbl3: _c
    ?olbl4: ( _d : bool = false )
    ()
  =
  true

let e =
  try
    true
  with
  | Exit ->
    true
  | _ ->
    false

let e =
  let rec
    a =
    true
  and _b =
    false
  in
  true

let e =
  new
    foo

let foo =
  object
  end

let e =
  foo#
    bar1

let e =
  (true :>
     bool)

let e =
  (true :
     bool :>
     bool)

let e =
  assert
    true

let e =
  lazy
    true

ocp-indent-1.8.2/tests/passing/unit-extensions.ml000066400000000000000000000026771355404771200221220ustar00rootroot00000000000000(** ocaml language extensions
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual021.html)
*)

(* other integer literals *)
let i = 12l
        + 0l

let i = 12L
        + 0l

let i = 12n
        + 0n

(* range patterns *)
let f = function
  | 'a'..'z' ->
    e1
  | 'A'..'Z'
  | '0'..'9' ->
    e2

(* local modules *)
let f =
  let module M =
    F(struct end)
  in
  M.f x

(* recursive modules *)
module rec M : S =
struct
  ;;
end
and M1 : S1 =
struct
  ;;
end

(* private types *)
type t = private
    X of string
  | Y

type t = private
  { f1:t1;
    f2: t2 }

type t =
  private t'

(* local opens *)

let _ =
  let open
    F(X)
  in
  ()

(* record shortcuts *)
let _ =
  let x = 1 and y = 2
  in
  { x;
    y
  }

let f = function
  | { x;
      y;
      _
    } ->
    ()

(* locally abstract types *)
let f = fun
  (type t)
  (x: t)
  ->
    ()

let f
    (type t)
    (x: t)
  =
  ()

(* first-class modules *)
type m =
  (module M.Sig
    with type t = 'b)
  * unit

let x =
  let m =
    (module M : M.Sig
      with type t = 'b)
  in
  let module M =
    (val m :
      M.sig
     with type t = 'b)
  in
  M

(* module type of *)
module type S = sig
  include module type of M
end

(* signature substitution *)
module type S = sig
  include
    M0 with type t := t
  val x : unit
end

(* class overriding *)
class cl = object
  inherit!
      cl
  val! v = v
  method! m = m
end

(* GADTs *)
type _ t =
    A: int t
  | B: 'a t * 'b t -> ('a*'b) t


ocp-indent-1.8.2/tests/passing/unit-lex.ml000066400000000000000000000032161355404771200205010ustar00rootroot00000000000000(* -*- encoding: iso-8859-1 -*- *)

(** ocaml lexical conventions
    (http://caml.inria.fr/pub/docs/manual-ocaml/lex.html)
*)

(*
 *** literals ***
*)

(* identifiers *)
let _id,
    iD',
    I9,
    _'i,
    A_',
    u',
    éçèæùà (* this file must be iso-8859-1 *)
  =
  _
;;

(* intergers *)
let _ =
  -1
  + 0
  + 10_
  + -0xAFfe_0 + 0X1_
  + 0O7_0_1_2 + -0o12__
  - 0B0_1_0 + -0b111_
;;

(* floats *)
let _ =
  0. +.
  0.0 +.
  0e12 +.
  0.e1_ +.
  999e+1 +.
  -9_99_E-0 +.
  -.12. +.
  0_._e-1_2
;;

(* chars *)
[ 'a';
  '&';
  'Ç';
  '§';
  '\\';
  '\"';
  '\'';
  '\b';
  '\234';
  '\999'; (* wrong, but yet... *)
  '\xAF' ]
;;

(* strings *)
let _ = "'a';\n\
        \ '&';\
         'Ç';\
         '§';\
         '\\';\
         '\"';\
         '\'';\
         '\b';\
         '\234';\
         '\999'; (* wrong, but yet... *)\
         '\xAF'"
;;

(* naming labels *)
val f :
  _l1 : int ->
  ? _' : float ->
  'a
let rec f
    ~ _l1 : int
    ? _' : float =
  f ~_l1: 0 ?_': 0e1
;;

(* prefix and infix symbols *)
_ = _
<:~ _
> _
  @ _
  ^$ _
     %%
;;

!! ( ????: _ )

(* keywords *)
(* don't care about indentation, just should'nt crash :) *)
and as assert asr begin class
constraint do done downto else end
exception external false for fun function
    functor if in include inherit initializer
  land lazy let lor lsl lsr
  lxor match method mod module mutable
  new object of open or private
  rec sig struct then to true
    try type val virtual when while
with
;;

(* line number directives *)
(* should be ignored and not indented: we may still want to indent generated
   code for readability *)
#9999 "bla.ml\ \n\999"
let _ =
#9999 "bla.ml\ \n\999"
  0
ocp-indent-1.8.2/tests/passing/unit-modexpr.ml000066400000000000000000000011131355404771200213610ustar00rootroot00000000000000(** ocaml module expressions
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual019.html)
*)

module M =
struct
end

module M = struct
  ;;
end

module M =
  functor (M1 : T1) -> functor (M2 : T2) ->
  struct
  end

module M = functor (M1 : T1) -> functor (M2 : T2) ->
struct
end

module M =
  functor (M1 : T1) ->
  functor (M2 : T2) ->
  struct
  end

module M =
  functor
    (M1 : T1) ->
  functor
    (M2 : T2) ->
  struct
  end

module M =
  F
    (X)
    (Y)

module M = (
struct
end :
sig
end
)

module M :
  Sig
=
struct
end

module M
    (X1: T1)
    (X2: T2) =
struct end

ocp-indent-1.8.2/tests/passing/unit-modtypes.ml000066400000000000000000000014231355404771200215530ustar00rootroot00000000000000(** ocaml module types
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual018.html)
*)

module type T =
  M.T

module type T =
sig
end

module type T = sig
  ;;
end

module type T =
  functor (M : T) ->
  functor (M1 : T1) ->
  sig
  end

module type T =
sig end
with type 'a t = 'b
 and module M = M'.MF(X)
 and type t' = t''

module type T = (
sig
end
)

module type T =
sig
  val v :
    t

  external x : 'a =
    "stub"

  type t =
    int
  and t2 =
    t

  exception Error
    of int

  class virtual ['a] cl :
    object
    end
  and cl2 :
    object
    end

  class type clt =
    object
    end
  and ['a] clt2 =
    object
    end

  module M :
    Sig

  module M (X) (Y):
    Sig

  module type Sig

  module type Sig1 =
  sig
  end

  open
    M

  include
    M
end
ocp-indent-1.8.2/tests/passing/unit-patterns.ml000066400000000000000000000007531355404771200215540ustar00rootroot00000000000000(** ocaml patterns
    (http://caml.inria.fr/pub/docs/manual-ocaml/patterns.html)
*)

let _ = function

    x -> () |

    _ -> () |

    'a'  -> () |

    x as y -> () |

    (x: 'a -> 'b) -> () |

    x | y  -> () |

    Some x -> () |

    `Var x -> () |

    #ty -> () |

    x, y -> () |

    { f1 = x;
      f2 = y;
      f3 = z;
      _
    } -> () |

    [ x;
      y;
      z;
    ] -> () |

    x::y
    :: z -> () |

    [| x;
       y;
       z;
    |] -> () |

    lazy w -> ()
ocp-indent-1.8.2/tests/passing/unit-typedefs.ml000066400000000000000000000012631355404771200215340ustar00rootroot00000000000000(** ocaml type and exception definitions
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual016.html)
*)

type
  t

type
  'a t

type
  +'_a t

type
  -'a t

type
  ('a,
   +'b,
   (-'c,-'d))
    t

type t =
  t2

type t =
    A

type t =
    A
  | B of 'a
  | C of 'a * 'b
  | D of ('a) Array.t * 'b list
  | E of _

type t =
  { f1 : t1;
    f2 : 'a;
    mutable f3: t2;
    f4 :
      'a 'b.t2;
  }

type 'a t
  constraint 'a = t
  constraint 'b = 'a

type
  ('a,
   +'b,
   (-'c,-'d))
    t
  =
  { f1 : t1;
    f2 : 'a;
    mutable f3: t2;
    f4 :
      t1 * t2;
  }
  constraint 'a = t
  constraint 'b = 'a


exception
  E

exception
  E of
    'a t * string

exception
  E' =
  E
ocp-indent-1.8.2/tests/passing/unit-types.ml000066400000000000000000000022151355404771200210530ustar00rootroot00000000000000(** ocaml type expressions
    (http://caml.inria.fr/pub/docs/manual-ocaml/types.html)
*)

(* variables *)
val a :
  'ident

val a :
  _

(* parentheses *)
val a :
  ( t )

(* functions *)
val a :
  int ->
  int ->
  t
  -> t
  -> t

val a :
  lab1: int
  -> lab2 :
       (t)
  -> t

val a :
  ? lab1:
    ( ?_ : int -> t )
  -> t

(* tuples *)
val a :
  (t1 * t2) * (
    t
  )

(* constructed *)
val a :
  int

val a :
  ('a -> 'b) Array.t


(* aliased *)
val a :
  int
  as 'bla

(* polymorphic variants *)
val a :
  [ `_ | `_' |
    `_00 |
    `Aa of int
  ]

val a : [
  | `_ | `_' |
    `_00 |
    `Aa of int
]

val a : [<
  `_ | `_' |
  `_00 |
  `Aa of int
]

val a :
  [
    | `_ | `_' |
      `_00 |
      `Aa of int
  ]

val a : [<
  | `Bb of int
           & string
           & t |
    int >
      `a `_bbb
      `c `d
]

(* objects *)
val a :
  < >

val a :
  < .. >

val a :
  < meth: int option;
    meth2: 'a. 'a option;
    meth3: 'a 'b. ('a,'b) Hashtbl.t >

val a :
  < meth: int option;
    meth2: 'a. 'a option;
    meth3: 'a 'b. ('a,'b) Hashtbl.t;
    .. >

(* #-types *)
val a :
  #M.meth

val a :
  'a#M.meth

val a :
  ('a,'b*'c)
  #M.meth
ocp-indent-1.8.2/tests/passing/unit-values.ml000066400000000000000000000020061355404771200212040ustar00rootroot00000000000000(** ocaml values
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual010.html)
*)

(* base values *)
let i32 = −1073741824, 1073741823
let i32_over = −1073741825, 1073741824
let i32_over_big = −10737418240, 10737418230
let i64 = -4611686018427387904, 4611686018427387903
let i64_over = -4611686018427387905, 4611686018427387904
let i64_over_big = -46116860184273879040, 46116860184273879030

let f = 4611686018427387903e-1022, 4611686018427387903e+1023
let f_over = 4611686018427387903e-1023, 4611686018427387903e+1024

(* tuples *)
let _ = (1, 2, 3, 4, 5,
         1, 2, 3, 4, 5
        , 1, 2, 3, 4, 5)

(* records *)
let _ = { f1 = 12; f2 = 13;
          f3 = 14; f4 = 15;
          f5 = 14; f6 = 15;
          f7 = 14; f8 = 15;
        }
let _ = { f1 = 12; f2 = 13;
          M_.f3 = 14; M.f4 = 15;
          M'.M3.f5 = 14; Mz.MM.f6 = 15;
          Mg.f7 = 14; Fe.f8 = 15
        }
;;

(* arrays *)
[| 5;468; 68;46;84;684;68;4;
   54;354;384;3;0;76;64;0;6;
   54;354;384;3;0;76;64;0;6;
   54;354;384;3;0;76;64;0;6;
|]
ocp-indent-1.8.2/tests/passing/variants.ml000066400000000000000000000005461355404771200205660ustar00rootroot00000000000000type t = [ `aaa
         | `bbb
         | `ccc
         ]

type t = [ `aaa | `bbb
         | `ccc
         ]

type t =
  [ `aaa
  | `bbb
  | `ccc
  ]

type t =
  [ `aaa | `bbb
  | `ccc
  ]

type t =
  [
    `aaa
  | `bbb
  | `ccc
  ]

type t =
  [
    `aaa | `bbb
  | `ccc
  ]

type t = [
    `aaa
  | `bbb
  | `ccc
]

type t = [
    `aaa | `bbb
  | `ccc
]
ocp-indent-1.8.2/tests/passing/with_2.ml000066400000000000000000000006271355404771200201330ustar00rootroot00000000000000let x =
  try y with
    | A -> _
    | B -> _

let x = try y with
  | A -> _
  | B -> _

let x =
  try y with
      A -> _
    | B -> _

let x = try y with
    A -> _
  | B -> _

let _ =
  let x =
    try y with
      | A -> _
      | B -> _
  in
  let x = try y with
    | A -> _
    | B -> _
  in
  let x =
    try y with
        A -> _
      | B -> _
  in
  let x = try y with
      A -> _
    | B -> _
ocp-indent-1.8.2/tests/passing/with_2.ml.opts000066400000000000000000000000121355404771200211030ustar00rootroot00000000000000-c with=2
ocp-indent-1.8.2/tests/passing/with_never.ml000066400000000000000000000014321355404771200211040ustar00rootroot00000000000000let f x = match x with
| `A -> "A"
| `B -> "B"

let f = function
| `A -> "A"
| `B -> "B"

let f = fun x -> match x with
| `A -> "A"
| `B -> "B"

let f = 
  let g x = match x with
  | `A -> "A"
  | `B -> "B"
  in
  g

let f = 
  let g = function 
  | `A -> "A"
  | `B -> "B"
  in
  g

let f = 
  let g = fun x -> match x with
  | `A -> "A"
  | `B -> "B"
  in
  g

let z =
  begin match
    x
  with
  | X -> x
  end

let config_converter =
  (fun str -> try (* just check syntax *)
     ignore (IndentConfig.update_from_string IndentConfig.default str);
     `Ok str
   with Invalid_argument s -> `Error s),
  ignore (IndentConfig.update_from_string IndentConfig.default str);
  `Ok str

let f =
  try match a
  with B -> x
  with C -> y

let g =
  try match X with
  | X -> X
  with
  | X -> Y
ocp-indent-1.8.2/tests/passing/with_never.ml.opts000066400000000000000000000000351355404771200220660ustar00rootroot00000000000000-c with=0,strict_with=always
ocp-indent-1.8.2/tests/test.sh000077500000000000000000000234341355404771200162600ustar00rootroot00000000000000#!/bin/bash -ue
#
# Copyright 2012-2013 OCamlPro
#
# All rights reserved.This file is distributed under the terms of the
# GNU Lesser General Public License version 2.1 with linking
# exception.
#
# TypeRex is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# Lesser GNU General Public License for more details.
#

shopt -s nullglob

ROOT=$(git rev-parse --show-toplevel | tr -d '\r')
OCP_INDENT=$ROOT/_build/install/default/bin/ocp-indent
cd $ROOT/tests

UPDATE=
GIT=
SHOW=
SHOWCMD=
HTML=

usegit() {
    printf "%-12s\t\e[34mgit %s\e[m\n" "" "$*";
    git "$@";
}

is_file_on_git() {
    [ $# -eq 1 ]; f=$1
    git ls-files $f --error-unmatch >/dev/null 2>&1
}

while [ $# -gt 0 ]; do
    case "$1" in
        --update|-u)
            UPDATE=1
            ;;
        --git-update)
            if ! git diff --ignore-cr-at-eol --exit-code -- . >/dev/null; then
                echo -e "\e[1mWarning:\e[m unstaged changes in tests/"
                echo "You may want to do 'git checkout -- tests/' or"\
                     "'git add -u -- tests/' first."
                exit 1
            fi
            UPDATE=1
            GIT="usegit "
            HTML=1
            ;;
        --ocp-indent)
            if [ $# -le 1 ]; then echo "Error: $1 needs an argument"; exit 1; fi
            shift;
            OCP_INDENT=$1
            ;;
        --show)
            SHOW=1
            ;;
        --meld)
            SHOW=1
            SHOWCMD="meld"
            ;;
        --html)
            HTML=1
            ;;
        *)
            cat </dev/stderr
Usage:
  -u --update         update the files according to the current results
  --git-update        update the files and state the changes in git
  --ocp-indent   use this ocp-indent exe
  --show              show a diff of changed results
  --meld              show progressions/regressions using meld
  --html              generate an html page showing the diff of failing tests
EOF
            exit 1
    esac
    shift
done

TMP=$(mktemp -d /tmp/ocp-indent-test.XXXXX)
trap "rm -rf /tmp/ocp-indent-${TMP#/tmp/ocp-indent-}" EXIT

ocp-indent() {
    [ $# -eq 1 ]
    opts=$(cat $1.opts 2>/dev/null || true)
    "$OCP_INDENT" $opts "$1" >$TMP/$(basename $1) 2>&1 || true
}

ocp-indent-i() {
    [ $# -eq 1 ]
    opts=$(cat $1.opts 2>/dev/null || true)
    "$OCP_INDENT" "-i" $opts "$1" >/dev/null 2>&1 || true
}



reffile() {
    [ $# -eq 1 ]
    if [ -e "$1.ref" ]
    then echo "$1.ref"
    else echo "$1"
    fi
}

PASSING=("")
FAILING=("")
INPLACE=("")
if [ -n "$GIT" ]; then
    PASSING+=($(git ls-files 'passing/*.ml' 'passing/*.ml[iyl]'))
    FAILING+=($(git ls-files 'failing/*.ml' 'failing/*.ml[iyl]'))
    INPLACE+=($(git ls-files 'inplace/*.ml' 'inplace/*.ml[iyl]'))
else
    PASSING+=(passing/*.ml passing/*.ml[iyl])
    FAILING+=(failing/*.ml failing/*.ml[iyl])
    INPLACE+=(inplace/*.ml inplace/*.ml[iyl])
fi
CHANGES=()


for f in ${PASSING[@]}; do
    base=$(basename $f)
    name=${base%.*}
    ocp-indent $f
    if diff --strip-trailing-cr -q "$(reffile "$f")" $TMP/$base >/dev/null; then
        printf "%-12s\t\e[32m[PASSED]\e[m\n" $name
    else
        printf "%-12s\t\e[31m[FAILED]\e[m \e[41m\e[30m[REGRESSION]\e[m\n" $name
        if [ -n "$UPDATE" ]; then
            mkdir -p failing
            $GIT mv -f $f* failing/
            f=failing/${f#passing/}
            mkdir -p failing-output
            cp $TMP/$base failing-output/
            if [ -n "$GIT" ]; then $GIT add failing-output/$base; fi
        fi
        CHANGES+=($f)
    fi
done

for f in ${FAILING[@]}; do
    base=$(basename $f)
    name=${base%.*}
    ocp-indent $f
    if diff --strip-trailing-cr -q $(reffile $f) $TMP/$base >/dev/null; then
        printf "%-12s\t\e[32m[PASSED]\e[m \e[42m\e[30m[PROGRESSION]\e[m\n" $name
        if [ -n "$UPDATE" ]; then
            $GIT mv -f $f* passing/
            $GIT rm -f failing-output/$base
        fi
    elif [ ! -e failing-output/$base ]; then
        printf "%-12s\t\e[33m[FAILED]\e[m \e[43m\e[30m[NEW]\e[m\n" $name
        cp $TMP/$base failing-output/
        if [ -n "$GIT" ]; then $GIT add failing-output/$base; fi
    elif diff --strip-trailing-cr -q $TMP/$base failing-output/$base >/dev/null; then
        printf "%-12s\t\e[33m[FAILED]\e[m\n" $name
        if [ -n "$GIT" ] && ! is_file_on_git failing-output/$base; then
            $GIT add failing-output/$base; fi
    else
        refcount=$(diff --strip-trailing-cr -y --suppress-common-lines \
            $(reffile $f) failing-output/$base \
            |wc -l)
        curcount=$(diff --strip-trailing-cr -y --suppress-common-lines \
            $(reffile $f) $TMP/$base \
            |wc -l)
        progress=$((refcount - curcount))
        printf "%-12s\t\e[33m[FAILED]\e[m \e[%dm\e[30m[CHANGE: %+d]\e[m\n" \
            $name \
            $(if [ $progress -gt 0 ]; then echo 42; \
              elif [ $progress -eq 0 ]; then echo 43; \
              else echo 41; fi) \
            $progress
        if [ -n "$UPDATE" ]; then
            mkdir -p failing-output
            cp $TMP/$base failing-output/
            if [ -n "$GIT" ]; then $GIT add failing-output/$base; fi
        fi
        CHANGES+=($f)
    fi
done

for f in ${INPLACE[@]}; do
    base=$(basename $f)
    name=${base%.*}
    if [ -L $f ]; then
	dest=$(readlink $f)
	ocp-indent-i $f
	if [ -L $f -a $(readlink $f) = $dest ]; then
	    printf "%-12s\t\e[32m[PASSED]\e[m\n" $name
	else
	    printf  "%-12s\t\e[31m[FAILED]\e[m (nothing will be put in CHANGES)\n" $name
	    rm -f $f
	    ln -s $dest $f
	fi
    else
	perm=$(stat -c '%a' $f)
	ocp-indent-i $f
	if [ $(stat -c '%a' $f) = $perm ]; then
	    printf "%-12s\t\e[32m[PASSED]\e[m\n" $name
	else
	    printf  "%-12s\t\e[31m[FAILED]\e[m (nothing will be put in CHANGES)\n" $name
	    chmod $perm $f
	fi
    fi
done

if [ -n "$SHOW" ] && [ ${#CHANGES[@]} -gt 0 ]; then
    if [ -z "$SHOWCMD" ]; then
        for f in ${CHANGES[@]}; do
            echo
            printf "\e[1m=== Showing differences in %s ===\e[m\n" $f
            # Custom less buggy version of colordiff -y
            diff --strip-trailing-cr -W 130 -ty  $(reffile $f) $TMP/$(basename $f) \
                | awk '/^.{64}[^ ].*/ { printf "%s\n",$0; next } 1' \
                || true
        done
    else
        echo
        echo "Meld view:"
        echo "[reference] [new result] [registered]"
        echo "You can update reference and registered status from meld"
        cmd=(meld)
        for f in ${CHANGES[@]}; do
            cur=failing-output/$(basename $f)
            if ! [ -e $cur ]; then cur=; fi
            cmd+=(--diff $(reffile $f) $TMP/$(basename $f) $cur)
        done
        ${cmd[*]}
    fi
elif [ -n "$SHOW" ]; then
    echo
    echo "No changes to show. To check the current failures use for example:"
    echo "  meld tests/failing tests/failing-output"
fi

diff2html() {
    f1=$1; shift
    f2=$1; shift
    [ $# -eq 0 ]

    echo "
    "
    echo "
    Differences in $(basename $f1)
    "
    echo ""
    echo ""

    {
        line=0
        XIFS="$IFS"
        IFS=
        while read -r l1; do
            read -r l2 <&3 || true
            class="correct"
            if [ "$l1" != "$l2" ]; then
                class="different"
                l1=$(sed 's/ /·/g' <<<"$l1")
                l2=$(sed 's/ /·/g' <<<"$l2")
            fi
            echo -n ''
            echo -n ''
            echo -n ''
            echo -n ''
            echo    ''
            : $((line++))
        done
        while read -r l2 <&3; do
            l2=$(sed 's/ /·/g' <<<"$l2")
            echo -n ''
            echo -n ''
            echo -n ''
            echo -n ''
            echo    ''
            : $((line++))
        done
        IFS="$XIFS"
    } <$f1 3<$f2

    echo "
    ExpectedOcp-indent output
    '$line'
    '"$l1"'
    '"$l2"'
    '$line'
    '"$l2"'
    "
    echo "
    "
}

if [ -n "$HTML" ]; then
    VERSION=$($OCP_INDENT --version | awk '{ print $NF; exit }')
    if COMMITS_SINCE=$(git log --oneline $VERSION.. 2>/dev/null); then
        VERSION="$VERSION+$((1+$(wc -l <<<"$COMMITS_SINCE")))"
    fi
    VERSION_STRING="$VERSION ($(date +%F))"
    echo
    echo -n "Generating summary of failures tests/failing.html..."
    cat < failing.html



    Failing tests, ocp-indent version $VERSION_STRING
    
    



    Failing tests, ocp-indent version $VERSION_STRING
    
EOF
    complete_success="1"
    for f in $(git ls-files 'failing/*.ml'); do
        complete_success=
        diff2html "$(reffile $f)" "failing-output/${f#failing/}" \
            >>failing.html
        echo -n "."
    done
    if [ -n "$complete_success" ]; then
        echo "
    All tests pass: no currently known bugs.
    " >>failing.html
    fi
    cat <>failing.html


EOF

    echo " done"
    if [ -n "$GIT" ]; then $GIT add failing.html; fi
fi

exit ${#CHANGES[@]}
ocp-indent-1.8.2/tools/000077500000000000000000000000001355404771200147325ustar00rootroot00000000000000ocp-indent-1.8.2/tools/dune000066400000000000000000000002231355404771200156050ustar00rootroot00000000000000(install
 (section share_root)
 (files
  (ocp-indent.el as emacs/site-lisp/ocp-indent.el)
  (ocp-indent.vim as ocp-indent/vim/indent/ocaml.vim))
)
ocp-indent-1.8.2/tools/ocp-indent.el000066400000000000000000000126231355404771200173200ustar00rootroot00000000000000;;; ocp-indent.el --- automatic indentation with ocp-indent
;;
;; Copyright 2012-2013 OCamlPro

;; Keywords: ocaml languages
;; URL: http://www.typerex.org/ocp-indent.html

;; All rights reserved.This file is distributed under the terms of the
;; GNU Lesser General Public License version 2.1 with linking
;; exception.

;; TypeRex is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; Lesser GNU General Public License for more details.
;;

;;; Commentary:

;; Description:
;; ocp-indent is a simple tool and library to indent OCaml code.

;; Installation:
;; You need ocp-indent installed on you system to work.

;; Usage:
;; Eval this file to automatically use ocp-indent on caml/tuareg buffers.

;;; Code:

(require 'cl)

(defgroup ocp-indent nil
  "ocp-indent OCaml indenter binding configuration"
  :group 'languages)

(defcustom ocp-indent-path "ocp-indent"
  "*Path to access the ocp-indent command"
  :group 'ocp-indent :type '(file))

(defcustom ocp-indent-config nil
  "*Ocp-indent config string, as for its --config option.
WARNING: DEPRECATED, this will override any user or project
ocp-indent configuration files"
  :group 'ocp-indent
  :type '(choice (const nil) (string)))

(defcustom ocp-indent-syntax nil
  "*Enabled syntax extensions for ocp-indent (see option --syntax)"
  :group 'ocp-indent
  :type '(repeat string))

(defcustom ocp-indent-allow-tabs nil
  "*Allow indent-tabs-mode in ocaml buffers. Not recommended, won't work well."
  :group 'ocp-indent
  :type '(bool))

(defcustom ocp-indent-untabify nil
  "Send the buffer `untabify'ed to ocp-indent. Allows partial
indent even with tabs present.

Tabs are not replaced in the buffer except on lines getting an
indentation change."
  :group 'ocp-indent
  :type '(bool))

(defun ocp-in-indentation-p ()
  "Tests whether all characters between beginning of line and point
are blanks."
  (save-excursion
    (skip-chars-backward " \t")
    (bolp)))

(defun ocp-indent-args (start-line end-line)
  (append
   (list "--numeric"
         "--lines" (format "%d-%d" start-line end-line))
   (if ocp-indent-config (list "--config" ocp-indent-config) nil)
   (reduce (lambda (acc syn) (list* "--syntax" syn acc))
           ocp-indent-syntax :initial-value nil)))

(defun ocp-indent-file-to-string (file)
  (replace-regexp-in-string
   "\n$" ""
   (with-temp-buffer (insert-file-contents file)
                     (buffer-string))))

(defmacro ocp-indent--with-untabify (&rest body)
  "If there are tabs and `ocp-indent-untabify', create a
temporary buffer containing the current buffer's contents
untabified and evaluate BODY there like `progn'. See also
`with-temp-buffer'. Otherwise evaluate BODY in the current
buffer."
  (declare (indent 0) (debug t))
  (let ((buf (make-symbol "buf")))
    `(if (not (and ocp-indent-untabify
                   (save-excursion (goto-char (point-min)) (search-forward "\t" nil t))))
         (progn ,@body)
       (let ((,buf (generate-new-buffer " *ocp-indent*")))
         (unwind-protect
             (progn
               (copy-to-buffer ,buf (point-min) (point-max))
               (with-current-buffer ,buf
                 (untabify (point-min) (point-max))
                 (progn ,@body)))
           (and (buffer-name ,buf) (kill-buffer ,buf)))))))

(defun ocp-indent-region (start end)
  (interactive "r")
  (let*
      ((start-line (line-number-at-pos start))
       (end-line (line-number-at-pos end))
       (errfile (make-temp-name (concat temporary-file-directory "ocp-indent-error")))
       (indents-str
        (with-output-to-string
          (ocp-indent--with-untabify
            (if (/= 0
                    (apply 'call-process-region
                           (point-min) (point-max) ocp-indent-path nil
                           (list standard-output errfile) nil
                           (ocp-indent-args start-line end-line)))
                (error "Can't indent: %s returned failure" ocp-indent-path)))))
       (indents (mapcar 'string-to-number (split-string indents-str))))
    (when (file-exists-p errfile)
      (message (ocp-indent-file-to-string errfile))
      (delete-file errfile))
    (save-excursion
      (goto-char start)
      (mapcar
       #'(lambda (indent) (indent-line-to indent) (forward-line))
       indents))
    (when (ocp-in-indentation-p) (back-to-indentation))))

(defun ocp-indent-line ()
  (interactive nil)
  (ocp-indent-region (point) (point)))

(defun ocp-indent-buffer ()
  (interactive nil)
  (ocp-indent-region 0 (buffer-size)))

;;;###autoload
(defun ocp-setup-indent ()
  (interactive nil)
  (let ((buffer-extension (and (buffer-file-name)
                               (file-name-extension (buffer-file-name)))))
    (unless (string= buffer-extension "mly")
      (unless ocp-indent-allow-tabs (set 'indent-tabs-mode nil))
      (when (string= buffer-extension "mll")
        (set (make-local-variable 'ocp-indent-syntax)
             (cons "mll" ocp-indent-syntax)))
      (set (make-local-variable 'indent-line-function) #'ocp-indent-line)
      (set (make-local-variable 'indent-region-function) #'ocp-indent-region))))

;;;###autoload
(defun ocp-indent-caml-mode-setup ()
  (ocp-setup-indent)
  (local-unset-key "\t"))  ;; caml-mode rebinds TAB !

(add-hook 'tuareg-mode-hook 'ocp-setup-indent t)

(add-hook 'caml-mode-hook 'ocp-indent-caml-mode-setup  t)

(provide 'ocp-indent)

;;; ocp-indent.el ends here
ocp-indent-1.8.2/tools/ocp-indent.vim000066400000000000000000000026471355404771200175200ustar00rootroot00000000000000" Only load this indent file when no other was loaded.
if exists("b:did_indent")
  finish
endif
let b:did_indent = 1

setlocal expandtab
setlocal indentkeys+=0=and,0=class,0=constraint,0=done,0=else,0=end,0=exception,0=external,0=if,0=in,0=include,0=inherit,0=initializer,0=let,0=method,0=open,0=then,0=type,0=val,0=with,0;;,0>\],0\|\],0>},0\|,0},0\],0)
setlocal nolisp
setlocal nosmartindent
setlocal indentexpr=GetOcpIndent(v:lnum)

" Comment formatting
if !exists("no_ocaml_comments")
 if (has("comments"))
   setlocal comments=sr:(*,mb:*,ex:*)
   setlocal fo+=cqor
 endif
endif

" Only define the function once.
if exists("*GetOcpIndent")
 finish
endif

" Indents are cached for the current buffer; they are only re-used when
" indenting lines in sequence and the buffer was unchanged.
let s:indents = []
let s:buffer = -1
let s:tick = -1
let s:lnum = -1

function! GetOcpIndent(lnum)
  if s:buffer == bufnr('') && s:tick == b:changedtick && s:lnum < a:lnum && match(getline(s:lnum + 1, a:lnum - 1),'.') == -1
    " Only use cache if there are only blank lines in-between
    call remove(s:indents, 0, a:lnum - s:lnum - 1)
  else
    " Compute indentation from current line on
    let cmdline = "ocp-indent --numeric --indent-empty --lines " . a:lnum . '-'
    let s:indents = split(system(cmdline, getline('1','$')))
    let s:buffer = bufnr('')
    let s:tick = b:changedtick
  endif
  let s:lnum = a:lnum

  return s:indents[0]
endfunction
ocp-indent-1.8.2/tools/tuareg-indent000077500000000000000000000054501355404771200174320ustar00rootroot00000000000000#!/bin/bash -ue
#
# Copyright 2012-2013 OCamlPro
#
# All rights reserved.This file is distributed under the terms of the
# GNU Lesser General Public License version 2.1 with linking
# exception.
#
# TypeRex is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# Lesser GNU General Public License for more details.
#

ocp-config-to-tuareg() {
    while [ $# -gt 0 ]; do
        case $1 in
            -c)
                shift
                local c="normal,$1"
                c=$(sed 's/normal/base=2,type=2,in=0,with=0,match_clause=2/' <<<"$c")
                c=$(sed 's/JaneStreet/base=2,type=0,in=0,with=0,match_clause=2/' <<<"$c")
                awk 'BEGIN { RS=","; FS="=" } { print $1,$2 }' <<<"$c" | {
                    while read var val; do
                        case "$var" in
                            "base")         echo "(setq tuareg-default-indent $val)";;
                            "type")         echo "(setq tuareg-type-indent $val)";;
                            "in")           echo "(setq tuareg-in-indent $val)";;
                            "with")         echo "(setq tuareg-with-indent $val)";;
                            "match_clause") echo "(setq tuareg-match-clause-indent $((val-1)))";;
                            "") ;;
                            *)
                                echo "Error: config option not understood by tuareg conversion: '$var'" >&2
                        esac
                    done
                }
                ;;
            *)
                echo "Error: config parameter not understood by tuareg conversion: '$1'" >&2
        esac
        shift
    done
}
tuareg-indent() {
    local f=$1; shift
    local config=$(ocp-config-to-tuareg $*)
    # At Jane Street, and perhaps other sites, Tuareg is found via the
    # user's ~/.emacs, rather than in a standard location in /usr.  We
    # may also wish to compare against standard or custom user config.
    if [ -n "${TUAREG_INDENT_USE_USER_DOT_EMACS+set}" ]; then
        local tuareg=${TUAREG_INDENT_USE_USER_DOT_EMACS:-$HOME/.emacs}
    else
        local tuareg=$(
            ls /usr/share/emacs*/site-lisp/tuareg-mode/tuareg.elc 2>/dev/null \
                || ls /usr/share/emacs/site-lisp/tuareg-mode/tuareg.el
        )
    fi
    emacs $f -Q -batch --eval '
      (progn
        (load-file "'"$tuareg"'")
        (tuareg-mode)
        '"$config"'
        (setq indent-tabs-mode nil)
        (indent-region (point-min) (point-max))
        (set-visited-file-name "/dev/stdout")
        (save-buffer 0))
    ' 2>/dev/null || true
}

# Note: This will whitespace-split individual arguments.
args=
while [ $# -gt 1 ]; do args="$args $1"; shift; done
file=$1

tuareg-indent "$file" $args