├── .gitignore ├── .ocp-indent ├── CHANGELOG ├── LICENSE ├── README.md ├── VERSION ├── doc ├── dune └── ocp-indent.md ├── dune-project ├── ocp-indent.opam ├── src ├── approx_lexer.mll ├── approx_tokens.ml ├── compat.ml ├── dune ├── indentArgs.ml ├── indentArgs.mli ├── indentBlock.ml ├── indentBlock.mli ├── indentConfig.ml ├── indentConfig.mli ├── indentExtend.ml ├── indentExtend.mli ├── indentLoader.ml ├── indentLoader.mli ├── indentMain.ml ├── indentPrinter.ml ├── indentPrinter.mli ├── nstream.ml ├── nstream.mli ├── pos.ml ├── pos.mli └── util.ml ├── tests ├── .ocp-indent ├── failing-output │ ├── escaped-nl.ml │ ├── indent-empty-numeric.ml │ ├── js-args.ml │ ├── js-begin.ml │ ├── js-fun.ml │ ├── js-functor.ml │ ├── js-pattern.ml │ ├── js-record.ml │ ├── js-syntax.ml │ ├── js-to-do.ml │ ├── js-upon.ml │ └── list_of_funs.ml ├── failing.html ├── failing │ ├── #js-default.ml# │ ├── escaped-nl.ml │ ├── escaped-nl.ml.ref │ ├── js-args.ml │ ├── js-args.ml.opts │ ├── js-begin.ml │ ├── js-begin.ml.opts │ ├── js-fun.ml │ ├── js-fun.ml.opts │ ├── js-functor.ml │ ├── js-functor.ml.opts │ ├── js-pattern.ml │ ├── js-pattern.ml.opts │ ├── js-record.ml │ ├── js-record.ml.opts │ ├── js-syntax.ml │ ├── js-syntax.ml.opts │ ├── js-to-do.ml │ ├── js-to-do.ml.opts │ ├── js-upon.ml │ ├── js-upon.ml.opts │ └── list_of_funs.ml ├── inplace │ ├── executable.ml │ ├── link.ml │ ├── link2.ml │ └── otherfile.ml ├── passing │ ├── alignment.ml │ ├── bracket.ml │ ├── cinaps.ml │ ├── comments.ml │ ├── core-failing.ml │ ├── core-passing.ml │ ├── edge-cases.ml │ ├── embedded-match.ml │ ├── exprs.ml │ ├── extensible.ml │ ├── gadt.ml │ ├── ifand.ml │ ├── indent-empty-1.ml │ ├── indent-empty-1.ml.opts │ ├── indent-empty-1.ml.ref │ ├── indent-empty-nm.ml │ ├── indent-empty-nm.ml.opts │ ├── indent-empty-nm.ml.ref │ ├── indent-empty.ml │ ├── indent-empty.ml.opts │ ├── indent-empty.ml.ref │ ├── js-2018.ml │ ├── js-2018.ml.opts │ ├── js-and.ml │ ├── js-and.ml.opts │ ├── js-andand.ml │ ├── js-andand.ml.opts │ ├── js-applicative.ml │ ├── js-applicative.ml.opts │ ├── js-bench.ml │ ├── js-bench.ml.opts │ ├── js-bind.ml │ ├── js-bind.ml.opts │ ├── js-comment.ml │ ├── js-comment.ml.opts │ ├── js-comment.ml.ref │ ├── js-comment1.ml │ ├── js-comment1.ml.opts │ ├── js-comment1.ml.ref │ ├── js-default.ml │ ├── js-default.ml.opts │ ├── js-fun-rec.ml │ ├── js-fun-rec.ml.opts │ ├── js-label.ml │ ├── js-label.ml.opts │ ├── js-let.ml │ ├── js-let.ml.opts │ ├── js-list.ml │ ├── js-list.ml.opts │ ├── js-low-priority.ml │ ├── js-low-priority.ml.opts │ ├── js-map.ml │ ├── js-map.ml.opts │ ├── js-model.ml │ ├── js-model.ml.opts │ ├── js-pipebang.ml │ ├── js-pipebang.ml.opts │ ├── js-poly.ml │ ├── js-poly.ml.opts │ ├── js-ppx-struct.ml │ ├── js-sexp.ml │ ├── js-sexp.ml.opts │ ├── js-str.ml │ ├── js-str.ml.opts │ ├── js-str.ml.ref │ ├── js-test.ml │ ├── js-test.ml.opts │ ├── js-try.ml │ ├── js-try.ml.opts │ ├── js-type.ml │ ├── js-type.ml.opts │ ├── js-var.ml │ ├── js-var.ml.opts │ ├── let-and.ml │ ├── let-open.ml │ ├── lwt.ml │ ├── lwt.ml.opts │ ├── macro.ml │ ├── match_fun.ml │ ├── misc-2018.ml │ ├── misc-2018.ml.opts │ ├── misc-2019.ml │ ├── misc-2019.ml.opts │ ├── module.ml │ ├── multiline.ml │ ├── nested_variants.ml │ ├── nesting.ml │ ├── never_align.ml │ ├── never_align.ml.opts │ ├── object.ml │ ├── obuild.ml │ ├── obuild.ml.opts │ ├── ocamldoc.ml │ ├── ocamldoc2.ml │ ├── partial-match.ml │ ├── partial-match.ml.opts │ ├── partial.ml │ ├── partial.ml.opts │ ├── partial2.ml │ ├── partial2.ml.opts │ ├── pattern.ml │ ├── ppx-string.ml │ ├── ppx_expr_ext.ml │ ├── ppx_expr_ext.ml.opts │ ├── ppx_stritem_ext.ml │ ├── quotations2.ml │ ├── record-with.ml │ ├── record_comments.ml │ ├── records.ml │ ├── semi.ml │ ├── semisemi.ml │ ├── sequence.ml │ ├── str_else_always.ml │ ├── str_else_always.ml.opts │ ├── str_else_auto.ml │ ├── str_else_auto.ml.opts │ ├── str_else_never.ml │ ├── str_else_never.ml.opts │ ├── traverse.mli │ ├── traverse.mli.opts │ ├── type-and.ml │ ├── types.ml │ ├── unit-classes.ml │ ├── unit-expr.ml │ ├── unit-extensions.ml │ ├── unit-lex.ml │ ├── unit-modexpr.ml │ ├── unit-modtypes.ml │ ├── unit-patterns.ml │ ├── unit-typedefs.ml │ ├── unit-types.ml │ ├── unit-values.ml │ ├── variants.ml │ ├── with_2.ml │ ├── with_2.ml.opts │ ├── with_never.ml │ └── with_never.ml.opts └── test.sh └── tools ├── dune ├── ocp-indent.el ├── ocp-indent.vim └── tuareg-indent /.gitignore: -------------------------------------------------------------------------------- 1 | .hgignore.in 2 | Makefile.config 3 | jbuild-ignore 4 | ocp-build.root* 5 | _obuild 6 | config.log 7 | config.status 8 | ocp-indent 9 | src/indentVersion.ml 10 | *~ 11 | version.ocp 12 | autom4te.cache 13 | aclocal.m4 14 | man/man1/ 15 | src/.hgignore.in 16 | src/Makefile.extracted-from-jenga 17 | src/buildable_targets.list 18 | **/.fe.sexp 19 | _build 20 | .merlin 21 | *.install -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | # -*- conf -*- 2 | # This is an example configuration file for ocp-indent 3 | # 4 | # Copy to the root of your project with name ".ocp-indent", customise, and 5 | # transparently get consistent indentation on all your ocaml source files. 6 | 7 | # Starting the configuration file with a preset ensures you won't fallback to 8 | # definitions from "~/.ocp/ocp-indent.conf". 9 | # These are `normal`, `apprentice` and `JaneStreet` and set different defaults. 10 | normal 11 | 12 | # 13 | # INDENTATION VALUES 14 | # 15 | 16 | # Number of spaces used in all base cases, for example: 17 | # let foo = 18 | # ^^bar 19 | base = 2 20 | 21 | # Indent for type definitions: 22 | # type t = 23 | # ^^int 24 | type = 2 25 | 26 | # Indent after `let in` (unless followed by another `let`): 27 | # let foo = () in 28 | # ^^bar 29 | in = 0 30 | 31 | # Indent after `match/try with` or `function`: 32 | # match foo with 33 | # ^^| _ -> bar 34 | with = 0 35 | 36 | # Indent for clauses inside a pattern-match (after the arrow): 37 | # match foo with 38 | # | _ -> 39 | # ^^^^bar 40 | # the default is 2, which aligns the pattern and the expression 41 | match_clause = 4 # this is non-default 42 | 43 | # Indentation for items inside extension nodes: 44 | # [%% id.id 45 | # ^^^^contents ] 46 | # [@@id 47 | # ^^^^foo 48 | # ] 49 | ppx_stritem_ext = 2 50 | 51 | # When nesting expressions on the same line, their indentation are in 52 | # some cases stacked, so that it remains correct if you close them one 53 | # at a line. This may lead to large indents in complex code though, so 54 | # this parameter can be used to set a maximum value. Note that it only 55 | # affects indentation after function arrows and opening parens at end 56 | # of line. 57 | # 58 | # for example (left: `none`; right: `4`) 59 | # let f = g (h (i (fun x -> # let f = g (h (i (fun x -> 60 | # x) # x) 61 | # ) # ) 62 | # ) # ) 63 | max_indent = 4 64 | 65 | 66 | # 67 | # INDENTATION TOGGLES 68 | # 69 | 70 | # Wether the `with` parameter should be applied even when in a sub-block. 71 | # Can be `always`, `never` or `auto`. 72 | # if `always`, there are no exceptions 73 | # if `auto`, the `with` parameter is superseded when seen fit (most of the time, 74 | # but not after `begin match` for example) 75 | # if `never`, `with` is only applied if the match block starts a line. 76 | # 77 | # For example, the following is not indented if set to `always`: 78 | # let f = function 79 | # ^^| Foo -> bar 80 | strict_with = never 81 | 82 | # Controls indentation after the `else` keyword. `always` indents after the 83 | # `else` keyword normally, like after `then`. 84 | # If set to `never', the `else` keyword won't indent when followed by a newline. 85 | # `auto` indents after `else` unless in a few "unclosable" cases (`let in`, 86 | # `match`...). 87 | # 88 | # For example, with `strict_else=never`: 89 | # if cond then 90 | # foo 91 | # else 92 | # bar; 93 | # baz 94 | # `never` is discouraged if you may encounter code like this example, 95 | # because it hides the scoping error (`baz` is always executed) 96 | strict_else = always 97 | 98 | # Ocp-indent will normally try to preserve your in-comment indentation, as long 99 | # as it respects the left-margin or starts with `(*\n`. Setting this to `true` 100 | # forces alignment within comments. 101 | strict_comments = false 102 | 103 | # Toggles preference of column-alignment over line indentation for most 104 | # of the common operators and after mid-line opening parentheses. 105 | # 106 | # for example (left: `false'; right: `true') 107 | # let f x = x # let f x = x 108 | # + y # + y 109 | align_ops = true 110 | 111 | # Function parameters are normally indented one level from the line containing 112 | # the function. This option can be used to have them align relative to the 113 | # column of the function body instead. 114 | # if set to `always`, always align below the function 115 | # if `auto`, only do that when seen fit (mainly, after arrows) 116 | # if `never`, no alignment whatsoever 117 | # 118 | # for example (left: `never`; right: `always or `auto) 119 | # match foo with # match foo with 120 | # | _ -> some_fun # | _ -> some_fun 121 | # ^^parameter # ^^parameter 122 | align_params = auto 123 | 124 | 125 | # 126 | # SYNTAX EXTENSIONS 127 | # 128 | 129 | # You can also add syntax extensions (as per the --syntax command-line option): 130 | # syntax = mll lwt 131 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | ## 1.8.1 2 | * tiny API change to help with the detection of top-level phrase boundaries 3 | * fixed a bug with end of comment detection in some cases (esp. related to cinaps) 4 | * tweaks for better indentation within cinaps comments 5 | * lowered priority of algebraic attributes in expressions (`[@...]`) to better match the actual meaning. 6 | 7 | ## 1.8.0 8 | * compatibility with OCaml 4.08.0 (new attributes, monadic lets...) 9 | * lots of smaller indentation fixes (module types, empty variants...) 10 | * more reliable "inplace" mode (preserving symlinks and permissions) 11 | * XDG compatibility (e.g. config file below `~/.config`) 12 | * support for "cinaps" comments (indent as code comments that start with `(*$`) 13 | * API: `IndentBlock.is_at_top` now returns true for top-level expressions 14 | 15 | ## 1.7.0 16 | * lots of small fixes 17 | * better handling of attributes and extension points 18 | * better handling of GADT definitions 19 | * fixed a stack-overflow on extremely large files 20 | * indent the same (1 step) after `let f = fun x ->` and `let f =\n fun x ->` 21 | * build using dune 22 | 23 | ## 1.6.1 24 | * fixes related to ppx extensions 25 | * fixed regression on indentation within record types 26 | 27 | ## 1.6.0 28 | * fixes some cases of comments 29 | * supports new cases of ppx 30 | * fixed cases of unstable indentation within records 31 | * supports local excemtions 32 | * fixed handling of polymorphic methods 33 | * uses cmdliner 1.0.0 34 | 35 | ## 1.5.3 36 | * fixes on nested try-with and some cases of comments 37 | * better alignment of stand-alone semicolons in records 38 | * improved emacs and vim scripts 39 | * better indentation within extension blocks 40 | 41 | ## 1.5.2 42 | * small emacs binding fix 43 | * compatibility with cmdliner 0.9.8 44 | 45 | ## 1.5.1 46 | * generic handling of ppx keywords 47 | * much improved vim binding 48 | * changed installation location of vim bindings (to share/ocp-indent/vim/indent) for easier autoload 49 | * don't increase indentation level for sequences of try..with 50 | * support for '[@' 51 | * restore back-alignment of '&&', '||' after 'if' and 'when' 52 | * support for extensible variant types 53 | 54 | ## 1.5 55 | * new vim binding 56 | * support for ppx lwt keywords 57 | * fixed indentation at BOF and EOF in some cases 58 | * back-alignment of '&&' and '||' disabled 59 | * tweaks to functor, struct and module indentation 60 | * support for ppx attributes 61 | * lots of fixes and tweaks 62 | 63 | ## 1.4.1 64 | * OCaml 4.01.0 warnings fix 65 | * fixed indent of lwt try/finally 66 | * sort Jane Street tests by priority 67 | * added support for BENCH syntax 68 | * added support for the new {xx| |xx} quotation syntax 69 | * emacs mode: cleaner loading 70 | * emacs mode: fixed the 'syntax' option 71 | * emacs mode: workaround an auto-complete.el display bug 72 | * emacs and vim modes: install in editor-specific directories 73 | * refactored build system. Install through opam-installer, register libs as ocamlfind sub-packages 74 | 75 | ## 1.4.0 76 | * license change: lessening the GPL to make ocp-indent easier to use as a library 77 | * removed indent by default after most common operators (when align_ops is set) 78 | * removed extra-indent in some pattern-matching cases 79 | * fixed a few bugs related to records, lazy as pattern, "module with" 80 | * added support for the cstruct syntax extension 81 | * fixed Makefile to properly install all cmi files, working around an ocp-build bug 82 | 83 | ## 1.3.2 84 | * bug-fix release: object types, module type of, first line, etc. 85 | 86 | ## 1.3.1 87 | * optimised functional operators on OCaml 4.00 88 | * fixed a bug in phrase boundary detection 89 | 90 | ## 1.3.0 91 | * Large API rewrite, offering much more flexibility and functionality 92 | * Still some bug fixes (comments at end, nested ocamldoc tags, etc.) 93 | * Man-page fixes (thanks to Kaustuv Chaudhuri) 94 | * Temporarily disabled the non-functional state-marshalling function 95 | * Emacs mode: auto-disabling indent-tabs-mode by default, it's not compatible 96 | anyways. 97 | 98 | ## 1.2.2 99 | * Fixed critical bug with the parsing of the --syntax option 100 | * a few indent fixes (functor sigs, comments in expressions) 101 | 102 | ## 1.2.1 103 | * Fixed bugs with GADTs, comments at end of modules 104 | * Fixed compilation with OCaml trunk (warnings as errors) 105 | * New vim script, contributed by Jonathan Derque 106 | * New option "strict_else" to allow unindenting after else 107 | 108 | ## 1.2.0 109 | * Lots of fixes 110 | * Switched most operators and constructs with parentheses to column aligned by 111 | default (can be disabled with option align_ops) 112 | * Better handling of records 113 | * Some code cleanup (record fields with meaningful names) 114 | * Documentation and manpage (now relying on cmdliner) 115 | * Added an option (max_indent) to limit over-indent in the most annoying cases 116 | * Syntax extensions can now be enabled from the configuration files 117 | 118 | ## 1.1.0 119 | * Small fixes, stabilised ocamldoc indentation 120 | * Support for configuration files, either user or project-wide 121 | 122 | ## 1.0.2 123 | * Supporting indentation of ocamldoc. In particular, code within 124 | ocamldoc blocks {[...]} should be automatically indented 125 | * Fixed the emacs mode not to set the mark 126 | * A few new configuration options (strict_with, strict_comments, align_params) 127 | * A few tweaks and improvements (better empty line indent, etc.) 128 | * Bugfixes (#43, #47) 129 | 130 | ## 1.0.1 131 | * Indentation of comments now follows ocamldoc conventions properly 132 | * Partial indent adapts more closely to manual indentation 133 | * Various small fixes (indent on empty lines, freeform comments...) 134 | -------------------------------------------------------------------------------- /VERSION: -------------------------------------------------------------------------------- 1 | 1.8.1 2 | -------------------------------------------------------------------------------- /doc/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets ocp-indent.1) 3 | (action 4 | (with-stdout-to %{targets} 5 | (run %{bin:ocp-indent} --help=groff))) 6 | ) 7 | (install 8 | (section man) 9 | (files ocp-indent.1) 10 | ) 11 | -------------------------------------------------------------------------------- /doc/ocp-indent.md: -------------------------------------------------------------------------------- 1 | # ocp-indent 2 | 3 | A simple tool to indent OCaml programs 4 | 5 | Authors: Louis Gesbert (OCamlPro), Thomas Gazagnaire (OCamlPro), Jun Furuse 6 | 7 | License: LGPL 2.1 with linking exception 8 | 9 | ## Installation 10 | 11 | ### Using OPAM 12 | 13 | The simplest way to install `ocp-indent` is using [OPAM](http://opam.ocamlpro.com): 14 | 15 | ```bash 16 | opam install ocp-indent 17 | ``` 18 | 19 | ### By hand 20 | 21 | You can also compile and install `ocp-indent` from sources. You'll need `ocaml 22 | (>= 3.12.1)` and `ocp-build (>= 1.99.6-beta)`: 23 | 24 | ```bash 25 | ./configure 26 | make 27 | make install 28 | ``` 29 | 30 | If you use opam and want it installed alongside ocaml, you may want to use 31 | `./configure --prefix $(opam config var prefix)`. 32 | 33 | ## Usage 34 | 35 | The above installation step copies elisp scripts to 36 | `/share/emacs/site-lisp/` and vim scripts to 37 | `/share/ocp-indent/vim/`. You then need to load them in the editor of 38 | your choice to automatically use ocp-indent. 39 | 40 | Installing OPAM package 41 | [`user-setup`](https://opam.ocaml.org/packages/user-setup/user-setup.0.3/) will 42 | trigger automatic configuration for popular editors (emacs and vim currently, 43 | but more are in the works). If you prefer to handle your configuration manually, 44 | read on. 45 | 46 | ### Emacs 47 | 48 | Run the following command to setup tuareg-mode or caml-mode to use `ocp-indent` 49 | for indentation: 50 | 51 | ```bash 52 | echo '(load-file "'"$(opam config var share)"'/emacs/site-lisp/ocp-indent.el")' >>~/.emacs 53 | ``` 54 | 55 | The `tab` key should now reindent the current line using ocp-indent. 56 | 57 | ### Vim 58 | 59 | Use the following command to tell Vim to use `ocp-indent` to indent OCaml code: 60 | 61 | ```bash 62 | echo 'set rtp^="'"$(opam config var ocp-indent:share)"'/vim"' >>~/.vimrc 63 | ``` 64 | 65 | Automatic indentation as you type should take place, depending on your 66 | configuration. Use `==` to reindent the current line, and `=G` to reindent until 67 | the end of buffer. 68 | 69 | ### Other editors 70 | 71 | As `ocp-indent` is a command-line tool, you can easily integrate it with other editors. 72 | 73 | ```bash 74 | ocp-indent > 75 | ``` 76 | 77 | You can also tell it to indent only a subsets of lines, and to output only the indentation level: 78 | 79 | ```bash 80 | ocp-indent --lines - --numeric 81 | ``` 82 | 83 | ## Configuration options 84 | 85 | By default, `ocp-indent` comes with sensible default parameters. However, 86 | you can customize some of the indentation options using command-line 87 | arguments. For more details, see: 88 | 89 | ```bash 90 | ocp-indent --help 91 | ``` 92 | 93 | ### Configuration file 94 | The same parameters can be defined in a configuration file, allowing for user 95 | defaults and per-project parameters. The latter is particularly convenient to 96 | transparently ensure consistency in projects with many contributors, without 97 | requiring them to change their settings in any way (except that, obviously, they 98 | need to use ocp-indent !). 99 | 100 | If a `.ocp-indent` file is found in the current directory or its ancestors, it 101 | overrides definitions from `$XDG_CONFIG_HOME/ocp/ocp-indent.conf`, 102 | `~/.ocp/ocp-indent.conf` and the built-in default. The command-line can of 103 | course still be used to override parameters defined in the files. 104 | 105 | Have a look at ocp-indent's own [`.ocp-indent`](.ocp-indent) file for an 106 | example. 107 | 108 | ### In-file configuration 109 | There is no built-in support for in-file configuration directives. Yet, some 110 | editors already provide that features, and with emacs, starting your file with a 111 | line like: 112 | 113 | ``` 114 | (* -*- ocp-indent-config: in=2 -*- *) 115 | ``` 116 | 117 | will enable you to have the indentation after `in` setup to 2 locally on this 118 | file. 119 | 120 | 121 | ## How does it compare to tuareg ? 122 | 123 | We've run some benchmarks on real code-bases and the result is quite 124 | conclusive. Keep in mind than most of existing source files are 125 | either indented manually or following tuareg standards. You can 126 | see the results [here](http://htmlpreview.github.com/?https://github.com/AltGr/ocp-indent-tests/blob/master/status.html). 127 | 128 | Moreover, as `ocp-indent` has a deep understanding of the OCaml syntax 129 | it shines on specific cases. See for instance the collection of 130 | unit-tests 131 | [here](https://github.com/OCamlPro/ocp-indent/tree/master/tests/passing). The 132 | currently failing tests can be seen 133 | [here](http://htmlpreview.github.com/?https://github.com/OCamlPro/ocp-indent/blob/master/tests/failing.html). 134 | 135 | 136 | ## Testing 137 | 138 | It's hard to deliver a great indenter without tests. We've built 139 | `ocp-indent` based on a growing collection of unit-tests. If you find an 140 | indentation bug, feel free to send us a code snippet that we will 141 | incorporate into our test suite. 142 | 143 | The tests are organized as follows: 144 | 145 | * `tests/passing` contains tests that are properly indented and should be left 146 | unchanged by ocp-indent. 147 | * `tests/failing` contains tests for which ocp-indent currently returns the 148 | results in `tests/failing-output`, hence `meld tests/failing{,-output}` should 149 | give an overview of currently known bugs (also available online 150 | [here](http://htmlpreview.github.com/?https://github.com/OCamlPro/ocp-indent/blob/master/tests/failing.html)). 151 | * `tests/test.sh` checks the current state against the reference state (checked 152 | into git). 153 | * `tests/test.sh --[git-]update` updates the current reference state. 154 | * See `tests/test.sh --help` for more 155 | 156 | Please make sure tu run `make && tests/test.sh --git-update` before any commit, 157 | so that the repo always reflects the state of the program. 158 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | (name ocp-indent) 3 | (version 1.8.1) 4 | -------------------------------------------------------------------------------- /ocp-indent.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "contact@ocamlpro.com" 3 | synopsis: "A simple tool to indent OCaml programs" 4 | description: """ 5 | Ocp-indent is based on an approximate, tolerant OCaml parser and a simple stack 6 | machine ; this is much faster and more reliable than using regexps. Presets and 7 | configuration options available, with the possibility to set them project-wide. 8 | Supports most common syntax extensions, and extensible for others. 9 | 10 | Includes: 11 | - An indentor program, callable from the command-line or from within editors 12 | - Bindings for popular editors 13 | - A library that can be directly used by editor writers, or just for 14 | fault-tolerant/approximate parsing. 15 | """ 16 | authors: [ 17 | "Louis Gesbert " 18 | "Thomas Gazagnaire " 19 | "Jun Furuse" 20 | ] 21 | homepage: "http://www.typerex.org/ocp-indent.html" 22 | bug-reports: "https://github.com/OCamlPro/ocp-indent/issues" 23 | license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" 24 | tags: ["org:ocamlpro" "org:typerex"] 25 | dev-repo: "git+https://github.com/OCamlPro/ocp-indent.git" 26 | build: [ 27 | ["dune" "build" "-p" name "-j" jobs] 28 | ] 29 | run-test: [ 30 | ["dune" "runtest" "-p" name "-j" jobs] 31 | ] 32 | depends: [ 33 | "ocaml" 34 | "dune" {>= "1.0"} 35 | "cmdliner" {>= "1.0.0"} 36 | "ocamlfind" 37 | "base-bytes" 38 | ] 39 | post-messages: [ 40 | "This package requires additional configuration for use in editors. Install package 'user-setup', or manually: 41 | 42 | * for Emacs, add these lines to ~/.emacs: 43 | (add-to-list 'load-path \"%{share}%/emacs/site-lisp\") 44 | (require 'ocp-indent) 45 | 46 | * for Vim, add this line to ~/.vimrc: 47 | set rtp^=\"%{share}%/ocp-indent/vim\" 48 | " 49 | {success & !user-setup:installed} 50 | ] 51 | -------------------------------------------------------------------------------- /src/compat.ml: -------------------------------------------------------------------------------- 1 | external ( @* ) : ('a -> 'b) -> 'a -> 'b = "%apply" 2 | external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply" 3 | 4 | 5 | module String = struct 6 | include String 7 | 8 | let is_space = function 9 | | ' ' | '\012' | '\n' | '\r' | '\t' -> true 10 | | _ -> false 11 | end 12 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets indentVersion.ml) 3 | (action 4 | (with-stdout-to %{targets} 5 | (echo "let version = \"%{version:ocp-indent}\""))) 6 | ) 7 | (ocamllex approx_lexer) 8 | (library 9 | (name ocp_indent_lexer) 10 | (public_name ocp-indent.lexer) 11 | (wrapped false) 12 | (modules indentExtend approx_tokens approx_lexer) 13 | ) 14 | (library 15 | (name ocp_indent_lib) 16 | (wrapped false) 17 | (public_name ocp-indent.lib) 18 | (libraries ocp-indent.utils) 19 | (modules indentConfig indentBlock indentPrinter) 20 | (flags :standard -w -9 -warn-error -57) 21 | ) 22 | (library 23 | (name ocp_indent_utils) 24 | (public_name ocp-indent.utils) 25 | (wrapped false) 26 | (libraries bytes ocp-indent.lexer) 27 | (modules compat pos util nstream) 28 | ) 29 | (library 30 | (name ocp_indent_dynlink) 31 | (public_name ocp-indent.dynlink) 32 | (wrapped false) 33 | (modules indentLoader) 34 | (libraries findlib dynlink ocp-indent.lexer ocp-indent.utils) 35 | ) 36 | (executable 37 | (name indentMain) 38 | (public_name ocp-indent) 39 | (modules indentVersion indentArgs indentMain) 40 | (libraries cmdliner ocp-indent.lexer ocp-indent.lib ocp-indent.dynlink unix) 41 | (flags :standard -w -9) 42 | ) 43 | -------------------------------------------------------------------------------- /src/indentArgs.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2013 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | type input = InChannel of in_channel 18 | | File of string 19 | 20 | (* Type of parameters obtained from command-line options *) 21 | type t = private { 22 | file_out : string option; 23 | numeric: bool; 24 | indent_config: string list; 25 | debug: bool; 26 | inplace : bool; 27 | indent_empty: bool; 28 | in_lines: int -> bool; 29 | indent_printer: out_channel -> unit IndentPrinter.output_kind; 30 | syntax_exts: string list; 31 | dynlink : [`Pkg of string | `Mod of string ] list; 32 | } 33 | 34 | val options: (t * input list) Cmdliner.Term.t 35 | 36 | val info: Cmdliner.Term.info 37 | -------------------------------------------------------------------------------- /src/indentBlock.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2012,2013 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | (** Indenter block *) 18 | type t 19 | 20 | (** Shift a block by a given offset *) 21 | val shift: t -> int -> t 22 | 23 | (** Set the start column of the given block to [column] *) 24 | val set_column: t -> int -> t 25 | 26 | (** [reverse block] updates the stack to account for the original indentation, 27 | assumed as correct. Useful for partial indentation *) 28 | val reverse: t -> t 29 | 30 | (** Return the current line offset *) 31 | val offset: t -> int 32 | 33 | (** Return the padding of the block, ie expected relative indentation of 34 | sub-blocks *) 35 | val padding: t -> int 36 | 37 | (** Return the block indentation *) 38 | val indent: t -> int 39 | 40 | (** Return the block original starting column *) 41 | val original_column: t -> int 42 | 43 | (** The empty block *) 44 | val empty: t 45 | 46 | (** [update t str tok] computes the new block state after processing 47 | the token [tok] in block [t]. The next tokens can be observed in 48 | the stream [str]. *) 49 | val update : IndentConfig.t -> t -> Nstream.t -> Nstream.token -> t 50 | 51 | (** Display token and stack of the block *) 52 | val dump: t -> unit 53 | 54 | (** [guess_indent line block] 55 | For indenting empty lines: attempt to guess what the most probable 56 | indent at this point would be *) 57 | val guess_indent: int -> t -> int 58 | 59 | (** A block is considered clean when it is not linked to any parser state (ie 60 | it's not within a comment, string, or ocamldoc stuff). This is not enough 61 | for a safe checkpoint: lots of rules depend on the previous/next token to 62 | decide indentation. *) 63 | val is_clean: t -> bool 64 | 65 | (** True only when the block is at the root of the file (the stack is empty, the 66 | block isn't included in any syntactical construct), and for top-level 67 | constructs. Implies is_clean *) 68 | val is_at_top: t -> bool 69 | 70 | (** True for any block that is alone on its stack *) 71 | val no_parents: t -> bool 72 | 73 | (** Returns true if the given block is at a top-level declaration level, ie not 74 | within any expression or type definition, but possibly inside a module, 75 | signature or class definition. Implies is_clean. Should be safe for 76 | checkpoints *) 77 | val is_declaration: t -> bool 78 | 79 | (** Either we are at a comment, or within an ocamldoc block *) 80 | val is_in_comment: t -> bool 81 | -------------------------------------------------------------------------------- /src/indentConfig.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2013 OCamlPro *) 4 | (* *) 5 | (* All rights reserved.This file is distributed under the terms of the *) 6 | (* GNU Lesser General Public License version 2.1 with linking *) 7 | (* exception. *) 8 | (* *) 9 | (* TypeRex is distributed in the hope that it will be useful, *) 10 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 11 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 12 | (* Lesser GNU General Public License for more details. *) 13 | (* *) 14 | (**************************************************************************) 15 | 16 | type threechoices = Always | Never | Auto 17 | 18 | (** See the [man] function to get the details of what the options are 19 | supposed to do (or the template .ocp-indent) *) 20 | type t = { 21 | 22 | i_base: int; 23 | (** indentation values *) 24 | i_type: int; 25 | i_in: int; 26 | i_with: int; 27 | i_match_clause: int; 28 | i_ppx_stritem_ext: int; 29 | 30 | i_max_indent: int option; 31 | (** indentation toggles *) 32 | i_strict_with: threechoices; 33 | i_strict_else: threechoices; 34 | i_strict_comments: bool; 35 | i_align_ops: bool; 36 | i_align_params: threechoices; 37 | i_match_tail_cascade: bool; 38 | } 39 | 40 | (** Documentation of the indentation options, in the Cmdliner 'Manpage.block' format *) 41 | 42 | type man_block = 43 | [ `S of string | `P of string | `Pre of string | `I of string * string 44 | | `Noblank | `Blocks of man_block list ] 45 | 46 | val man: man_block list 47 | 48 | val default: t 49 | 50 | (** String format is ["option=value,option2=value,..."]. Commas can be replaced 51 | by newlines. Use [?extra] to handle extra options (by side-effects only) *) 52 | val update_from_string : ?extra:(string -> (string -> unit) option) -> 53 | t -> string -> t 54 | 55 | (** sep should be comma or newline if you want to reparse. Comma by default *) 56 | val to_string : ?sep:string -> t -> string 57 | 58 | (** Load from the given filename, optionally updating from the given indent 59 | instead of the default one. On error, returns the original indent config 60 | unchanged and prints a message to stderr. The file may also contain 61 | bindings of the form 'syntax=SYNTAX_EXTENSION[,...]', that are returned 62 | as a the list of their names *) 63 | val load: ?indent:t -> string -> t * string list * [`Mod of string | `Pkg of string] list 64 | 65 | (** Save the given indent config to the given filename; returns true on 66 | success *) 67 | val save: t -> string -> bool 68 | 69 | (** Looks in given and parent directories for a [.ocp-indent] configuration 70 | file *) 71 | val find_conf_file: string -> string option 72 | 73 | (** Returns the local default configuration, obtained from (in order), the 74 | built-in [default], the file [~/.ocp/ocp-indent.conf], a file [.ocp-indent] 75 | in the current directory or any parent, and the environment variable 76 | [OCP_INDENT_CONFIG]. Returns the list of syntax extensions that may 77 | have been activated in conf-files as well *) 78 | val local_default: ?path:string -> unit -> t * string list * [`Mod of string | `Pkg of string] list 79 | -------------------------------------------------------------------------------- /src/indentExtend.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* All rights reserved.This file is distributed under the terms of the *) 4 | (* GNU Lesser General Public License version 2.1 with linking *) 5 | (* exception. *) 6 | (* *) 7 | (* TypeRex is distributed in the hope that it will be useful, *) 8 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 9 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 10 | (* Lesser GNU General Public License for more details. *) 11 | (* *) 12 | (**************************************************************************) 13 | 14 | exception Syntax_not_found of string 15 | 16 | type t = { 17 | keywords : (string * Approx_tokens.token) list; 18 | lexer : (Lexing.lexbuf -> Approx_tokens.token) option 19 | } 20 | 21 | let extensions = Hashtbl.create 17 22 | 23 | let register name ?(keywords=[]) ?lexer () = 24 | Hashtbl.add extensions name {keywords;lexer} 25 | 26 | let available () = 27 | Hashtbl.fold (fun name _ acc -> name::acc) extensions [] 28 | 29 | let find (name : string) = 30 | try 31 | Hashtbl.find extensions name 32 | with Not_found -> 33 | raise (Syntax_not_found name) 34 | 35 | (* predefined extensions *) 36 | open Approx_tokens 37 | let _ = 38 | register "lwt" ~keywords:[ 39 | "for_lwt", FOR; 40 | "lwt", LET; 41 | "match_lwt", MATCH; 42 | "try_lwt", TRY; 43 | "while_lwt", WHILE; 44 | "finally", WITH; (* -- no equivalence for this one, this is a hack ! *) 45 | ] (); 46 | register "mll" ~keywords:[ 47 | "rule", LET; 48 | "parse", FUNCTION; 49 | ] (); 50 | register "stream" ~keywords:[ 51 | "parser", FUNCTION; 52 | ] (); 53 | register "cstruct" ~keywords:[ 54 | "cstruct", TYPE; 55 | ] (); 56 | register "bitstring" ~keywords:[ 57 | "bitmatch", MATCH; 58 | ] (); 59 | -------------------------------------------------------------------------------- /src/indentExtend.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* All rights reserved.This file is distributed under the terms of the *) 4 | (* GNU Lesser General Public License version 2.1 with linking *) 5 | (* exception. *) 6 | (* *) 7 | (* TypeRex is distributed in the hope that it will be useful, *) 8 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 9 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 10 | (* Lesser GNU General Public License for more details. *) 11 | (* *) 12 | (**************************************************************************) 13 | 14 | exception Syntax_not_found of string 15 | 16 | type t = { 17 | keywords : (string * Approx_tokens.token) list; 18 | lexer : (Lexing.lexbuf -> Approx_tokens.token) option 19 | } 20 | 21 | (** Register lexer extension.*) 22 | val register : string -> 23 | ?keywords:(string * Approx_tokens.token) list -> 24 | ?lexer:(Lexing.lexbuf -> Approx_tokens.token) -> 25 | unit -> unit 26 | 27 | (** Get available extensions *) 28 | val available : unit -> string list 29 | 30 | (** Find an extension by its name *) 31 | val find : string -> t 32 | -------------------------------------------------------------------------------- /src/indentLoader.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* All rights reserved.This file is distributed under the terms of the *) 4 | (* GNU Lesser General Public License version 2.1 with linking *) 5 | (* exception. *) 6 | (* *) 7 | (* TypeRex is distributed in the hope that it will be useful, *) 8 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 9 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 10 | (* Lesser GNU General Public License for more details. *) 11 | (* *) 12 | (**************************************************************************) 13 | 14 | module SS = Set.Make(String) 15 | 16 | let loaded = ref SS.empty 17 | 18 | let predicates = 19 | if Dynlink.is_native 20 | then [ "plugin" ; "native" ] 21 | else [ "plugin" ; "byte" ] 22 | 23 | let dynlink debug s = 24 | if debug then Format.eprintf "loading archive %s..@." s; 25 | try 26 | Dynlink.loadfile s 27 | with exc -> 28 | Format.eprintf "Error while linking %s : %s@." s (Printexc.to_string exc); 29 | raise exc 30 | 31 | let load_pkg debug pkg = 32 | if not (SS.mem pkg !loaded) then 33 | begin 34 | let d = Findlib.package_directory pkg in 35 | let archive = 36 | try Findlib.package_property predicates pkg "archive" 37 | with 38 | Not_found -> "" 39 | in 40 | let archives = Util.string_split ' ' archive in 41 | List.iter (fun arch -> 42 | if arch <> "" 43 | then 44 | let arch' = Findlib.resolve_path ~base:d arch in 45 | dynlink debug arch') 46 | archives; 47 | loaded:=SS.add pkg !loaded 48 | end 49 | 50 | let rec partition mods pkgs = function 51 | | [] -> List.rev pkgs, List.rev mods 52 | | `Mod m :: rest -> partition (m::mods) pkgs rest 53 | | `Pkg p :: rest -> partition mods (p::pkgs) rest 54 | 55 | let load ?(debug=false) l = 56 | let pkglist,mods = partition [] [] l in 57 | List.iter (dynlink debug) mods; 58 | let eff_pkglist = 59 | Findlib.package_deep_ancestors predicates pkglist in 60 | List.iter (load_pkg debug) eff_pkglist 61 | -------------------------------------------------------------------------------- /src/indentLoader.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* All rights reserved.This file is distributed under the terms of the *) 4 | (* GNU Lesser General Public License version 2.1 with linking *) 5 | (* exception. *) 6 | (* *) 7 | (* TypeRex is distributed in the hope that it will be useful, *) 8 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 9 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 10 | (* Lesser GNU General Public License for more details. *) 11 | (* *) 12 | (**************************************************************************) 13 | 14 | (** Dynlink of modules and finlib packages *) 15 | val load : ?debug:bool -> [`Mod of string | `Pkg of string ] list -> unit 16 | -------------------------------------------------------------------------------- /src/indentMain.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2012,2013 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | module Args = IndentArgs 18 | 19 | let indent_channel ic args config out perm = 20 | let oc, need_close = match out with 21 | | None | Some "-" -> stdout, false 22 | | Some file -> open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_text] perm file, true 23 | in 24 | let output = { 25 | IndentPrinter. 26 | debug = args.Args.debug; 27 | config = config; 28 | in_lines = args.Args.in_lines; 29 | indent_empty = args.Args.indent_empty; 30 | adaptive = true; 31 | kind = args.Args.indent_printer oc; 32 | } 33 | in 34 | let stream = Nstream.of_channel ic in 35 | IndentPrinter.proceed output stream IndentBlock.empty (); 36 | flush oc; 37 | if need_close then close_out oc 38 | 39 | let config_syntaxes syntaxes = 40 | Approx_lexer.disable_extensions (); 41 | List.iter (fun stx -> 42 | try 43 | Approx_lexer.enable_extension stx 44 | with IndentExtend.Syntax_not_found name -> 45 | Format.eprintf "Warning: unknown syntax extension %S@." name) 46 | syntaxes 47 | 48 | let indent_file args = function 49 | | Args.InChannel ic -> 50 | let config, syntaxes, dlink = IndentConfig.local_default () in 51 | IndentLoader.load ~debug:args.Args.debug (dlink @ args.Args.dynlink); 52 | config_syntaxes (syntaxes @ args.Args.syntax_exts); 53 | let config = 54 | List.fold_left 55 | IndentConfig.update_from_string 56 | config 57 | args.Args.indent_config 58 | in 59 | indent_channel ic args config args.Args.file_out 0o644 (* won't be used *) 60 | | Args.File path -> 61 | let config, syntaxes, dlink = 62 | IndentConfig.local_default ~path:(Filename.dirname path) () 63 | in 64 | IndentLoader.load ~debug:args.Args.debug (dlink @ args.Args.dynlink); 65 | config_syntaxes (syntaxes @ args.Args.syntax_exts); 66 | let config = 67 | List.fold_left 68 | IndentConfig.update_from_string 69 | config 70 | args.Args.indent_config 71 | in 72 | let out, perm, need_move = 73 | if args.Args.inplace then 74 | let tmp_file = path ^ ".ocp-indent-tmp" in 75 | let rec get_true_file path = 76 | let open Unix in 77 | match lstat path with 78 | | { st_kind = S_REG ; st_perm } -> Some tmp_file, st_perm, Some path 79 | | { st_kind = S_LNK ; } -> get_true_file @@ readlink path 80 | | { st_kind = _ ; } -> failwith "invalid file type" 81 | in get_true_file path 82 | else 83 | args.Args.file_out, 0o644, None 84 | in 85 | let ic = open_in path in 86 | try 87 | indent_channel ic args config out perm; 88 | match out, need_move with 89 | | Some src, Some dst -> Sys.rename src dst 90 | | _, _ -> () 91 | with e -> 92 | close_in ic; raise e 93 | 94 | let main = 95 | Cmdliner.Term.( 96 | pure (fun (args,files) -> List.iter (indent_file args) files) 97 | $ Args.options 98 | ), 99 | Args.info 100 | 101 | let _ = 102 | match Cmdliner.Term.eval main with 103 | | `Error _ -> exit 1 104 | | _ -> exit 0 105 | -------------------------------------------------------------------------------- /src/indentPrinter.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2013 OCamlPro *) 4 | (* *) 5 | (* All rights reserved.This file is distributed under the terms of the *) 6 | (* GNU Lesser General Public License version 2.1 with linking *) 7 | (* exception. *) 8 | (* *) 9 | (* TypeRex is distributed in the hope that it will be useful, *) 10 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 11 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 12 | (* Lesser GNU General Public License for more details. *) 13 | (* *) 14 | (**************************************************************************) 15 | 16 | (** Passed to the function specified with the [Extended] output_kind *) 17 | type output_elt = Newline | Indent of int | Whitespace of string | Text of string 18 | 19 | (** * If [Print f], the whole input is fed as strings through f, with expected 20 | lines reindented (with spaces). 21 | * If [Numeric f], the indentation values (i.e. total number of leading 22 | spaces) for each lines on which [in_lines] is true are passed through the 23 | function. 24 | * If [Extended f], every element is fed to [f] with arguments [state 25 | element]. There is at least an element for each token, but there may be more 26 | (whitespace, multiline tokens...). You may safely raise an exception from 27 | [f] to stop further processing. This version can be used for syntax 28 | highlighting or storing checkpoints. *) 29 | type 'a output_kind = 30 | | Numeric of (int -> 'a -> 'a) 31 | | Print of (string -> 'a -> 'a) 32 | | Extended of (IndentBlock.t -> output_elt -> 'a -> 'a) 33 | 34 | type 'a output = { 35 | debug: bool; 36 | config: IndentConfig.t; 37 | (** Returns true on the lines that should be reindented (lines start at 1) *) 38 | in_lines: int -> bool; 39 | (** if true, partial indent will adapt to the current indent of the file *) 40 | adaptive: bool; 41 | indent_empty: bool; 42 | kind: 'a output_kind; 43 | } 44 | 45 | val std_output : unit output 46 | 47 | val proceed : 'a output -> Nstream.t -> IndentBlock.t -> 'a -> 'a 48 | -------------------------------------------------------------------------------- /src/nstream.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2012-2013 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | open Pos 18 | open Approx_lexer 19 | 20 | type token = { 21 | region : Region.t; 22 | token : Approx_lexer.token; 23 | newlines: int; 24 | between : string Lazy.t; 25 | substr : string Lazy.t; 26 | offset : int; 27 | } 28 | 29 | type cons = 30 | | Cons of token * t 31 | | Null 32 | 33 | and t = cons lazy_t 34 | 35 | let of_string ?(start_pos=Position.zero) ?(start_offset=0) string = 36 | let lexbuf = { 37 | Lexing. 38 | refill_buff = (fun lexbuf -> lexbuf.Lexing.lex_eof_reached <- true); 39 | lex_buffer = Bytes.of_string string; 40 | lex_buffer_len = String.length string; 41 | lex_abs_pos = start_offset; 42 | lex_start_pos = start_offset; 43 | lex_curr_pos = start_offset; 44 | lex_last_pos = start_offset; 45 | lex_last_action = 0; 46 | lex_mem = [||]; 47 | lex_eof_reached = true; 48 | lex_start_p = start_pos; 49 | lex_curr_p = start_pos; 50 | } 51 | in 52 | Approx_lexer.init (); 53 | let rec loop last = 54 | let open Lexing in 55 | match Approx_lexer.token_with_comments lexbuf with 56 | | EOL 57 | | SPACES -> loop last 58 | | token -> 59 | let pos_last = Region.snd last 60 | and pos_start = lexbuf.lex_start_p 61 | and pos_end = lexbuf.lex_curr_p 62 | in 63 | let region = Region.create pos_start pos_end in 64 | let offset = Region.start_column region - Region.start_column last 65 | in 66 | let spaces = pos_start.pos_cnum - pos_last.pos_cnum in 67 | let len = pos_end.pos_cnum - pos_start.pos_cnum in 68 | let newlines = pos_start.pos_lnum - pos_last.pos_lnum in 69 | let between = lazy (String.sub string pos_last.pos_cnum spaces) in 70 | let substr = lazy (String.sub string pos_start.pos_cnum len) in 71 | Cons ({ region; token; newlines; between; substr; offset }, 72 | lazy (match token with 73 | | EOF -> Null 74 | | _ -> loop region) 75 | ) 76 | in 77 | let init_region = 78 | let pos_above = 79 | {start_pos with Lexing.pos_lnum = start_pos.Lexing.pos_lnum - 1} 80 | in 81 | Region.create pos_above pos_above 82 | in 83 | lazy (loop init_region) 84 | 85 | let of_channel ?(start_pos=Position.zero) ic = 86 | (* add some caching to the reader function, so that 87 | we can get back the original strings *) 88 | let buf = Buffer.create 511 in 89 | let reader str count = 90 | let n = input ic str 0 count in 91 | Buffer.add_substring buf (Bytes.to_string str) 0 n; 92 | n 93 | in 94 | let lexbuf = Lexing.from_function reader in 95 | let lexbuf = { lexbuf with Lexing.lex_start_p = start_pos; 96 | Lexing.lex_curr_p = start_pos; } 97 | in 98 | Approx_lexer.init (); 99 | let rec loop last = 100 | let open Lexing in 101 | match Approx_lexer.token_with_comments lexbuf with 102 | | EOL 103 | | SPACES -> loop last 104 | | token -> 105 | let pos_last = Region.snd last 106 | and pos_start = lexbuf.lex_start_p 107 | and pos_end = lexbuf.lex_curr_p 108 | in 109 | let spaces = pos_start.pos_cnum - pos_last.pos_cnum in 110 | let len = pos_end.pos_cnum - pos_start.pos_cnum in 111 | let newlines = pos_start.pos_lnum - pos_last.pos_lnum in 112 | let between = let s = Buffer.sub buf 0 spaces in lazy s in 113 | let substr = let s = Buffer.sub buf spaces len in lazy s 114 | in 115 | let total = pos_end.pos_cnum - pos_last.pos_cnum in 116 | let more = Buffer.sub buf total (Buffer.length buf - total) in 117 | Buffer.clear buf; 118 | Buffer.add_string buf more; 119 | let region = Region.create pos_start pos_end in 120 | let offset = Region.start_column region - Region.start_column last in 121 | Cons ({ region; token; newlines; between; substr; offset }, 122 | lazy (match token with 123 | | EOF -> Null 124 | | _ -> loop region) 125 | ) 126 | in 127 | let init_region = 128 | let pos_above = 129 | {start_pos with Lexing.pos_lnum = start_pos.Lexing.pos_lnum - 1} 130 | in 131 | Region.create pos_above pos_above 132 | in 133 | lazy (loop init_region) 134 | 135 | let next = function 136 | | lazy Null -> None 137 | | lazy (Cons (car, cdr)) -> Some (car, cdr) 138 | -------------------------------------------------------------------------------- /src/nstream.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2012-2013 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | (** Stream with efficient n-lookup *) 18 | 19 | open Pos 20 | 21 | (** Enhanced tokens *) 22 | type token = { 23 | region : Region.t; 24 | token : Approx_lexer.token; 25 | newlines: int; 26 | between : string Lazy.t; 27 | substr : string Lazy.t; 28 | offset : int; 29 | } 30 | 31 | type t 32 | 33 | (** Creates a stream from a string. Make sure you don't change the string 34 | in-place after calling [of_string], or anything could happen *) 35 | val of_string: ?start_pos:Position.t -> ?start_offset:int -> string -> t 36 | 37 | (** Creates a stream from a channel. Better if you don't want to block, but less 38 | efficient *) 39 | val of_channel: ?start_pos:Position.t -> in_channel -> t 40 | 41 | (** Get next token from the filter. Returns None after EOF *) 42 | val next: t -> (token * t) option 43 | -------------------------------------------------------------------------------- /src/pos.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2012 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | module Position = struct 18 | 19 | type t = Lexing.position = { 20 | pos_fname : string; 21 | pos_lnum : int; 22 | pos_bol : int; 23 | pos_cnum : int; 24 | } 25 | 26 | let to_string t = 27 | Printf.sprintf "%s%d:%d" 28 | (if t.pos_fname = "" then "" else t.pos_fname ^ ":") 29 | t.pos_lnum 30 | (t.pos_cnum - t.pos_bol) 31 | 32 | let zero = { pos_fname = ""; 33 | pos_lnum = 1; 34 | pos_bol = 0; 35 | pos_cnum = 0 } 36 | 37 | let column p = p.pos_cnum - p.pos_bol 38 | end 39 | 40 | module Region = struct 41 | open Position 42 | type t = Position.t * Position.t 43 | 44 | let fst = fst 45 | let snd = snd 46 | 47 | let create p1 p2 = (p1,p2) 48 | 49 | let start_column (p,_) = column p 50 | let end_column (_,p) = column p 51 | 52 | let start_line (p,_) = p.pos_lnum 53 | let end_line (_,p) = p.pos_lnum 54 | 55 | let char_offset (p, _) = p.pos_cnum 56 | let length (p1, p2) = p2.Position.pos_cnum - p1.Position.pos_cnum 57 | 58 | let zero = (Position.zero, Position.zero) 59 | 60 | let translate (p,p') diff = 61 | { p with pos_cnum = p .pos_cnum + diff }, 62 | { p' with pos_cnum = p'.pos_cnum + diff } 63 | end 64 | 65 | 66 | -------------------------------------------------------------------------------- /src/pos.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2012 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | (** Lexer positions & regions *) 18 | 19 | (** Lexer positions *) 20 | module Position : sig 21 | 22 | (** A position in a lexer stream *) 23 | type t = Lexing.position 24 | 25 | (** Pretty-print a position *) 26 | val to_string: t -> string 27 | 28 | (** Initial position *) 29 | val zero: t 30 | 31 | (** Get the coloumn offset associated to a lexing position *) 32 | val column: t -> int 33 | end 34 | 35 | (** Lexer regions *) 36 | module Region : sig 37 | 38 | (** A region in a lexer stream *) 39 | type t 40 | 41 | (** Create a region from a starting and an ending position *) 42 | val create: Position.t -> Position.t -> t 43 | 44 | val fst: t -> Position.t 45 | val snd: t -> Position.t 46 | 47 | (** Return the column where the region starts *) 48 | val start_column: t -> int 49 | 50 | (** Return the column where the region ends *) 51 | val end_column: t -> int 52 | 53 | (** Get the region offset (number of characters from the beginning 54 | of the file *) 55 | val char_offset: t -> int 56 | 57 | (** Get the lenght of a region *) 58 | val length: t -> int 59 | 60 | (** Return the line number where the region starts *) 61 | val start_line: t -> int 62 | 63 | (** Return the line number where the region ends *) 64 | val end_line: t -> int 65 | 66 | (** The empty region *) 67 | val zero: t 68 | 69 | (** [translate t x] shifts a region by [x] characters *) 70 | val translate: t -> int -> t 71 | end 72 | -------------------------------------------------------------------------------- /src/util.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* Copyright 2011 Jun Furuse *) 4 | (* Copyright 2012,2013 OCamlPro *) 5 | (* *) 6 | (* All rights reserved.This file is distributed under the terms of the *) 7 | (* GNU Lesser General Public License version 2.1 with linking *) 8 | (* exception. *) 9 | (* *) 10 | (* TypeRex is distributed in the hope that it will be useful, *) 11 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 12 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 13 | (* Lesser GNU General Public License for more details. *) 14 | (* *) 15 | (**************************************************************************) 16 | 17 | let compose : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c 18 | = fun f g x -> f (g (x)) 19 | 20 | let ( @* ) = compose 21 | 22 | let default d = function Some x -> x | None -> d 23 | 24 | let string_split char str = 25 | let rec aux acc pos = 26 | let i = 27 | try Some (String.rindex_from str pos char) 28 | with Not_found | Invalid_argument _ -> None 29 | in 30 | match i with 31 | | Some i -> aux (String.sub str (i + 1) (pos - i) :: acc) (pred i) 32 | | None -> String.sub str 0 (pos + 1) :: acc 33 | in 34 | aux [] (String.length str - 1) 35 | 36 | let string_split_chars chars str = 37 | let len = String.length str in 38 | let rec split pos = 39 | let rec lookup i = 40 | if i >= len then raise Not_found 41 | else if String.contains chars str.[i] then i 42 | else lookup (succ i) 43 | in 44 | try 45 | let i = lookup pos in 46 | if i > pos then String.sub str pos (i - pos) :: split (succ i) 47 | else split (succ i) 48 | with Not_found | Invalid_argument _ -> 49 | [ String.sub str pos (len - pos) ] 50 | in 51 | split 0 52 | 53 | let is_prefix pfx str = 54 | let pfxlen = String.length pfx in 55 | let rec check i = i >= pfxlen || pfx.[i] = str.[i] && check (i+1) in 56 | String.length str >= pfxlen && check 0 57 | 58 | let ends_with_escape s = 59 | let rec aux n = n >= 0 && s.[n] = '\\' && not (aux (n-1)) 60 | in aux (String.length s - 1) 61 | 62 | let count_leading_spaces s = 63 | let rec aux i = 64 | if i >= String.length s || s.[i] <> ' ' then i 65 | else aux (i+1) 66 | in 67 | aux 0 68 | 69 | let shorten_string n s = 70 | match string_split '\n' s with 71 | | [] -> "" 72 | | [s] -> 73 | if String.length s <= n then s 74 | else 75 | let n1 = (n - 3) / 2 in 76 | let n2 = n - 3 - n1 in 77 | String.sub s 0 n1 78 | ^ "..." 79 | ^ String.sub s (String.length s - n2) n2 80 | | s1::r1::r -> 81 | let s2 = 82 | let rec last x = function x::r -> last x r | [] -> x in 83 | last r1 r 84 | in 85 | let l1 = String.length s1 and l2 = String.length s2 in 86 | let n1 = min l1 (max ((n-3) / 2) (n-3 - l2)) in 87 | let n2 = min l2 (n - 3 - n1) in 88 | String.sub s1 0 n1 89 | ^ "..." 90 | ^ String.sub s2 (l2 - n2) n2 91 | -------------------------------------------------------------------------------- /tests/.ocp-indent: -------------------------------------------------------------------------------- 1 | normal 2 | -------------------------------------------------------------------------------- /tests/failing-output/escaped-nl.ml: -------------------------------------------------------------------------------- 1 | let s1 = "No field 'install', but a field 'remove': install instructions \ 2 | probably part of 'build'. Use the 'install' field or a .install \ 3 | file" 4 | 5 | let x = 6 | cond 40 `Warning 7 | "Package uses flags that aren't recognised by earlier versions in \ 8 | OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \ 9 | instead for compatibility" 10 | ~detail:alpha_flags 11 | (alpha_flags <> []) 12 | 13 | let s2 = "bla bla 14 | bli bli \ 15 | blo" 16 | 17 | let s3 = "\ 18 | " 19 | 20 | let s4 = " \ 21 | " 22 | 23 | let s5 = " \ 24 | \ 25 | " 26 | 27 | let s6 = " 28 | " 29 | 30 | let s7 = " 31 | " 32 | 33 | let c1 = ' 34 | ' 35 | 36 | let x1 = f x ' 37 | ' y 38 | z 39 | 40 | let zz = "\ 41 | 42 | s \ 43 | \ 44 | " 45 | -------------------------------------------------------------------------------- /tests/failing-output/indent-empty-numeric.ml: -------------------------------------------------------------------------------- 1 | 0 2 | 0 3 | 2 4 | 2 5 | 0 6 | 0 7 | 0 8 | 0 9 | 2 10 | 15 11 | -------------------------------------------------------------------------------- /tests/failing-output/js-args.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | foo.bar <- 3 | f x 4 | y z 5 | 6 | let should_check_can_sell_and_marking regulatory_regime = 7 | match z with 8 | | `foo 9 | -> some_function 10 | argument 11 | (* The above typically occurs in a multi-pattern match clause, so the clause 12 | expression is on a line by itself. This is the more typical way a long 13 | single-pattern match clause would be written: *) 14 | let should_check_can_sell_and_marking regulatory_regime = 15 | match z with 16 | | `foo -> 17 | some_function 18 | argument 19 | 20 | let f = fun x -> 21 | ghi 22 | x 23 | 24 | (* common *) 25 | let x = 26 | try x with 27 | | a -> b 28 | | c -> d 29 | let x = try x with 30 | | a -> b 31 | | c -> d 32 | let x = 33 | try x 34 | with 35 | | a -> b 36 | | c -> d 37 | 38 | let z = 39 | some_function 40 | argument 41 | 42 | 43 | 44 | let () = 45 | f a b ~c:c 46 | d 47 | 48 | let () = 49 | f a b ~c:1. 50 | d 51 | 52 | let () = 53 | My_module.f a b ~c:c 54 | d 55 | 56 | (* This last case is where Tuareg is inconsistent with the others. *) 57 | let () = 58 | My_module.f a b ~c:1. 59 | d 60 | 61 | 62 | 63 | let () = 64 | messages := 65 | Message_store.create (Session_id.of_string "") 66 | (* Tuareg indents these lines too far to the left. *) 67 | "herd-retransmitter" 68 | Message_store.Message_size.Byte 69 | 70 | 71 | 72 | let () = 73 | raise (Bug ("foo" 74 | (* In this and similar cases, we want the subsequent lines to 75 | align with the first expression. *) 76 | ^ "bar")); 77 | raise (Bug ("foo" ^ "quux" 78 | ^ "bar")); 79 | raise (Bug (foo + quux 80 | ^ "bar")); 81 | raise (Bug ((foo + quux) 82 | ^ "bar")) 83 | 84 | (* Except in specific cases, we want the argument indented relative to the 85 | function being called. (Exceptions include "fun" arguments where the line 86 | ends with "->" and subsequent lines beginning with operators, like above.) *) 87 | let () = 88 | Some (Message_store.create s 89 | "herd-retransmitter" ~unlink:true Message_store.Message_size.Byte) 90 | 91 | 92 | 93 | (* We like the indentation of most arguments, but want to get back towards the 94 | left margin in a few special cases: *) 95 | let _ = 96 | foo (bar (fun x -> (* special: "fun _ ->" at EOL *) 97 | baz)) (* assume no more arguments to "bar" *) 98 | let _ = 99 | foo 100 | ~a_long_field_name:(check (fun bar -> 101 | baz)) 102 | let _ = 103 | foo ~a_long_field_name:(check (fun bar -> 104 | baz)) 105 | let _ = 106 | foo (bar (quux (fnord (fun x -> (* any depth *) 107 | baz)))) 108 | 109 | (* We also wanted to tweak the operator indentation, making operators like <= 110 | not special cases in contexts like this: *) 111 | let _ = 112 | assert (foo (bar + baz 113 | <= quux)) (* lined up under left argument to op, 114 | sim. to ^ above *) 115 | (* Sim. indentation of if conditions: *) 116 | let _ = 117 | if (a 118 | <= b) 119 | then () 120 | let _ = 121 | (* Comparisons are different than conditionals; we don't regard them as 122 | conceptually part of the [if] expression. *) 123 | if a 124 | <= b 125 | then () 126 | let _ = 127 | (* We regard the outermost condition terms as conceptually part of the [if] 128 | expression and indent accordingly. Whether [&&] or [||], conditionals 129 | effectively state lists of conditions for [then]. *) 130 | if Edge_adjustment.is_zero arb.cfg.extra_edge 131 | && 0. = sys.plugs.edge_backoff 132 | && 0. = zero_acvol_edge_backoff 133 | then 0. 134 | else 1. 135 | let _ = 136 | if 137 | Edge_adjustment.is_zero arb.cfg.extra_edge 138 | && 0. = sys.plugs.edge_backoff 139 | && 0. = zero_acvol_edge_backoff 140 | then 0. 141 | else 1. 142 | let _ = 143 | let entries = List.filter (Lazy.force transferstati) ~f:(fun ts -> 144 | Pcre.pmatch ~pat ts.RQ.description 145 | ) in 146 | x 147 | 148 | (* combination of operator at BOL and -> at EOL: *) 149 | let _ = 150 | Shell.ssh_lines x 151 | |! List.map ~f:(f (g (fun x -> 152 | let name, path = String.lsplit2_exn ~on:'|' x in 153 | String.strip name, String.strip path))) 154 | 155 | (* open paren ending line like begin *) 156 | let _ = 157 | if a (p ^/ "s") [ e ] = Ok () then `S ( 158 | let label count = 159 | sprintf "%d s" c ^ if c = 1 then ":" else "s" 160 | in 161 | x 162 | ) 163 | -------------------------------------------------------------------------------- /tests/failing-output/js-begin.ml: -------------------------------------------------------------------------------- 1 | let f = function 2 | | zoo -> begin 3 | foo; 4 | bar; 5 | end 6 | ;; 7 | let g = function 8 | | zoo -> ( 9 | foo; 10 | bar; 11 | ) 12 | ;; 13 | let () = 14 | begin match foo with 15 | | Bar -> snoo 16 | end 17 | ;; 18 | -------------------------------------------------------------------------------- /tests/failing-output/js-fun.ml: -------------------------------------------------------------------------------- 1 | (* preferred list style *) 2 | let z = 3 | f 4 | [ y 5 | ; foo ~f:(fun () -> 6 | arg) 7 | ] 8 | ;; 9 | let z = 10 | f 11 | [ y 12 | ; foo ~f:(fun () -> 13 | arg 14 | ) 15 | ] 16 | ;; 17 | 18 | (* legacy list style *) 19 | let _ = 20 | [ f (fun x -> 21 | x); 22 | f (fun x -> 23 | x); 24 | f (fun x -> 25 | x); 26 | ] 27 | let _ = 28 | [ f (fun x -> 29 | x 30 | ); 31 | f (fun x -> 32 | x 33 | ); 34 | f (fun x -> 35 | x 36 | ); 37 | ] 38 | ;; 39 | let _ = 40 | [f (fun x -> 41 | x 42 | ); 43 | f (fun x -> 44 | x 45 | ); 46 | f (fun x -> 47 | x 48 | ); 49 | ] 50 | ;; 51 | 52 | let _ = 53 | x 54 | >>= fun x -> 55 | (try x with _ -> ()) 56 | >>= fun x -> 57 | try x with _ -> () 58 | >>= fun x -> 59 | x 60 | ;; 61 | 62 | let () = 63 | expr 64 | >>| function 65 | | x -> 3 66 | | y -> 4 67 | ;; 68 | 69 | let () = 70 | expr 71 | >>| fun z -> match z with 72 | | x -> 3 73 | | y -> 4 74 | ;; 75 | 76 | let () = 77 | expr 78 | >>| fun z -> function 79 | | x -> 3 80 | | y -> 4 81 | ;; 82 | 83 | let () = 84 | my_func () >>= function 85 | | A -> 0 86 | | B -> 0 87 | ;; 88 | 89 | let () = 90 | my_func () >>= (function 91 | | A -> 0 92 | | B -> 0) 93 | ;; 94 | 95 | let () = 96 | expr 97 | >>| function 98 | | x -> 3 99 | | y -> 4 100 | ;; 101 | 102 | let () = 103 | expr 104 | >>| (function 105 | | x -> 3 106 | | y -> 4) 107 | ;; 108 | 109 | 110 | 111 | let f = 112 | f >>= m (fun f -> 113 | fun x -> 114 | y); 115 | z 116 | ;; 117 | 118 | let f = 119 | f 120 | |> m (fun f -> 121 | fun x -> 122 | y 123 | ); 124 | z 125 | ;; 126 | let f = 127 | f 128 | |> m (fun f -> 129 | fun x -> 130 | y); 131 | z 132 | ;; 133 | -------------------------------------------------------------------------------- /tests/failing-output/js-functor.ml: -------------------------------------------------------------------------------- 1 | module M = 2 | Foo (G) 3 | (H) 4 | 5 | module M = 6 | Foo 7 | (G) 8 | (struct 9 | let x 10 | end) 11 | (H) 12 | 13 | (* To me, this looks fine as it is. The rule seems fine as "indent arguments by 14 | 2". To illustrate, with a case where the functor name is longer: *) 15 | module M = 16 | Functor (G) 17 | (H) 18 | (I) 19 | 20 | 21 | 22 | include Foo (struct 23 | let x 24 | end) (struct 25 | let y 26 | end) 27 | 28 | include 29 | Foo (struct 30 | let x 31 | end) (struct 32 | let y 33 | end) 34 | 35 | include 36 | Foo 37 | (struct 38 | let x 39 | end) (struct 40 | let y 41 | end) 42 | 43 | include Persistent.Make 44 | (struct let version = 1 end) 45 | (Stable.Cr_soons_or_pending.V1) 46 | 47 | include Persistent.Make 48 | (struct 49 | let version = 1 50 | end) 51 | (Stable.Cr_soons_or_pending.V1) 52 | 53 | include 54 | Persistent.Make 55 | (struct let version = 1 end) 56 | (Stable.Cr_soons_or_pending.V1) 57 | 58 | include 59 | Persistent.Make 60 | (struct 61 | let version = 1 62 | end) 63 | (Stable.Cr_soons_or_pending.V1) 64 | 65 | module M = 66 | Foo (struct 67 | let x 68 | end) (struct 69 | let y 70 | end) 71 | 72 | module M : S = 73 | Make (M) 74 | module M : S with type t := int = 75 | Make (M) 76 | 77 | 78 | 79 | module Simple_command(Arg:sig 80 | end) = struct end 81 | 82 | module Simple_command(Arg : sig 83 | end) = struct end 84 | 85 | module Simple_command (Arg:sig 86 | end) = struct end 87 | 88 | module Simple_command (Arg : sig 89 | end) = struct end 90 | 91 | module Simple_command 92 | (Arg : sig 93 | end) = struct end 94 | -------------------------------------------------------------------------------- /tests/failing-output/js-pattern.ml: -------------------------------------------------------------------------------- 1 | let f = function 2 | | _ -> 0 3 | ;; 4 | 5 | let f x = match x with 6 | | _ -> 0 7 | ;; 8 | 9 | let f = 10 | function 11 | | _ -> 0 12 | ;; 13 | 14 | let f x = 15 | match x with 16 | | _ -> 0 17 | ;; 18 | 19 | let f x = 20 | begin match x with 21 | | _ -> 0 22 | end 23 | ;; 24 | 25 | let check_price t = function 26 | | { Exec. 27 | trade_at_settlement = (None | Some false); 28 | } -> () 29 | 30 | let check_price t = function 31 | | simpler -> () 32 | | other -> () 33 | 34 | (* Sometimes we like to write big alternations like this, in which case the 35 | comment should typically align with the following clause. *) 36 | let 0 = 37 | match x with 38 | | A 39 | (* a *) 40 | -> a 41 | let 0 = 42 | match x with 43 | A 44 | (* a *) 45 | -> a 46 | 47 | let _ = 48 | a 49 | || match a with 50 | | a -> true 51 | | b -> false 52 | -------------------------------------------------------------------------------- /tests/failing-output/js-record.ml: -------------------------------------------------------------------------------- 1 | type x = 2 | { foo : int 3 | ; bar : int 4 | } 5 | 6 | let x = 7 | { x with 8 | foo = 3 9 | ; bar = 5 10 | } 11 | 12 | let x = 13 | { (* blah blah blah *) 14 | foo = 3 15 | ; bar = 5 16 | } 17 | ;; 18 | 19 | let x = 20 | [{ x with 21 | foo = 3 22 | ; bar = 5 23 | }] 24 | 25 | let x = 26 | [{ (* blah blah blah *) 27 | foo = 3 28 | ; bar = 5 29 | }] 30 | ;; 31 | 32 | let x = 33 | { M.x with 34 | M. 35 | foo = 3 36 | } 37 | ;; 38 | 39 | let x = 40 | { x with 41 | M. 42 | foo = 3 43 | } 44 | ;; 45 | 46 | let x = 47 | { M. 48 | foo = 3 49 | } 50 | ;; 51 | 52 | let _ = 53 | { foo with 54 | Bar. 55 | field1 = value1 56 | ; field2 = value2 57 | } 58 | ;; 59 | let _ = 60 | { foo 61 | with Bar. 62 | field1 = value1 63 | ; field2 = value2 64 | } 65 | ;; 66 | 67 | (* multicomponent record module pathname *) 68 | let _ = 69 | { A.B. 70 | a = b 71 | ; c = d 72 | } 73 | ;; 74 | 75 | type t = 76 | { a 77 | : something_lengthy list list 78 | [@default String.Map.empty] 79 | } 80 | 81 | type t = 82 | { a 83 | : Something_lengthy.t list list 84 | [@default String.Map.empty] 85 | } 86 | 87 | type t = 88 | { a 89 | : something_lengthy list 90 | list 91 | } 92 | 93 | type t = 94 | { a 95 | : Something_lengthy.t list 96 | list 97 | } 98 | 99 | type t = 100 | { a 101 | : Something_lengthy.t 102 | list 103 | } 104 | -------------------------------------------------------------------------------- /tests/failing-output/js-syntax.ml: -------------------------------------------------------------------------------- 1 | (* s *) 2 | 3 | let _ = 4 | [%raise_structural_sexp 5 | "feature's tip is already an ancestor of new base" 6 | { feature_tip = (old_tip : Rev.t) 7 | ; new_base = (new_base : Rev.t) 8 | }] 9 | 10 | let _ = 11 | [%raise_structural_sexp "feature's tip is already an ancestor of new base" 12 | { feature_tip = (old_tip : Rev.t) 13 | ; new_base = (new_base : Rev.t) 14 | } 15 | ] 16 | -------------------------------------------------------------------------------- /tests/failing-output/js-to-do.ml: -------------------------------------------------------------------------------- 1 | (* Indentation that Jane Street needs to think about and make precise. 2 | 3 | These are long term ideas, possibly even conflicting with other tests. *) 4 | 5 | 6 | 7 | (* js-args *) 8 | 9 | let _ = 10 | let min_closing_backoff = 11 | -. ( Hidden_float.expose (arb.cfg.base_edge @! Buy) 12 | +. Hidden_float.expose (arb.cfg.base_edge @! Sell)) 13 | in 14 | 0 15 | 16 | 17 | 18 | (* js-type *) 19 | 20 | (* The following tests incorporate several subtle and different indentation 21 | ideas. Please consider this only a proposal for discussion, for now. 22 | 23 | First, notice the display treatment of "(,)" tuples, analogous to "[;]" 24 | lists. While "(,)" is an intensional combination of "()" and ",", unlike 25 | "[;]" lists, we believe "(,)" isn't too big a departure. Value expression 26 | analogies are included in js-type.ml, (meant to be) consistent with the 27 | proposed type indentation. 28 | 29 | Second, and more divergently, the proposed indentation of function types is 30 | based on the idea of aligning the arguments, even the first argument, even 31 | where that means automatically inserting spaces within lines. This applies 32 | to the extra spaces in ":__unit" and "(____Config.Network.t" below. 33 | 34 | We believe this fits into a more general incorporation of alignment into 35 | ocp-indent, to replace our internal alignment tool with a syntax-aware one. 36 | We like to align things for readability, like big records, record types, 37 | lists used to build tables, etc. 38 | 39 | The proposal also includes indenting "->" in the circumstances below relative 40 | to the enclosing "()", by two spaces. In a sense, this happens first, and 41 | then the first argument is aligned accordingly. So, there's no manual 42 | indentation or spacing below. *) 43 | 44 | val instances 45 | : unit 46 | -> ( Config.Network.t 47 | -> (App.t * Config.instance * Config.app) list 48 | -> verbose:bool 49 | -> 'm 50 | , 'm 51 | ) Command.Spec.t 52 | 53 | val instances 54 | : unit 55 | -> ( Config.Network.t 56 | -> (App.t * Config.instance * Config.app) list 57 | -> verbose:bool -> 'm 58 | , 'm 59 | ) Command.Spec.t 60 | 61 | (* presumed analog with stars *) 62 | val instances : 63 | unit 64 | * ( Config.Network.t 65 | * (App.t * Config.instance * Config.app) list 66 | * bool 67 | * 'm 68 | , 'm 69 | ) Command.Spec.t 70 | -------------------------------------------------------------------------------- /tests/failing-output/js-upon.ml: -------------------------------------------------------------------------------- 1 | let f x = 2 | stop 3 | (* We don't do this as a matter of style, but the indentation reveals a common 4 | mistake. *) 5 | >>> fun () -> don't_wait_for (close fd); 6 | bind fd 7 | 8 | let f x = 9 | stop 10 | (* This is what was intended, which is indented correctly, although it's bad 11 | style on my part. *) 12 | >>> (fun () -> don't_wait_for (close fd)); 13 | bind 14 | -------------------------------------------------------------------------------- /tests/failing-output/list_of_funs.ml: -------------------------------------------------------------------------------- 1 | let f x = 2 | (fun x -> x [ (fun () -> 3) ; 3 | (fun () -> 4) ]) 4 | 5 | let f x = (fun x -> x [ (fun () -> 3) ; 6 | (fun () -> 4) ]) 7 | 8 | let f x = 9 | x [ (fun () -> 3) ; 10 | (fun () -> 4) ] 11 | 12 | let f x = 13 | [ (fun () -> 3) ; 14 | (fun () -> 4) ] 15 | 16 | let f x = 17 | (fun x -> x [ (fun () -> 18 | 3) ; 19 | (fun () -> 4) ]) 20 | 21 | let f x = (fun x -> x [ (fun () -> 22 | 3) ; 23 | (fun () -> 4) ]) 24 | 25 | let f x = 26 | x [ (fun () -> 27 | 3) ; 28 | (fun () -> 4) ] 29 | 30 | let f x = 31 | [ (fun () -> 32 | 3) ; 33 | (fun () -> 4) ] 34 | -------------------------------------------------------------------------------- /tests/failing/#js-default.ml#: -------------------------------------------------------------------------------- 1 | type t = 2 | { last_trading : Week_date.Spec.t; 3 | first_notice : Week_date.Spec.t option; 4 | first_notice_exceptions : Date.t Year_month.Map.t 5 | with default(Year_month.Map.empty); 6 | offset : Week_date.Offset.t; 7 | (* n > 0 *) 8 | new_contract_expires_in_n_months : int 9 | } 10 | [@@deriving sexp, compare] 11 | -------------------------------------------------------------------------------- /tests/failing/escaped-nl.ml: -------------------------------------------------------------------------------- 1 | let s1 = "No field 'install', but a field 'remove': install instructions \ 2 | probably part of 'build'. Use the 'install' field or a .install \ 3 | file" 4 | 5 | let x = 6 | cond 40 `Warning 7 | "Package uses flags that aren't recognised by earlier versions in \ 8 | OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \ 9 | instead for compatibility" 10 | ~detail:alpha_flags 11 | (alpha_flags <> []) 12 | 13 | let s2 = "bla bla 14 | bli bli \ 15 | blo" 16 | 17 | let s3 = "\ 18 | " 19 | 20 | let s4 = " \ 21 | " 22 | 23 | let s5 = " \ 24 | \ 25 | " 26 | 27 | let s6 = " 28 | " 29 | 30 | let s7 = " 31 | " 32 | 33 | let c1 = ' 34 | ' 35 | 36 | let x1 = f x ' 37 | ' y 38 | z 39 | 40 | let zz = "\ 41 | 42 | s \ 43 | \ 44 | " 45 | -------------------------------------------------------------------------------- /tests/failing/escaped-nl.ml.ref: -------------------------------------------------------------------------------- 1 | let s1 = "No field 'install', but a field 'remove': install instructions \ 2 | probably part of 'build'. Use the 'install' field or a .install \ 3 | file" 4 | 5 | let x = 6 | cond 40 `Warning 7 | "Package uses flags that aren't recognised by earlier versions in \ 8 | OPAM 1.2 branch. At the moment, you should use a tag \"flags:foo\" \ 9 | instead for compatibility" 10 | ~detail:alpha_flags 11 | (alpha_flags <> []) 12 | 13 | let s2 = "bla bla 14 | bli bli \ 15 | blo" 16 | 17 | let s3 = "\ 18 | " 19 | 20 | let s4 = " \ 21 | " 22 | 23 | let s5 = " \ 24 | \ 25 | " 26 | 27 | let s6 = " 28 | " 29 | 30 | let s7 = " 31 | " 32 | 33 | let c1 = ' 34 | ' 35 | 36 | let x1 = f x ' 37 | ' y 38 | z 39 | 40 | let zz = "\ 41 | 42 | s \ 43 | \ 44 | " 45 | -------------------------------------------------------------------------------- /tests/failing/js-args.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | foo.bar <- 3 | f x 4 | y z 5 | 6 | let should_check_can_sell_and_marking regulatory_regime = 7 | match z with 8 | | `foo 9 | -> some_function 10 | argument 11 | (* The above typically occurs in a multi-pattern match clause, so the clause 12 | expression is on a line by itself. This is the more typical way a long 13 | single-pattern match clause would be written: *) 14 | let should_check_can_sell_and_marking regulatory_regime = 15 | match z with 16 | | `foo -> 17 | some_function 18 | argument 19 | 20 | let f = fun x -> 21 | ghi 22 | x 23 | 24 | (* common *) 25 | let x = 26 | try x with 27 | | a -> b 28 | | c -> d 29 | let x = try x with 30 | | a -> b 31 | | c -> d 32 | let x = 33 | try x 34 | with 35 | | a -> b 36 | | c -> d 37 | 38 | let z = 39 | some_function 40 | argument 41 | 42 | 43 | 44 | let () = 45 | f a b ~c:c 46 | d 47 | 48 | let () = 49 | f a b ~c:1. 50 | d 51 | 52 | let () = 53 | My_module.f a b ~c:c 54 | d 55 | 56 | (* This last case is where Tuareg is inconsistent with the others. *) 57 | let () = 58 | My_module.f a b ~c:1. 59 | d 60 | 61 | 62 | 63 | let () = 64 | messages := 65 | Message_store.create (Session_id.of_string "") 66 | (* Tuareg indents these lines too far to the left. *) 67 | "herd-retransmitter" 68 | Message_store.Message_size.Byte 69 | 70 | 71 | 72 | let () = 73 | raise (Bug ("foo" 74 | (* In this and similar cases, we want the subsequent lines to 75 | align with the first expression. *) 76 | ^ "bar")); 77 | raise (Bug ("foo" ^ "quux" 78 | ^ "bar")); 79 | raise (Bug (foo + quux 80 | ^ "bar")); 81 | raise (Bug ((foo + quux) 82 | ^ "bar")) 83 | 84 | (* Except in specific cases, we want the argument indented relative to the 85 | function being called. (Exceptions include "fun" arguments where the line 86 | ends with "->" and subsequent lines beginning with operators, like above.) *) 87 | let () = 88 | Some (Message_store.create s 89 | "herd-retransmitter" ~unlink:true Message_store.Message_size.Byte) 90 | 91 | 92 | 93 | (* We like the indentation of most arguments, but want to get back towards the 94 | left margin in a few special cases: *) 95 | let _ = 96 | foo (bar (fun x -> (* special: "fun _ ->" at EOL *) 97 | baz)) (* assume no more arguments to "bar" *) 98 | let _ = 99 | foo 100 | ~a_long_field_name:(check (fun bar -> 101 | baz)) 102 | let _ = 103 | foo ~a_long_field_name:(check (fun bar -> 104 | baz)) 105 | let _ = 106 | foo (bar (quux (fnord (fun x -> (* any depth *) 107 | baz)))) 108 | 109 | (* We also wanted to tweak the operator indentation, making operators like <= 110 | not special cases in contexts like this: *) 111 | let _ = 112 | assert (foo (bar + baz 113 | <= quux)) (* lined up under left argument to op, 114 | sim. to ^ above *) 115 | (* Sim. indentation of if conditions: *) 116 | let _ = 117 | if (a 118 | <= b) 119 | then () 120 | let _ = 121 | (* Comparisons are different than conditionals; we don't regard them as 122 | conceptually part of the [if] expression. *) 123 | if a 124 | <= b 125 | then () 126 | let _ = 127 | (* We regard the outermost condition terms as conceptually part of the [if] 128 | expression and indent accordingly. Whether [&&] or [||], conditionals 129 | effectively state lists of conditions for [then]. *) 130 | if Edge_adjustment.is_zero arb.cfg.extra_edge 131 | && 0. = sys.plugs.edge_backoff 132 | && 0. = zero_acvol_edge_backoff 133 | then 0. 134 | else 1. 135 | let _ = 136 | if 137 | Edge_adjustment.is_zero arb.cfg.extra_edge 138 | && 0. = sys.plugs.edge_backoff 139 | && 0. = zero_acvol_edge_backoff 140 | then 0. 141 | else 1. 142 | let _ = 143 | let entries = List.filter (Lazy.force transferstati) ~f:(fun ts -> 144 | Pcre.pmatch ~pat ts.RQ.description 145 | ) in 146 | x 147 | 148 | (* combination of operator at BOL and -> at EOL: *) 149 | let _ = 150 | Shell.ssh_lines x 151 | |! List.map ~f:(f (g (fun x -> 152 | let name, path = String.lsplit2_exn ~on:'|' x in 153 | String.strip name, String.strip path))) 154 | 155 | (* open paren ending line like begin *) 156 | let _ = 157 | if a (p ^/ "s") [ e ] = Ok () then `S ( 158 | let label count = 159 | sprintf "%d s" c ^ if c = 1 then ":" else "s" 160 | in 161 | x 162 | ) 163 | -------------------------------------------------------------------------------- /tests/failing/js-args.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-begin.ml: -------------------------------------------------------------------------------- 1 | let f = function 2 | | zoo -> begin 3 | foo; 4 | bar; 5 | end 6 | ;; 7 | let g = function 8 | | zoo -> ( 9 | foo; 10 | bar; 11 | ) 12 | ;; 13 | let () = 14 | begin match foo with 15 | | Bar -> snoo 16 | end 17 | ;; 18 | -------------------------------------------------------------------------------- /tests/failing/js-begin.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-fun.ml: -------------------------------------------------------------------------------- 1 | (* preferred list style *) 2 | let z = 3 | f 4 | [ y 5 | ; foo ~f:(fun () -> 6 | arg) 7 | ] 8 | ;; 9 | let z = 10 | f 11 | [ y 12 | ; foo ~f:(fun () -> 13 | arg 14 | ) 15 | ] 16 | ;; 17 | 18 | (* legacy list style *) 19 | let _ = 20 | [ f (fun x -> 21 | x); 22 | f (fun x -> 23 | x); 24 | f (fun x -> 25 | x); 26 | ] 27 | let _ = 28 | [ f (fun x -> 29 | x 30 | ); 31 | f (fun x -> 32 | x 33 | ); 34 | f (fun x -> 35 | x 36 | ); 37 | ] 38 | ;; 39 | let _ = 40 | [f (fun x -> 41 | x 42 | ); 43 | f (fun x -> 44 | x 45 | ); 46 | f (fun x -> 47 | x 48 | ); 49 | ] 50 | ;; 51 | 52 | let _ = 53 | x 54 | >>= fun x -> 55 | (try x with _ -> ()) 56 | >>= fun x -> 57 | try x with _ -> () 58 | >>= fun x -> 59 | x 60 | ;; 61 | 62 | let () = 63 | expr 64 | >>| function 65 | | x -> 3 66 | | y -> 4 67 | ;; 68 | 69 | let () = 70 | expr 71 | >>| fun z -> match z with 72 | | x -> 3 73 | | y -> 4 74 | ;; 75 | 76 | let () = 77 | expr 78 | >>| fun z -> function 79 | | x -> 3 80 | | y -> 4 81 | ;; 82 | 83 | let () = 84 | my_func () >>= function 85 | | A -> 0 86 | | B -> 0 87 | ;; 88 | 89 | let () = 90 | my_func () >>= (function 91 | | A -> 0 92 | | B -> 0) 93 | ;; 94 | 95 | let () = 96 | expr 97 | >>| function 98 | | x -> 3 99 | | y -> 4 100 | ;; 101 | 102 | let () = 103 | expr 104 | >>| (function 105 | | x -> 3 106 | | y -> 4) 107 | ;; 108 | 109 | 110 | 111 | let f = 112 | f >>= m (fun f -> 113 | fun x -> 114 | y); 115 | z 116 | ;; 117 | 118 | let f = 119 | f 120 | |> m (fun f -> 121 | fun x -> 122 | y 123 | ); 124 | z 125 | ;; 126 | let f = 127 | f 128 | |> m (fun f -> 129 | fun x -> 130 | y); 131 | z 132 | ;; 133 | -------------------------------------------------------------------------------- /tests/failing/js-fun.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-functor.ml: -------------------------------------------------------------------------------- 1 | module M = 2 | Foo (G) 3 | (H) 4 | 5 | module M = 6 | Foo 7 | (G) 8 | (struct 9 | let x 10 | end) 11 | (H) 12 | 13 | (* To me, this looks fine as it is. The rule seems fine as "indent arguments by 14 | 2". To illustrate, with a case where the functor name is longer: *) 15 | module M = 16 | Functor (G) 17 | (H) 18 | (I) 19 | 20 | 21 | 22 | include Foo (struct 23 | let x 24 | end) (struct 25 | let y 26 | end) 27 | 28 | include 29 | Foo (struct 30 | let x 31 | end) (struct 32 | let y 33 | end) 34 | 35 | include 36 | Foo 37 | (struct 38 | let x 39 | end) (struct 40 | let y 41 | end) 42 | 43 | include Persistent.Make 44 | (struct let version = 1 end) 45 | (Stable.Cr_soons_or_pending.V1) 46 | 47 | include Persistent.Make 48 | (struct 49 | let version = 1 50 | end) 51 | (Stable.Cr_soons_or_pending.V1) 52 | 53 | include 54 | Persistent.Make 55 | (struct let version = 1 end) 56 | (Stable.Cr_soons_or_pending.V1) 57 | 58 | include 59 | Persistent.Make 60 | (struct 61 | let version = 1 62 | end) 63 | (Stable.Cr_soons_or_pending.V1) 64 | 65 | module M = 66 | Foo (struct 67 | let x 68 | end) (struct 69 | let y 70 | end) 71 | 72 | module M : S = 73 | Make (M) 74 | module M : S with type t := int = 75 | Make (M) 76 | 77 | 78 | 79 | module Simple_command(Arg:sig 80 | end) = struct end 81 | 82 | module Simple_command(Arg : sig 83 | end) = struct end 84 | 85 | module Simple_command (Arg:sig 86 | end) = struct end 87 | 88 | module Simple_command (Arg : sig 89 | end) = struct end 90 | 91 | module Simple_command 92 | (Arg : sig 93 | end) = struct end 94 | -------------------------------------------------------------------------------- /tests/failing/js-functor.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-pattern.ml: -------------------------------------------------------------------------------- 1 | let f = function 2 | | _ -> 0 3 | ;; 4 | 5 | let f x = match x with 6 | | _ -> 0 7 | ;; 8 | 9 | let f = 10 | function 11 | | _ -> 0 12 | ;; 13 | 14 | let f x = 15 | match x with 16 | | _ -> 0 17 | ;; 18 | 19 | let f x = 20 | begin match x with 21 | | _ -> 0 22 | end 23 | ;; 24 | 25 | let check_price t = function 26 | | { Exec. 27 | trade_at_settlement = (None | Some false); 28 | } -> () 29 | 30 | let check_price t = function 31 | | simpler -> () 32 | | other -> () 33 | 34 | (* Sometimes we like to write big alternations like this, in which case the 35 | comment should typically align with the following clause. *) 36 | let 0 = 37 | match x with 38 | | A 39 | (* a *) 40 | -> a 41 | let 0 = 42 | match x with 43 | A 44 | (* a *) 45 | -> a 46 | 47 | let _ = 48 | a 49 | || match a with 50 | | a -> true 51 | | b -> false 52 | -------------------------------------------------------------------------------- /tests/failing/js-pattern.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-record.ml: -------------------------------------------------------------------------------- 1 | type x = 2 | { foo : int 3 | ; bar : int 4 | } 5 | 6 | let x = 7 | { x with 8 | foo = 3 9 | ; bar = 5 10 | } 11 | 12 | let x = 13 | { (* blah blah blah *) 14 | foo = 3 15 | ; bar = 5 16 | } 17 | ;; 18 | 19 | let x = 20 | [{ x with 21 | foo = 3 22 | ; bar = 5 23 | }] 24 | 25 | let x = 26 | [{ (* blah blah blah *) 27 | foo = 3 28 | ; bar = 5 29 | }] 30 | ;; 31 | 32 | let x = 33 | { M.x with 34 | M. 35 | foo = 3 36 | } 37 | ;; 38 | 39 | let x = 40 | { x with 41 | M. 42 | foo = 3 43 | } 44 | ;; 45 | 46 | let x = 47 | { M. 48 | foo = 3 49 | } 50 | ;; 51 | 52 | let _ = 53 | { foo with 54 | Bar. 55 | field1 = value1 56 | ; field2 = value2 57 | } 58 | ;; 59 | let _ = 60 | { foo 61 | with Bar. 62 | field1 = value1 63 | ; field2 = value2 64 | } 65 | ;; 66 | 67 | (* multicomponent record module pathname *) 68 | let _ = 69 | { A.B. 70 | a = b 71 | ; c = d 72 | } 73 | ;; 74 | 75 | type t = 76 | { a 77 | : something_lengthy list list 78 | [@default String.Map.empty] 79 | } 80 | 81 | type t = 82 | { a 83 | : Something_lengthy.t list list 84 | [@default String.Map.empty] 85 | } 86 | 87 | type t = 88 | { a 89 | : something_lengthy list 90 | list 91 | } 92 | 93 | type t = 94 | { a 95 | : Something_lengthy.t list 96 | list 97 | } 98 | 99 | type t = 100 | { a 101 | : Something_lengthy.t 102 | list 103 | } 104 | -------------------------------------------------------------------------------- /tests/failing/js-record.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-syntax.ml: -------------------------------------------------------------------------------- 1 | (* s *) 2 | 3 | let _ = 4 | [%raise_structural_sexp 5 | "feature's tip is already an ancestor of new base" 6 | { feature_tip = (old_tip : Rev.t) 7 | ; new_base = (new_base : Rev.t) 8 | }] 9 | 10 | let _ = 11 | [%raise_structural_sexp "feature's tip is already an ancestor of new base" 12 | { feature_tip = (old_tip : Rev.t) 13 | ; new_base = (new_base : Rev.t) 14 | } 15 | ] 16 | -------------------------------------------------------------------------------- /tests/failing/js-syntax.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-to-do.ml: -------------------------------------------------------------------------------- 1 | (* Indentation that Jane Street needs to think about and make precise. 2 | 3 | These are long term ideas, possibly even conflicting with other tests. *) 4 | 5 | 6 | 7 | (* js-args *) 8 | 9 | let _ = 10 | let min_closing_backoff = 11 | -. ( Hidden_float.expose (arb.cfg.base_edge @! Buy) 12 | +. Hidden_float.expose (arb.cfg.base_edge @! Sell)) 13 | in 14 | 0 15 | 16 | 17 | 18 | (* js-type *) 19 | 20 | (* The following tests incorporate several subtle and different indentation 21 | ideas. Please consider this only a proposal for discussion, for now. 22 | 23 | First, notice the display treatment of "(,)" tuples, analogous to "[;]" 24 | lists. While "(,)" is an intensional combination of "()" and ",", unlike 25 | "[;]" lists, we believe "(,)" isn't too big a departure. Value expression 26 | analogies are included in js-type.ml, (meant to be) consistent with the 27 | proposed type indentation. 28 | 29 | Second, and more divergently, the proposed indentation of function types is 30 | based on the idea of aligning the arguments, even the first argument, even 31 | where that means automatically inserting spaces within lines. This applies 32 | to the extra spaces in ":__unit" and "(____Config.Network.t" below. 33 | 34 | We believe this fits into a more general incorporation of alignment into 35 | ocp-indent, to replace our internal alignment tool with a syntax-aware one. 36 | We like to align things for readability, like big records, record types, 37 | lists used to build tables, etc. 38 | 39 | The proposal also includes indenting "->" in the circumstances below relative 40 | to the enclosing "()", by two spaces. In a sense, this happens first, and 41 | then the first argument is aligned accordingly. So, there's no manual 42 | indentation or spacing below. *) 43 | 44 | val instances 45 | : unit 46 | -> ( Config.Network.t 47 | -> (App.t * Config.instance * Config.app) list 48 | -> verbose:bool 49 | -> 'm 50 | , 'm 51 | ) Command.Spec.t 52 | 53 | val instances 54 | : unit 55 | -> ( Config.Network.t 56 | -> (App.t * Config.instance * Config.app) list 57 | -> verbose:bool -> 'm 58 | , 'm 59 | ) Command.Spec.t 60 | 61 | (* presumed analog with stars *) 62 | val instances : 63 | unit 64 | * ( Config.Network.t 65 | * (App.t * Config.instance * Config.app) list 66 | * bool 67 | * 'm 68 | , 'm 69 | ) Command.Spec.t 70 | -------------------------------------------------------------------------------- /tests/failing/js-to-do.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/js-upon.ml: -------------------------------------------------------------------------------- 1 | let f x = 2 | stop 3 | (* We don't do this as a matter of style, but the indentation reveals a common 4 | mistake. *) 5 | >>> fun () -> don't_wait_for (close fd); 6 | bind fd 7 | 8 | let f x = 9 | stop 10 | (* This is what was intended, which is indented correctly, although it's bad 11 | style on my part. *) 12 | >>> (fun () -> don't_wait_for (close fd)); 13 | bind 14 | -------------------------------------------------------------------------------- /tests/failing/js-upon.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/failing/list_of_funs.ml: -------------------------------------------------------------------------------- 1 | let f x = 2 | (fun x -> x [ (fun () -> 3) ; 3 | (fun () -> 4) ]) 4 | 5 | let f x = (fun x -> x [ (fun () -> 3) ; 6 | (fun () -> 4) ]) 7 | 8 | let f x = 9 | x [ (fun () -> 3) ; 10 | (fun () -> 4) ] 11 | 12 | let f x = 13 | [ (fun () -> 3) ; 14 | (fun () -> 4) ] 15 | 16 | let f x = 17 | (fun x -> x [ (fun () -> 18 | 3) ; 19 | (fun () -> 4) ]) 20 | 21 | let f x = (fun x -> x [ (fun () -> 22 | 3) ; 23 | (fun () -> 4) ]) 24 | 25 | let f x = 26 | x [ (fun () -> 27 | 3) ; 28 | (fun () -> 4) ] 29 | 30 | let f x = 31 | [ (fun () -> 32 | 3) ; 33 | (fun () -> 4) ] 34 | -------------------------------------------------------------------------------- /tests/inplace/executable.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OCamlPro/ocp-indent/f38578c25d62701847b1bcb45099a9020e2032fe/tests/inplace/executable.ml -------------------------------------------------------------------------------- /tests/inplace/link.ml: -------------------------------------------------------------------------------- 1 | otherfile.ml -------------------------------------------------------------------------------- /tests/inplace/link2.ml: -------------------------------------------------------------------------------- 1 | link.ml -------------------------------------------------------------------------------- /tests/inplace/otherfile.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OCamlPro/ocp-indent/f38578c25d62701847b1bcb45099a9020e2032fe/tests/inplace/otherfile.ml -------------------------------------------------------------------------------- /tests/passing/alignment.ml: -------------------------------------------------------------------------------- 1 | let file_contents = [ 2 | ] 3 | @ [ 4 | foo 5 | ] @ [ 6 | bar 7 | ] 8 | 9 | let _ = 10 | match s.src with 11 | | None -> [ 12 | zz 13 | ] + 2 14 | | Some s -> [ Variable ( 15 | s_src, 16 | OpamFormat.make_string (OpamFilename.to_string s) 17 | ); 18 | yy ]; 19 | foo 20 | | Some s -> { 21 | fww = 22 | s_src, 23 | OpamFormat.make_string (OpamFilename.to_string s) 24 | ; gdd = 25 | yy 26 | } 27 | 28 | let _ = 29 | [ x; 30 | y ] 31 | @ z 32 | 33 | let _ = 34 | [ 35 | x; 36 | y ] 37 | @ z 38 | 39 | let _ = [ 40 | x; 41 | y 42 | ] 43 | @ z 44 | -------------------------------------------------------------------------------- /tests/passing/bracket.ml: -------------------------------------------------------------------------------- 1 | let _ = 2 | match a with 3 | | b -> 4 | cccccc [ 5 | d [ 6 | e 7 | ] 8 | ] 9 | | b' -> 10 | (ccccc' [ 11 | d' [ 12 | e' 13 | ] 14 | ]) 15 | -------------------------------------------------------------------------------- /tests/passing/cinaps.ml: -------------------------------------------------------------------------------- 1 | (*$ open Bin_prot_cinaps $*) 2 | 3 | let bin_read_nat0 buf ~pos_ref = 4 | let pos = safe_get_pos buf pos_ref in 5 | assert_pos pos; 6 | match unsafe_get buf pos with 7 | | '\x00'..'\x7f' as ch -> 8 | pos_ref := pos + 1; 9 | Nat0.unsafe_of_int (Char.code ch) 10 | | (*$ Code.char INT16 *)'\xfe'(*$*) -> 11 | safe_bin_read_nat0_16 buf ~pos_ref ~pos:(pos + 1) 12 | | (*$ Code.char INT32 *)'\xfd'(*$*) -> 13 | safe_bin_read_nat0_32 buf ~pos_ref ~pos:(pos + 1) 14 | | (*$ Code.char INT64 *)'\xfc'(*$*) -> 15 | if arch_sixtyfour then 16 | safe_bin_read_nat0_64 buf ~pos_ref ~pos:(pos + 1) 17 | else 18 | raise_read_error ReadError.Nat0_overflow pos 19 | | _ -> 20 | raise_read_error ReadError.Nat0_code pos 21 | [@@ocamlformat "disable"] 22 | 23 | let bin_read_int buf ~pos_ref = 24 | let pos = safe_get_pos buf pos_ref in 25 | assert_pos pos; 26 | match unsafe_get buf pos with 27 | | '\x00'..'\x7f' as ch -> 28 | pos_ref := pos + 1; 29 | Char.code ch 30 | | (*$ Code.char NEG_INT8 *)'\xff'(*$*) -> 31 | safe_bin_read_neg_int8 buf ~pos_ref ~pos:(pos + 1) 32 | | (*$ Code.char INT16 *)'\xfe'(*$*) -> 33 | safe_bin_read_int16 buf ~pos_ref ~pos:(pos + 1) 34 | | (*$ Code.char INT32 *)'\xfd'(*$*) -> 35 | safe_bin_read_int32_as_int buf ~pos_ref ~pos:(pos + 1) 36 | | (*$ Code.char INT64 *)'\xfc'(*$*) -> 37 | if arch_sixtyfour then 38 | safe_bin_read_int64_as_int buf ~pos_ref ~pos:(pos + 1) 39 | else 40 | raise_read_error ReadError.Int_overflow pos 41 | | _ -> 42 | raise_read_error ReadError.Int_code pos 43 | [@@ocamlformat "disable"] 44 | 45 | let bin_read_float buf ~pos_ref = 46 | let pos = safe_get_pos buf pos_ref in 47 | assert_pos pos; 48 | let next = pos + 8 in 49 | check_next buf next; 50 | pos_ref := next; 51 | (* No error possible either. *) 52 | Int64.float_of_bits (unsafe_get64le buf pos) 53 | ;; 54 | 55 | let bin_read_int32 buf ~pos_ref = 56 | let pos = safe_get_pos buf pos_ref in 57 | assert_pos pos; 58 | match unsafe_get buf pos with 59 | | '\x00'..'\x7f' as ch -> 60 | pos_ref := pos + 1; 61 | Int32.of_int (Char.code ch) 62 | | (*$ Code.char NEG_INT8 *)'\xff'(*$*) -> 63 | Int32.of_int (safe_bin_read_neg_int8 buf ~pos_ref ~pos:(pos + 1)) 64 | | (*$ Code.char INT16 *)'\xfe'(*$*) -> 65 | Int32.of_int (safe_bin_read_int16 buf ~pos_ref ~pos:(pos + 1)) 66 | | (*$ Code.char INT32 *)'\xfd'(*$*) -> 67 | safe_bin_read_int32 buf ~pos_ref ~pos:(pos + 1) 68 | | _ -> 69 | raise_read_error ReadError.Int32_code pos 70 | [@@ocamlformat "disable"] 71 | 72 | let bin_read_int64 buf ~pos_ref = 73 | let pos = safe_get_pos buf pos_ref in 74 | assert_pos pos; 75 | match unsafe_get buf pos with 76 | | '\x00'..'\x7f' as ch -> 77 | pos_ref := pos + 1; 78 | Int64.of_int (Char.code ch) 79 | | (*$ Code.char NEG_INT8 *)'\xff'(*$*) -> 80 | Int64.of_int (safe_bin_read_neg_int8 buf ~pos_ref ~pos:(pos + 1)) 81 | | (*$ Code.char INT16 *)'\xfe'(*$*) -> 82 | Int64.of_int (safe_bin_read_int16 buf ~pos_ref ~pos:(pos + 1)) 83 | | (*$ Code.char INT32 *)'\xfd'(*$*) -> 84 | safe_bin_read_int32_as_int64 buf ~pos_ref ~pos:(pos + 1) 85 | | (*$ Code.char INT64 *)'\xfc'(*$*) -> 86 | safe_bin_read_int64 buf ~pos_ref ~pos:(pos + 1) 87 | | _ -> 88 | raise_read_error ReadError.Int64_code pos 89 | [@@ocamlformat "disable"] 90 | 91 | let _ = 92 | (*$ 93 | {x=[]}; 94 | () 95 | *) 96 | (*$*) 97 | -------------------------------------------------------------------------------- /tests/passing/comments.ml: -------------------------------------------------------------------------------- 1 | (* A *) 2 | 3 | type x = 4 | (* A *) 5 | | Foo 6 | 7 | (* B *) 8 | 9 | | Bar 10 | 11 | (* AA *) 12 | 13 | (* D *) 14 | let x = 3 15 | 16 | module M = struct 17 | (* M1 *) 18 | let x = 19 | a 20 | (* M2 *) 21 | let y = 22 | b 23 | 24 | (* M3 *) 25 | (* M4 *) 26 | end 27 | 28 | let f x = 29 | if true then 30 | 0 31 | (* comment *) 32 | else if false then 33 | 1 34 | 35 | let g x = 36 | if true then 37 | 0 38 | 39 | (* comment *) 40 | else if false then 41 | 1 42 | 43 | let _ = 44 | f x 45 | (* bla *) y 46 | (* bla *) (z) 47 | 48 | module M_bad : sig 49 | type _ t = 50 | | A : a -> a t 51 | | B : b -> b t 52 | (** Indented correctly *) 53 | 54 | type 'a t = 55 | | A of 'a 56 | (** Indented correctly *) 57 | 58 | type 'a t = 59 | | A of 'a 60 | | B of 'a 61 | (** Indented too far *) 62 | end 63 | 64 | module M_ok : sig 65 | type _ t = 66 | | A : a -> a t 67 | | B : b -> b t 68 | (** Indented correctly *) 69 | 70 | type 'a t = 71 | | A of 'a 72 | (** Indented correctly *) 73 | 74 | type 'a t = 75 | | A of 'a 76 | | B of 'a 77 | (** Indented correctly! *) 78 | 79 | val x : int 80 | end 81 | 82 | module M = struct 83 | type _ t = 84 | | A : a -> a t 85 | | B : b -> b t 86 | (** Indented too far *) 87 | end 88 | 89 | module type M = sig 90 | type _ t = 91 | | A : a -> a t 92 | | B : b -> b t 93 | (** Indented correctly! *) 94 | 95 | val x : int 96 | end 97 | 98 | module M : sig 99 | type _ t = 100 | | A : a -> a t 101 | (** Indented correctly *) 102 | end 103 | 104 | type _ t = 105 | | A : a -> a t 106 | | B : b -> b t 107 | (** Indented correctly *) 108 | 109 | (* ending comments *) 110 | 111 | -------------------------------------------------------------------------------- /tests/passing/core-failing.ml: -------------------------------------------------------------------------------- 1 | exception IOError of 2 | int * 3 | exn 4 | 5 | module type S = S 6 | with type ('a, 'b, 'c) map := ('a, 'b, 'c) t 7 | 8 | let _ = 9 | let start_finaliser_thread () = 10 | ignore (Thread.create (fun () -> Fn.forever (fun () -> 11 | match read_finaliser_queue () with 12 | | None -> Thread.delay 1.0 13 | | Some f -> Exn.handle_uncaught ~exit:false f)) ()) 14 | in 15 | () 16 | 17 | module F 18 | (A) 19 | (B) 20 | -------------------------------------------------------------------------------- /tests/passing/core-passing.ml: -------------------------------------------------------------------------------- 1 | type t1 = 2 | { 3 | a: int; 4 | b: int -> int; 5 | c: int; 6 | } 7 | 8 | let try_lock t = 9 | wrap_mutex a.b (fun () -> 10 | was_locked) 11 | 12 | let blit_string_bigstring ~src ?src_pos ?src_len ~dst ?dst_pos () = 13 | blit_common 14 | ~get_src_len:String.length ~get_dst_len:length 15 | ~blit:unsafe_blit_string_bigstring 16 | ~src ?src_pos ?src_len ~dst ?dst_pos 17 | () 18 | 19 | let f = 20 | test bla Int32.to_string 21 | pack_signed_32 22 | 23 | module S : S1 24 | with type t = S1.t 25 | with type comparator = S.comparator 26 | 27 | let error_string message = error message () <:sexp_of< unit >> 28 | let unimplemented s = () 29 | 30 | let () = 31 | StdLabels.List.iter 32 | ~f:(fun (exc, handler) -> 33 | Conv.Exn_converter.add_auto ~finalise:false exc handler) 34 | () 35 | 36 | let _ = 37 | Date.to_string date 38 | :: " " 39 | :: (if is_utc then ["Z"] 40 | else bla) 41 | 42 | val v 43 | : t 44 | 45 | let _ = 46 | let module M = (val m : S with type t = t') in 47 | x 48 | 49 | let a,b,c = 50 | d 51 | 52 | type t = t0 = { 53 | a: int; 54 | } 55 | 56 | type t2 = [ 57 | | `a 58 | | `b 59 | ] 60 | 61 | type t = private 62 | | A 63 | | B 64 | 65 | module Make : (S with type t = t') = 66 | struct 67 | type contents = C.t 68 | end 69 | 70 | module Map_and_set_binable = struct 71 | module C : (S with type t = t) 72 | val v 73 | end 74 | 75 | type compare = 76 | [`no_polymorphic_compare] 77 | -> [`no_polymorphic_compare] 78 | 79 | let _ = 80 | {Parts. 81 | sign = sign; 82 | hr = hr; 83 | } 84 | 85 | module M (A) : sig 86 | val bla : bla 87 | end = struct 88 | end 89 | 90 | val marshal_blit : 91 | ?flags : Marshal.extern_flags list -> 'a -> 92 | ?pos : int -> ?len : int -> t -> int 93 | 94 | let daemonize ?(redirect_stdout=`Dev_null) ?(redirect_stderr=`Dev_null) 95 | ?(cd = "/") ?umask:(umask_value = default_umask) () = 96 | bla 97 | 98 | val add : 99 | t -> 100 | (event -> Time.t -> unit) -> 101 | a 102 | 103 | let _ = match a with 104 | | A 105 | when b -> c 106 | | A b 107 | when b -> c 108 | 109 | module S : S1 110 | with type t = S1.t 111 | with type comparator = S.comparator 112 | 113 | let _ = 114 | let f x = 115 | bla 116 | and g x = 117 | bli 118 | 119 | include struct 120 | exception Break = Break 121 | let y = 2 122 | end 123 | 124 | let should_check_can_sell_and_marking regulatory_regime = 125 | match z with 126 | | `foo 127 | -> some_function 128 | argument; 129 | flu 130 | | `foo -> some_function 131 | argument; 132 | flu 133 | 134 | let _ = 135 | invalid_arg 136 | (sprintf "Dequeue.%s: index %i is not in [%d, %d]" 137 | fname i (front_index buf) (back_index buf)) 138 | 139 | let mem { ar; cmp } el = 140 | let len = Array.length ar in 141 | len > 0 && 142 | let rec loop pos = 143 | bla 144 | in 145 | blu 146 | 147 | let blit_to (type a) (blit : (Base.t, a) Blit.t) = 148 | (); fun t ~dst ~dst_pos -> 149 | blit ~src:t.base ~src_pos:t.pos ~src_len:t.len ~dst ~dst_pos () 150 | 151 | type 'a t = 'a Bin_prot.Type_class.writer 152 | = { size : 'a Size.sizer; 153 | write : 'a Write_ml.writer; 154 | unsafe_write : 'a Unsafe_write_c.writer; 155 | } 156 | 157 | let create 158 | ?(message = Pid.to_string (Unix.getpid ())) 159 | ?(close_on_exec=true) 160 | = 161 | xx 162 | 163 | module Make_using_comparator (Elt : Comparator.S) 164 | : S with type Elt.t = Elt.t 165 | with type Elt.comparator = Elt.comparator 166 | 167 | let _ = 168 | find_thread_count 169 | (In_channel.read_lines 170 | ("/proc/" ^ string_of_int (Unix.getpid ()) ^ "/status")) 171 | 172 | type variant = [ `Jan | `Feb | `Mar | `Apr | `May | `Jun 173 | | `Jul | `Aug | `Sep | `Oct | `Nov | `Dec ] 174 | 175 | let _ = 176 | let exception E in 177 | () 178 | 179 | let _ = 180 | let exception E of string in 181 | () 182 | -------------------------------------------------------------------------------- /tests/passing/edge-cases.ml: -------------------------------------------------------------------------------- 1 | 2 | (* this could be fixed, but we actually want to handle the first case 3 | differently for when there is only one case (see next examples) *) 4 | let f x = function A -> x; 5 | 2 6 | | B -> y; 7 | 3 8 | 9 | (* if we were to fix to the case above, the second >>= would be below the _ 10 | (test taken from js-fun) *) 11 | let _ = 12 | x 13 | >>= fun x -> 14 | try x with _ -> () 15 | >>= fun x -> 16 | x 17 | 18 | (* (and also: the some_handling here would be below Not_found) *) 19 | let _ = 20 | try 21 | _ 22 | with Not_found -> 23 | some_handling 24 | 25 | let f = fun x -> 26 | x 27 | 28 | let f = (fun x -> 29 | x 30 | ) 31 | 32 | let f g = g @@ fun x -> 33 | x 34 | 35 | let f g = g @@ (fun x -> 36 | x 37 | ) 38 | 39 | 40 | (* the above should probably be consistent with: *) 41 | let f x y = y + match x with A -> 42 | 0 43 | 44 | let f x y = y + (match x with A -> 45 | 0 46 | ) 47 | 48 | (* wich means we may over-indent even when the block is non-closable *) 49 | 50 | let f x y = y + match x with 51 | | A -> 0 52 | 53 | let f x y = y + (match x with 54 | | A -> 0 55 | ) 56 | 57 | let f x y = y + match x with 58 | | A -> 0 59 | 60 | let _ = 61 | somefun 62 | (fun x -> 63 | x); 64 | somefun 65 | (if 66 | bla 67 | then 68 | bli); 69 | somefun 70 | (if bla then 71 | bli 72 | else 73 | blu) 74 | 75 | let _ = 76 | a 77 | ; 78 | b 79 | 80 | (* Surprisingly, this is the indentation correpsonding to OCaml's interpretation 81 | of this code. Indenting this accordingly may help users notice that they're 82 | doing something dubious. 83 | EDIT Louis/2019: [function] used to be unindented. Not sure what the above 84 | meant since this is a parse error anyway ? 85 | *) 86 | let b = `b 87 | let d = `d 88 | ;; 89 | let a = b 90 | function (_ : [ `c ]) -> d 91 | ;; 92 | -------------------------------------------------------------------------------- /tests/passing/embedded-match.ml: -------------------------------------------------------------------------------- 1 | let f x = function 2 | | A when match x with A | B -> true | _ -> false 3 | -> 4 | B 5 | | A -> x 6 | | _ -> B 7 | 8 | let f x = 9 | if 10 | match x with 11 | | A -> true 12 | then 13 | 1 14 | else 15 | 0 16 | 17 | let f x = 18 | match x with 19 | | A -> true 20 | | B -> 21 | false 22 | | exception 23 | Not_found -> 24 | false 25 | | C -> true 26 | | exception (Failure _ | Invalid_argument _) -> 27 | true 28 | | exception (A | B) | exception B.Err 29 | | exception C.Types.Xxx "someparam" -> 30 | false 31 | 32 | exception MyExn of string 33 | -------------------------------------------------------------------------------- /tests/passing/exprs.ml: -------------------------------------------------------------------------------- 1 | f "foo" 2 | g 3 | [ 1; 4 | 2] 5 | ;; 6 | 7 | let x = 8 | f 1 ((x 3) 9 | || (x f) 10 | lor (g lsl k) 11 | lor g 12 | && g 13 | lsr g) 14 | 15 | let f x = 16 | g 17 | (fun x -> x) 18 | [] 19 | x:x 20 | ?y:z 21 | () 22 | 0 23 | 24 | let f 25 | ~p 26 | ~g 27 | () 28 | ?k 29 | () = 30 | let x = 0 in 31 | p 32 | 33 | let f = 34 | for i = 0 to 1; do 35 | a; 36 | b; 37 | done; 38 | x 39 | 40 | external f : 41 | 'a -> x : int -> t 42 | = "b" 43 | 44 | external g : 45 | x : t -> s : i -> d : t -> unit 46 | = "b2" 47 | 48 | let f ?(g = []) v ?(x = 0) ?l b = 49 | let l = g b ~p l in 50 | c ~l:"foo" b ~p ~l; 51 | u v ~p ~l b f 52 | 53 | let f () = 54 | g x y 55 | ?x:y ?y:w 56 | ~a:b 57 | 58 | let f () = 59 | f (fun () -> 60 | for i = 0 to 10 do 61 | g 62 | done; 63 | x 64 | ) 65 | 66 | external f: int -> int = "foo" 67 | 68 | let f () = 69 | for i = 0 to 10 do 70 | g 71 | done 72 | 73 | let f () = 74 | { x = 1; 75 | y = 2; 76 | } 77 | 78 | let f () = { 79 | x = 1; 80 | y = 2; 81 | } 82 | 83 | let f () = 84 | { 85 | x = 1; 86 | y = 2; 87 | } 88 | 89 | let f () = 90 | { x = 1 91 | ; y = 2 } 92 | 93 | let f x = 94 | if x then 95 | x 96 | else 97 | f @@ fun () -> 98 | g; 99 | h 100 | 101 | let funct param 102 | : A_very_long_module_name.t t1 103 | * t2 104 | = 105 | something 106 | -------------------------------------------------------------------------------- /tests/passing/extensible.ml: -------------------------------------------------------------------------------- 1 | (* Simple declaration : OK *) 2 | type t = .. 3 | type t += 4 | A 5 | | B 6 | 7 | (* But : *) 8 | type t = .. 9 | type t += 10 | | A 11 | | B 12 | 13 | (* Inside modules : same pb *) 14 | module P = struct 15 | type t = .. 16 | type t += 17 | | A 18 | | B 19 | end 20 | 21 | module Q = struct 22 | type P.t += 23 | | C 24 | | D 25 | end 26 | 27 | (* another one *) 28 | module Q' = struct 29 | type P.t += 30 | | C = P.A 31 | | D 32 | end 33 | 34 | (* also *) 35 | module M = struct 36 | type t = .. 37 | let a = 1 38 | let b = 2 39 | end 40 | -------------------------------------------------------------------------------- /tests/passing/gadt.ml: -------------------------------------------------------------------------------- 1 | type _ term = 2 | | Int : int -> int term 3 | | Add : (int -> int -> int) term 4 | | App : ('b -> 'a) term * 'b term -> 'a term 5 | 6 | let rec eval : type a. a term -> a = function 7 | | Int n -> n (* a = int *) 8 | | Add -> (fun x y -> x+y) (* a = int -> int -> int *) 9 | | App(f,x) -> (eval f) (eval x) 10 | (* eval called at types (b->a) and b for fresh b *) 11 | 12 | let two = eval (App (App (Add, Int 1), Int 1)) 13 | 14 | let rec sum : type a. a term -> _ = fun x -> 15 | let y = 16 | match x with 17 | | Int n -> n 18 | | Add -> 0 19 | | App(f,x) -> sum f + sum x 20 | in y + 1 21 | 22 | type _ typ = 23 | | Int : int typ 24 | | String : string typ 25 | | Pair : 'a typ * 'b typ -> ('a * 'b) typ 26 | 27 | let rec to_string: type t. t typ -> t -> string = 28 | fun t x -> 29 | match t with 30 | | Int -> string_of_int x 31 | | String -> Printf.sprintf "%S" x 32 | | Pair(t1,t2) -> 33 | let (x1, x2) = x in 34 | Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2) 35 | 36 | type (_,_) eq = Eq : ('a,'a) eq 37 | 38 | let cast : type a b. (a,b) eq -> a -> b = fun Eq x -> x 39 | 40 | let rec eq_type : type a b. a typ -> b typ -> (a,b) eq option = 41 | fun a b -> 42 | match a, b with 43 | | Int, Int -> Some Eq 44 | | String, String -> Some Eq 45 | | Pair(a1,a2), Pair(b1,b2) -> 46 | begin match eq_type a1 b1, eq_type a2 b2 with 47 | | Some Eq, Some Eq -> Some Eq 48 | | _ -> None 49 | end 50 | | _ -> None 51 | 52 | type dyn = Dyn : 'a typ * 'a -> dyn 53 | 54 | let get_dyn : type a. a typ -> dyn -> a option = 55 | fun a (Dyn(b,x)) -> 56 | match eq_type a b with 57 | | None -> None 58 | | Some Eq -> Some x 59 | 60 | let _ = 61 | let f: type a. a list -> int = 62 | fun _x -> 42 63 | in 64 | f [] 65 | 66 | let nth t n = 67 | if n < 0 then None else 68 | let rec nth_aux: type b. ('a, b) t -> int -> 'a option = fun t n -> 69 | match t with 70 | | Empty -> None 71 | | Node (a, t) -> if n = 0 then Some a else nth_aux t (n-1) 72 | in 73 | nth_aux t n 74 | 75 | let rec f : type a b. a = function 76 | | _ -> assert false 77 | and g : type a. a = function 78 | | _ -> assert false 79 | -------------------------------------------------------------------------------- /tests/passing/ifand.ml: -------------------------------------------------------------------------------- 1 | let _ = 2 | if cond1 3 | && cond2 4 | then _ 5 | 6 | let _ = function 7 | | _ when x = 2 8 | && y = 3 -> 9 | begin if a = b 10 | || b = c 11 | && c = d then 12 | _ 13 | end 14 | -------------------------------------------------------------------------------- /tests/passing/indent-empty-1.ml: -------------------------------------------------------------------------------- 1 | module M = struct 2 | 3 | let f = 4 | 5 | end 6 | 7 | let g = 8 | 9 | fun x -> 3 + 4 * 10 | -------------------------------------------------------------------------------- /tests/passing/indent-empty-1.ml.opts: -------------------------------------------------------------------------------- 1 | --lines 4 --numeric 2 | -------------------------------------------------------------------------------- /tests/passing/indent-empty-1.ml.ref: -------------------------------------------------------------------------------- 1 | 4 2 | -------------------------------------------------------------------------------- /tests/passing/indent-empty-nm.ml: -------------------------------------------------------------------------------- 1 | module M = struct 2 | 3 | let f = 4 | 5 | end 6 | 7 | let g = 8 | 9 | fun x -> 3 + 4 * 10 | -------------------------------------------------------------------------------- /tests/passing/indent-empty-nm.ml.opts: -------------------------------------------------------------------------------- 1 | --indent-empty --numeric 2 | -------------------------------------------------------------------------------- /tests/passing/indent-empty-nm.ml.ref: -------------------------------------------------------------------------------- 1 | 0 2 | 2 3 | 2 4 | 4 5 | 0 6 | 0 7 | 0 8 | 2 9 | 2 10 | 15 11 | -------------------------------------------------------------------------------- /tests/passing/indent-empty.ml: -------------------------------------------------------------------------------- 1 | module M = struct 2 | 3 | let f = 4 | 5 | end 6 | 7 | let g = 8 | 9 | fun x -> 3 + 4 * 10 | -------------------------------------------------------------------------------- /tests/passing/indent-empty.ml.opts: -------------------------------------------------------------------------------- 1 | --indent-empty 2 | -------------------------------------------------------------------------------- /tests/passing/indent-empty.ml.ref: -------------------------------------------------------------------------------- 1 | module M = struct 2 | 3 | let f = 4 | 5 | end 6 | 7 | let g = 8 | 9 | fun x -> 3 + 4 * 10 | -------------------------------------------------------------------------------- /tests/passing/js-2018.ml: -------------------------------------------------------------------------------- 1 | (* New issues reported as of 2018 *) 2 | 3 | (* include.ml *) 4 | 5 | module M : sig 6 | include module type of struct 7 | include I 8 | end 9 | 10 | val f : unit -> unit 11 | end 12 | 13 | (* record.ml *) 14 | let _ = 15 | { a_field : int = 16 | 3 17 | ; another_field : int = 18 | 3 19 | } 20 | 21 | let _ = 22 | { a_field = 23 | 3 24 | ; another_field = 25 | 3 26 | } 27 | 28 | (* polyvariant.mli *) 29 | module type S = sig 30 | val a : 31 | something:int 32 | -> non_optional: 33 | int list 34 | list 35 | list 36 | -> ?optional: 37 | int 38 | -> int 39 | end 40 | 41 | module type S = sig 42 | val a 43 | : something:int 44 | -> non_optional: 45 | [ `A 46 | | `B 47 | ] 48 | -> ?optional: 49 | [ `A 50 | | `B 51 | ] 52 | -> int 53 | end 54 | 55 | (* type_annot_ext.ml *) 56 | let x = 57 | let v : [%ext : int] = w in 58 | "hello" 59 | 60 | let f a = 61 | match (a : Nothing.t) with 62 | | _ -> . 63 | 64 | let g () = 65 | 1 66 | 67 | ;; 68 | 69 | (* let_module_functor_application.ml *) 70 | let module X = Make (struct 71 | let i = 10 72 | end) 73 | 74 | (* gadts.ml *) 75 | type 'a t = 76 | | Foo : 77 | int list list list list 78 | * string list 79 | * float list 80 | * bool list 81 | * 'a option list list 82 | -> 'a option list list t 83 | 84 | (* inline_record_indentation.ml *) 85 | type t = 86 | | Clause of { 87 | field : ty; 88 | } 89 | | Clause of { 90 | field : ty; 91 | } 92 | | Clause of { 93 | field : ty; 94 | } 95 | 96 | (* constraint.ml *) 97 | type 'a t = 'b constraint 'a = < foo : 'b > 98 | 99 | let x = 8 100 | 101 | (* custom_delim_in_comments.ml *) 102 | (* some comment {|"|} *) 103 | let f x = x 104 | (* {|"|} *) 105 | -------------------------------------------------------------------------------- /tests/passing/js-2018.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-and.ml: -------------------------------------------------------------------------------- 1 | module M : S with type a = b 2 | and type c = d 3 | and type e = f 4 | ;; 5 | -------------------------------------------------------------------------------- /tests/passing/js-and.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-andand.ml: -------------------------------------------------------------------------------- 1 | let all_equal = 2 | a = b 3 | && c = d 4 | && e = f (* this && should line up with previous one *) 5 | ;; 6 | 7 | (* '=' seems to be relevant here *) 8 | let _ = 9 | x 10 | && t.entity = entity 11 | && t.clearing_firm = clearing_firm 12 | && t.type_ = type_ 13 | -------------------------------------------------------------------------------- /tests/passing/js-andand.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-applicative.ml: -------------------------------------------------------------------------------- 1 | (* applicative_intf.ml *) 2 | 3 | let args = 4 | bar "A" 5 | @> baz "B" 6 | @> nil 7 | 8 | let args = 9 | bar "A" 10 | @> baz_qux 11 | @@ zap "D" 12 | @> nil 13 | -------------------------------------------------------------------------------- /tests/passing/js-applicative.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-bench.ml: -------------------------------------------------------------------------------- 1 | BENCH_FUN "Array.get (tuple)" = 2 | (* This is mis-indented only when BENCH_FUN is on the first line. *) 3 | let len = 300 in 4 | let arr = create ~len (1,2) in 5 | (fun () -> ignore(arr.(len-1))) 6 | 7 | BENCH_FUN "Array.set (tuple)" = 8 | let len = 300 in 9 | let arr = create ~len (1,2) in 10 | (fun () -> arr.(len-1) <- (3,4)) 11 | 12 | (* Some benchmarks of the blit operations *) 13 | BENCH_MODULE "Blit tests" = struct 14 | let lengths = [0; 10; 100; 1000; 10_000] 15 | 16 | BENCH_MODULE "Int" = struct 17 | BENCH_INDEXED "blit" len lengths = 18 | let src = create ~len 0 in 19 | let dst = create ~len 0 in 20 | (fun () -> Int.blit ~src ~src_pos:0 ~dst ~dst_pos:0 ~len) 21 | 22 | BENCH_INDEXED "blito" len lengths = 23 | let src = create ~len 0 in 24 | let dst = create ~len 0 in 25 | (fun () -> Int.blito ~src ~src_pos:0 ~dst ~dst_pos:0 ~src_len:len ()) 26 | end 27 | 28 | BENCH_MODULE "Float" = struct 29 | BENCH_INDEXED "blit" len lengths = 30 | let src = create ~len 0.0 in 31 | let dst = create ~len 0.0 in 32 | (fun () -> Float.blit ~src ~src_pos:0 ~dst ~dst_pos:0 ~len) 33 | 34 | BENCH_INDEXED "blito" len lengths = 35 | let src = create ~len 0.0 in 36 | let dst = create ~len 0.0 in 37 | (fun () -> Float.blito ~src ~src_pos:0 ~dst ~dst_pos:0 ~src_len:len ()) 38 | end 39 | end 40 | -------------------------------------------------------------------------------- /tests/passing/js-bench.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-bind.ml: -------------------------------------------------------------------------------- 1 | let assigned_to u = 2 | Deferred.List.filter (Request_util.requests ()) ~f:(fun request -> 3 | if _ 4 | then _ 5 | else 6 | status_request ~request () ~msg_client:no_msg >>= fun status -> 7 | not (up_to_date_user status u)) 8 | 9 | 10 | 11 | let old_good = 12 | foo bar qaz *>>= fun x -> 13 | hey ho lala *>>= fun y -> 14 | return (x,y) 15 | 16 | let old_good = 17 | foo bar qaz +>>= fun x -> 18 | hey ho lala +>>= fun y -> 19 | return (x,y) 20 | 21 | (* generalizations based on Tuareg code *) 22 | let old_good = 23 | foo bar qaz *>>| fun x -> 24 | hey ho lala *>>> fun y -> 25 | foo bar qaz +>>| fun x -> 26 | hey ho lala +>>> fun y -> 27 | return (x,y) 28 | -------------------------------------------------------------------------------- /tests/passing/js-bind.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-comment.ml: -------------------------------------------------------------------------------- 1 | (* ocp-indent is not going to be confused by comment-embedded tokens. *) 2 | 3 | 4 | 5 | type t = { 6 | (* This is a comment *) 7 | a: int; 8 | } 9 | 10 | type t = { 11 | (* This is a comment : with a colon. *) 12 | a: int; 13 | } 14 | 15 | type t = { 16 | a: int; 17 | (* with the : second field *) 18 | b: int; 19 | } 20 | 21 | type t = { 22 | a: int; 23 | b: int; 24 | (* and : the third... *) 25 | c: int; 26 | } 27 | 28 | 29 | 30 | (* colon in CR comment messes Tuareg up *) 31 | type cfg = { 32 | foo : int; (* ignore-CR someone: float? *) 33 | bar : string; 34 | } 35 | 36 | (* To be more precise about the Tuareg bug, it is the fact that the colon in the comment 37 | is the first or second colon after the start of the record definition. If the comment 38 | occurs after the first 2 fields in the record everything is fine. 39 | 40 | For example, this is OK: *) 41 | type t= { 42 | foo : int; 43 | bar : string; (* ignore-CR someone: float? *) 44 | baz : string; 45 | } 46 | 47 | (* but Tuareg messes this up *) 48 | type t= { 49 | foo : int; 50 | (* ignore-CR someone: float? *) 51 | bar : string; 52 | } 53 | 54 | 55 | 56 | (* Now that we have support for {v v} and {[ ]}, reindent inside comments, 57 | unless they are explicitly delimited as code or pre-formatted text. These 58 | three all end up flattened to the same level. *) 59 | (* 60 | type t = { 61 | (* This is a comment *) 62 | a: int; 63 | } 64 | *) 65 | (* 66 | type t = { 67 | (* This is a comment *) 68 | a: int; 69 | } 70 | *) 71 | (* 72 | type t = { 73 | (* This is a comment *) 74 | a: int; 75 | } 76 | *) 77 | 78 | 79 | 80 | (* Possible to-do warning: Star-prefixed lines are allowed and indented a little 81 | less, to line up with the star in the opening comment parenthesis. Maybe we 82 | don't care enough about them to worry about it, though. *) 83 | 84 | 85 | 86 | (** Doc comment text should be aligned with the first line, so indented more 87 | than otherwise. *) 88 | 89 | (* We're now using some ocamldoc block syntax to control indentation, and sweeks 90 | and the rest of us have been relying on it, in and out of doc comments. 91 | 92 | {[ 93 | let code = 94 | should be reindented like code 95 | so as to work also with vim 96 | ]} 97 | 98 | {v g 99 | This is totally verbatim text and shouldn't be reindented. It 100 | probably doesn't matter what the indentation of the first line of a 101 | verbatim block is. But how will this be done in vim? 102 | xx 103 | yy 104 | zz 105 | c v} 106 | 107 | Does this even confront ocp-indent? I think, when reindenting whole files, 108 | source code blocks do confront ocp-indent. 109 | *) 110 | 111 | 112 | 113 | (* {v 114 | 115 | (* comments embedded in verbatim sections *) 116 | (* want to be able to verbatim-out big chunks of code *) 117 | 118 | v} *) 119 | 120 | 121 | 122 | (* {v 123 | 124 | non-comments in verbatim sections 125 | duh 126 | 127 | v} *) 128 | 129 | 130 | 131 | module M = struct 132 | let x = 0 133 | 134 | (* reference *) 135 | end 136 | 137 | module M = struct 138 | let () = 139 | () 140 | 141 | (* If there's a blank line before this, at least, shouldn't it revert to the 142 | block-level indentation, even if it doesn't precede a declaration? As 143 | long as the prior declaration is complete, I mean. If there isn't a 144 | blank line, I can see associating the comment with the line before. *) 145 | end 146 | 147 | module M = struct 148 | let () = () 149 | 150 | (* sim. *) 151 | end 152 | 153 | module M = struct 154 | let () = 155 | () 156 | 157 | (* no problem *) 158 | let () = 159 | () 160 | end 161 | 162 | 163 | 164 | val f : foo : int -> 165 | -> bar_snoo : a b 166 | (* this comment is in the wrong place *) 167 | -> unit 168 | 169 | val f : foo : int -> 170 | -> bar_snoo : a 171 | (* this comment is in the right place [under discussion] *) 172 | -> unit 173 | 174 | (* The only difference is the type "a b" instead of "a" for the labeled value 175 | bar_snoo. *) 176 | 177 | 178 | 179 | module M : sig 180 | val v : 'a t -> s -> 'a t 181 | (* ... *) 182 | end 183 | -------------------------------------------------------------------------------- /tests/passing/js-comment.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-comment.ml.ref: -------------------------------------------------------------------------------- 1 | (* ocp-indent is not going to be confused by comment-embedded tokens. *) 2 | 3 | 4 | 5 | type t = { 6 | (* This is a comment *) 7 | a: int; 8 | } 9 | 10 | type t = { 11 | (* This is a comment : with a colon. *) 12 | a: int; 13 | } 14 | 15 | type t = { 16 | a: int; 17 | (* with the : second field *) 18 | b: int; 19 | } 20 | 21 | type t = { 22 | a: int; 23 | b: int; 24 | (* and : the third... *) 25 | c: int; 26 | } 27 | 28 | 29 | 30 | (* colon in CR comment messes Tuareg up *) 31 | type cfg = { 32 | foo : int; (* ignore-CR someone: float? *) 33 | bar : string; 34 | } 35 | 36 | (* To be more precise about the Tuareg bug, it is the fact that the colon in the comment 37 | is the first or second colon after the start of the record definition. If the comment 38 | occurs after the first 2 fields in the record everything is fine. 39 | 40 | For example, this is OK: *) 41 | type t= { 42 | foo : int; 43 | bar : string; (* ignore-CR someone: float? *) 44 | baz : string; 45 | } 46 | 47 | (* but Tuareg messes this up *) 48 | type t= { 49 | foo : int; 50 | (* ignore-CR someone: float? *) 51 | bar : string; 52 | } 53 | 54 | 55 | 56 | (* Now that we have support for {v v} and {[ ]}, reindent inside comments, 57 | unless they are explicitly delimited as code or pre-formatted text. These 58 | three all end up flattened to the same level. *) 59 | (* 60 | type t = { 61 | (* This is a comment *) 62 | a: int; 63 | } 64 | *) 65 | (* 66 | type t = { 67 | (* This is a comment *) 68 | a: int; 69 | } 70 | *) 71 | (* 72 | type t = { 73 | (* This is a comment *) 74 | a: int; 75 | } 76 | *) 77 | 78 | 79 | 80 | (* Possible to-do warning: Star-prefixed lines are allowed and indented a little 81 | less, to line up with the star in the opening comment parenthesis. Maybe we 82 | don't care enough about them to worry about it, though. *) 83 | 84 | 85 | 86 | (** Doc comment text should be aligned with the first line, so indented more 87 | than otherwise. *) 88 | 89 | (* We're now using some ocamldoc block syntax to control indentation, and sweeks 90 | and the rest of us have been relying on it, in and out of doc comments. 91 | 92 | {[ 93 | let code = 94 | should be reindented like code 95 | so as to work also with vim 96 | ]} 97 | 98 | {v g 99 | This is totally verbatim text and shouldn't be reindented. It 100 | probably doesn't matter what the indentation of the first line of a 101 | verbatim block is. But how will this be done in vim? 102 | xx 103 | yy 104 | zz 105 | c v} 106 | 107 | Does this even confront ocp-indent? I think, when reindenting whole files, 108 | source code blocks do confront ocp-indent. 109 | *) 110 | 111 | 112 | 113 | (* {v 114 | 115 | (* comments embedded in verbatim sections *) 116 | (* want to be able to verbatim-out big chunks of code *) 117 | 118 | v} *) 119 | 120 | 121 | 122 | (* {v 123 | 124 | non-comments in verbatim sections 125 | duh 126 | 127 | v} *) 128 | 129 | 130 | 131 | module M = struct 132 | let x = 0 133 | 134 | (* reference *) 135 | end 136 | 137 | module M = struct 138 | let () = 139 | () 140 | 141 | (* If there's a blank line before this, at least, shouldn't it revert to the 142 | block-level indentation, even if it doesn't precede a declaration? As 143 | long as the prior declaration is complete, I mean. If there isn't a 144 | blank line, I can see associating the comment with the line before. *) 145 | end 146 | 147 | module M = struct 148 | let () = () 149 | 150 | (* sim. *) 151 | end 152 | 153 | module M = struct 154 | let () = 155 | () 156 | 157 | (* no problem *) 158 | let () = 159 | () 160 | end 161 | 162 | 163 | 164 | val f : foo : int -> 165 | -> bar_snoo : a b 166 | (* this comment is in the wrong place *) 167 | -> unit 168 | 169 | val f : foo : int -> 170 | -> bar_snoo : a 171 | (* this comment is in the right place [under discussion] *) 172 | -> unit 173 | 174 | (* The only difference is the type "a b" instead of "a" for the labeled value 175 | bar_snoo. *) 176 | 177 | 178 | 179 | module M : sig 180 | val v : 'a t -> s -> 'a t 181 | (* ... *) 182 | end 183 | -------------------------------------------------------------------------------- /tests/passing/js-comment1.ml: -------------------------------------------------------------------------------- 1 | type foo = int (* just in case *) 2 | 3 | 4 | 5 | (* These two shouldn't be indented differently, but are. *) 6 | 7 | type z = 8 | [ `Bar of foo 9 | (* a comment [expected to apply to `Foo as below] *) 10 | | `Foo ] 11 | 12 | type z = 13 | [ `Bar 14 | (* a comment *) 15 | | `Foo ] 16 | 17 | 18 | 19 | (* On second thought, I kind of like this way of thinking about this 20 | indentation, even though it is kind of parasyntactic: *) 21 | 22 | type z = 23 | (* Applies to "[" or `Bar. *) 24 | [ `Bar of foo 25 | (* Applies to "|" or `Foo. Indented too much. *) 26 | | `Foo ] 27 | 28 | type z = 29 | (* Applies to "[" or `Bar. *) 30 | [ `Bar 31 | (* Applies to "|" or `Foo. *) 32 | | `Foo ] 33 | 34 | (* The way we write code, that will line up more nicely. *) 35 | 36 | 37 | 38 | let _ = 39 | (foo 40 | (* This is indented too far to the left *) 41 | (bar)) 42 | 43 | (* It looks to me like we generally want the comment to apply to the 44 | following line in most circumstances, including this one. The default indent 45 | for an empty line after a function application that isn't terminated with a 46 | ";" or something would probably also be in a bit, in anticipation of an 47 | argument, although I don't think that's crucial. *) 48 | let _ = 49 | foo quux 50 | (* about bar *) 51 | bar 52 | (* about baz *) 53 | baz 54 | 55 | (** Trying lists within comments: 56 | - this is a 57 | multi-line element of a list. 58 | - and this is a one-liner 59 | - this 60 | has 61 | many 62 | more 63 | lines 64 | - and this is indented like a sub-list 65 | - but isn't one at 66 | -all 67 | 68 | this is outside of the list though. 69 | 70 | - and this is 71 | - another 72 | list 73 | 74 | - and another 75 | one 76 | 77 | the end 78 | *) 79 | 80 | (* There is an issue with toplevel sessions: 81 | # expr1;; 82 | - : type1 = value1 83 | # expr2;; 84 | - : type2 = value2 85 | 86 | Comment. *) 87 | 88 | (* Comment: 89 | 90 | - [code]; 91 | - {[ code ]} *) 92 | -------------------------------------------------------------------------------- /tests/passing/js-comment1.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-comment1.ml.ref: -------------------------------------------------------------------------------- 1 | type foo = int (* just in case *) 2 | 3 | 4 | 5 | (* These two shouldn't be indented differently, but are. *) 6 | 7 | type z = 8 | [ `Bar of foo 9 | (* a comment [expected to apply to `Foo as below] *) 10 | | `Foo ] 11 | 12 | type z = 13 | [ `Bar 14 | (* a comment *) 15 | | `Foo ] 16 | 17 | 18 | 19 | (* On second thought, I kind of like this way of thinking about this 20 | indentation, even though it is kind of parasyntactic: *) 21 | 22 | type z = 23 | (* Applies to "[" or `Bar. *) 24 | [ `Bar of foo 25 | (* Applies to "|" or `Foo. Indented too much. *) 26 | | `Foo ] 27 | 28 | type z = 29 | (* Applies to "[" or `Bar. *) 30 | [ `Bar 31 | (* Applies to "|" or `Foo. *) 32 | | `Foo ] 33 | 34 | (* The way we write code, that will line up more nicely. *) 35 | 36 | 37 | 38 | let _ = 39 | (foo 40 | (* This is indented too far to the left *) 41 | (bar)) 42 | 43 | (* It looks to me like we generally want the comment to apply to the 44 | following line in most circumstances, including this one. The default indent 45 | for an empty line after a function application that isn't terminated with a 46 | ";" or something would probably also be in a bit, in anticipation of an 47 | argument, although I don't think that's crucial. *) 48 | let _ = 49 | foo quux 50 | (* about bar *) 51 | bar 52 | (* about baz *) 53 | baz 54 | 55 | (** Trying lists within comments: 56 | - this is a 57 | multi-line element of a list. 58 | - and this is a one-liner 59 | - this 60 | has 61 | many 62 | more 63 | lines 64 | - and this is indented like a sub-list 65 | - but isn't one at 66 | -all 67 | 68 | this is outside of the list though. 69 | 70 | - and this is 71 | - another 72 | list 73 | 74 | - and another 75 | one 76 | 77 | the end 78 | *) 79 | 80 | (* There is an issue with toplevel sessions: 81 | # expr1;; 82 | - : type1 = value1 83 | # expr2;; 84 | - : type2 = value2 85 | 86 | Comment. *) 87 | 88 | (* Comment: 89 | 90 | - [code]; 91 | - {[ code ]} *) 92 | -------------------------------------------------------------------------------- /tests/passing/js-default.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { last_trading : Week_date.Spec.t; 3 | first_notice : Week_date.Spec.t option; 4 | first_notice_exceptions : Date.t Year_month.Map.t 5 | with default(Year_month.Map.empty); 6 | offset : Week_date.Offset.t; 7 | (* n > 0 *) 8 | new_contract_expires_in_n_months : int 9 | } 10 | [@@deriving sexp, compare] 11 | 12 | module M = struct 13 | type t = { x: int } 14 | [@@deriving sexp] 15 | end 16 | -------------------------------------------------------------------------------- /tests/passing/js-default.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-fun-rec.ml: -------------------------------------------------------------------------------- 1 | let rec check_header t = 2 | if Iobuf.length t.buf < header_length then failwiths "Short packet" t !sexp_of_t; 3 | and session t = 4 | check_header t; 5 | Session_id.of_int_exn id_int 6 | and length t = 7 | let len = raw_length t in 8 | if len = eos_marker then 0 else len 9 | and sexp_of_t t = (* something pretty for debugging *) 10 | let lo, len = Iobuf.snapshot t.buf, Iobuf.length t.buf in 11 | protect ~finally:(fun () -> Iobuf.Snapshot.rewind lo t.buf; Iobuf.resize t.buf len) 12 | (fun () -> ()) 13 | ;; 14 | -------------------------------------------------------------------------------- /tests/passing/js-fun-rec.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-label.ml: -------------------------------------------------------------------------------- 1 | (* Get C.t and (r : S.t -> T.t) indented two chars right of their labels. *) 2 | type t 3 | = A.t 4 | -> bbb : 5 | C.t 6 | -> D.t 7 | -> e : (f : G.t -> H.t) 8 | -> I.t 9 | -> jjj : [ `K 10 | | `L 11 | ] 12 | -> M.t 13 | -> nnn : 14 | [ `O 15 | | `P 16 | ] 17 | -> qqq : 18 | (r : S.t -> T.t) 19 | -> U.t 20 | -------------------------------------------------------------------------------- /tests/passing/js-label.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-let.ml: -------------------------------------------------------------------------------- 1 | let foo 2 | some very long arguments that we break onto the next line 3 | = 4 | bar (); 5 | baz 6 | (* The [some] above is indented less when [let foo] is the first line. The 7 | problem goes away if there's anything on the line before [let foo]. *) 8 | 9 | (* The picture shows where we want the `=' to be. However, Tuareg currently moves it over 10 | to line up with the arguments. 11 | 12 | Perhaps this is merely a personal preference, but that seems ugly to me. 13 | 14 | pszilagyi: It's consistent with other infix operators (although this is syntax) for it 15 | to be where you prefer. *) 16 | 17 | let foo arguments 18 | = bar 19 | 20 | let foo 21 | arguments 22 | = bar 23 | 24 | (* This program parses, but the [let] is indented incorrectly. *) 25 | module M = struct 26 | module M : module type of M = struct 27 | let x = () 28 | end 29 | end 30 | (* Removing the [: module type of M] removes the bug. *) 31 | 32 | let parenthesized_let_tweak = 33 | (let sub value n l f = 34 | case ~value (message ("fix_sending_" ^ n) ~length:(35 + 29 + l) f) 35 | in 36 | x) 37 | 38 | let parenthesized_let_tweak = 39 | f ~x:(let n = 40 | S.S.g s.S.s ~s 41 | in 42 | y) 43 | -------------------------------------------------------------------------------- /tests/passing/js-let.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-list.ml: -------------------------------------------------------------------------------- 1 | (* mixed list styles *) 2 | let cases = 3 | [ Group ("publishing", [ 4 | basic_pre2 5 | ~name; 6 | ]); (* I think this line and the 2 preceding ones are indented one space too 7 | few by ocp-indent *) 8 | Group ("recovery", [ 9 | basic_pre2 10 | ~name 11 | ]); 12 | ] 13 | -------------------------------------------------------------------------------- /tests/passing/js-list.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-low-priority.ml: -------------------------------------------------------------------------------- 1 | (* Relatively low priority Jane Street indentation bugs. *) 2 | 3 | 4 | 5 | (* js-args *) 6 | 7 | (* uncommon *) 8 | let x = 9 | try x with a -> b 10 | | c -> d 11 | let x = 12 | try x 13 | with a -> b 14 | | c -> d 15 | 16 | 17 | 18 | (* js-comment *) 19 | 20 | let mk_cont_parser cont_parse = (); fun _state str ~max_pos ~pos -> 21 | let len = max_pos - pos + 1 in 22 | cont_parse ~pos ~len str 23 | 24 | (* sexp parser is sensitive to 25 | absent newlines at the end of files. *) 26 | 27 | 28 | 29 | (* It would be nice if a partially completed ocamldoc code fragment inside a 30 | comment had the closing delimiter "]}" indented nicely before the comment is 31 | closed. (This has to be the last comment in the file, to be partial.) *) 32 | (* Maybe add: 33 | {[ 34 | val state : t -> [ `Unstarted | `Running | `Stopped ] 35 | ]} 36 | -------------------------------------------------------------------------------- /tests/passing/js-low-priority.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-map.ml: -------------------------------------------------------------------------------- 1 | let projection_files = 2 | Deferred.List.map x ~f:(fun p -> 3 | _) 4 | >>| String.split ~on:'\n' 5 | -------------------------------------------------------------------------------- /tests/passing/js-map.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-model.ml: -------------------------------------------------------------------------------- 1 | val f 2 | : int 3 | -> int 4 | 5 | type t = 6 | | A 7 | | B 8 | 9 | let height = function 10 | | A -> 0 11 | | B -> 1 12 | 13 | let _ = 14 | if x then begin 15 | y 16 | end else if x then 17 | y 18 | else z 19 | 20 | type t 21 | = int 22 | -> int 23 | -------------------------------------------------------------------------------- /tests/passing/js-model.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-pipebang.ml: -------------------------------------------------------------------------------- 1 | let f x = 2 | x 3 | >>| fun x -> 4 | g x 5 | >>| fun x -> 6 | h x 7 | ;; 8 | 9 | let f x = 10 | x >>| fun x -> 11 | g x >>| fun x -> 12 | h x 13 | ;; 14 | 15 | let f x = 16 | x 17 | |! fun x -> 18 | g x 19 | |! fun x -> 20 | h x 21 | ;; 22 | 23 | let f x = 24 | x |! fun x -> 25 | g x |! fun x -> 26 | h x 27 | ;; 28 | 29 | let _ = 30 | (z (fun x -> x) 31 | |! Validate.of_list) (* Tuareg indents this line too far. *) 32 | 33 | let _ = 34 | (* Tuareg works correctly on this (if you drop the fun). *) 35 | (z x 36 | |! Validate.of_list) 37 | 38 | (* jli found this great one. Tuareg gets confused by the paren before List.map and 39 | indents |! way too far, under "k ^". ocp-indent should shine, since it understands the 40 | syntax better. *) 41 | let _ = 42 | List.filter_opt [ 43 | format old (fun old -> "removed: " 44 | ^ (List.map old ~f:(fun (k, v) -> k ^ "=" ^ acl_to_string v) 45 | |! String.concat ~sep:", ")) 46 | ] 47 | 48 | 49 | 50 | (* (|>) = (|!) *) 51 | 52 | let f x = 53 | x 54 | |> fun x -> 55 | g x 56 | |> fun x -> 57 | h x 58 | ;; 59 | 60 | let f x = 61 | x |> fun x -> 62 | g x |> fun x -> 63 | h x 64 | ;; 65 | 66 | let _ = 67 | (z (fun x -> x) 68 | |> Validate.of_list) (* Tuareg indents this line too far. *) 69 | 70 | let _ = 71 | (* Tuareg works correctly on this (if you drop the fun). *) 72 | (z x 73 | |> Validate.of_list) 74 | 75 | (* jli found this great one. Tuareg gets confused by the paren before List.map and 76 | indents |> way too far, under "k ^". ocp-indent should shine, since it understands the 77 | syntax better. *) 78 | let _ = 79 | List.filter_opt [ 80 | format old (fun old -> "removed: " 81 | ^ (List.map old ~f:(fun (k, v) -> k ^ "=" ^ acl_to_string v) 82 | |> String.concat ~sep:", ")) 83 | ] 84 | -------------------------------------------------------------------------------- /tests/passing/js-pipebang.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-poly.ml: -------------------------------------------------------------------------------- 1 | let handle_query qs ~msg_client:_ = 2 | try_with (fun () -> 3 | if _ then 4 | f >>| fun () -> 5 | `Done () 6 | else 7 | _ 8 | ) 9 | ;; 10 | 11 | if _ then 12 | _ 13 | else 14 | assert_branch_has_node branch node >>| fun () -> 15 | { t with node; floating } 16 | ;; 17 | -------------------------------------------------------------------------------- /tests/passing/js-poly.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-ppx-struct.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open Ppxlib 3 | open Ast_builder.Default 4 | 5 | let loc = location ~start:[%here] ~end_:[%here] ~ghost:true 6 | 7 | (* These three are okay: *) 8 | 9 | include struct 10 | let _ = [%expr `x] 11 | let _ = () 12 | end 13 | 14 | include struct 15 | let _ = [%type: [`x]] 16 | let _ = () 17 | end 18 | 19 | include struct 20 | let _ = [%pat? `x] 21 | let _ = () 22 | end 23 | 24 | (* These four cause the following line to jump back all the way to the left: *) 25 | 26 | include struct 27 | let _ = [%stri let () = ();;] 28 | let _ = () 29 | end 30 | 31 | include struct 32 | let _ = [%str let () = ();;] 33 | let _ = () 34 | end 35 | 36 | include struct 37 | let _ = [%sigi: val x : int] 38 | let _ = () 39 | end 40 | 41 | include struct 42 | let _ = [%sig: val x : int] 43 | let _ = () 44 | end 45 | -------------------------------------------------------------------------------- /tests/passing/js-sexp.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | f 3 | x 4 | [%sexp_of int] 5 | y 6 | ;; 7 | 8 | (* y *) 9 | let z = 10 | some_function 11 | [%sexp_of foo] 12 | ;; 13 | 14 | let z = 15 | some_function 16 | argument 17 | 18 | let d = 19 | print_sexp 20 | [%sexp_of unit] 21 | () 22 | -------------------------------------------------------------------------------- /tests/passing/js-sexp.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-str.ml: -------------------------------------------------------------------------------- 1 | (* gigantic string with weird characters that causes trouble *) 2 | TEST_UNIT = 3 | eprintf "%s\n" 4 | (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'") 5 | 6 | let _ = 7 | x 8 | -------------------------------------------------------------------------------- /tests/passing/js-str.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-str.ml.ref: -------------------------------------------------------------------------------- 1 | (* gigantic string with weird characters that causes trouble *) 2 | TEST_UNIT = 3 | eprintf "%s\n" 4 | (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'") 5 | 6 | let _ = 7 | x 8 | -------------------------------------------------------------------------------- /tests/passing/js-test.ml: -------------------------------------------------------------------------------- 1 | let%test = 2 | let b = true in 3 | b 4 | (* Above, a multi-line TEST (likewise BENCH) was indented wrong only when it 5 | started on the first line. (That wasn't really a big problem.) *) 6 | 7 | (* oUnit *) 8 | 9 | module E = Example 10 | 11 | let%test_module = 12 | (module struct 13 | let%test = false 14 | let%test = 15 | let b = true in 16 | b 17 | let%test "Name_test" = 18 | let b = true in (* tricky for Tuareg *) 19 | b 20 | end) 21 | 22 | let%test_module "Name" = 23 | (module struct 24 | let%test_unit = () 25 | let%test_unit = 26 | let () = () in 27 | () 28 | let%test_unit "Name_unit" = 29 | let () = () in (* tricky for Tuareg *) 30 | () 31 | 32 | let%test_unit = 33 | let msgcount = 10_000 in (* tricky for Tuareg *) 34 | () 35 | end) 36 | 37 | let _ = printf "Hello, world!\n" 38 | -------------------------------------------------------------------------------- /tests/passing/js-test.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-try.ml: -------------------------------------------------------------------------------- 1 | (* nested "try" *) 2 | try 3 | try x 4 | with e -> e 5 | with e -> e (* indented too far *) 6 | -------------------------------------------------------------------------------- /tests/passing/js-try.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-type.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | S.s (* looks like a constructor to ocp-indent, which indents too far *) 3 | type t = 4 | s (* correct, because this doesn't look like a constructor to ocp-indent *) 5 | type t = 6 | S (* correctly indented a little more, because... *) 7 | type t = 8 | | S (* we leave room for the vertical bar *) 9 | 10 | 11 | 12 | (* analogous value expressions, analogous to lists, some different from now *) 13 | let _ = 14 | [ x 15 | ; y 16 | ] 17 | let _ = 18 | [ x; 19 | y 20 | ] 21 | let _ = 22 | ( x 23 | , y 24 | ) 25 | let _ = 26 | ( x, 27 | y 28 | ) 29 | let _ = 30 | ( 31 | x 32 | , y 33 | ) 34 | let _ = 35 | [ 36 | x 37 | ; y 38 | ] 39 | let _ = ( 40 | x, 41 | y 42 | ) 43 | let _ = [ 44 | x; 45 | y 46 | ] 47 | let _ = ( 48 | x 49 | , y 50 | ) 51 | let _ = [ 52 | x 53 | ; y 54 | ] 55 | -------------------------------------------------------------------------------- /tests/passing/js-type.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/js-var.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | A 3 | | B of int 4 | | C 5 | -------------------------------------------------------------------------------- /tests/passing/js-var.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/let-and.ml: -------------------------------------------------------------------------------- 1 | let f 2 | = fun x -> x 3 | and g 4 | = fun x -> x 5 | and h 6 | = fun x -> x 7 | 8 | let rec f : 'a. 'a -> 'a 9 | = fun x -> g x 10 | and g : 'a. 'a -> 'a 11 | = fun x -> h x 12 | and h : 'a. 'a -> 'a 13 | = fun x -> f x 14 | -------------------------------------------------------------------------------- /tests/passing/let-open.ml: -------------------------------------------------------------------------------- 1 | 2 | let _ = 3 | (* ... *) 4 | let open Option in 5 | indented_line 6 | -------------------------------------------------------------------------------- /tests/passing/lwt.ml: -------------------------------------------------------------------------------- 1 | let f () = 2 | lwt x = g () in 3 | Lwt.return x 4 | 5 | let f x = match_lwt x with 6 | | A -> A 7 | | B -> B 8 | 9 | let g x = try_lwt 10 | f x 11 | finally 12 | g x 13 | 14 | let a f x = 15 | try_lwt f x 16 | with Failure _ -> () 17 | finally () 18 | 19 | (* should'nt break normal try/with imbrication *) 20 | let z f x = 21 | try 22 | try f x 23 | with Exit -> () 24 | with _ -> () 25 | -------------------------------------------------------------------------------- /tests/passing/lwt.ml.opts: -------------------------------------------------------------------------------- 1 | --syntax lwt 2 | -------------------------------------------------------------------------------- /tests/passing/macro.ml: -------------------------------------------------------------------------------- 1 | open Foo 2 | 3 | INCLUDE "bar" 4 | 5 | IFDEF "foo" 6 | let f x = 3 7 | ENDIF 8 | 9 | TEST foo 10 | TEST bar 11 | -------------------------------------------------------------------------------- /tests/passing/match_fun.ml: -------------------------------------------------------------------------------- 1 | let reset_cond = 2 | match states with 3 | | [ _ ] -> fun _ v _ -> e_id v 4 | | _ -> fun s v clk -> (* … *) 5 | -------------------------------------------------------------------------------- /tests/passing/misc-2018.ml: -------------------------------------------------------------------------------- 1 | (* #183 *) 2 | 3 | type 'a repr = 4 | | Bytes of ('a -> string) 5 | | Int of ('a -> int) 6 | | Int32 of ('a -> int32) 7 | | Int64 of ('a -> int64) 8 | | Float of ('a -> float) 9 | 10 | let bytes_of_repr = function 11 | | Bytes b -> fun v -> b v 12 | | Int i -> fun v -> R_byte_sort.of_int (i v) 13 | | Int32 i -> fun v -> R_byte_sort.of_int32 (i v) 14 | | Int64 i -> fun v -> R_byte_sort.of_int64 (i v) 15 | | Float f -> fun v -> R_byte_sort.of_float (f v) 16 | 17 | (* #265 *) 18 | 19 | let _ = ( a 20 | ; 21 | b 22 | ) 23 | 24 | let _ = { 25 | a 26 | ; 27 | b 28 | } 29 | 30 | let f x = 31 | ( foo 32 | ; 33 | bar ) 34 | 35 | let _ = ( a 36 | ; (* foo *) 37 | b 38 | ) 39 | 40 | let _ = { 41 | a 42 | ; (* foo *) 43 | b 44 | } 45 | 46 | let f x = 47 | ( foo 48 | ; (* foo *) 49 | bar ) 50 | 51 | (* #224 *) 52 | let () = 53 | begin [@attribute] 54 | print_endline "hello"; 55 | print_endline "world"; 56 | end 57 | 58 | (* #188 *) 59 | let f : t1 -> t2 -> t3 = 60 | fun x y z -> 61 | x + y + z 62 | 63 | (* #257 *) 64 | module M = struct 65 | type a = A of b [@@deriving compare] 66 | and b = B of a 67 | end 68 | 69 | (* #275 *) 70 | let g x = 71 | (x * x 72 | [@ocaml.ppwarning "TODO: blabla"]) 73 | 74 | let h = "I am well indented" 75 | 76 | let i x = 77 | x * x 78 | [@ocaml.ppwarning "TODO: blabla"] 79 | 80 | let j = "I am NOT well indented" 81 | 82 | (* #277 *) 83 | module V = struct 84 | type t = 85 | | A of A.t [@blah "a"] 86 | | B of B.t [@blah "b"] 87 | | C of C.t [@blah "c"] 88 | end 89 | 90 | let foo = 91 | let f x = 92 | foo bar [@@bla] in 93 | zz 94 | -------------------------------------------------------------------------------- /tests/passing/misc-2018.ml.opts: -------------------------------------------------------------------------------- 1 | -c strict_with=always,with=0 2 | -------------------------------------------------------------------------------- /tests/passing/misc-2019.ml: -------------------------------------------------------------------------------- 1 | module Unsafe_blit = struct 2 | external unsafe_blit 3 | : src:t_ 4 | -> src_pos:int 5 | -> dst:t_ 6 | -> dst_pos:int 7 | -> len:int 8 | -> unit 9 | = "core_array_unsafe_int_blit" 10 | [@@noalloc] 11 | end 12 | 13 | (** @open *) 14 | include 15 | module type of struct 16 | include Base.Array 17 | end 18 | with type 'a t := 'a t 19 | 20 | (** Return the class of the given floating-point number: 21 | normal, subnormal, zero, infinite, or not a number. *) 22 | external classify_float 23 | : (float[@unboxed]) 24 | -> fpclass 25 | = "caml_classify_float" "caml_classify_float_unboxed" 26 | [@@noalloc] [@@deprecated "[since 2014-10] Use [Float.classify]"] 27 | 28 | (** {6 String operations} 29 | 30 | More string operations are provided in module {!String}. 31 | *) 32 | 33 | (** String concatenation. *) 34 | val ( ^ ) : string -> string -> string 35 | 36 | module V1 = struct 37 | type t = Xxxxxxxxxxxxxxxx.t = 38 | { xxxxxxxxxxxxxxxxxxxx : Xxxxxxxxxxxxxx.t 39 | [@default Xxxxxxxxxxxxxx.empty] 40 | [@sexp_drop_if Xxxxxxxxxxxxxx.is_empty] 41 | } 42 | [@@deriving bin_io, sexp] 43 | end 44 | 45 | module M = struct 46 | 47 | include Validate (struct type nonrec t = t [@@deriving_inline compare, sexp_of] 48 | let compare : t -> t -> int = compare 49 | let sexp_of_t : t -> Ppx_sexp_conv_lib.Sexp.t = sexp_of_t 50 | [@@@end] end) 51 | end 52 | 53 | type t = | 54 | let x = () 55 | 56 | (* nested [open struct] (#300) *) 57 | include struct 58 | open struct 59 | include String 60 | end 61 | let get = get 62 | end 63 | 64 | (* cinaps comments (#299) *) 65 | let _ = 66 | (*$ 67 | let f = function 68 | | Some x -> x 69 | | None -> 0 70 | in 71 | print_endline 72 | ";;" 73 | *) 74 | () 75 | 76 | (* and+ mis-indented (#292) *) 77 | let (and+) x y = 78 | match x,y with 79 | | Some x, Some y -> Some (x, y) 80 | | _ -> None 81 | 82 | module Infix : sig 83 | val (and+) : ('a, 'error) result -> ('b, 'error) result -> ('a * 'b, 'error) result 84 | val (let+) : ('a, 'error) result -> ('a -> 'b) -> ('b, 'error) result 85 | end 86 | -------------------------------------------------------------------------------- /tests/passing/misc-2019.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/module.ml: -------------------------------------------------------------------------------- 1 | module M (S : S) = 2 | F.Make(struct 3 | module G = struct 4 | type t 5 | include Foo with type t := t 6 | include Bar with type t := t 7 | end 8 | end) 9 | 10 | module M = 11 | struct 12 | type t 13 | end 14 | 15 | module Update : sig 16 | val f : ('a, 'b) t -> 'a -> unit 17 | val g : ('a, 'b) t -> 'a -> unit 18 | module M : C with type k = t 19 | module G : C with type k := f 20 | type t 21 | end = struct 22 | type t = int 23 | end 24 | 25 | module M : S 26 | with type t = x 27 | and type t' = y 28 | and type t' = y 29 | = 30 | struct 31 | type t = int 32 | end 33 | 34 | module M : S with type t = x 35 | and type t' = y 36 | and type t' = y 37 | = struct 38 | type t = int 39 | end 40 | 41 | module Make: functor (M : T) -> sig 42 | val f : int -> int 43 | val g : int -> int 44 | end 45 | 46 | let _ = (module struct 47 | end) 48 | 49 | let _ = 50 | let _ = (module struct 51 | foo 52 | end) 53 | 54 | include (Bad : (module type of M 55 | with module N = O)) 56 | 57 | val debatable : (module Module.Sub 58 | with type t1 = t1' 59 | and type t2 = t2') 60 | 61 | module Store (K: API.KEY) (V: API.VALUE) : 62 | API.STORE with module K = K 63 | and module V = V = 64 | struct 65 | 66 | module K = K 67 | -------------------------------------------------------------------------------- /tests/passing/multiline.ml: -------------------------------------------------------------------------------- 1 | let _ = 2 | (* multiline-comments 3 | can be troublesome: 4 | let x = 5 | let y = 6 | f z 7 | in y 8 | indented code should be kept as is *) 9 | () 10 | 11 | let _ = (* what about multi-line 12 | comments that don't start a line ? 13 | *) 14 | w 15 | 16 | let s1 = "a b c d 17 | e f g h 18 | i j k" 19 | 20 | let s2 = "a b c d \ 21 | e f g h \ 22 | i j k\ 23 | \ l" 24 | 25 | let s3 = "a b c d \ 26 | e f g h 27 | i j k \ 28 | l m" 29 | -------------------------------------------------------------------------------- /tests/passing/nested_variants.ml: -------------------------------------------------------------------------------- 1 | type tt = 2 | | A of 3 | int 4 | | B of 5 | string 6 | | C of 7 | float 8 | | D of 9 | char 10 | 11 | type tt = [ 12 | | `a of int 13 | | `blskdjf of 14 | float 15 | | `problem_cause of [ `more_brackets ] 16 | | `problematic_case of 17 | string 18 | ] 19 | -------------------------------------------------------------------------------- /tests/passing/nesting.ml: -------------------------------------------------------------------------------- 1 | module M = struct 2 | let a = (((((( 3 | ) 4 | ) 5 | ) 6 | ) 7 | ) 8 | ) 9 | 10 | let a = (ff(ff(ff(ff(ff(ff( 11 | ) 12 | ) 13 | ) 14 | ) 15 | ) 16 | ) 17 | ) 18 | 19 | let a = [[[[[[ 20 | ] 21 | ] 22 | ] 23 | ] 24 | ] 25 | ] 26 | 27 | let a = [ff[ff[ff[ff[ff[ff[ 28 | ] 29 | ] 30 | ] 31 | ] 32 | ] 33 | ] 34 | ] 35 | -------------------------------------------------------------------------------- /tests/passing/never_align.ml: -------------------------------------------------------------------------------- 1 | let _ = ( 2 | a 3 | b 4 | c 5 | ) 6 | 7 | let _ = (a 8 | b 9 | c) 10 | 11 | let _ = { 12 | a 13 | b 14 | b 15 | } 16 | 17 | let _ = { a 18 | b 19 | c 20 | } 21 | -------------------------------------------------------------------------------- /tests/passing/never_align.ml.opts: -------------------------------------------------------------------------------- 1 | -c align_params=never 2 | -------------------------------------------------------------------------------- /tests/passing/object.ml: -------------------------------------------------------------------------------- 1 | let x = 2 | object 3 | inherit foo 4 | method bar = _ 5 | end 6 | 7 | class foo = 8 | object 9 | method x = 2 10 | inherit bar 11 | end 12 | 13 | class foo = 14 | object(this) 15 | inherit bar 16 | end 17 | 18 | class virtual map = object 19 | method visit_expr_node : 20 | 'env 'info_0 'info_1 . 21 | ('env -> 'info_0 -> 'info_1) -> 22 | 'env -> 'info_0 expr_node -> 'info_1 expr_node = 23 | assert false 24 | end 25 | -------------------------------------------------------------------------------- /tests/passing/obuild.ml: -------------------------------------------------------------------------------- 1 | type predicate = 2 | Pred_Byte 3 | | Pred_Native 4 | | Pred_Toploop 5 | 6 | let _ = 7 | { pkg with 8 | package_version = projFile.version 9 | ; package_description = _ 10 | ; package_requires = [] } 11 | -------------------------------------------------------------------------------- /tests/passing/obuild.ml.opts: -------------------------------------------------------------------------------- 1 | -c base=2,type=2,match_clause=4,with=2 2 | -------------------------------------------------------------------------------- /tests/passing/ocamldoc.ml: -------------------------------------------------------------------------------- 1 | (** From http://caml.inria.fr/pub/docs/manual-ocaml-4.00/manual029.html#htoc172 2 | The first special comment of the file is the comment associated 3 | with the whole module.*) 4 | 5 | 6 | (** Special comments can be placed between elements and are kept 7 | by the OCamldoc tool, but are not associated to any element. 8 | @-tags in these comments are ignored.*) 9 | 10 | (*******************************************************************) 11 | (** Comments like the one above, with more than two asterisks, 12 | are ignored. *) 13 | 14 | (** The comment for function f. *) 15 | val f : int -> int -> int 16 | (** The continuation of the comment for function f. *) 17 | 18 | (** Comment for exception My_exception, even with a simple comment 19 | between the special comment and the exception.*) 20 | (* Hello, I'm a simple comment :-) *) 21 | exception My_exception of (int -> int) * int 22 | 23 | (** Comment for type weather *) 24 | type weather = 25 | | Rain of int (** The comment for construtor Rain *) 26 | | Sun (** The comment for constructor Sun *) 27 | 28 | (** Comment for type weather2 *) 29 | type weather2 = 30 | | Rain of int (** The comment for construtor Rain *) 31 | | Sun (** The comment for constructor Sun *) 32 | (** I can continue the comment for type weather2 here 33 | because there is already a comment associated to the last constructor.*) 34 | 35 | (** The comment for type my_record *) 36 | type my_record = 37 | { 38 | foo : int ; (** Comment for field foo *) 39 | bar : string ; (** Comment for field bar *) 40 | } 41 | (** Continuation of comment for type my_record *) 42 | 43 | (** Comment for foo *) 44 | val foo : string 45 | (** This comment is associated to foo and not to bar. *) 46 | val bar : string 47 | (** This comment is assciated to bar. *) 48 | 49 | (** The comment for class my_class *) 50 | class my_class : 51 | object 52 | (** A comment to describe inheritance from cl *) 53 | inherit cl 54 | 55 | (** The comment for attribute tutu *) 56 | val mutable tutu : string 57 | 58 | (** The comment for attribute toto. *) 59 | val toto : int 60 | 61 | (** This comment is not attached to titi since 62 | there is a blank line before titi, but is kept 63 | as a comment in the class. *) 64 | 65 | val titi : string 66 | 67 | (** Comment for method toto *) 68 | method toto : string 69 | 70 | (** Comment for method m *) 71 | method m : float -> int 72 | end 73 | 74 | (** The comment for the class type my_class_type *) 75 | class type my_class_type = 76 | object 77 | (** The comment for variable x. *) 78 | val mutable x : int 79 | 80 | (** The commend for method m. *) 81 | method m : int -> int 82 | end 83 | 84 | (** The comment for module Foo *) 85 | module Foo = 86 | struct 87 | (** The comment for x *) 88 | val x : int 89 | 90 | (** A special comment that is kept but not associated to any element *) 91 | end 92 | 93 | (** The comment for module type my_module_type. *) 94 | module type my_module_type = 95 | sig 96 | (** The comment for value x. *) 97 | val x : int 98 | 99 | (** The comment for module M. *) 100 | module M = 101 | struct 102 | (** The comment for value y. *) 103 | val y : int 104 | 105 | (* ... *) 106 | end 107 | 108 | end 109 | 110 | (** The comment for class my_class *) 111 | class my_class = 112 | object 113 | (** A comment to describe inheritance from cl *) 114 | inherit cl 115 | 116 | (** The comment for the instance variable tutu *) 117 | val mutable tutu = "tutu" 118 | (** The comment for toto *) 119 | val toto = 1 120 | val titi = "titi" 121 | (** Comment for method toto *) 122 | method toto = tutu ^ "!" 123 | (** Comment for method m *) 124 | method m (f : float) = 1 125 | end 126 | 127 | (** The comment for class type my_class_type *) 128 | class type my_class_type = 129 | object 130 | (** The comment for the instance variable x. *) 131 | val mutable x : int 132 | (** The commend for method m. *) 133 | method m : int -> int 134 | end 135 | 136 | (** The comment for module Foo *) 137 | module Foo = 138 | struct 139 | (** The comment for x *) 140 | val x : int 141 | (** A special comment in the class, but not associated to any element. *) 142 | end 143 | 144 | (** The comment for module type my_module_type. *) 145 | module type my_module_type = 146 | sig 147 | (* Comment for value x. *) 148 | val x : int 149 | (* ... *) 150 | end 151 | 152 | (** Starting bla doc *) 153 | type bla = 154 | | Hup (** The hup case *) 155 | | Hap (** The hap case *) 156 | (** Ending bla doc *) 157 | 158 | (** Starting bla doc *) 159 | type bla = 160 | | Hup 161 | (** The hup case *) 162 | | Hap 163 | (** The hap case *) 164 | (** Ending bla doc *) 165 | 166 | type hop 167 | (** Hop's documentation *) 168 | 169 | type mip = 170 | { fup : int; (** fup field *) 171 | fip : int; (** fip field *) } 172 | (** Mip's documentation *) 173 | 174 | type t = Hey | Ho 175 | (** Let's go. *) 176 | 177 | type tp = [ `Hey | `Ho ] 178 | (** Tp doc. 179 | Second line. *) 180 | 181 | (** Starting function f doc *) 182 | val f : 'a -> 'b 183 | (** Ending function f doc. *) 184 | 185 | val g : 'a -> t 186 | (** Function g doc. 187 | Second line. *) 188 | 189 | val g : 'a -> [`Hey | `Ho ] 190 | (** Let's go 191 | Second line. *) 192 | 193 | val x : unit -> unit 194 | (** Here are a couple examples of some of its many uses 195 | 196 | {v step (fun m v -> m ~foo:v) 197 | +> flag "-foo" no_arg : (foo:bool -> 'm, 'm) t 198 | v} 199 | *) 200 | -------------------------------------------------------------------------------- /tests/passing/ocamldoc2.ml: -------------------------------------------------------------------------------- 1 | a 2 | (* {[ (* {v *) ]} {v v} *) 3 | b 4 | 5 | let _ = 6 | (* 7 | {[ 8 | while true do 9 | xx 10 | done 11 | (* this is totally crazy !!! *) 12 | ]} 13 | *) 14 | () 15 | -------------------------------------------------------------------------------- /tests/passing/partial-match.ml: -------------------------------------------------------------------------------- 1 | let () = match x with 2 | | `A -> "A" 3 | | `B -> "B" 4 | -------------------------------------------------------------------------------- /tests/passing/partial-match.ml.opts: -------------------------------------------------------------------------------- 1 | --lines 3- 2 | -------------------------------------------------------------------------------- /tests/passing/partial.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | ffff; 3 | hhhhhh; 4 | fff; 5 | let (quot, _rem) = 6 | let quot_rem n k = 7 | let (d, m) = (n / k, n mod k) in 8 | if d < 0 && m > 0 then (d+1, m-k) 9 | else (d, m) 10 | in 11 | let quot n k = fst (quot_rem n k) in 12 | let rem n k = snd (quot_rem n k) in 13 | 14 | quot, rem 15 | -------------------------------------------------------------------------------- /tests/passing/partial.ml.opts: -------------------------------------------------------------------------------- 1 | --lines 5-8 2 | -------------------------------------------------------------------------------- /tests/passing/partial2.ml: -------------------------------------------------------------------------------- 1 | if () then () else 2 | match () with 3 | | () -> 4 | -------------------------------------------------------------------------------- /tests/passing/partial2.ml.opts: -------------------------------------------------------------------------------- 1 | --lines 3 -c strict_else=auto 2 | -------------------------------------------------------------------------------- /tests/passing/pattern.ml: -------------------------------------------------------------------------------- 1 | let f = match x with 2 | | { x = 3 } -> 3 | let x = 4 in 4 | () 5 | 6 | let f = match x with 7 | | (X|Y) | (Z|U) -> 1 8 | | K -> 2 9 | 10 | let f = match x with 11 | | X when foo = bar -> 12 | fff 13 | | Y when f = x 14 | && g = 3 -> 15 | z 16 | 17 | let f () = 18 | match s with 19 | (* Parenthesized ident ? *) 20 | | x -> x, d 21 | (* Regular ident *) 22 | | _ -> g 23 | ;; 24 | 25 | match x with 26 | | X | Y -> 1 27 | | X -> 28 | 2; 29 | 3 30 | | A -> 2 31 | ;; 32 | 33 | let f g = 34 | (* haha *) 35 | match z with 36 | | Z | B _ -> x 37 | | A (a, _, _, b) as x -> 38 | let x = f a and hr = f b in 39 | f 40 | 41 | let unwind_to = 42 | match t with KType | KModule -> true | Kblob -> false 43 | | _ -> true 44 | 45 | let f x = match x with 46 | | A | B 47 | | C -> 48 | x 49 | | z -> match z with 50 | | _ -> function 51 | | x -> 52 | x 53 | 54 | let fun_dep ulam = function 55 | | A 56 | | B 57 | | C -> 58 | () 59 | 60 | let fun_dep ulam = function 61 | |A 62 | |B|C 63 | |D -> 64 | () 65 | 66 | let _ = 67 | (match bla 68 | with bli) 69 | -------------------------------------------------------------------------------- /tests/passing/ppx-string.ml: -------------------------------------------------------------------------------- 1 | let s = {| 2 | |} 3 | 4 | let s = {xx| 5 | xx|} 6 | 7 | let s = 8 | {xx| 9 | |} 10 | |xx} 11 | 12 | let s = {| foo 13 | bar 14 | |} 15 | 16 | let s = {| foo 17 | bar 18 | |} 19 | 20 | let s = {| foo 21 | bar 22 | |} 23 | 24 | let s = 25 | {| 26 | |} 27 | 28 | let s = 29 | {| 30 | |} 31 | 32 | let s = 33 | {| foo 34 | |} 35 | 36 | let s = 37 | {xx| foo 38 | bar 39 | |yy} 40 | baz 41 | |xx} 42 | 43 | let s = 44 | {| 45 | foo bar 46 | baz 47 | |} 48 | -------------------------------------------------------------------------------- /tests/passing/ppx_expr_ext.ml: -------------------------------------------------------------------------------- 1 | let x = 2 | [%x f 3 ] 3 | 4 | let x = 5 | [%x (f 6 | 3 7 | 5) ] 8 | 9 | let x = 10 | [%x f 11 | 3 12 | 5 ] 13 | 14 | let x = 15 | [%xy f 16 | 3 17 | 5 ] 18 | 19 | let x = 20 | [%x fg 21 | 3 22 | 5 ] 23 | 24 | let x = 25 | [%x f 26 | 3 27 | 5 ] 28 | 29 | let x = 30 | [%x 31 | f 32 | 3 33 | 5 34 | ] 35 | 36 | let x = 37 | 3 + 38 | [%f f ] 39 | 40 | let x = 41 | [%f f ] * [%f f ] 42 | + 43 | [%f f ] 44 | 45 | let x = 46 | [%f f 47 | 4 48 | 2 ] 49 | * 50 | [%f f 51 | 3 52 | 4 ] 53 | 54 | let x = 55 | [%f f 56 | 2 57 | 3 ] * [%f f 58 | 3 59 | 4 ] + 60 | [%f f 61 | 2 62 | 3 ] 63 | 64 | let x = 65 | [%f f 66 | 2 67 | 3 ] * [%f f 68 | 3 69 | 4 ] 70 | + [%f f 71 | 2 72 | 3 ] 73 | 74 | let x = 75 | [%f f 76 | 2 77 | 3 ] + [%f f 78 | 3 79 | 4 ] * 80 | [%f f 81 | 2 82 | 3 ] 83 | 84 | let x = 85 | [%f f 86 | 2 87 | 3 ] + [%f f 88 | 3 89 | 4 ] 90 | * [%f f 91 | 2 92 | 3 ] 93 | 94 | let x = 95 | [%f f 96 | 2 97 | 3 ] + [%f f 98 | 3 99 | 4 ] 100 | + [%f f 101 | 2 102 | 3 ] 103 | 104 | 105 | let x = 106 | [% 107 | f f 108 | 4 109 | 2 ] 110 | * 111 | [% 112 | f 113 | f 114 | 3 115 | 4 ] 116 | 117 | let x = 118 | [% 119 | f 120 | .u f 121 | 4 122 | 2 ] 123 | * 124 | [% 125 | f 126 | .u 127 | f 128 | 3 129 | 4 ] 130 | 131 | let invariant invariant_a t = 132 | Invariant.invariant [%here] t [%sexp_of: _ t] (fun () -> 133 | let check f = Invariant.check_field t f in 134 | Fields.iter 135 | ~has_any_waiters:(check (fun has_any_waiters -> 136 | if Ivar.has_handlers t.ivar 137 | then (assert has_any_waiters))) 138 | ~ivar:(check (fun ivar -> 139 | Ivar.invariant invariant_a ivar; 140 | assert (Ivar.is_empty ivar)))) 141 | ;; 142 | 143 | let core_type_of_decl ~options ~path type_decl = 144 | let typ = Ppx_deriving.core_type_of_type_decl type_decl in 145 | Ppx_deriving.poly_arrow_of_type_decl 146 | (fun var -> [%type: [%t var] -> [%t var] -> Ppx_deriving_runtime.bool]) 147 | type_decl 148 | [%type: [%t typ] -> [%t typ] -> Ppx_deriving_runtime.bool] 149 | 150 | module A = struct 151 | let x = 1 152 | 153 | let%bench_fun "now" [@indexed i = List.range 0 (List.length zones)] = 154 | let time = now () in 155 | fun () -> of_time time ~zone 156 | 157 | let x = 2 158 | end 159 | 160 | [%%sig: 161 | module type M = sig 162 | val x : int 163 | end 164 | 165 | module S : module type of 166 | struct 167 | let x = 12 168 | end 169 | ] 170 | -------------------------------------------------------------------------------- /tests/passing/ppx_expr_ext.ml.opts: -------------------------------------------------------------------------------- 1 | -c JaneStreet 2 | -------------------------------------------------------------------------------- /tests/passing/ppx_stritem_ext.ml: -------------------------------------------------------------------------------- 1 | let x = 3 2 | 3 | [%% a 4 | let x = [ 5 | 3; 6 | 2; 7 | ] 8 | ] 9 | 10 | module S = sig 11 | 12 | let x = 3 13 | 14 | [%% b 15 | let x = [ 16 | 3; 17 | 2; 18 | ] 19 | ] 20 | 21 | end 22 | 23 | [%% c 24 | let x = [ 25 | 3; 26 | 2; 27 | ] 28 | 29 | [%% d 30 | let x = [ 31 | 3; 32 | 2; 33 | ] 34 | ] 35 | 36 | ] 37 | 38 | [%% x 39 | 2 * 3 40 | + 41 | x 42 | ] 43 | 44 | [%% x 45 | 2 + 3 46 | * 47 | x 48 | ] 49 | 50 | [%% x 51 | 2 52 | ] 53 | 54 | [%% x 55 | . 56 | y 57 | 2 58 | ] 59 | 60 | 61 | [%% x 62 | .y 63 | 2 64 | ] 65 | 66 | [%% x . 67 | y 68 | 2 69 | ] 70 | 71 | [%% 72 | x 73 | 2 74 | ] 75 | 76 | module S = sig 77 | 78 | let x = 3 79 | 80 | [%% x 81 | .y 82 | 2 83 | ] 84 | 85 | [%% x 86 | .y 87 | 2 88 | ] 89 | 90 | [%% 91 | x 92 | .y 93 | 2 94 | ] 95 | 96 | end 97 | 98 | [%% client 99 | 100 | open M 101 | let x = 3 102 | module M = struct end 103 | 104 | ] 105 | 106 | [%% client 107 | 108 | let x = 3 109 | open M 110 | module M = struct end 111 | 112 | ] 113 | 114 | [%% client 115 | 116 | module M = struct end 117 | open M 118 | let x = 3 119 | ] 120 | 121 | module M = struct 122 | type a = A of b [@@deriving compare] 123 | and b = B of a 124 | end 125 | -------------------------------------------------------------------------------- /tests/passing/quotations2.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | let header current categories pages = 4 | let aux short = 5 | let long = match Category.find short with 6 | | None -> failwith ("cannot find category " ^ short) 7 | | Some c -> c in 8 | let url = 9 | try 10 | let first = List.find 11 | (fun p -> p.Page.category = Some short && p.Page.id = 1) 12 | pages in 13 | first.Page.permalink 14 | with Not_found -> 15 | (* we are processing a blog entry 16 | or an index page *) 17 | Config.url short / "index.html" in 18 | if short = current then 19 | <:xhtml<
  • $str:long$
    • &>> 20 | else 21 | <:xhtml<
  • $str:long$
    • &>> in 22 | <:xhtml< 23 |
    24 |
    25 |
    26 | 27 |
    28 |
    29 |
      $list:List.map aux categories$
    30 |
    31 |
    32 |
    33 | >> 34 | 35 | let footer current categories pages = 36 | let categories = 37 | List.map (fun short -> 38 | let long = match Category.find short with 39 | | None -> failwith ("cannot find category " ^ short) 40 | | Some c -> c in 41 | short, 42 | long, 43 | List.sort Page.compare (List.filter (fun p -> p.Page.category = Some short) pages) 44 | ) categories in 45 | let aux (short, long, pages) = 46 | let pages = List.map (fun p -> 47 | if p.Page.footer then 48 | <:xhtml< 49 |
  • $str:p.Page.title$
    • 50 | >> else 51 | Xhtml.empty 52 | ) pages in 53 | <:xhtml< 54 |
      55 |

    • $str:long$

      • 56 | $list:pages$ 57 |
    58 | >> in 59 | <:xhtml< 60 |
    61 |
    62 | $list:List.map aux categories$ 63 |
    64 |
    65 | >> 66 | -------------------------------------------------------------------------------- /tests/passing/record-with.ml: -------------------------------------------------------------------------------- 1 | let a = 2 | { 3 | somerecord 4 | with 5 | a = b; 6 | c = d; 7 | } 8 | 9 | let a = 10 | { 11 | somerecord 12 | with a = b; 13 | c = d; 14 | } 15 | 16 | let z = 17 | { recofzfzfzrd with a = bli; bzeefe = 18 | k 19 | ; efgeg = a 20 | } 21 | 22 | let b = 23 | let z = 24 | { reczfzrd with a = bli; 25 | bzeefe = _; 26 | } 27 | 28 | let b = 29 | let z = 30 | { reczfzrd with a = bli; 31 | bzeefe 32 | } 33 | 34 | let lexbuf = { lexbuf with Lexing.lex_start_p = start_pos; 35 | Lexing.lex_curr_p = start_pos; } 36 | 37 | let () = 38 | { Foo. 39 | foo 40 | ; bar = (fun () -> 41 | if a then b) 42 | } 43 | 44 | let () = 45 | { foo 46 | ; bar = (fun () -> 47 | if a then b) 48 | } 49 | -------------------------------------------------------------------------------- /tests/passing/record_comments.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | a : int ; 3 | (** blablabla *) 4 | b : int ; 5 | (** blublublu *) 6 | 7 | c : int ; 8 | (** ccc *) 9 | } 10 | 11 | let _ = 12 | [ A ; 13 | (* A *) 14 | B ; 15 | (* B *) 16 | ] 17 | 18 | type t = { 19 | x : t1; (* c1 *)(* c2 *) 20 | y : t2; 21 | } 22 | -------------------------------------------------------------------------------- /tests/passing/records.ml: -------------------------------------------------------------------------------- 1 | let read_raw_gen_ic read_pixel ic l c max = 2 | let img = Index8.create c l in 3 | let greymap = 4 | { Color.max = max; 5 | Color.map = 6 | let make_grey i = {r = i; g = i; b = i} in 7 | Array.init (max + 1) make_grey} in 8 | img.Index8.colormap <- greymap; 9 | for i = 0 to l - 1 do 10 | for j = 0 to c - 1 do 11 | Index8.set img j i (read_pixel ic) 12 | done 13 | done; 14 | img;; 15 | 16 | let func_darken_only org level = 17 | let level = 255 - level in 18 | { r = if org.r > level then level else org.r; 19 | g = if org.g > level then level else org.g; 20 | b = if org.b > level then level else org.b };; 21 | 22 | let f = function 23 | | { f1 = Foo 24 | | Bar; 25 | f2 = _; f3 = Foo 26 | | Bar } 27 | -> { f1 = Foo, 28 | Bar; 29 | f2 = xxx 30 | = yyy; f3 = Foo, 31 | Bar } 32 | 33 | let _ = 34 | match a with 35 | | { kind = 36 | x } -> () 37 | | { LibIndex.kind = 38 | x } -> () 39 | 40 | let x = { kind = 41 | x }, 42 | { LibIndex.kind = 43 | x } 44 | -------------------------------------------------------------------------------- /tests/passing/semi.ml: -------------------------------------------------------------------------------- 1 | let f () = 2 | print_endline "a" 3 | ; 4 | print_endline "b" 5 | 6 | let f () = toto 7 | ; blah 8 | 9 | let f () = 10 | { a = 3 11 | ; b = 4 12 | ; 13 | } 14 | 15 | module A = struct 16 | 17 | type x = 18 | { a: int 19 | ; b: int 20 | ; 21 | } 22 | 23 | end 24 | -------------------------------------------------------------------------------- /tests/passing/semisemi.ml: -------------------------------------------------------------------------------- 1 | module M = struct 2 | let () = () 3 | ;; 4 | let f x = 3;; 5 | let () = () 6 | end 7 | 8 | ;; 9 | 10 | let () = () 11 | -------------------------------------------------------------------------------- /tests/passing/sequence.ml: -------------------------------------------------------------------------------- 1 | let f = fun x -> 2 | x 3 | 4 | let f x = 5 | x 6 | 7 | let f g = fun x -> g 8 | x 9 | 10 | let f g x = g 11 | x 12 | 13 | let l1 = (a :: 14 | b :: 15 | []) 16 | 17 | let l1 = ( 18 | a :: 19 | b :: 20 | []) 21 | 22 | let l1 = 23 | a :: 24 | b :: 25 | [] 26 | 27 | let l1 = a :: 28 | b :: 29 | [] 30 | 31 | let l1 = [a; 32 | b; 33 | ] 34 | 35 | let l1 = [ 36 | a; 37 | b; 38 | ] 39 | 40 | let l1 = 41 | [ a; 42 | b; 43 | ] 44 | 45 | let l1 = 46 | [ a 47 | ; b 48 | ] 49 | 50 | let l1 = [ 51 | a 52 | ; b 53 | ] 54 | 55 | let l1 = 56 | [ a; 57 | b 58 | ; c 59 | ] 60 | 61 | let f1 = function 62 | | {k=A|B} -> true 63 | | {k=C} -> false 64 | 65 | let overflow_small = 66 | 4611686018427387904 (* max_int (63) + 1 *) 67 | let overflow_big = 68 | 46116860184273879030 69 | 70 | let ppx_sequence = 71 | ();%ext 72 | () 73 | -------------------------------------------------------------------------------- /tests/passing/str_else_always.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | if true then "bla" else 3 | if true then "bli" else 4 | "blo" 5 | 6 | let () = 7 | if true then "bla" else 8 | if true then "bli" else 9 | begin 10 | "hop" 11 | end 12 | 13 | let () = 14 | if true then "hop" else 15 | if true then "hap" else 16 | ((); "bla") 17 | 18 | let () = 19 | if 20 | x 21 | then 22 | y 23 | else k, 24 | w; 25 | z 26 | 27 | let () = 28 | if x then a 29 | else 30 | let y = x / 42 in 31 | y 32 | 33 | let () = 34 | if x then a 35 | else if y 36 | then b 37 | else begin 38 | blabla 39 | end; 40 | x 41 | 42 | let () = 43 | if x then 44 | a 45 | else match y with 46 | | A -> x 47 | | B -> y 48 | 49 | let () = 50 | if x then 51 | a 52 | else 53 | match y with 54 | | A -> x 55 | | B -> y 56 | 57 | let () = 58 | if x then a else 59 | fun x -> 60 | y 61 | -------------------------------------------------------------------------------- /tests/passing/str_else_always.ml.opts: -------------------------------------------------------------------------------- 1 | -c strict_else=always 2 | -------------------------------------------------------------------------------- /tests/passing/str_else_auto.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | if true then "bla" else 3 | if true then "bli" else 4 | "blo" 5 | 6 | let () = 7 | if true then "bla" else 8 | if true then "bli" else 9 | begin 10 | "hop" 11 | end 12 | 13 | let () = 14 | if true then "hop" else 15 | if true then "hap" else 16 | ((); "bla") 17 | 18 | let () = 19 | if 20 | x 21 | then 22 | y 23 | else k, 24 | w; 25 | z 26 | 27 | let () = 28 | if x then a 29 | else 30 | let y = x / 42 in 31 | y 32 | 33 | let () = 34 | if x then a 35 | else if y 36 | then b 37 | else begin 38 | blabla 39 | end; 40 | x 41 | 42 | let () = 43 | if x then 44 | a 45 | else match y with 46 | | A -> x 47 | | B -> y 48 | 49 | let () = 50 | if x then 51 | a 52 | else 53 | match y with 54 | | A -> x 55 | | B -> y 56 | 57 | let () = 58 | if x then a else 59 | fun x -> 60 | y 61 | -------------------------------------------------------------------------------- /tests/passing/str_else_auto.ml.opts: -------------------------------------------------------------------------------- 1 | -c strict_else=auto 2 | -------------------------------------------------------------------------------- /tests/passing/str_else_never.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | if true then "bla" else 3 | if true then "bli" else 4 | "blo" 5 | 6 | let () = 7 | if true then "bla" else 8 | if true then "bli" else 9 | begin 10 | "hop" 11 | end 12 | 13 | let () = 14 | if true then "hop" else 15 | if true then "hap" else 16 | ((); "bla") 17 | 18 | let () = 19 | if 20 | x 21 | then 22 | y 23 | else k, 24 | w; 25 | z 26 | 27 | let () = 28 | if x then a 29 | else 30 | let y = x / 42 in 31 | y 32 | 33 | let () = 34 | if x then a 35 | else if y 36 | then b 37 | else begin 38 | blabla 39 | end; 40 | x 41 | 42 | let () = 43 | if x then 44 | a 45 | else match y with 46 | | A -> x 47 | | B -> y 48 | 49 | let () = 50 | if x then 51 | a 52 | else 53 | match y with 54 | | A -> x 55 | | B -> y 56 | 57 | let () = 58 | if x then a else 59 | fun x -> 60 | y 61 | -------------------------------------------------------------------------------- /tests/passing/str_else_never.ml.opts: -------------------------------------------------------------------------------- 1 | -c strict_else=never 2 | -------------------------------------------------------------------------------- /tests/passing/traverse.mli.opts: -------------------------------------------------------------------------------- 1 | -c in=2,match_clause=4 2 | -------------------------------------------------------------------------------- /tests/passing/type-and.ml: -------------------------------------------------------------------------------- 1 | type a = 2 | | A 3 | and b = int 4 | 5 | module M = struct 6 | type s = t and t = { 7 | foo : s; 8 | } 9 | end 10 | -------------------------------------------------------------------------------- /tests/passing/types.ml: -------------------------------------------------------------------------------- 1 | type ('a, 'b) t 2 | = a : 'a 3 | -> ?b : b 4 | -> unit 5 | 6 | type ('a, 'b) t = 7 | | A 8 | | B of ('a, 'b) t * 'k 9 | | C of 'a * 'b 10 | 11 | type t = Foo 12 | | Bar 13 | | Baz 14 | 15 | type t = 16 | | Foo 17 | | Bar 18 | | Baz 19 | 20 | type t = 21 | Foo 22 | | Bar 23 | | Baz 24 | 25 | type t = | Foo 26 | | Bar 27 | | Baz 28 | 29 | type t = Foo | Bar 30 | | Baz 31 | 32 | type t = { 33 | foo: int -> int; 34 | bar: 'a; 35 | } 36 | 37 | type t = { 38 | x: int; 39 | } 40 | 41 | type t = { 42 | x: int; 43 | y: int -> a:string -> ?b:(int -> string) -> unit; 44 | mutable 45 | z: int; 46 | mutable a: 47 | string -> unit A.t; 48 | } 49 | 50 | type t = { 51 | x: int 52 | ; y: int -> a:string -> ?b:(int -> string) -> unit 53 | ; mutable 54 | z: int; 55 | a: string -> 56 | unit A.t; 57 | } 58 | 59 | type t = 60 | { 61 | x: int 62 | ; y: int -> a:string -> ?b:(int -> string) -> unit 63 | ; mutable 64 | z: int; 65 | a: string -> 66 | unit A.t; 67 | } 68 | 69 | type t = 70 | { x: int 71 | ; y: int -> a:string -> ?b:(int -> string) -> unit 72 | ; mutable 73 | z: int 74 | ; mutable a: string 75 | -> unit A.t 76 | } 77 | 78 | type t = { x: int 79 | ; y: int -> a:string -> ?b:(int -> string) -> unit 80 | ; mutable 81 | z: int 82 | ; mutable a: string -> unit A.t 83 | } 84 | 85 | type t = [ 86 | | `a | `b 87 | | `c 88 | ] 89 | 90 | type t = 91 | [ 92 | `a 93 | | `b 94 | | `c 95 | ] 96 | 97 | type t = 98 | [ 99 | | `a 100 | | `b 101 | | `c 102 | ] 103 | 104 | type t = 105 | [ `a 106 | | `b 107 | | `c 108 | ] 109 | 110 | type t = [ `a 111 | | `b 112 | | `c 113 | ] 114 | 115 | type t = [ `a | `b 116 | | `c 117 | ] 118 | 119 | module M = struct 120 | type t = t0 121 | and t' 122 | and t'' = t 123 | val v: t 124 | end 125 | 126 | module Regression = struct 127 | let f : 'a. 128 | 'a t * some_other_type 129 | -> result_type 130 | = body 131 | end 132 | -------------------------------------------------------------------------------- /tests/passing/unit-classes.ml: -------------------------------------------------------------------------------- 1 | (** ocaml classes 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/manual017.html) 3 | *) 4 | 5 | (* class types *) 6 | 7 | class type c = 8 | object 9 | end 10 | 11 | class type c = 12 | M.cl 13 | 14 | class type c = 15 | ['a, 'b] M.cl 16 | 17 | class type c = 18 | object 19 | ('ty) 20 | inherit cl 21 | val mutable virtual 22 | var : bool 23 | method private bar1 x ~y : bool 24 | method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t 25 | constraint 26 | 'a = 'b 27 | end 28 | 29 | (* class expressions *) 30 | 31 | class c = 32 | ['a, 'b] 33 | M.cl 34 | 35 | class c = 36 | fun a b -> 37 | object 38 | end 39 | 40 | class c = object 41 | val x = true 42 | end 43 | 44 | class c = 45 | object 46 | (_ : 47 | 'a) 48 | inherit Something.someclass 49 | as v 50 | val mutable 51 | var : bool 52 | = true 53 | val mutable virtual var2 54 | : string 55 | method private bar1 x ~y : bool = 56 | false 57 | method private virtual bar2 : 'a 'b.('a,'b) Hashtbl.t 58 | constraint 59 | 'a = 'b 60 | initializer 61 | z 62 | end 63 | 64 | (* method specific expressions *) 65 | 66 | let e = 67 | var <- true 68 | 69 | let e = 70 | {< var = false; 71 | var2 = true; 72 | >} 73 | 74 | 75 | (* class definitions *) 76 | 77 | class cl = 78 | object 79 | val x = true 80 | end 81 | and 82 | virtual ['a, 'b] 83 | cl2 x y : 84 | object 85 | val x : bool 86 | end = fun x y -> 87 | object 88 | val x : bool = true 89 | end 90 | 91 | class cl 92 | : object end 93 | 94 | class type virtual ['a] clty = object 95 | method x : int 96 | end 97 | 98 | (* objects *) 99 | val a : 100 | < > 101 | let () = () 102 | 103 | val a : 104 | < .. > 105 | let () = () 106 | 107 | val a : 108 | < meth: int option; 109 | meth2: 'a. 'a option; 110 | meth3: 'a 'b. ('a,'b) Hashtbl.t > 111 | let () = () 112 | 113 | val a : 114 | < meth: int option; 115 | meth2: 'a. 'a option; 116 | meth3: 'a 'b. ('a,'b) Hashtbl.t; 117 | .. > 118 | let () = () 119 | 120 | (* #-types *) 121 | val a : 122 | #M.meth 123 | 124 | val a : 125 | 'a#M.meth 126 | 127 | val a : 128 | ('a,'b*'c) 129 | #M.meth 130 | 131 | (* object types *) 132 | type a = 133 | < > 134 | let () = () 135 | 136 | type a = 137 | < .. > 138 | let () = () 139 | 140 | type a = 141 | < meth: int option; 142 | meth2: 'a. 'a option; 143 | meth3: 'a 'b. ('a,'b) Hashtbl.t > 144 | let () = () 145 | 146 | type a = 147 | < meth: int option; 148 | meth2: 'a. 'a option; 149 | meth3: 'a 'b. ('a,'b) Hashtbl.t; 150 | .. > 151 | let () = () 152 | 153 | type t = 154 | < a : int; b: 155 | < a: int; b: < c:int > > 156 | > 157 | let () = () 158 | 159 | type t = 160 | < a : int; b: 161 | < a: int; b: < c: int -> int> >; 162 | c: int 163 | > 164 | let () = () 165 | 166 | type 'a t = 167 | | Bla : < x : int > t 168 | | Blo : < y : int > t 169 | -------------------------------------------------------------------------------- /tests/passing/unit-expr.ml: -------------------------------------------------------------------------------- 1 | (** ocaml expressions 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/expr.html) 3 | *) 4 | 5 | let e = 6 | Array.make 7 | 8 | let e = 9 | true 10 | 11 | let e = 12 | (true) 13 | 14 | let e = 15 | begin 16 | true 17 | end 18 | 19 | let e = 20 | (true: 21 | bool) 22 | 23 | let e = 24 | true, 25 | false, 26 | true 27 | 28 | let e = 29 | Some 30 | true 31 | 32 | let e = 33 | `_ 34 | true 35 | 36 | let e = 37 | true :: 38 | false :: 39 | true 40 | 41 | let e = 42 | [ true; 43 | false; 44 | true; 45 | ] 46 | 47 | let e = 48 | [| true; 49 | false; 50 | true 51 | |] 52 | 53 | let e = 54 | { f1 = true; 55 | f2 = false; 56 | f3 = true; 57 | } 58 | 59 | let e = 60 | { e with f1 = true; 61 | f2 = false; 62 | } 63 | 64 | let e = 65 | f 66 | true 67 | false 68 | true 69 | 70 | let e = 71 | !? 72 | true 73 | 74 | let e = 75 | true 76 | || false 77 | && true 78 | 79 | let e = 80 | 1 81 | mod 1 82 | land 1 83 | lor 1 84 | lxor 1 85 | lsl 1 86 | lsr 1 87 | asr 1 88 | 89 | let e = 90 | re.f1 91 | 92 | let e = 93 | re.f1 <- 94 | true 95 | 96 | let e = 97 | a.(0) <- 98 | true 99 | 100 | let e = 101 | a.[0] <- 102 | true 103 | 104 | let e = 105 | if 106 | true 107 | then 108 | false 109 | else 110 | true 111 | 112 | let e = 113 | while 114 | true 115 | do 116 | () 117 | done 118 | 119 | let e = 120 | for x = 121 | a 122 | to 123 | b 124 | do 125 | () 126 | done 127 | 128 | let e = 129 | true; 130 | false; 131 | true 132 | 133 | let e = 134 | match 135 | true 136 | with 137 | | true -> 138 | false 139 | | false 140 | -> 141 | true 142 | 143 | let e = match 144 | true 145 | with 146 | | true -> 147 | false 148 | | false 149 | -> 150 | true 151 | 152 | let e = 153 | function 154 | | true -> 155 | false 156 | | false 157 | -> 158 | true 159 | 160 | let e = 161 | fun 162 | x 163 | ~ lbl1 164 | ~ ( lbl2 : int ) 165 | ~lbl3: _a 166 | ? olbl1 167 | ? (olbl2 : 'a list = []) 168 | ?olbl3: _c 169 | ?olbl4: ( _d : bool = false ) 170 | () 171 | when 172 | true 173 | -> 174 | true 175 | 176 | let e = 177 | fun x -> 178 | fun ~ lbl1 -> 179 | fun ~ ( lbl2 : int ) -> 180 | fun ~lbl3: _a -> 181 | fun ? olbl1 -> 182 | fun ? (olbl2 : 'a list = []) -> 183 | fun ?olbl3: _c 184 | when true 185 | -> 186 | fun ?olbl4: ( _d : bool = false ) -> 187 | fun () 188 | when 189 | true 190 | -> 191 | true 192 | 193 | let e 194 | x 195 | ~ lbl1 196 | ~ ( lbl2 : int ) 197 | ~lbl3: _a 198 | ? olbl1 199 | ? (olbl2 : 'a list = []) 200 | ?olbl3: _c 201 | ?olbl4: ( _d : bool = false ) 202 | () 203 | = 204 | true 205 | 206 | let e = 207 | try 208 | true 209 | with 210 | | Exit -> 211 | true 212 | | _ -> 213 | false 214 | 215 | let e = 216 | let rec 217 | a = 218 | true 219 | and _b = 220 | false 221 | in 222 | true 223 | 224 | let e = 225 | new 226 | foo 227 | 228 | let foo = 229 | object 230 | end 231 | 232 | let e = 233 | foo# 234 | bar1 235 | 236 | let e = 237 | (true :> 238 | bool) 239 | 240 | let e = 241 | (true : 242 | bool :> 243 | bool) 244 | 245 | let e = 246 | assert 247 | true 248 | 249 | let e = 250 | lazy 251 | true 252 | 253 | -------------------------------------------------------------------------------- /tests/passing/unit-extensions.ml: -------------------------------------------------------------------------------- 1 | (** ocaml language extensions 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/manual021.html) 3 | *) 4 | 5 | (* other integer literals *) 6 | let i = 12l 7 | + 0l 8 | 9 | let i = 12L 10 | + 0l 11 | 12 | let i = 12n 13 | + 0n 14 | 15 | (* range patterns *) 16 | let f = function 17 | | 'a'..'z' -> 18 | e1 19 | | 'A'..'Z' 20 | | '0'..'9' -> 21 | e2 22 | 23 | (* local modules *) 24 | let f = 25 | let module M = 26 | F(struct end) 27 | in 28 | M.f x 29 | 30 | (* recursive modules *) 31 | module rec M : S = 32 | struct 33 | ;; 34 | end 35 | and M1 : S1 = 36 | struct 37 | ;; 38 | end 39 | 40 | (* private types *) 41 | type t = private 42 | X of string 43 | | Y 44 | 45 | type t = private 46 | { f1:t1; 47 | f2: t2 } 48 | 49 | type t = 50 | private t' 51 | 52 | (* local opens *) 53 | 54 | let _ = 55 | let open 56 | F(X) 57 | in 58 | () 59 | 60 | (* record shortcuts *) 61 | let _ = 62 | let x = 1 and y = 2 63 | in 64 | { x; 65 | y 66 | } 67 | 68 | let f = function 69 | | { x; 70 | y; 71 | _ 72 | } -> 73 | () 74 | 75 | (* locally abstract types *) 76 | let f = fun 77 | (type t) 78 | (x: t) 79 | -> 80 | () 81 | 82 | let f 83 | (type t) 84 | (x: t) 85 | = 86 | () 87 | 88 | (* first-class modules *) 89 | type m = 90 | (module M.Sig 91 | with type t = 'b) 92 | * unit 93 | 94 | let x = 95 | let m = 96 | (module M : M.Sig 97 | with type t = 'b) 98 | in 99 | let module M = 100 | (val m : 101 | M.sig 102 | with type t = 'b) 103 | in 104 | M 105 | 106 | (* module type of *) 107 | module type S = sig 108 | include module type of M 109 | end 110 | 111 | (* signature substitution *) 112 | module type S = sig 113 | include 114 | M0 with type t := t 115 | val x : unit 116 | end 117 | 118 | (* class overriding *) 119 | class cl = object 120 | inherit! 121 | cl 122 | val! v = v 123 | method! m = m 124 | end 125 | 126 | (* GADTs *) 127 | type _ t = 128 | A: int t 129 | | B: 'a t * 'b t -> ('a*'b) t 130 | 131 | 132 | -------------------------------------------------------------------------------- /tests/passing/unit-lex.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OCamlPro/ocp-indent/f38578c25d62701847b1bcb45099a9020e2032fe/tests/passing/unit-lex.ml -------------------------------------------------------------------------------- /tests/passing/unit-modexpr.ml: -------------------------------------------------------------------------------- 1 | (** ocaml module expressions 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/manual019.html) 3 | *) 4 | 5 | module M = 6 | struct 7 | end 8 | 9 | module M = struct 10 | ;; 11 | end 12 | 13 | module M = 14 | functor (M1 : T1) -> functor (M2 : T2) -> 15 | struct 16 | end 17 | 18 | module M = functor (M1 : T1) -> functor (M2 : T2) -> 19 | struct 20 | end 21 | 22 | module M = 23 | functor (M1 : T1) -> 24 | functor (M2 : T2) -> 25 | struct 26 | end 27 | 28 | module M = 29 | functor 30 | (M1 : T1) -> 31 | functor 32 | (M2 : T2) -> 33 | struct 34 | end 35 | 36 | module M = 37 | F 38 | (X) 39 | (Y) 40 | 41 | module M = ( 42 | struct 43 | end : 44 | sig 45 | end 46 | ) 47 | 48 | module M : 49 | Sig 50 | = 51 | struct 52 | end 53 | 54 | module M 55 | (X1: T1) 56 | (X2: T2) = 57 | struct end 58 | 59 | -------------------------------------------------------------------------------- /tests/passing/unit-modtypes.ml: -------------------------------------------------------------------------------- 1 | (** ocaml module types 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/manual018.html) 3 | *) 4 | 5 | module type T = 6 | M.T 7 | 8 | module type T = 9 | sig 10 | end 11 | 12 | module type T = sig 13 | ;; 14 | end 15 | 16 | module type T = 17 | functor (M : T) -> 18 | functor (M1 : T1) -> 19 | sig 20 | end 21 | 22 | module type T = 23 | sig end 24 | with type 'a t = 'b 25 | and module M = M'.MF(X) 26 | and type t' = t'' 27 | 28 | module type T = ( 29 | sig 30 | end 31 | ) 32 | 33 | module type T = 34 | sig 35 | val v : 36 | t 37 | 38 | external x : 'a = 39 | "stub" 40 | 41 | type t = 42 | int 43 | and t2 = 44 | t 45 | 46 | exception Error 47 | of int 48 | 49 | class virtual ['a] cl : 50 | object 51 | end 52 | and cl2 : 53 | object 54 | end 55 | 56 | class type clt = 57 | object 58 | end 59 | and ['a] clt2 = 60 | object 61 | end 62 | 63 | module M : 64 | Sig 65 | 66 | module M (X) (Y): 67 | Sig 68 | 69 | module type Sig 70 | 71 | module type Sig1 = 72 | sig 73 | end 74 | 75 | open 76 | M 77 | 78 | include 79 | M 80 | end 81 | -------------------------------------------------------------------------------- /tests/passing/unit-patterns.ml: -------------------------------------------------------------------------------- 1 | (** ocaml patterns 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/patterns.html) 3 | *) 4 | 5 | let _ = function 6 | 7 | x -> () | 8 | 9 | _ -> () | 10 | 11 | 'a' -> () | 12 | 13 | x as y -> () | 14 | 15 | (x: 'a -> 'b) -> () | 16 | 17 | x | y -> () | 18 | 19 | Some x -> () | 20 | 21 | `Var x -> () | 22 | 23 | #ty -> () | 24 | 25 | x, y -> () | 26 | 27 | { f1 = x; 28 | f2 = y; 29 | f3 = z; 30 | _ 31 | } -> () | 32 | 33 | [ x; 34 | y; 35 | z; 36 | ] -> () | 37 | 38 | x::y 39 | :: z -> () | 40 | 41 | [| x; 42 | y; 43 | z; 44 | |] -> () | 45 | 46 | lazy w -> () 47 | -------------------------------------------------------------------------------- /tests/passing/unit-typedefs.ml: -------------------------------------------------------------------------------- 1 | (** ocaml type and exception definitions 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/manual016.html) 3 | *) 4 | 5 | type 6 | t 7 | 8 | type 9 | 'a t 10 | 11 | type 12 | +'_a t 13 | 14 | type 15 | -'a t 16 | 17 | type 18 | ('a, 19 | +'b, 20 | (-'c,-'d)) 21 | t 22 | 23 | type t = 24 | t2 25 | 26 | type t = 27 | A 28 | 29 | type t = 30 | A 31 | | B of 'a 32 | | C of 'a * 'b 33 | | D of ('a) Array.t * 'b list 34 | | E of _ 35 | 36 | type t = 37 | { f1 : t1; 38 | f2 : 'a; 39 | mutable f3: t2; 40 | f4 : 41 | 'a 'b.t2; 42 | } 43 | 44 | type 'a t 45 | constraint 'a = t 46 | constraint 'b = 'a 47 | 48 | type 49 | ('a, 50 | +'b, 51 | (-'c,-'d)) 52 | t 53 | = 54 | { f1 : t1; 55 | f2 : 'a; 56 | mutable f3: t2; 57 | f4 : 58 | t1 * t2; 59 | } 60 | constraint 'a = t 61 | constraint 'b = 'a 62 | 63 | 64 | exception 65 | E 66 | 67 | exception 68 | E of 69 | 'a t * string 70 | 71 | exception 72 | E' = 73 | E 74 | -------------------------------------------------------------------------------- /tests/passing/unit-types.ml: -------------------------------------------------------------------------------- 1 | (** ocaml type expressions 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/types.html) 3 | *) 4 | 5 | (* variables *) 6 | val a : 7 | 'ident 8 | 9 | val a : 10 | _ 11 | 12 | (* parentheses *) 13 | val a : 14 | ( t ) 15 | 16 | (* functions *) 17 | val a : 18 | int -> 19 | int -> 20 | t 21 | -> t 22 | -> t 23 | 24 | val a : 25 | lab1: int 26 | -> lab2 : 27 | (t) 28 | -> t 29 | 30 | val a : 31 | ? lab1: 32 | ( ?_ : int -> t ) 33 | -> t 34 | 35 | (* tuples *) 36 | val a : 37 | (t1 * t2) * ( 38 | t 39 | ) 40 | 41 | (* constructed *) 42 | val a : 43 | int 44 | 45 | val a : 46 | ('a -> 'b) Array.t 47 | 48 | 49 | (* aliased *) 50 | val a : 51 | int 52 | as 'bla 53 | 54 | (* polymorphic variants *) 55 | val a : 56 | [ `_ | `_' | 57 | `_00 | 58 | `Aa of int 59 | ] 60 | 61 | val a : [ 62 | | `_ | `_' | 63 | `_00 | 64 | `Aa of int 65 | ] 66 | 67 | val a : [< 68 | `_ | `_' | 69 | `_00 | 70 | `Aa of int 71 | ] 72 | 73 | val a : 74 | [ 75 | | `_ | `_' | 76 | `_00 | 77 | `Aa of int 78 | ] 79 | 80 | val a : [< 81 | | `Bb of int 82 | & string 83 | & t | 84 | int > 85 | `a `_bbb 86 | `c `d 87 | ] 88 | 89 | (* objects *) 90 | val a : 91 | < > 92 | 93 | val a : 94 | < .. > 95 | 96 | val a : 97 | < meth: int option; 98 | meth2: 'a. 'a option; 99 | meth3: 'a 'b. ('a,'b) Hashtbl.t > 100 | 101 | val a : 102 | < meth: int option; 103 | meth2: 'a. 'a option; 104 | meth3: 'a 'b. ('a,'b) Hashtbl.t; 105 | .. > 106 | 107 | (* #-types *) 108 | val a : 109 | #M.meth 110 | 111 | val a : 112 | 'a#M.meth 113 | 114 | val a : 115 | ('a,'b*'c) 116 | #M.meth 117 | -------------------------------------------------------------------------------- /tests/passing/unit-values.ml: -------------------------------------------------------------------------------- 1 | (** ocaml values 2 | (http://caml.inria.fr/pub/docs/manual-ocaml/manual010.html) 3 | *) 4 | 5 | (* base values *) 6 | let i32 = −1073741824, 1073741823 7 | let i32_over = −1073741825, 1073741824 8 | let i32_over_big = −10737418240, 10737418230 9 | let i64 = -4611686018427387904, 4611686018427387903 10 | let i64_over = -4611686018427387905, 4611686018427387904 11 | let i64_over_big = -46116860184273879040, 46116860184273879030 12 | 13 | let f = 4611686018427387903e-1022, 4611686018427387903e+1023 14 | let f_over = 4611686018427387903e-1023, 4611686018427387903e+1024 15 | 16 | (* tuples *) 17 | let _ = (1, 2, 3, 4, 5, 18 | 1, 2, 3, 4, 5 19 | , 1, 2, 3, 4, 5) 20 | 21 | (* records *) 22 | let _ = { f1 = 12; f2 = 13; 23 | f3 = 14; f4 = 15; 24 | f5 = 14; f6 = 15; 25 | f7 = 14; f8 = 15; 26 | } 27 | let _ = { f1 = 12; f2 = 13; 28 | M_.f3 = 14; M.f4 = 15; 29 | M'.M3.f5 = 14; Mz.MM.f6 = 15; 30 | Mg.f7 = 14; Fe.f8 = 15 31 | } 32 | ;; 33 | 34 | (* arrays *) 35 | [| 5;468; 68;46;84;684;68;4; 36 | 54;354;384;3;0;76;64;0;6; 37 | 54;354;384;3;0;76;64;0;6; 38 | 54;354;384;3;0;76;64;0;6; 39 | |] 40 | -------------------------------------------------------------------------------- /tests/passing/variants.ml: -------------------------------------------------------------------------------- 1 | type t = [ `aaa 2 | | `bbb 3 | | `ccc 4 | ] 5 | 6 | type t = [ `aaa | `bbb 7 | | `ccc 8 | ] 9 | 10 | type t = 11 | [ `aaa 12 | | `bbb 13 | | `ccc 14 | ] 15 | 16 | type t = 17 | [ `aaa | `bbb 18 | | `ccc 19 | ] 20 | 21 | type t = 22 | [ 23 | `aaa 24 | | `bbb 25 | | `ccc 26 | ] 27 | 28 | type t = 29 | [ 30 | `aaa | `bbb 31 | | `ccc 32 | ] 33 | 34 | type t = [ 35 | `aaa 36 | | `bbb 37 | | `ccc 38 | ] 39 | 40 | type t = [ 41 | `aaa | `bbb 42 | | `ccc 43 | ] 44 | -------------------------------------------------------------------------------- /tests/passing/with_2.ml: -------------------------------------------------------------------------------- 1 | let x = 2 | try y with 3 | | A -> _ 4 | | B -> _ 5 | 6 | let x = try y with 7 | | A -> _ 8 | | B -> _ 9 | 10 | let x = 11 | try y with 12 | A -> _ 13 | | B -> _ 14 | 15 | let x = try y with 16 | A -> _ 17 | | B -> _ 18 | 19 | let _ = 20 | let x = 21 | try y with 22 | | A -> _ 23 | | B -> _ 24 | in 25 | let x = try y with 26 | | A -> _ 27 | | B -> _ 28 | in 29 | let x = 30 | try y with 31 | A -> _ 32 | | B -> _ 33 | in 34 | let x = try y with 35 | A -> _ 36 | | B -> _ 37 | -------------------------------------------------------------------------------- /tests/passing/with_2.ml.opts: -------------------------------------------------------------------------------- 1 | -c with=2 2 | -------------------------------------------------------------------------------- /tests/passing/with_never.ml: -------------------------------------------------------------------------------- 1 | let f x = match x with 2 | | `A -> "A" 3 | | `B -> "B" 4 | 5 | let f = function 6 | | `A -> "A" 7 | | `B -> "B" 8 | 9 | let f = fun x -> match x with 10 | | `A -> "A" 11 | | `B -> "B" 12 | 13 | let f = 14 | let g x = match x with 15 | | `A -> "A" 16 | | `B -> "B" 17 | in 18 | g 19 | 20 | let f = 21 | let g = function 22 | | `A -> "A" 23 | | `B -> "B" 24 | in 25 | g 26 | 27 | let f = 28 | let g = fun x -> match x with 29 | | `A -> "A" 30 | | `B -> "B" 31 | in 32 | g 33 | 34 | let z = 35 | begin match 36 | x 37 | with 38 | | X -> x 39 | end 40 | 41 | let config_converter = 42 | (fun str -> try (* just check syntax *) 43 | ignore (IndentConfig.update_from_string IndentConfig.default str); 44 | `Ok str 45 | with Invalid_argument s -> `Error s), 46 | ignore (IndentConfig.update_from_string IndentConfig.default str); 47 | `Ok str 48 | 49 | let f = 50 | try match a 51 | with B -> x 52 | with C -> y 53 | 54 | let g = 55 | try match X with 56 | | X -> X 57 | with 58 | | X -> Y 59 | -------------------------------------------------------------------------------- /tests/passing/with_never.ml.opts: -------------------------------------------------------------------------------- 1 | -c with=0,strict_with=always 2 | -------------------------------------------------------------------------------- /tools/dune: -------------------------------------------------------------------------------- 1 | (install 2 | (section share_root) 3 | (files 4 | (ocp-indent.el as emacs/site-lisp/ocp-indent.el) 5 | (ocp-indent.vim as ocp-indent/vim/indent/ocaml.vim)) 6 | ) 7 | -------------------------------------------------------------------------------- /tools/ocp-indent.vim: -------------------------------------------------------------------------------- 1 | " Only load this indent file when no other was loaded. 2 | if exists("b:did_indent") 3 | finish 4 | endif 5 | let b:did_indent = 1 6 | 7 | setlocal expandtab 8 | 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) 9 | setlocal nolisp 10 | setlocal nosmartindent 11 | setlocal indentexpr=GetOcpIndent(v:lnum) 12 | 13 | " Comment formatting 14 | if !exists("no_ocaml_comments") 15 | if (has("comments")) 16 | setlocal comments=sr:(*,mb:*,ex:*) 17 | setlocal fo+=cqor 18 | endif 19 | endif 20 | 21 | " Only define the function once. 22 | if exists("*GetOcpIndent") 23 | finish 24 | endif 25 | 26 | " Indents are cached for the current buffer; they are only re-used when 27 | " indenting lines in sequence and the buffer was unchanged. 28 | let s:indents = [] 29 | let s:buffer = -1 30 | let s:tick = -1 31 | let s:lnum = -1 32 | 33 | function! GetOcpIndent(lnum) 34 | if s:buffer == bufnr('') && s:tick == b:changedtick && s:lnum < a:lnum && match(getline(s:lnum + 1, a:lnum - 1),'.') == -1 35 | " Only use cache if there are only blank lines in-between 36 | call remove(s:indents, 0, a:lnum - s:lnum - 1) 37 | else 38 | " Compute indentation from current line on 39 | let cmdline = "ocp-indent --numeric --indent-empty --lines " . a:lnum . '-' 40 | let s:indents = split(system(cmdline, getline('1','$'))) 41 | let s:buffer = bufnr('') 42 | let s:tick = b:changedtick 43 | endif 44 | let s:lnum = a:lnum 45 | 46 | return s:indents[0] 47 | endfunction 48 | -------------------------------------------------------------------------------- /tools/tuareg-indent: -------------------------------------------------------------------------------- 1 | #!/bin/bash -ue 2 | # 3 | # Copyright 2012-2013 OCamlPro 4 | # 5 | # All rights reserved.This file is distributed under the terms of the 6 | # GNU Lesser General Public License version 2.1 with linking 7 | # exception. 8 | # 9 | # TypeRex is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # Lesser GNU General Public License for more details. 13 | # 14 | 15 | ocp-config-to-tuareg() { 16 | while [ $# -gt 0 ]; do 17 | case $1 in 18 | -c) 19 | shift 20 | local c="normal,$1" 21 | c=$(sed 's/normal/base=2,type=2,in=0,with=0,match_clause=2/' <<<"$c") 22 | c=$(sed 's/JaneStreet/base=2,type=0,in=0,with=0,match_clause=2/' <<<"$c") 23 | awk 'BEGIN { RS=","; FS="=" } { print $1,$2 }' <<<"$c" | { 24 | while read var val; do 25 | case "$var" in 26 | "base") echo "(setq tuareg-default-indent $val)";; 27 | "type") echo "(setq tuareg-type-indent $val)";; 28 | "in") echo "(setq tuareg-in-indent $val)";; 29 | "with") echo "(setq tuareg-with-indent $val)";; 30 | "match_clause") echo "(setq tuareg-match-clause-indent $((val-1)))";; 31 | "") ;; 32 | *) 33 | echo "Error: config option not understood by tuareg conversion: '$var'" >&2 34 | esac 35 | done 36 | } 37 | ;; 38 | *) 39 | echo "Error: config parameter not understood by tuareg conversion: '$1'" >&2 40 | esac 41 | shift 42 | done 43 | } 44 | tuareg-indent() { 45 | local f=$1; shift 46 | local config=$(ocp-config-to-tuareg $*) 47 | # At Jane Street, and perhaps other sites, Tuareg is found via the 48 | # user's ~/.emacs, rather than in a standard location in /usr. We 49 | # may also wish to compare against standard or custom user config. 50 | if [ -n "${TUAREG_INDENT_USE_USER_DOT_EMACS+set}" ]; then 51 | local tuareg=${TUAREG_INDENT_USE_USER_DOT_EMACS:-$HOME/.emacs} 52 | else 53 | local tuareg=$( 54 | ls /usr/share/emacs*/site-lisp/tuareg-mode/tuareg.elc 2>/dev/null \ 55 | || ls /usr/share/emacs/site-lisp/tuareg-mode/tuareg.el 56 | ) 57 | fi 58 | emacs $f -Q -batch --eval ' 59 | (progn 60 | (load-file "'"$tuareg"'") 61 | (tuareg-mode) 62 | '"$config"' 63 | (setq indent-tabs-mode nil) 64 | (indent-region (point-min) (point-max)) 65 | (set-visited-file-name "/dev/stdout") 66 | (save-buffer 0)) 67 | ' 2>/dev/null || true 68 | } 69 | 70 | # Note: This will whitespace-split individual arguments. 71 | args= 72 | while [ $# -gt 1 ]; do args="$args $1"; shift; done 73 | file=$1 74 | 75 | tuareg-indent "$file" $args 76 | --------------------------------------------------------------------------------