pax_global_header00006660000000000000000000000064133745572670014535gustar00rootroot0000000000000052 comment=6e6ff005fc1692489fa80767a23bc381ebc987e1 ocp-indent-1.7.0/000077500000000000000000000000001337455726700136025ustar00rootroot00000000000000ocp-indent-1.7.0/.gitignore000066400000000000000000000004411337455726700155710ustar00rootroot00000000000000.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.7.0/.ocp-indent000066400000000000000000000077501337455726700156540ustar00rootroot00000000000000# -*- 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.7.0/CHANGELOG000066400000000000000000000104271337455726700150200ustar00rootroot00000000000000## 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.7.0/LICENSE000066400000000000000000002267121337455726700146210ustar00rootroot00000000000000All files in this repository are distributed under GNU LESSER GENERAL PUBLIC LICENSE v2.1 with STATIC LINKING EXCEPTION as written below. If you wish to get copies of this software, either source or binary, under other licenses, please contact us at . If you want to contribute to this software, before sending your patches to OCamlPro's online versioned source repositories, you should send us by email a signed version of OCamlPro Contributor License Agreement, either Individual (if you are contributing outside of any corporate entity) or Corporate. Both CLAs can be find at the end of this file. ======================================================================= STATIC LINKING EXCEPTION As a special exception to the GNU Lesser General Public License, you may link, statically or dynamically, a "work that uses the library" with a publicly distributed version of the library to produce an executable file containing portions of the library, 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 the library", we mean either the unmodified library as distributed by OCamlPro, or a modified version of the library 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 GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, 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 them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If 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 convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU 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 Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program 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 General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . ======================================================================== 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. GNU LESSER GENERAL PUBLIC LICENSE 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. Copyright (C) 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. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! ======================================================================= OCAMLPRO INDIVIDUAL CONTRIBUTOR LICENSE AGREEMENT http://www.ocamlpro.com/files/CLA-OCamlPro-individual.txt In order to clarify the intellectual property license granted with Contributions from any person or entity, OCamlPro SAS ("OCamlPro") must have a Contributor License Agreement ("CLA") on file that has been signed by each Contributor, indicating agreement to the license terms below. This license is for your protection as a Contributor as well as the protection of OCamlPro; it does not change your rights to use your own Contributions for any other purpose. If you have not already done so, please send a message to cla@ocamlpro.com with the following content: -------------------------------------------------------- BEGIN EMAIL I agree with the Contributor License Agreement in http://www.ocamlpro.com/files/CLA-OCamlPro-individual.txt that I have read carefully. FULL NAME: _______________ EMAIL: _____@_________ MAILING ADDRESS: ______________________________ ______________________________ ______________________________ COUNTRY: PHONE: -------------------------------------------------------- END EMAIL You accept and agree to the following terms and conditions for Your present and future Contributions submitted to OCamlPro. Except for the license granted herein to OCamlPro and recipients of software distributed by OCamlPro, You reserve all right, title, and interest in and to Your Contributions. 1. Definitions. "You" (or "Your") shall mean the copyright owner or legal entity authorized by the copyright owner that is making this Agreement with OCamlPro. For legal entities, the entity making a Contribution and all other entities that control, are controlled by, or are under common control with that entity are considered to be a single Contributor. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "Contribution" shall mean any original work of authorship, including any modifications or additions to an existing work, that is intentionally submitted by You to OCamlPro for inclusion in, or documentation of, any of the products owned or managed by OCamlPro (the "Work"). For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to OCamlPro or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, OCamlPro for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by You as "Not a Contribution." 2. Grant of Copyright License. Subject to the terms and conditions of this Agreement, You hereby grant to OCamlPro and to recipients of software distributed by OCamlPro a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, sublicense, and distribute Your Contributions and such derivative works. 3. Grant of Patent License. Subject to the terms and conditions of this Agreement, You hereby grant to OCamlPro and to recipients of software distributed by OCamlPro a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by You that are necessarily infringed by Your Contribution(s) alone or by combination of Your Contribution(s) with the Work to which such Contribution(s) was submitted. If any entity institutes patent litigation against You or any other entity (including a cross-claim or counterclaim in a lawsuit) alleging that your Contribution, or the Work to which you have contributed, constitutes direct or contributory patent infringement, then any patent licenses granted to that entity under this Agreement for that Contribution or Work shall terminate as of the date such litigation is filed. 4. You represent that you are legally entitled to grant the above license. If your employer(s) has rights to intellectual property that you create that includes your Contributions, you represent that you have received permission to make Contributions on behalf of that employer, that your employer has waived such rights for your Contributions to OCamlPro, or that your employer has executed a separate Corporate CLA with OCamlPro. 5. You represent that each of Your Contributions is Your original creation (see section 7 for submissions on behalf of others). You represent that Your Contribution submissions include complete details of any third-party license or other restriction (including, but not limited to, related patents and trademarks) of which you are personally aware and which are associated with any part of Your Contributions. 6. You are not expected to provide support for Your Contributions, except to the extent You desire to provide support. You may provide support for free, for a fee, or not at all. Unless required by applicable law or agreed to in writing, You provide Your Contributions on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. 7. Should You wish to submit work that is not Your original creation, You may submit it to OCamlPro separately from any Contribution, identifying the complete details of its source and of any license or other restriction (including, but not limited to, related patents, trademarks, and license agreements) of which you are personally aware, and conspicuously marking the work as "Submitted on behalf of a third-party: [[]named here]". 8. You agree to notify OCamlPro of any facts or circumstances of which you become aware that would make these representations inaccurate in any respect. ======================================================================= OCAMLPRO CONTRIBUTOR LICENSE AGREMENT FOR CORPORATE CONTRIBUTOR ------------------------------------- In order to clarify the intellectual property license granted with Contributions from any person or entity, OCamlPro SAS ("OCamlPro") must have a Contributor License Agreement (CLA) on file that has been signed by each Contributor, indicating agreement to the license terms below. This license is for your protection as a Contributor as well as the protection of OCamlPro and its users; it does not change your rights to use your own Contributions for any other purpose. This version of the Agreement allows an entity (the "Corporation") to submit Contributions to OCamlPro, to authorize Contributions submitted by its designated employees to OCamlPro, and to grant copyright and patent licenses thereto. If you have not already done so, please complete and sign, then scan and email a pdf file of this Agreement to contact@ocamlpro.com. Corporation name: ________________________________________________ Corporation address: ________________________________________________ ________________________________________________ ________________________________________________ Point of Contact: ________________________________________________ E-Mail: ________________________________________________ Telephone: _____________________ Fax: _____________________ You accept and agree to the following terms and conditions for Your present and future Contributions submitted to OCamlPro. In return, OCamlPro shall not use Your Contributions in a way that is contrary to the public benefit or inconsistent with its nonprofit status and bylaws in effect at the time of the Contribution. Except for the license granted herein to OCamlPro and recipients of software distributed by OCamlPro, You reserve all right, title, and interest in and to Your Contributions. 1. Definitions. "You" (or "Your") shall mean the copyright owner or legal entity authorized by the copyright owner that is making this Agreement with OCamlPro. For legal entities, the entity making a Contribution and all other entities that control, are controlled by, or are under common control with that entity are considered to be a single Contributor. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "Contribution" shall mean the code, documentation or other original works of authorship expressly identified in Schedule B, as well as any original work of authorship, including any modifications or additions to an existing work, that is intentionally submitted by You to OCamlPro for inclusion in, or documentation of, any of the products owned or managed by OCamlPro (the "Work"). For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to OCamlPro or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, OCamlPro for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by You as "Not a Contribution." 2. Grant of Copyright License. Subject to the terms and conditions of this Agreement, You hereby grant to OCamlPro and to recipients of software distributed by OCamlPro a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, sublicense, and distribute Your Contributions and such derivative works. 3. Grant of Patent License. Subject to the terms and conditions of this Agreement, You hereby grant to OCamlPro and to recipients of software distributed by OCamlPro a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by You that are necessarily infringed by Your Contribution(s) alone or by combination of Your Contribution(s) with the Work to which such Contribution(s) were submitted. If any entity institutes patent litigation against You or any other entity (including a cross-claim or counterclaim in a lawsuit) alleging that your Contribution, or the Work to which you have contributed, constitutes direct or contributory patent infringement, then any patent licenses granted to that entity under this Agreement for that Contribution or Work shall terminate as of the date such litigation is filed. 4. You represent that You are legally entitled to grant the above license. You represent further that each employee of the Corporation designated on Schedule A below (or in a subsequent written modification to that Schedule) is authorized to submit Contributions on behalf of the Corporation. 5. You represent that each of Your Contributions is Your original creation (see section 7 for submissions on behalf of others). 6. You are not expected to provide support for Your Contributions, except to the extent You desire to provide support. You may provide support for free, for a fee, or not at all. Unless required by applicable law or agreed to in writing, You provide Your Contributions on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. 7. Should You wish to submit work that is not Your original creation, You may submit it to OCamlPro separately from any Contribution, identifying the complete details of its source and of any license or other restriction (including, but not limited to, related patents, trademarks, and license agreements) of which you are personally aware, and conspicuously marking the work as "Submitted on behalf of a third-party: [named here]". 8. It is your responsibility to notify OCamlPro when any change is required to the list of designated employees authorized to submit Contributions on behalf of the Corporation, or to the Corporation's Point of Contact with OCamlPro. Please sign: __________________________________ Date: _______________ Title: __________________________________ Corporation: __________________________________ Schedule A [Initial list of designated employees. NB: authorization is not tied to particular Contributions.] Schedule B [Identification of optional concurrent software grant. Would be left blank or omitted if there is no concurrent software grant.] ocp-indent-1.7.0/README.md000066400000000000000000000004361337455726700150640ustar00rootroot00000000000000ocp-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.7.0/VERSION000066400000000000000000000000051337455726700146450ustar00rootroot000000000000001.7.0ocp-indent-1.7.0/doc/000077500000000000000000000000001337455726700143475ustar00rootroot00000000000000ocp-indent-1.7.0/doc/dune000066400000000000000000000002401337455726700152210ustar00rootroot00000000000000(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.7.0/doc/ocp-indent.md000066400000000000000000000120441337455726700167320ustar00rootroot00000000000000# 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 `~/.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.7.0/dune-project000066400000000000000000000000421337455726700161200ustar00rootroot00000000000000(lang dune 1.0) (name ocp-indent) ocp-indent-1.7.0/ocp-indent.opam000066400000000000000000000016651337455726700165300ustar00rootroot00000000000000opam-version: "1.2" maintainer: "contact@ocamlpro.com" 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" tags: ["org:ocamlpro" "org:typerex"] dev-repo: "https://github.com/OCamlPro/ocp-indent.git" build: [ ["dune" "build" "-p" name "-j" jobs] ] run-test: [ ["dune" "runtest" "-p" name] ] depends: [ "dune" {build} "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.7.0/src/000077500000000000000000000000001337455726700143715ustar00rootroot00000000000000ocp-indent-1.7.0/src/approx_lexer.mll000066400000000000000000000536121337455726700176160ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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 | 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 | Verbatim) :: r -> comment_stack := r; close_comment () | [] -> assert false ;; let in_comment () = match !comment_stack with | (Comment | CommentCont | Verbatim) :: _ -> true | Code :: _ | [] -> false ;; let in_verbatim () = List.mem Verbatim !comment_stack 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 ;; 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 } ;; (* 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 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 ) } | "(*" { 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 } | "<:" 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 + { PREFIXOP(Lexing.lexeme lexbuf) } | ['~' '?'] symbolchar + { PREFIXOP(Lexing.lexeme lexbuf) } | ['=' '<' '>' '|' '&' '$'] symbolchar * { INFIXOP0(Lexing.lexeme lexbuf) } | ['@' '^'] symbolchar * { INFIXOP1(Lexing.lexeme lexbuf) } | ['+' '-'] symbolchar * { INFIXOP2(Lexing.lexeme lexbuf) } | "**" symbolchar * { INFIXOP4(Lexing.lexeme lexbuf) } | ['*' '/' '%'] symbolchar * { INFIXOP3(Lexing.lexeme lexbuf) } | 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.7.0/src/approx_tokens.ml000066400000000000000000000063411337455726700176230ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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 ocp-indent-1.7.0/src/compat.ml000066400000000000000000000003651337455726700162120ustar00rootroot00000000000000external ( @* ) : ('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.7.0/src/dune000066400000000000000000000017321337455726700152520ustar00rootroot00000000000000(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) ) (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) ) ocp-indent-1.7.0/src/indentArgs.ml000066400000000000000000000222441337455726700170250ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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 `\\$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.7.0/src/indentArgs.mli000066400000000000000000000032211337455726700171700ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/indentBlock.ml000066400000000000000000001647311337455726700171730ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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 (* 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 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 | 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 = match next_offset tok stream with | None (* EOL *) -> reset_line_indent config current_line path | Some _ -> 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 -> 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 | LBRACKETAT -> let path = before_append_atom block.path in append ~pad:4 (KExtendedExpr ([], ext_kind tok.token)) L path | LBRACKETATAT -> let path = (unwind (function KBody k | k -> top_kind k || stritem_kind k) block.path) in append ~pad:4 (KExtendedItem ([], ext_kind tok.token)) L (reset_padding 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 _ -> true | _ -> false) block.path in let indent = 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 | {kind=KParen|KBegin}::{kind=KExpr prio; line; indent}::_ when prio = prio_apply && line = current_line -> indent | _ -> Path.indent block.path in Path.maptop (fun n -> {n with indent}) (append k L (reset_padding block.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}::_ 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 -> 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) | 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_token stream = Some TYPE -> append KUnknown L block.path (* : module type of *) | Some (WITH|AND) -> append KType L 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=KExtendedItem (_, Attr)|KExtendedExpr (_, Attr)} :: p -> 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|KExternal | KAnd(KModule|KLet|KLetIn|KExternal)} :: _ -> append KColon L 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 | LESSMINUS | COMMA | OR | AMPERSAND | INFIXOP0 _ | INFIXOP1 _ | COLONCOLON | INFIXOP2 _ | PLUSDOT | PLUS | MINUSDOT | MINUS | INFIXOP3 _ | STAR | INFIXOP4 _ | SHARP | AS | COLONGREATER | OF -> 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 + 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 :: _ | 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 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.7.0/src/indentBlock.mli000066400000000000000000000061251337455726700173340ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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). Implies is_clean *) val is_at_top: 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.7.0/src/indentConfig.ml000066400000000000000000000364571337455726700173510ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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 "int_of_string" -> 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) let set ?(extra=fun _ -> None) t var_name value = try match var_name with | "base" -> {t with i_base = int_of_string value} | "type" -> {t with i_type = int_of_string value} | "in" -> {t with i_in = int_of_string value} | "with" -> {t with i_with = int_of_string value} | "match_clause" -> {t with i_match_clause = int_of_string value} | "ppx_stritem_ext" -> {t with i_ppx_stritem_ext = int_of_string value} | "max_indent" -> {t with i_max_indent = intoption_of_string value} | "strict_with" -> {t with i_strict_with = threechoices_of_string value} | "strict_else" -> {t with i_strict_else = threechoices_of_string value} | "with_never" -> (* backwards compat, don't document *) {t with i_strict_with = if bool_of_string value then Always else Never} | "strict_comments" -> {t with i_strict_comments = bool_of_string value} | "align_ops" -> {t with i_align_ops = bool_of_string value} | "align_params" -> {t with i_align_params = threechoices_of_string value} | 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 | Failure "int_of_string" -> let e = Printf.sprintf "%s should be an integer, not %S" var_name value in raise (Invalid_argument e) | Failure "bool_of_string" -> let e = Printf.sprintf "%s should be either \"true\" or \"false\", not %S" var_name value in raise (Invalid_argument e) | Failure "threechoices_of_string" -> let e = Printf.sprintf "%s should be either \"always\", \"never\" or \"auto\", not %S" var_name value in raise (Invalid_argument e) | Failure "intoption_of_string" -> let e = Printf.sprintf "%s should be either an integer or \"none\", not %S" var_name value in raise (Invalid_argument e) 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 f = (Sys.getenv "HOME") / ".ocp" / "ocp-indent.conf" in if Sys.file_exists f then load ~indent:conf f 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.7.0/src/indentConfig.mli000066400000000000000000000064401337455726700175070ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/indentExtend.ml000066400000000000000000000036421337455726700173610ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/indentExtend.mli000066400000000000000000000025531337455726700175320ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/indentLoader.ml000066400000000000000000000042651337455726700173420ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/indentLoader.mli000066400000000000000000000020251337455726700175030ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/indentMain.ml000066400000000000000000000067161337455726700170230ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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 = let oc, need_close = match out with | None | Some "-" -> stdout, false | Some file -> open_out 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 | 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, need_move = if args.Args.inplace then let tmp_file = path ^ ".ocp-indent-tmp" in Some tmp_file, Some path else args.Args.file_out, None in let ic = open_in path in try indent_channel ic args config out; 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.7.0/src/indentPrinter.ml000066400000000000000000000241211337455726700175500ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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 -> 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.7.0/src/indentPrinter.mli000066400000000000000000000045621337455726700177300ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/nstream.ml000066400000000000000000000113301337455726700163720ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/nstream.mli000066400000000000000000000035101337455726700165440ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/pos.ml000066400000000000000000000042101337455726700155210ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/pos.mli000066400000000000000000000045221337455726700157000ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/src/util.ml000066400000000000000000000061521337455726700157040ustar00rootroot00000000000000(**************************************************************************) (* *) (* 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.7.0/tests/000077500000000000000000000000001337455726700147445ustar00rootroot00000000000000ocp-indent-1.7.0/tests/.ocp-indent000066400000000000000000000000071337455726700170020ustar00rootroot00000000000000normal ocp-indent-1.7.0/tests/failing-output/000077500000000000000000000000001337455726700177135ustar00rootroot00000000000000ocp-indent-1.7.0/tests/failing-output/edge-cases.ml000066400000000000000000000026151337455726700222510ustar00rootroot00000000000000 (* 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. *) let b = `b let d = `d ;; let a = b function (_ : [ `c ]) -> d ;; ocp-indent-1.7.0/tests/failing-output/escaped-nl.ml000066400000000000000000000012301337455726700222540ustar00rootroot00000000000000let 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.7.0/tests/failing-output/gadt.ml000066400000000000000000000035621337455726700211720ustar00rootroot00000000000000type _ 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.7.0/tests/failing-output/indent-empty-numeric.ml000066400000000000000000000000251337455726700243170ustar00rootroot000000000000000 0 2 2 0 0 0 0 2 15 ocp-indent-1.7.0/tests/failing-output/js-args.ml000066400000000000000000000074201337455726700216160ustar00rootroot00000000000000let () = 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.7.0/tests/failing-output/js-begin.ml000066400000000000000000000002711337455726700217430ustar00rootroot00000000000000let f = function | zoo -> begin foo; bar; end ;; let g = function | zoo -> ( foo; bar; ) ;; let () = begin match foo with | Bar -> snoo end ;; ocp-indent-1.7.0/tests/failing-output/js-fun.ml000066400000000000000000000023111337455726700214440ustar00rootroot00000000000000(* 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.7.0/tests/failing-output/js-functor.ml000066400000000000000000000024331337455726700223410ustar00rootroot00000000000000module 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.7.0/tests/failing-output/js-pattern.ml000066400000000000000000000012271337455726700223360ustar00rootroot00000000000000let 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.7.0/tests/failing-output/js-record.ml000066400000000000000000000017721337455726700221440ustar00rootroot00000000000000type 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.7.0/tests/failing-output/js-syntax.ml000066400000000000000000000006611337455726700222100ustar00rootroot00000000000000(* 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.7.0/tests/failing-output/js-to-do.ml000066400000000000000000000042701337455726700217040ustar00rootroot00000000000000(* 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.7.0/tests/failing-output/js-upon.ml000066400000000000000000000005271337455726700216440ustar00rootroot00000000000000let 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.7.0/tests/failing-output/list_of_funs.ml000066400000000000000000000010131337455726700227320ustar00rootroot00000000000000let 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.7.0/tests/failing-output/unit-classes.ml000066400000000000000000000041751337455726700226660ustar00rootroot00000000000000(** 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.7.0/tests/failing.html000066400000000000000000004550451337455726700172600ustar00rootroot00000000000000 Failing tests, ocp-indent version 1.6.1+45 (2018-11-19)

Failing tests, ocp-indent version 1.6.1+45 (2018-11-19)

Differences in edge-cases.ml

ExpectedOcp-indent output
0


1
(* this could be fixed, but we actually want to handle the first case
(* this could be fixed, but we actually want to handle the first case


2
   differently for when there is only one case (see next examples) *)
   differently for when there is only one case (see next examples) *)


3
let f x = function A -> x;
let f x = function A -> x;


4
  2
  2


5
                 | B -> y;
                 | B -> y;


6
                   3
                   3


7


8
(* if we were to fix to the case above, the second >>= would be below the _
(* if we were to fix to the case above, the second >>= would be below the _


9
   (test taken from js-fun) *)
   (test taken from js-fun) *)


10
let _ =
let _ =


11
  x
  x


12
  >>= fun x ->
  >>= fun x ->


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


14
    >>= fun x ->
    >>= fun x ->


15
    x
    x


16


17
(* (and also: the some_handling here would be below Not_found) *)
(* (and also: the some_handling here would be below Not_found) *)


18
let _ =
let _ =


19
  try
  try


20
    _
    _


21
  with Not_found ->
  with Not_found ->


22
    some_handling
    some_handling


23


24
let f = fun x ->
let f = fun x ->


25
  x
  x


26


27
let f = (fun x ->
let f = (fun x ->


28
    x
    x


29
  )
  )


30


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


32
  x
  x


33


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


35
    x
    x


36
  )
  )


37


38


39
(* the above should probably be consistent with: *)
(* the above should probably be consistent with: *)


40
let f x y = y + match x with A ->
let f x y = y + match x with A ->


41
    0
    0


42


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


44
    0
    0


45
  )
  )


46


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


48


49
let f x y = y + match x with
let f x y = y + match x with


50
  | A -> 0
  | A -> 0


51


52
let f x y = y + (match x with
let f x y = y + (match x with


53
    | A -> 0
    | A -> 0


54
  )
  )


55


56
let f x y = y + match x with
let f x y = y + match x with


57
  | A -> 0
  | A -> 0


58


59
let _ =
let _ =


60
  somefun
  somefun


61
    (fun x ->
    (fun x ->


62
       x);
       x);


63
  somefun
  somefun


64
    (if
    (if


65
      bla
      bla


66
     then
     then


67
       bli);
       bli);


68
  somefun
  somefun


69
    (if bla then
    (if bla then


70
       bli
       bli


71
     else
     else


72
       blu)
       blu)


73


74
let _ =
let _ =


75
  a
  a


76
  ;
  ;


77
  b
  b


78


79
(* Surprisingly, this is the indentation correpsonding to OCaml's interpretation
(* Surprisingly, this is the indentation correpsonding to OCaml's interpretation


80
   of this code.  Indenting this accordingly may help users notice that they're
   of this code.  Indenting this accordingly may help users notice that they're


81
   doing something dubious. *)
   doing something dubious. *)


82
let b = `b
let b = `b


83
let d = `d
let d = `d


84
;;
;;


85
let a = b
let a = b


86
function·(_·:·[·`c·])·->·d
····function·(_·:·[·`c·])·->·d


87
;;
;;








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 gadt.ml




ExpectedOcp-indent output


0
type _ term =
type _ term =


1
  | Int : int -> int term
  | Int : int -> int term


2
  | Add : (int -> int -> int) term
  | Add : (int -> int -> int) term


3
  | App : ('b -> 'a) term * 'b term -> 'a term
  | App : ('b -> 'a) term * 'b term -> 'a term


4


5
let rec eval : type a. a term -> a = function
let rec eval : type a. a term -> a = function


6
  | Int n    -> n                 (* a = int *)
  | Int n    -> n                 (* a = int *)


7
  | Add      -> (fun x y -> x+y)  (* a = int -> int -> int *)
  | Add      -> (fun x y -> x+y)  (* a = int -> int -> int *)


8
  | App(f,x) -> (eval f) (eval x)
  | App(f,x) -> (eval f) (eval x)


9
(* eval called at types (b->a) and b for fresh b *)
(* eval called at types (b->a) and b for fresh b *)


10


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


12


13
let rec sum : type a. a term -> _ = fun x ->
let rec sum : type a. a term -> _ = fun x ->


14
  let y =
  let y =


15
    match x with
    match x with


16
    | Int n -> n
    | Int n -> n


17
    | Add   -> 0
    | Add   -> 0


18
    | App(f,x) -> sum f + sum x
    | App(f,x) -> sum f + sum x


19
  in y + 1
  in y + 1


20


21
type _ typ =
type _ typ =


22
  | Int : int typ
  | Int : int typ


23
  | String : string typ
  | String : string typ


24
  | Pair : 'a typ * 'b typ -> ('a * 'b) typ
  | Pair : 'a typ * 'b typ -> ('a * 'b) typ


25


26
let rec to_string: type t. t typ -> t -> string =
let rec to_string: type t. t typ -> t -> string =


27
  fun t x ->
  fun t x ->


28
····match·t·with
··match·t·with


29
····|·Int·->·string_of_int·x
··|·Int·->·string_of_int·x


30
····|·String·->·Printf.sprintf·"%S"·x
··|·String·->·Printf.sprintf·"%S"·x


31
····|·Pair(t1,t2)·->
··|·Pair(t1,t2)·->


32
······let·(x1,·x2)·=·x·in
····let·(x1,·x2)·=·x·in


33
······Printf.sprintf·"(%s,%s)"·(to_string·t1·x1)·(to_string·t2·x2)
····Printf.sprintf·"(%s,%s)"·(to_string·t1·x1)·(to_string·t2·x2)


34


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


36


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


38


39
let rec eq_type : type a b. a typ -> b typ -> (a,b) eq option =
let rec eq_type : type a b. a typ -> b typ -> (a,b) eq option =


40
  fun a b ->
  fun a b ->


41
····match·a,·b·with
··match·a,·b·with


42
····|·Int,·Int·->·Some·Eq
··|·Int,·Int·->·Some·Eq


43
····|·String,·String·->·Some·Eq
··|·String,·String·->·Some·Eq


44
····|·Pair(a1,a2),·Pair(b1,b2)·->
··|·Pair(a1,a2),·Pair(b1,b2)·->


45
······begin·match·eq_type·a1·b1,·eq_type·a2·b2·with
····begin·match·eq_type·a1·b1,·eq_type·a2·b2·with


46
········|·Some·Eq,·Some·Eq·->·Some·Eq
······|·Some·Eq,·Some·Eq·->·Some·Eq


47
········|·_·->·None
······|·_·->·None


48
······end
····end


49
····|·_·->·None
··|·_·->·None


50


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


52


53
let get_dyn : type a. a typ -> dyn -> a option =
let get_dyn : type a. a typ -> dyn -> a option =


54
  fun a (Dyn(b,x)) ->
  fun a (Dyn(b,x)) ->


55
····match·eq_type·a·b·with
··match·eq_type·a·b·with


56
····|·None·->·None
··|·None·->·None


57
····|·Some·Eq·->·Some·x
··|·Some·Eq·->·Some·x


58


59
let _ =
let _ =


60
  let f: type a. a list -> int =
  let f: type a. a list -> int =


61
    fun _x -> 42
    fun _x -> 42


62
  in
  in


63
  f []
  f []


64


65
let nth t n =
let nth t n =


66
  if n < 0 then None else
  if n < 0 then None else


67
    let rec nth_aux: type b. ('a, b) t -> int -> 'a option = fun t n ->
    let rec nth_aux: type b. ('a, b) t -> int -> 'a option = fun t n ->


68
      match t with
      match t with


69
      | Empty -> None
      | Empty -> None


70
      | Node (a, t) -> if n = 0 then Some a else nth_aux t (n-1)
      | Node (a, t) -> if n = 0 then Some a else nth_aux t (n-1)


71
    in
    in


72
    nth_aux t n
    nth_aux t n


73


74
let rec f : type a b. a = function
let rec f : type a b. a = function


75
  | _ -> assert false
  | _ -> assert false


76
and g : type a. a = function
and g : type a. a = function


77
  | _ -> assert false
  | _ -> assert false








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) ]








Differences in unit-classes.ml




ExpectedOcp-indent output


0
(** ocaml classes
(** ocaml classes


1
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual017.html)
    (http://caml.inria.fr/pub/docs/manual-ocaml/manual017.html)


2
*)
*)


3


4
(* class types *)
(* class types *)


5


6
class type c =
class type c =


7
  object
  object


8
  end
  end


9


10
class type c =
class type c =


11
  M.cl
  M.cl


12


13
class type c =
class type c =


14
  ['a, 'b] M.cl
  ['a, 'b] M.cl


15


16
class type c =
class type c =


17
  object
  object


18
    ('ty)
    ('ty)


19
    inherit cl
    inherit cl


20
    val mutable virtual
    val mutable virtual


21
      var : bool
      var : bool


22
    method private bar1 x ~y : bool
    method private bar1 x ~y : bool


23
    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t
    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t


24
    constraint
    constraint


25
      'a = 'b
      'a = 'b


26
  end
  end


27


28
(* class expressions *)
(* class expressions *)


29


30
class c =
class c =


31
  ['a, 'b]
  ['a, 'b]


32
    M.cl
    M.cl


33


34
class c =
class c =


35
  fun a b ->
  fun a b ->


36
····object
··object


37
····end
··end


38


39
class c = object
class c = object


40
  val x = true
  val x = true


41
end
end


42


43
class c =
class c =


44
  object
  object


45
    (_ :
    (_ :


46
       'a)
       'a)


47
    inherit Something.someclass
    inherit Something.someclass


48
      as v
      as v


49
    val mutable
    val mutable


50
      var : bool
      var : bool


51
      = true
      = true


52
    val mutable virtual var2
    val mutable virtual var2


53
      : string
      : string


54
    method private bar1 x ~y : bool =
    method private bar1 x ~y : bool =


55
      false
      false


56
    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t
    method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t


57
    constraint
    constraint


58
      'a = 'b
      'a = 'b


59
    initializer
    initializer


60
      z
      z


61
  end
  end


62


63
(* method specific expressions *)
(* method specific expressions *)


64


65
let e =
let e =


66
  var <- true
  var <- true


67


68
let e =
let e =


69
  {< var = false;
  {< var = false;


70
     var2 = true;
     var2 = true;


71
  >}
  >}


72


73


74
(* class definitions *)
(* class definitions *)


75


76
class cl =
class cl =


77
  object
  object


78
    val x = true
    val x = true


79
  end
  end


80
and
and


81
  virtual ['a, 'b]
  virtual ['a, 'b]


82
    cl2 x y :
    cl2 x y :


83
  object
  object


84
    val x : bool
    val x : bool


85
  end = fun x y ->
  end = fun x y ->


86
  object
  object


87
    val x : bool = true
    val x : bool = true


88
  end
  end


89


90
class cl
class cl


91
  : object end
  : object end


92


93
class type virtual ['a] clty = object
class type virtual ['a] clty = object


94
  method x : int
  method x : int


95
end
end


96


97
(* objects *)
(* objects *)


98
val a :
val a :


99
  < >
  < >


100
let () = ()
let () = ()


101


102
val a :
val a :


103
  < .. >
  < .. >


104
let () = ()
let () = ()


105


106
val a :
val a :


107
  < meth: int option;
  < meth: int option;


108
    meth2: 'a. 'a option;
    meth2: 'a. 'a option;


109
    meth3: 'a 'b. ('a,'b) Hashtbl.t >
    meth3: 'a 'b. ('a,'b) Hashtbl.t >


110
let () = ()
let () = ()


111


112
val a :
val a :


113
  < meth: int option;
  < meth: int option;


114
    meth2: 'a. 'a option;
    meth2: 'a. 'a option;


115
    meth3: 'a 'b. ('a,'b) Hashtbl.t;
    meth3: 'a 'b. ('a,'b) Hashtbl.t;


116
    .. >
    .. >


117
let () = ()
let () = ()


118


119
(* #-types *)
(* #-types *)


120
val a :
val a :


121
  #M.meth
  #M.meth


122


123
val a :
val a :


124
  'a#M.meth
  'a#M.meth


125


126
val a :
val a :


127
  ('a,'b*'c)
  ('a,'b*'c)


128
  #M.meth
  #M.meth


129


130
(* object types *)
(* object types *)


131
type a =
type a =


132
  < >
  < >


133
let () = ()
let () = ()


134


135
type a =
type a =


136
  < .. >
  < .. >


137
let () = ()
let () = ()


138


139
type a =
type a =


140
  < meth: int option;
  < meth: int option;


141
    meth2: 'a. 'a option;
    meth2: 'a. 'a option;


142
    meth3: 'a 'b. ('a,'b) Hashtbl.t >
    meth3: 'a 'b. ('a,'b) Hashtbl.t >


143
let () = ()
let () = ()


144


145
type a =
type a =


146
  < meth: int option;
  < meth: int option;


147
    meth2: 'a. 'a option;
    meth2: 'a. 'a option;


148
    meth3: 'a 'b. ('a,'b) Hashtbl.t;
    meth3: 'a 'b. ('a,'b) Hashtbl.t;


149
    .. >
    .. >


150
let () = ()
let () = ()


151


152
type t =
type t =


153
  < a : int; b:
  < a : int; b:


154
      < a: int; b: < c:int > >
      < a: int; b: < c:int > >


155
  >
  >


156
let () = ()
let () = ()


157


158
type t =
type t =


159
  < a : int; b:
  < a : int; b:


160
      < a: int; b: < c: int -> int> >;
      < a: int; b: < c: int -> int> >;


161
    c: int
    c: int


162
  >
  >


163
let () = ()
let () = ()


164


165
type 'a t =
type 'a t =


166
  | Bla : < x : int > t
  | Bla : < x : int > t


167
  | Blo : < y : int > t
  | Blo : < y : int > t







ocp-indent-1.7.0/tests/failing/000077500000000000000000000000001337455726700163555ustar00rootroot00000000000000ocp-indent-1.7.0/tests/failing/#js-default.ml#000066400000000000000000000004751337455726700210610ustar00rootroot00000000000000type 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.7.0/tests/failing/edge-cases.ml000066400000000000000000000026111337455726700207070ustar00rootroot00000000000000
(* 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. *)
let b = `b
let d = `d
;;
let a = b
function (_ : [ `c ]) -> d
;;
ocp-indent-1.7.0/tests/failing/escaped-nl.ml000066400000000000000000000011241337455726700207200ustar00rootroot00000000000000let 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.7.0/tests/failing/escaped-nl.ml.ref000066400000000000000000000011761337455726700215020ustar00rootroot00000000000000let 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.7.0/tests/failing/gadt.ml000066400000000000000000000036261337455726700176350ustar00rootroot00000000000000type _ 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.7.0/tests/failing/js-args.ml000066400000000000000000000074261337455726700202660ustar00rootroot00000000000000let () =
  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.7.0/tests/failing/js-args.ml.opts000066400000000000000000000000161337455726700212360ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-begin.ml000066400000000000000000000002771337455726700204130ustar00rootroot00000000000000let f = function
  | zoo -> begin
      foo;
      bar;
    end
;;
let g = function
  | zoo -> (
      foo;
      bar;
    )
;;
let () =
  begin match foo with
        | Bar -> snoo
  end
;;
ocp-indent-1.7.0/tests/failing/js-begin.ml.opts000066400000000000000000000000161337455726700213660ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-fun.ml000066400000000000000000000023431337455726700201130ustar00rootroot00000000000000(* 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.7.0/tests/failing/js-fun.ml.opts000066400000000000000000000000161337455726700210720ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-functor.ml000066400000000000000000000024371337455726700210070ustar00rootroot00000000000000module 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.7.0/tests/failing/js-functor.ml.opts000066400000000000000000000000161337455726700217620ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-pattern.ml000066400000000000000000000012531337455726700207770ustar00rootroot00000000000000let 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.7.0/tests/failing/js-pattern.ml.opts000066400000000000000000000000161337455726700217570ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-record.ml000066400000000000000000000017711337455726700206050ustar00rootroot00000000000000type 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.7.0/tests/failing/js-record.ml.opts000066400000000000000000000000161337455726700215600ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-syntax.ml000066400000000000000000000005431337455726700206510ustar00rootroot00000000000000(* 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.7.0/tests/failing/js-syntax.ml.opts000066400000000000000000000000161337455726700216300ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-to-do.ml000066400000000000000000000042401337455726700203430ustar00rootroot00000000000000(* 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.7.0/tests/failing/js-to-do.ml.opts000066400000000000000000000000161337455726700213240ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/js-upon.ml000066400000000000000000000005451337455726700203060ustar00rootroot00000000000000let 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.7.0/tests/failing/js-upon.ml.opts000066400000000000000000000000161337455726700212630ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/failing/list_of_funs.ml000066400000000000000000000011151337455726700213770ustar00rootroot00000000000000let 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.7.0/tests/failing/unit-classes.ml000066400000000000000000000042011337455726700213160ustar00rootroot00000000000000(** 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.7.0/tests/passing/000077500000000000000000000000001337455726700164105ustar00rootroot00000000000000ocp-indent-1.7.0/tests/passing/alignment.ml000066400000000000000000000007221337455726700207210ustar00rootroot00000000000000let 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.7.0/tests/passing/bracket.ml000066400000000000000000000002241337455726700203530ustar00rootroot00000000000000let _ =
  match a with
  | b ->
    cccccc [
      d [
        e
      ]
    ]
  | b' ->
    (ccccc' [
        d' [
          e'
        ]
      ])
ocp-indent-1.7.0/tests/passing/comments.ml000066400000000000000000000023771337455726700206000ustar00rootroot00000000000000(* 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.7.0/tests/passing/core-failing.ml000066400000000000000000000005751337455726700213100ustar00rootroot00000000000000exception 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.7.0/tests/passing/core-passing.ml000066400000000000000000000060431337455726700213370ustar00rootroot00000000000000type 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.7.0/tests/passing/embedded-match.ml000066400000000000000000000007311337455726700215660ustar00rootroot00000000000000let 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.7.0/tests/passing/exprs.ml000066400000000000000000000020151337455726700201010ustar00rootroot00000000000000f "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.7.0/tests/passing/extensible.ml000066400000000000000000000006331337455726700211060ustar00rootroot00000000000000(* 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.7.0/tests/passing/gadt.ml000066400000000000000000000035621337455726700176670ustar00rootroot00000000000000type _ 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.7.0/tests/passing/ifand.ml000066400000000000000000000002611337455726700200220ustar00rootroot00000000000000let _ =
  if cond1
  && cond2
  then _

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

  let f =

end

let g =

  fun x -> 3 + 4 *
ocp-indent-1.7.0/tests/passing/indent-empty-1.ml.opts000066400000000000000000000000241337455726700224750ustar00rootroot00000000000000--lines 4 --numeric
ocp-indent-1.7.0/tests/passing/indent-empty-1.ml.ref000066400000000000000000000000021337455726700222600ustar00rootroot000000000000004
ocp-indent-1.7.0/tests/passing/indent-empty-nm.ml000066400000000000000000000000771337455726700217730ustar00rootroot00000000000000module M = struct

  let f =

end

let g =

  fun x -> 3 + 4 *
ocp-indent-1.7.0/tests/passing/indent-empty-nm.ml.opts000066400000000000000000000000311337455726700227450ustar00rootroot00000000000000--indent-empty --numeric
ocp-indent-1.7.0/tests/passing/indent-empty-nm.ml.ref000066400000000000000000000000251337455726700225370ustar00rootroot000000000000000
2
2
4
0
0
0
2
2
15
ocp-indent-1.7.0/tests/passing/indent-empty.ml000066400000000000000000000000771337455726700213630ustar00rootroot00000000000000module M = struct

  let f =

end

let g =

  fun x -> 3 + 4 *
ocp-indent-1.7.0/tests/passing/indent-empty.ml.opts000066400000000000000000000000171337455726700223410ustar00rootroot00000000000000--indent-empty
ocp-indent-1.7.0/tests/passing/indent-empty.ml.ref000066400000000000000000000001261337455726700221310ustar00rootroot00000000000000module M = struct
  
  let f =
    
end

let g =
  
  fun x -> 3 + 4 *
               ocp-indent-1.7.0/tests/passing/js-2018.ml000066400000000000000000000026071337455726700177530ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-2018.ml.opts000066400000000000000000000000161337455726700207270ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-and.ml000066400000000000000000000001321337455726700201120ustar00rootroot00000000000000module M : S with type a = b
              and type c = d
              and type e = f
;;
ocp-indent-1.7.0/tests/passing/js-and.ml.opts000066400000000000000000000000161337455726700210770ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-andand.ml000066400000000000000000000003421337455726700206000ustar00rootroot00000000000000let 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.7.0/tests/passing/js-andand.ml.opts000066400000000000000000000000161337455726700215620ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-applicative.ml000066400000000000000000000001771337455726700216620ustar00rootroot00000000000000(* applicative_intf.ml *)

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

let args =
  bar "A"
  @> baz_qux
  @@ zap "D"
  @> nil
ocp-indent-1.7.0/tests/passing/js-applicative.ml.opts000066400000000000000000000000161337455726700226360ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-bench.ml000066400000000000000000000023211337455726700204310ustar00rootroot00000000000000BENCH_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.7.0/tests/passing/js-bench.ml.opts000066400000000000000000000000161337455726700214140ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-bind.ml000066400000000000000000000011141337455726700202650ustar00rootroot00000000000000let 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.7.0/tests/passing/js-bind.ml.opts000066400000000000000000000000161337455726700212510ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-comment.ml000066400000000000000000000064401337455726700210220ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-comment.ml.opts000066400000000000000000000000161337455726700217770ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-comment.ml.ref000066400000000000000000000064201337455726700215730ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-comment1.ml000066400000000000000000000033141337455726700211000ustar00rootroot00000000000000type 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.7.0/tests/passing/js-comment1.ml.opts000066400000000000000000000000161337455726700220600ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-comment1.ml.ref000066400000000000000000000033141337455726700216530ustar00rootroot00000000000000type 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.7.0/tests/passing/js-default.ml000066400000000000000000000005741337455726700210060ustar00rootroot00000000000000type 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.7.0/tests/passing/js-default.ml.opts000066400000000000000000000000161337455726700217610ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-fun-rec.ml000066400000000000000000000007641337455726700207220ustar00rootroot00000000000000let 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.7.0/tests/passing/js-fun-rec.ml.opts000066400000000000000000000000161337455726700216740ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-label.ml000066400000000000000000000004551337455726700204370ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-label.ml.opts000066400000000000000000000000161337455726700214140ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-let.ml000066400000000000000000000020521337455726700201370ustar00rootroot00000000000000let 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.7.0/tests/passing/js-let.ml.opts000066400000000000000000000000161337455726700211210ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-list.ml000066400000000000000000000004241337455726700203270ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-list.ml.opts000066400000000000000000000000161337455726700213100ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-low-priority.ml000066400000000000000000000013331337455726700220340ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-low-priority.ml.opts000066400000000000000000000000161337455726700230150ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-map.ml000066400000000000000000000001351337455726700201300ustar00rootroot00000000000000let projection_files =
  Deferred.List.map x ~f:(fun p ->
    _)
  >>| String.split ~on:'\n'
ocp-indent-1.7.0/tests/passing/js-map.ml.opts000066400000000000000000000000161337455726700211120ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-model.ml000066400000000000000000000002721337455726700204550ustar00rootroot00000000000000val 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.7.0/tests/passing/js-model.ml.opts000066400000000000000000000000161337455726700214350ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-pipebang.ml000066400000000000000000000030541337455726700211430ustar00rootroot00000000000000let 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.7.0/tests/passing/js-pipebang.ml.opts000066400000000000000000000000161337455726700221220ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-poly.ml000066400000000000000000000003531337455726700203400ustar00rootroot00000000000000let 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.7.0/tests/passing/js-poly.ml.opts000066400000000000000000000000161337455726700213200ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-ppx-struct.ml000066400000000000000000000012021337455726700215000ustar00rootroot00000000000000open! 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.7.0/tests/passing/js-sexp.ml000066400000000000000000000002751337455726700203370ustar00rootroot00000000000000let () =
  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.7.0/tests/passing/js-sexp.ml.opts000066400000000000000000000000161337455726700213140ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-str.ml000066400000000000000000000023301337455726700201620ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-str.ml.opts000066400000000000000000000000161337455726700211450ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-str.ml.ref000066400000000000000000000023321337455726700207370ustar00rootroot00000000000000(* 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.7.0/tests/passing/js-test.ml000066400000000000000000000014111337455726700203300ustar00rootroot00000000000000let%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.7.0/tests/passing/js-test.ml.opts000066400000000000000000000000161337455726700213140ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-try.ml000066400000000000000000000001201337455726700201630ustar00rootroot00000000000000(* nested "try" *)
try
  try x
  with e -> e
with e -> e (* indented too far *)
ocp-indent-1.7.0/tests/passing/js-try.ml.opts000066400000000000000000000000161337455726700211530ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-type.ml000066400000000000000000000012461337455726700203400ustar00rootroot00000000000000type 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.7.0/tests/passing/js-type.ml.opts000066400000000000000000000000161337455726700213160ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/js-var.ml000066400000000000000000000000421337455726700201400ustar00rootroot00000000000000type t =
  | A
  | B of int
  | C
ocp-indent-1.7.0/tests/passing/js-var.ml.opts000066400000000000000000000000161337455726700211250ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/let-and.ml000066400000000000000000000002661337455726700202720ustar00rootroot00000000000000let 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.7.0/tests/passing/let-open.ml000066400000000000000000000000721337455726700204640ustar00rootroot00000000000000
let _ =
  (* ... *)
  let open Option in
  indented_line
ocp-indent-1.7.0/tests/passing/lwt.ml000066400000000000000000000004761337455726700175570ustar00rootroot00000000000000let 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.7.0/tests/passing/lwt.ml.opts000066400000000000000000000000151337455726700205300ustar00rootroot00000000000000--syntax lwt
ocp-indent-1.7.0/tests/passing/macro.ml000066400000000000000000000001121337455726700200350ustar00rootroot00000000000000open Foo

INCLUDE "bar"

IFDEF "foo"
let f x = 3
ENDIF

TEST foo
TEST bar
ocp-indent-1.7.0/tests/passing/match_fun.ml000066400000000000000000000001561337455726700207100ustar00rootroot00000000000000let reset_cond =
  match states with
  | [ _ ] -> fun _ v _   -> e_id v
  |   _   -> fun s v clk -> (* … *)
ocp-indent-1.7.0/tests/passing/misc-2018.ml000066400000000000000000000016051337455726700202670ustar00rootroot00000000000000(* #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
ocp-indent-1.7.0/tests/passing/misc-2018.ml.opts000066400000000000000000000000351337455726700212470ustar00rootroot00000000000000-c strict_with=always,with=0
ocp-indent-1.7.0/tests/passing/module.ml000066400000000000000000000020561337455726700202320ustar00rootroot00000000000000module 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.7.0/tests/passing/multiline.ml000066400000000000000000000006661337455726700207540ustar00rootroot00000000000000let _ =
  (* 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.7.0/tests/passing/nested_variants.ml000066400000000000000000000003441337455726700221340ustar00rootroot00000000000000type 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.7.0/tests/passing/nesting.ml000066400000000000000000000004171337455726700204130ustar00rootroot00000000000000module 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.7.0/tests/passing/object.ml000066400000000000000000000005511337455726700202110ustar00rootroot00000000000000let 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.7.0/tests/passing/obuild.ml000066400000000000000000000002731337455726700202220ustar00rootroot00000000000000type predicate =
    Pred_Byte
  | Pred_Native
  | Pred_Toploop

let _ =
  { pkg with
      package_version = projFile.version
    ; package_description = _
    ; package_requires = [] }
ocp-indent-1.7.0/tests/passing/obuild.ml.opts000066400000000000000000000000471337455726700212050ustar00rootroot00000000000000-c base=2,type=2,match_clause=4,with=2
ocp-indent-1.7.0/tests/passing/ocamldoc.ml000066400000000000000000000111011337455726700205150ustar00rootroot00000000000000(** 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.7.0/tests/passing/ocamldoc2.ml000066400000000000000000000002371337455726700206070ustar00rootroot00000000000000a
  (* {[ (* {v *) ]} {v v} *)
  b

let _ =
  (*
     {[
       while true do
         xx
       done
       (* this is totally crazy !!! *)
     ]}
  *)
  ()
ocp-indent-1.7.0/tests/passing/partial-match.ml000066400000000000000000000001071337455726700214660ustar00rootroot00000000000000let () = match x with 
            | `A -> "A"
            | `B -> "B"
ocp-indent-1.7.0/tests/passing/partial-match.ml.opts000066400000000000000000000000131337455726700224460ustar00rootroot00000000000000--lines 3-
ocp-indent-1.7.0/tests/passing/partial.ml000066400000000000000000000004231337455726700203750ustar00rootroot00000000000000   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.7.0/tests/passing/partial.ml.opts000066400000000000000000000000141337455726700213550ustar00rootroot00000000000000--lines 5-8
ocp-indent-1.7.0/tests/passing/partial2.ml000066400000000000000000000000611337455726700204550ustar00rootroot00000000000000if () then () else
    match () with
    | () ->
ocp-indent-1.7.0/tests/passing/partial2.ml.opts000066400000000000000000000000361337455726700214430ustar00rootroot00000000000000--lines 3 -c strict_else=auto
ocp-indent-1.7.0/tests/passing/pattern.ml000066400000000000000000000015361337455726700204240ustar00rootroot00000000000000let 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.7.0/tests/passing/ppx-string.ml000066400000000000000000000004261337455726700210570ustar00rootroot00000000000000let 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.7.0/tests/passing/ppx_expr_ext.ml000066400000000000000000000042331337455726700214710ustar00rootroot00000000000000let 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
ocp-indent-1.7.0/tests/passing/ppx_expr_ext.ml.opts000066400000000000000000000000161337455726700224500ustar00rootroot00000000000000-c JaneStreet
ocp-indent-1.7.0/tests/passing/ppx_stritem_ext.ml000066400000000000000000000014101337455726700221740ustar00rootroot00000000000000let 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.7.0/tests/passing/quotations2.ml000066400000000000000000000034641337455726700212410ustar00rootroot00000000000000open 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.7.0/tests/passing/record-with.ml000066400000000000000000000013361337455726700211740ustar00rootroot00000000000000let 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.7.0/tests/passing/record_comments.ml000066400000000000000000000003151337455726700221240ustar00rootroot00000000000000type 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.7.0/tests/passing/records.ml000066400000000000000000000017201337455726700204030ustar00rootroot00000000000000let 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.7.0/tests/passing/semi.ml000066400000000000000000000003121337455726700176730ustar00rootroot00000000000000let 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.7.0/tests/passing/semisemi.ml000066400000000000000000000001301337455726700205470ustar00rootroot00000000000000module M = struct
  let () = ()
  ;;
  let f x = 3;;
  let () = ()
end

;;

let () = ()
ocp-indent-1.7.0/tests/passing/sequence.ml000066400000000000000000000011451337455726700205530ustar00rootroot00000000000000let 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.7.0/tests/passing/str_else_always.ml000066400000000000000000000012001337455726700221330ustar00rootroot00000000000000let () =
  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.7.0/tests/passing/str_else_always.ml.opts000066400000000000000000000000261337455726700231240ustar00rootroot00000000000000-c strict_else=always
ocp-indent-1.7.0/tests/passing/str_else_auto.ml000066400000000000000000000011621337455726700216120ustar00rootroot00000000000000let () =
  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.7.0/tests/passing/str_else_auto.ml.opts000066400000000000000000000000241337455726700225720ustar00rootroot00000000000000-c strict_else=auto
ocp-indent-1.7.0/tests/passing/str_else_never.ml000066400000000000000000000011501337455726700217560ustar00rootroot00000000000000let () =
  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.7.0/tests/passing/str_else_never.ml.opts000066400000000000000000000000251337455726700227420ustar00rootroot00000000000000-c strict_else=never
ocp-indent-1.7.0/tests/passing/traverse.mli000066400000000000000000000224611337455726700207530ustar00rootroot00000000000000(*
    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.7.0/tests/passing/traverse.mli.opts000066400000000000000000000000271337455726700217310ustar00rootroot00000000000000-c in=2,match_clause=4
ocp-indent-1.7.0/tests/passing/type-and.ml000066400000000000000000000001321337455726700204570ustar00rootroot00000000000000type a =
  | A
and b = int

module M = struct
  type s = t and t = {
    foo : s;
  }
end
ocp-indent-1.7.0/tests/passing/types.ml000066400000000000000000000027361337455726700201160ustar00rootroot00000000000000type ('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.7.0/tests/passing/unit-classes.ml000066400000000000000000000041751337455726700213630ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-expr.ml000066400000000000000000000042421337455726700206770ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-extensions.ml000066400000000000000000000026771337455726700221320ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-lex.ml000066400000000000000000000032161337455726700205110ustar00rootroot00000000000000(* -*- 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.7.0/tests/passing/unit-modexpr.ml000066400000000000000000000011131337455726700213710ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-modtypes.ml000066400000000000000000000014231337455726700215630ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-patterns.ml000066400000000000000000000007531337455726700215640ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-typedefs.ml000066400000000000000000000012631337455726700215440ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-types.ml000066400000000000000000000022151337455726700210630ustar00rootroot00000000000000(** 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.7.0/tests/passing/unit-values.ml000066400000000000000000000020061337455726700212140ustar00rootroot00000000000000(** 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.7.0/tests/passing/variants.ml000066400000000000000000000005461337455726700205760ustar00rootroot00000000000000type 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.7.0/tests/passing/with_2.ml000066400000000000000000000006271337455726700201430ustar00rootroot00000000000000let 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.7.0/tests/passing/with_2.ml.opts000066400000000000000000000000121337455726700211130ustar00rootroot00000000000000-c with=2
ocp-indent-1.7.0/tests/passing/with_never.ml000066400000000000000000000014321337455726700211140ustar00rootroot00000000000000let 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.7.0/tests/passing/with_never.ml.opts000066400000000000000000000000351337455726700220760ustar00rootroot00000000000000-c with=0,strict_with=always
ocp-indent-1.7.0/tests/test.sh000077500000000000000000000214211337455726700162620ustar00rootroot00000000000000#!/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)
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 --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
}

reffile() {
    [ $# -eq 1 ]
    if [ -e "$1.ref" ]
    then echo "$1.ref"
    else echo "$1"
    fi
}

PASSING=("")
FAILING=("")
if [ -n "$GIT" ]; then
    PASSING+=($(git ls-files 'passing/*.ml' 'passing/*.ml[iyl]'))
    FAILING+=($(git ls-files 'failing/*.ml' 'failing/*.ml[iyl]'))
else
    PASSING+=(passing/*.ml passing/*.ml[iyl])
    FAILING+=(failing/*.ml failing/*.ml[iyl])
fi
CHANGES=()


for f in ${PASSING[@]}; do
    base=$(basename $f)
    name=${base%.*}
    ocp-indent $f
    if diff -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 -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 -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 -y --suppress-common-lines \
            $(reffile $f) failing-output/$base \
            |wc -l)
        curcount=$(diff -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

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 -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.7.0/tools/000077500000000000000000000000001337455726700147425ustar00rootroot00000000000000ocp-indent-1.7.0/tools/dune000066400000000000000000000002231337455726700156150ustar00rootroot00000000000000(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.7.0/tools/ocp-indent.el000066400000000000000000000126771337455726700173410ustar00rootroot00000000000000;;; 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 (expand-file-name (make-temp-name "ocp-indent-error")
                                  temporary-file-directory))
       (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.7.0/tools/ocp-indent.vim000066400000000000000000000026471337455726700175300ustar00rootroot00000000000000" 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.7.0/tools/tuareg-indent000077500000000000000000000054651337455726700174500ustar00rootroot00000000000000#!/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
}

# CR-soon pszilagyi: This will whitespace-split individual arguments.
args=
while [ $# -gt 1 ]; do args="$args $1"; shift; done
file=$1

tuareg-indent "$file" $args