├── .editorconfig ├── .github ├── dependabot.yml └── workflows │ └── main.yml ├── .gitignore ├── .markdownlint.json ├── .ocamlformat ├── CHANGELOG.md ├── LICENSE.md ├── Makefile ├── README.md ├── TODO.md ├── dune ├── dune-project ├── examples ├── Makefile ├── buffer_ex.ml ├── defstrat.ml ├── dune ├── stupid_ga.ml └── weak_ex.ml ├── lib ├── Makefile ├── dune ├── nopres_impl.ml ├── nopres_intf.ml ├── pres_impl.ml ├── pres_intf.ml ├── res.ml ├── res.mli ├── strat.ml ├── weak_impl.ml └── weak_intf.ml └── res.opam /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig: https://EditorConfig.org 2 | 3 | # Top-most EditorConfig file 4 | root = true 5 | 6 | # Default settings for all files 7 | [*] 8 | charset = utf-8 9 | end_of_line = lf 10 | insert_final_newline = true 11 | trim_trailing_whitespace = true 12 | indent_style = space 13 | indent_size = 2 14 | max_line_length = 80 15 | 16 | # Makefile 17 | [Makefile] 18 | # Makefiles require tabs instead of spaces 19 | indent_style = tab 20 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | # To get started with Dependabot version updates, you'll need to specify which 2 | # package ecosystems to update and where the package manifests are located. 3 | # Please see the documentation for all configuration options: 4 | # https://docs.github.com/code-security/dependabot/dependabot-version-updates/configuration-options-for-the-dependabot.yml-file 5 | 6 | version: 2 7 | updates: 8 | - package-ecosystem: github-actions 9 | directory: "/" # Location of package manifests 10 | schedule: 11 | interval: "weekly" 12 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Builds, tests & co 2 | 3 | on: 4 | - pull_request 5 | - push 6 | - workflow_dispatch 7 | 8 | permissions: read-all 9 | 10 | jobs: 11 | build: 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | os: 16 | - ubuntu-latest 17 | - macos-latest 18 | - windows-latest 19 | 20 | runs-on: ${{ matrix.os }} 21 | 22 | steps: 23 | - name: Checkout tree 24 | uses: actions/checkout@v4 25 | 26 | - name: Set-up OCaml 27 | uses: ocaml/setup-ocaml@v3 28 | with: 29 | ocaml-compiler: 5 30 | 31 | - run: opam install . --deps-only --with-test 32 | 33 | - run: opam exec -- dune build 34 | 35 | - run: opam exec -- dune runtest 36 | 37 | lint-doc: 38 | runs-on: ubuntu-latest 39 | steps: 40 | - name: Checkout tree 41 | uses: actions/checkout@v4 42 | - name: Set-up OCaml 43 | uses: ocaml/setup-ocaml@v3 44 | with: 45 | ocaml-compiler: 5 46 | - uses: ocaml/setup-ocaml/lint-doc@v3 47 | 48 | lint-fmt: 49 | runs-on: ubuntu-latest 50 | steps: 51 | - name: Checkout tree 52 | uses: actions/checkout@v4 53 | - name: Set-up OCaml 54 | uses: ocaml/setup-ocaml@v3 55 | with: 56 | ocaml-compiler: 5 57 | - uses: ocaml/setup-ocaml/lint-fmt@v3 58 | 59 | lint-opam: 60 | runs-on: ubuntu-latest 61 | steps: 62 | - name: Checkout tree 63 | uses: actions/checkout@v4 64 | - name: Set-up OCaml 65 | uses: ocaml/setup-ocaml@v3 66 | with: 67 | ocaml-compiler: 5 68 | - uses: ocaml/setup-ocaml/lint-opam@v3 69 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .*.swp 2 | .merlin 3 | *.install 4 | _build 5 | -------------------------------------------------------------------------------- /.markdownlint.json: -------------------------------------------------------------------------------- 1 | { 2 | "no-duplicate-heading": { 3 | "siblings_only": true 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.27.0 2 | profile = conventional 3 | 4 | # Default overrides 5 | wrap-comments = true 6 | parse-docstrings = true 7 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## [5.0.2] - 2024-10-27 4 | 5 | ### Added 6 | 7 | - GitHub workflow for CI. 8 | 9 | ### Changed 10 | 11 | - Switched to OPAM file generation via `dune-project`. 12 | - Used packed float array implementation for resizable float arrays. 13 | - Used ocamlformat to format code and fixed OCaml doc problems. 14 | 15 | ### Fixed 16 | 17 | - Fixed closure allocation due to match on mutable (thanks to Luke Palmer). 18 | 19 | ### Removed 20 | 21 | - Removed `bytes` dependency (thanks to Marek Kubica). 22 | 23 | ## [5.0.1] - 2018-10-25 24 | 25 | ### Changed 26 | 27 | - Switched to dune, dune-release, and OPAM 2.0. 28 | 29 | ## [5.0.0] - 2017-08-02 30 | 31 | ### Changed 32 | 33 | - Switched to jbuilder and topkg. 34 | 35 | ## Changes Before Version 5.0.0 36 | 37 | ```text 38 | 2017-01-18: Changed license to LGPL 2.1 39 | 40 | 2014-12-18: Fixed a bug in the "remove_range" function. 41 | 42 | 2014-10-23: Fixed string handling for new OCaml version 4.02 (String/Bytes 43 | modules). Requires new findlib version (>= 1.5). 44 | 45 | 2014-07-06: Moved to GitHub. 46 | 47 | 2013-06-12: Fixed a bug in the fill functions that made them not behave 48 | according to specification when filling past the end. 49 | 50 | 2012-07-20: Downgraded findlib version constraint to support the Debian 51 | testing branch. 52 | 53 | 2012-07-15: New major release version 4.0.0: 54 | 55 | * Upgraded to OCaml 4.00 56 | * Switched to Oasis for packaging 57 | * Switched to OCamlBuild for the build process 58 | * Rewrote README in Markdown 59 | * Added stricter compilation flags 60 | 61 | 2009-06-01: Robustified implementation to avoid internal use of Obg.magic. 62 | 63 | 2008-09-16: Changed strategy API to greatly improve performance of 64 | growing/shrinking. 65 | 66 | 2008-05-09: Added unsafe_expose_array to parameterized resizable arrays. 67 | 68 | 2006-11-22: Updated OCamlMakefile. 69 | 70 | 2005-12-26: Fixed a build problem. 71 | 72 | 2005-10-24: Added sof_list. 73 | 74 | 2004-04-11: Removed use of unsafe external function that depends on 75 | current CVS-version. 76 | 77 | 2004-01-28: Renamed external function for compatibility with most recent 78 | OCaml-version. 79 | 80 | Updated OCamlMakefile. 81 | 82 | 2003-04-09: Updated OCamlMakefile. 83 | Fixed an installation problem. 84 | 85 | 2003-01-07: Updated OCamlMakefile to make use of "findlib". 86 | 87 | 2002-09-23: Fixed a bug in "remove_n" (arguments not fully checked). 88 | 89 | Slightly improved efficiency. 90 | 91 | 2002-09-11: Updated OCamlMakefile and license. 92 | 93 | Documented all modules for ocamldoc. 94 | 95 | Changed module Res for better accessibility. 96 | 97 | Made resizable weak arrays conform to module Weak again. 98 | 99 | 2002-05-04: Revised the whole installation procedure. See INSTALL for 100 | details. 101 | 102 | 2002-04-30: Updated OCamlMakefile: it does not ask for confirmation 103 | during installation anymore. 104 | 105 | 2001-06-30: Removed "Printexc.catch" from stupid_ga-example: 106 | deprecated in upcoming OCaml-release. 107 | 108 | 2001-06-24: Added special module for resizable integer arrays (again) for 109 | better performance. 110 | 111 | 2001-01-30: Made Makefile more general (allows simpler addition of 112 | further examples). 113 | 114 | 2001-01-26: Made use of the new OCaml-keyword "include" for module 115 | inclusion. This makes the file "lib/res.ml" shorter. 116 | This change requires an OCaml-version higher than 3.00. 117 | 118 | 2001-01-24: Updated OCamlMakefile 119 | 120 | 2000-06-24: Updated OCamlMakefile 121 | 122 | 2000-06-13: Updated OCamlMakefile 123 | 124 | 2000-06-11: Updated OCamlMakefile 125 | 126 | 2000-06-08: Added installation routine + updated OCamlMakefile again: 127 | 128 | This upgrade makes installation much easier. Read the 129 | updated INSTALL-file. 130 | 131 | 2000-06-07: Upgraded to new OCamlMakefile. 132 | 133 | 2000-04-28: Fixed *critical* bug: 134 | 135 | Filling and blitting truncated the array if the last index of the 136 | operation was smaller than the one of the target array. 137 | 138 | Resizable bit-vectors should be *much* more efficient now 139 | (blitting, resizing, etc. about 30 (60) times faster, depending on 140 | your architecture): 141 | 142 | I took the new implementation of Jean-Christophe Filliatre's 143 | bitv-library, which uses some clever algorithms for efficient 144 | blitting. In the near (?) future I'll also add his functions for 145 | common logical, efficient operations on bit-strings (unless 146 | somebody wants to volunteer... ;-) 147 | 148 | 2000-03-23: Removed special module for resizable integer arrays: 149 | 150 | Integer arrays are not unboxed and won't be in the (near?) 151 | future: this would cause generic polymorphic functions such as 152 | equality, hashing and output_value to produce wrong results. 153 | 154 | Use the comparably fast parameterized version instead. 155 | 156 | 2000-03-08: New function (in all implementations): 157 | 158 | find_index - takes a predicate, a resizable array and a 159 | start index and returns the index of the 160 | first element that satisfies the predicate - 161 | see interface documentation for details. 162 | 163 | Fixed documentation of interfaces: in some cases we used the wrong 164 | name for possibly raised exceptions. 165 | 166 | 2000-01-10: Added functions for converting standard arrays to resizable 167 | ones and strings to buffers. 168 | 169 | Added "create" and "screate" to the interface of parameterized 170 | arrays. This makes it easier to use it in place of the 171 | standard array. 172 | 173 | Removed "make" and "smake" from resizable weak arrays - 174 | not useful there. 175 | 176 | Updated documentation on how to use the index operators with 177 | the resizable datastructures and how to replace the 178 | standard arrays/strings with the resizable ones in large 179 | sources. 180 | 181 | 1999-12-25: Added support for weak arrays + small example 182 | 183 | 1999-11-04: Added support for bit-vectors 184 | (peeked at Jean-Christophe Filliatre's bitv-library for this). 185 | 186 | Added new example: 187 | 188 | stupid_ga.ml (a brain-dead genetic algorithm using bit-vectors) 189 | 190 | 1999-10-23: Added three new functions: 191 | 192 | remove_range - removes a range of elements within a resizable 193 | array 194 | 195 | pos - returns the index of the first logically equal element 196 | posq - returns the index of the first physically equal element 197 | 198 | 1999-10-13: First release. 199 | ``` 200 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright © 1999- Markus Mottl 2 | 3 | The Library is distributed under the terms of the GNU Lesser General 4 | Public License version 2.1 (included below). 5 | 6 | As a special exception to the GNU Lesser General Public License, you 7 | may link, statically or dynamically, a "work that uses the Library" 8 | with a publicly distributed version of the Library to produce an 9 | executable file containing portions of the Library, and distribute that 10 | executable file under terms of your choice, without any of the additional 11 | requirements listed in clause 6 of the GNU Lesser General Public License. 12 | By "a publicly distributed version of the Library", we mean either the 13 | unmodified Library as distributed by the authors, or a modified version 14 | of the Library that is distributed under the conditions defined in clause 15 | 2 of the GNU Lesser General Public License. This exception does not 16 | however invalidate any other reasons why the executable file might be 17 | covered by the GNU Lesser General Public License. 18 | 19 | --------------------------------------------------------------------------- 20 | 21 | ### GNU LESSER GENERAL PUBLIC LICENSE 22 | 23 | Version 2.1, February 1999 24 | 25 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 26 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 27 | 28 | Everyone is permitted to copy and distribute verbatim copies 29 | of this license document, but changing it is not allowed. 30 | 31 | [This is the first released version of the Lesser GPL. It also counts 32 | as the successor of the GNU Library Public License, version 2, hence 33 | the version number 2.1.] 34 | 35 | ### Preamble 36 | 37 | The licenses for most software are designed to take away your freedom 38 | to share and change it. By contrast, the GNU General Public Licenses 39 | are intended to guarantee your freedom to share and change free 40 | software--to make sure the software is free for all its users. 41 | 42 | This license, the Lesser General Public License, applies to some 43 | specially designated software packages--typically libraries--of the 44 | Free Software Foundation and other authors who decide to use it. You 45 | can use it too, but we suggest you first think carefully about whether 46 | this license or the ordinary General Public License is the better 47 | strategy to use in any particular case, based on the explanations 48 | below. 49 | 50 | When we speak of free software, we are referring to freedom of use, 51 | not price. Our General Public Licenses are designed to make sure that 52 | you have the freedom to distribute copies of free software (and charge 53 | for this service if you wish); that you receive source code or can get 54 | it if you want it; that you can change the software and use pieces of 55 | it in new free programs; and that you are informed that you can do 56 | these things. 57 | 58 | To protect your rights, we need to make restrictions that forbid 59 | distributors to deny you these rights or to ask you to surrender these 60 | rights. These restrictions translate to certain responsibilities for 61 | you if you distribute copies of the library or if you modify it. 62 | 63 | For example, if you distribute copies of the library, whether gratis 64 | or for a fee, you must give the recipients all the rights that we gave 65 | you. You must make sure that they, too, receive or can get the source 66 | code. If you link other code with the library, you must provide 67 | complete object files to the recipients, so that they can relink them 68 | with the library after making changes to the library and recompiling 69 | it. And you must show them these terms so they know their rights. 70 | 71 | We protect your rights with a two-step method: (1) we copyright the 72 | library, and (2) we offer you this license, which gives you legal 73 | permission to copy, distribute and/or modify the library. 74 | 75 | To protect each distributor, we want to make it very clear that there 76 | is no warranty for the free library. Also, if the library is modified 77 | by someone else and passed on, the recipients should know that what 78 | they have is not the original version, so that the original author's 79 | reputation will not be affected by problems that might be introduced 80 | by others. 81 | 82 | Finally, software patents pose a constant threat to the existence of 83 | any free program. We wish to make sure that a company cannot 84 | effectively restrict the users of a free program by obtaining a 85 | restrictive license from a patent holder. Therefore, we insist that 86 | any patent license obtained for a version of the library must be 87 | consistent with the full freedom of use specified in this license. 88 | 89 | Most GNU software, including some libraries, is covered by the 90 | ordinary GNU General Public License. This license, the GNU Lesser 91 | General Public License, applies to certain designated libraries, and 92 | is quite different from the ordinary General Public License. We use 93 | this license for certain libraries in order to permit linking those 94 | libraries into non-free programs. 95 | 96 | When a program is linked with a library, whether statically or using a 97 | shared library, the combination of the two is legally speaking a 98 | combined work, a derivative of the original library. The ordinary 99 | General Public License therefore permits such linking only if the 100 | entire combination fits its criteria of freedom. The Lesser General 101 | Public License permits more lax criteria for linking other code with 102 | the library. 103 | 104 | We call this license the "Lesser" General Public License because it 105 | does Less to protect the user's freedom than the ordinary General 106 | Public License. It also provides other free software developers Less 107 | of an advantage over competing non-free programs. These disadvantages 108 | are the reason we use the ordinary General Public License for many 109 | libraries. However, the Lesser license provides advantages in certain 110 | special circumstances. 111 | 112 | For example, on rare occasions, there may be a special need to 113 | encourage the widest possible use of a certain library, so that it 114 | becomes a de-facto standard. To achieve this, non-free programs must 115 | be allowed to use the library. A more frequent case is that a free 116 | library does the same job as widely used non-free libraries. In this 117 | case, there is little to gain by limiting the free library to free 118 | software only, so we use the Lesser General Public License. 119 | 120 | In other cases, permission to use a particular library in non-free 121 | programs enables a greater number of people to use a large body of 122 | free software. For example, permission to use the GNU C Library in 123 | non-free programs enables many more people to use the whole GNU 124 | operating system, as well as its variant, the GNU/Linux operating 125 | system. 126 | 127 | Although the Lesser General Public License is Less protective of the 128 | users' freedom, it does ensure that the user of a program that is 129 | linked with the Library has the freedom and the wherewithal to run 130 | that program using a modified version of the Library. 131 | 132 | The precise terms and conditions for copying, distribution and 133 | modification follow. Pay close attention to the difference between a 134 | "work based on the library" and a "work that uses the library". The 135 | former contains code derived from the library, whereas the latter must 136 | be combined with the library in order to run. 137 | 138 | ### TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 139 | 140 | **0.** This License Agreement applies to any software library or other 141 | program which contains a notice placed by the copyright holder or 142 | other authorized party saying it may be distributed under the terms of 143 | this Lesser General Public License (also called "this License"). Each 144 | licensee is addressed as "you". 145 | 146 | A "library" means a collection of software functions and/or data 147 | prepared so as to be conveniently linked with application programs 148 | (which use some of those functions and data) to form executables. 149 | 150 | The "Library", below, refers to any such software library or work 151 | which has been distributed under these terms. A "work based on the 152 | Library" means either the Library or any derivative work under 153 | copyright law: that is to say, a work containing the Library or a 154 | portion of it, either verbatim or with modifications and/or translated 155 | straightforwardly into another language. (Hereinafter, translation is 156 | included without limitation in the term "modification".) 157 | 158 | "Source code" for a work means the preferred form of the work for 159 | making modifications to it. For a library, complete source code means 160 | all the source code for all modules it contains, plus any associated 161 | interface definition files, plus the scripts used to control 162 | compilation and installation of the library. 163 | 164 | Activities other than copying, distribution and modification are not 165 | covered by this License; they are outside its scope. The act of 166 | running a program using the Library is not restricted, and output from 167 | such a program is covered only if its contents constitute a work based 168 | on the Library (independent of the use of the Library in a tool for 169 | writing it). Whether that is true depends on what the Library does and 170 | what the program that uses the Library does. 171 | 172 | **1.** You may copy and distribute verbatim copies of the Library's 173 | complete source code as you receive it, in any medium, provided that 174 | you conspicuously and appropriately publish on each copy an 175 | appropriate copyright notice and disclaimer of warranty; keep intact 176 | all the notices that refer to this License and to the absence of any 177 | warranty; and distribute a copy of this License along with the 178 | Library. 179 | 180 | You may charge a fee for the physical act of transferring a copy, and 181 | you may at your option offer warranty protection in exchange for a 182 | fee. 183 | 184 | **2.** You may modify your copy or copies of the Library or any 185 | portion of it, thus forming a work based on the Library, and copy and 186 | distribute such modifications or work under the terms of Section 1 187 | above, provided that you also meet all of these conditions: 188 | 189 | - **a)** The modified work must itself be a software library. 190 | - **b)** You must cause the files modified to carry prominent 191 | notices stating that you changed the files and the date of 192 | any change. 193 | - **c)** You must cause the whole of the work to be licensed at no 194 | charge to all third parties under the terms of this License. 195 | - **d)** If a facility in the modified Library refers to a function 196 | or a table of data to be supplied by an application program that 197 | uses the facility, other than as an argument passed when the 198 | facility is invoked, then you must make a good faith effort to 199 | ensure that, in the event an application does not supply such 200 | function or table, the facility still operates, and performs 201 | whatever part of its purpose remains meaningful. 202 | 203 | (For example, a function in a library to compute square roots has 204 | a purpose that is entirely well-defined independent of 205 | the application. Therefore, Subsection 2d requires that any 206 | application-supplied function or table used by this function must 207 | be optional: if the application does not supply it, the square 208 | root function must still compute square roots.) 209 | 210 | These requirements apply to the modified work as a whole. If 211 | identifiable sections of that work are not derived from the Library, 212 | and can be reasonably considered independent and separate works in 213 | themselves, then this License, and its terms, do not apply to those 214 | sections when you distribute them as separate works. But when you 215 | distribute the same sections as part of a whole which is a work based 216 | on the Library, the distribution of the whole must be on the terms of 217 | this License, whose permissions for other licensees extend to the 218 | entire whole, and thus to each and every part regardless of who wrote 219 | it. 220 | 221 | Thus, it is not the intent of this section to claim rights or contest 222 | your rights to work written entirely by you; rather, the intent is to 223 | exercise the right to control the distribution of derivative or 224 | collective works based on the Library. 225 | 226 | In addition, mere aggregation of another work not based on the Library 227 | with the Library (or with a work based on the Library) on a volume of 228 | a storage or distribution medium does not bring the other work under 229 | the scope of this License. 230 | 231 | **3.** You may opt to apply the terms of the ordinary GNU General 232 | Public License instead of this License to a given copy of the Library. 233 | To do this, you must alter all the notices that refer to this License, 234 | so that they refer to the ordinary GNU General Public License, version 235 | 2, instead of to this License. (If a newer version than version 2 of 236 | the ordinary GNU General Public License has appeared, then you can 237 | specify that version instead if you wish.) Do not make any other 238 | change in these notices. 239 | 240 | Once this change is made in a given copy, it is irreversible for that 241 | copy, so the ordinary GNU General Public License applies to all 242 | subsequent copies and derivative works made from that copy. 243 | 244 | This option is useful when you wish to copy part of the code of the 245 | Library into a program that is not a library. 246 | 247 | **4.** You may copy and distribute the Library (or a portion or 248 | derivative of it, under Section 2) in object code or executable form 249 | under the terms of Sections 1 and 2 above provided that you accompany 250 | it with the complete corresponding machine-readable source code, which 251 | must be distributed under the terms of Sections 1 and 2 above on a 252 | medium customarily used for software interchange. 253 | 254 | If distribution of object code is made by offering access to copy from 255 | a designated place, then offering equivalent access to copy the source 256 | code from the same place satisfies the requirement to distribute the 257 | source code, even though third parties are not compelled to copy the 258 | source along with the object code. 259 | 260 | **5.** A program that contains no derivative of any portion of the 261 | Library, but is designed to work with the Library by being compiled or 262 | linked with it, is called a "work that uses the Library". Such a work, 263 | in isolation, is not a derivative work of the Library, and therefore 264 | falls outside the scope of this License. 265 | 266 | However, linking a "work that uses the Library" with the Library 267 | creates an executable that is a derivative of the Library (because it 268 | contains portions of the Library), rather than a "work that uses the 269 | library". The executable is therefore covered by this License. Section 270 | 6 states terms for distribution of such executables. 271 | 272 | When a "work that uses the Library" uses material from a header file 273 | that is part of the Library, the object code for the work may be a 274 | derivative work of the Library even though the source code is not. 275 | Whether this is true is especially significant if the work can be 276 | linked without the Library, or if the work is itself a library. The 277 | threshold for this to be true is not precisely defined by law. 278 | 279 | If such an object file uses only numerical parameters, data structure 280 | layouts and accessors, and small macros and small inline functions 281 | (ten lines or less in length), then the use of the object file is 282 | unrestricted, regardless of whether it is legally a derivative work. 283 | (Executables containing this object code plus portions of the Library 284 | will still fall under Section 6.) 285 | 286 | Otherwise, if the work is a derivative of the Library, you may 287 | distribute the object code for the work under the terms of Section 6. 288 | Any executables containing that work also fall under Section 6, 289 | whether or not they are linked directly with the Library itself. 290 | 291 | **6.** As an exception to the Sections above, you may also combine or 292 | link a "work that uses the Library" with the Library to produce a work 293 | containing portions of the Library, and distribute that work under 294 | terms of your choice, provided that the terms permit modification of 295 | the work for the customer's own use and reverse engineering for 296 | debugging such modifications. 297 | 298 | You must give prominent notice with each copy of the work that the 299 | Library is used in it and that the Library and its use are covered by 300 | this License. You must supply a copy of this License. If the work 301 | during execution displays copyright notices, you must include the 302 | copyright notice for the Library among them, as well as a reference 303 | directing the user to the copy of this License. Also, you must do one 304 | of these things: 305 | 306 | - **a)** Accompany the work with the complete corresponding 307 | machine-readable source code for the Library including whatever 308 | changes were used in the work (which must be distributed under 309 | Sections 1 and 2 above); and, if the work is an executable linked 310 | with the Library, with the complete machine-readable "work that 311 | uses the Library", as object code and/or source code, so that the 312 | user can modify the Library and then relink to produce a modified 313 | executable containing the modified Library. (It is understood that 314 | the user who changes the contents of definitions files in the 315 | Library will not necessarily be able to recompile the application 316 | to use the modified definitions.) 317 | - **b)** Use a suitable shared library mechanism for linking with 318 | the Library. A suitable mechanism is one that (1) uses at run time 319 | a copy of the library already present on the user's computer 320 | system, rather than copying library functions into the executable, 321 | and (2) will operate properly with a modified version of the 322 | library, if the user installs one, as long as the modified version 323 | is interface-compatible with the version that the work was 324 | made with. 325 | - **c)** Accompany the work with a written offer, valid for at least 326 | three years, to give the same user the materials specified in 327 | Subsection 6a, above, for a charge no more than the cost of 328 | performing this distribution. 329 | - **d)** If distribution of the work is made by offering access to 330 | copy from a designated place, offer equivalent access to copy the 331 | above specified materials from the same place. 332 | - **e)** Verify that the user has already received a copy of these 333 | materials or that you have already sent this user a copy. 334 | 335 | For an executable, the required form of the "work that uses the 336 | Library" must include any data and utility programs needed for 337 | reproducing the executable from it. However, as a special exception, 338 | the materials to be distributed need not include anything that is 339 | normally distributed (in either source or binary form) with the major 340 | components (compiler, kernel, and so on) of the operating system on 341 | which the executable runs, unless that component itself accompanies 342 | the executable. 343 | 344 | It may happen that this requirement contradicts the license 345 | restrictions of other proprietary libraries that do not normally 346 | accompany the operating system. Such a contradiction means you cannot 347 | use both them and the Library together in an executable that you 348 | distribute. 349 | 350 | **7.** You may place library facilities that are a work based on the 351 | Library side-by-side in a single library together with other library 352 | facilities not covered by this License, and distribute such a combined 353 | library, provided that the separate distribution of the work based on 354 | the Library and of the other library facilities is otherwise 355 | permitted, and provided that you do these two things: 356 | 357 | - **a)** Accompany the combined library with a copy of the same work 358 | based on the Library, uncombined with any other 359 | library facilities. This must be distributed under the terms of 360 | the Sections above. 361 | - **b)** Give prominent notice with the combined library of the fact 362 | that part of it is a work based on the Library, and explaining 363 | where to find the accompanying uncombined form of the same work. 364 | 365 | **8.** You may not copy, modify, sublicense, link with, or distribute 366 | the Library except as expressly provided under this License. Any 367 | attempt otherwise to copy, modify, sublicense, link with, or 368 | distribute the Library is void, and will automatically terminate your 369 | rights under this License. However, parties who have received copies, 370 | or rights, from you under this License will not have their licenses 371 | terminated so long as such parties remain in full compliance. 372 | 373 | **9.** You are not required to accept this License, since you have not 374 | signed it. However, nothing else grants you permission to modify or 375 | distribute the Library or its derivative works. These actions are 376 | prohibited by law if you do not accept this License. Therefore, by 377 | modifying or distributing the Library (or any work based on the 378 | Library), you indicate your acceptance of this License to do so, and 379 | all its terms and conditions for copying, distributing or modifying 380 | the Library or works based on it. 381 | 382 | **10.** Each time you redistribute the Library (or any work based on 383 | the Library), the recipient automatically receives a license from the 384 | original licensor to copy, distribute, link with or modify the Library 385 | subject to these terms and conditions. You may not impose any further 386 | restrictions on the recipients' exercise of the rights granted herein. 387 | You are not responsible for enforcing compliance by third parties with 388 | this License. 389 | 390 | **11.** If, as a consequence of a court judgment or allegation of 391 | patent infringement or for any other reason (not limited to patent 392 | issues), conditions are imposed on you (whether by court order, 393 | agreement or otherwise) that contradict the conditions of this 394 | License, they do not excuse you from the conditions of this License. 395 | If you cannot distribute so as to satisfy simultaneously your 396 | obligations under this License and any other pertinent obligations, 397 | then as a consequence you may not distribute the Library at all. For 398 | example, if a patent license would not permit royalty-free 399 | redistribution of the Library by all those who receive copies directly 400 | or indirectly through you, then the only way you could satisfy both it 401 | and this License would be to refrain entirely from distribution of the 402 | Library. 403 | 404 | If any portion of this section is held invalid or unenforceable under 405 | any particular circumstance, the balance of the section is intended to 406 | apply, and the section as a whole is intended to apply in other 407 | circumstances. 408 | 409 | It is not the purpose of this section to induce you to infringe any 410 | patents or other property right claims or to contest validity of any 411 | such claims; this section has the sole purpose of protecting the 412 | integrity of the free software distribution system which is 413 | implemented by public license practices. Many people have made 414 | generous contributions to the wide range of software distributed 415 | through that system in reliance on consistent application of that 416 | system; it is up to the author/donor to decide if he or she is willing 417 | to distribute software through any other system and a licensee cannot 418 | impose that choice. 419 | 420 | This section is intended to make thoroughly clear what is believed to 421 | be a consequence of the rest of this License. 422 | 423 | **12.** If the distribution and/or use of the Library is restricted in 424 | certain countries either by patents or by copyrighted interfaces, the 425 | original copyright holder who places the Library under this License 426 | may add an explicit geographical distribution limitation excluding 427 | those countries, so that distribution is permitted only in or among 428 | countries not thus excluded. In such case, this License incorporates 429 | the limitation as if written in the body of this License. 430 | 431 | **13.** The Free Software Foundation may publish revised and/or new 432 | versions of the Lesser General Public License from time to time. Such 433 | new versions will be similar in spirit to the present version, but may 434 | differ in detail to address new problems or concerns. 435 | 436 | Each version is given a distinguishing version number. If the Library 437 | specifies a version number of this License which applies to it and 438 | "any later version", you have the option of following the terms and 439 | conditions either of that version or of any later version published by 440 | the Free Software Foundation. If the Library does not specify a 441 | license version number, you may choose any version ever published by 442 | the Free Software Foundation. 443 | 444 | **14.** If you wish to incorporate parts of the Library into other 445 | free programs whose distribution conditions are incompatible with 446 | these, write to the author to ask for permission. For software which 447 | is copyrighted by the Free Software Foundation, write to the Free 448 | Software Foundation; we sometimes make exceptions for this. Our 449 | decision will be guided by the two goals of preserving the free status 450 | of all derivatives of our free software and of promoting the sharing 451 | and reuse of software generally. 452 | 453 | **NO WARRANTY** 454 | 455 | **15.** BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 456 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 457 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 458 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 459 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 460 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 461 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 462 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 463 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 464 | 465 | **16.** IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 466 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 467 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 468 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 469 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 470 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 471 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 472 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 473 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 474 | DAMAGES. 475 | 476 | ### END OF TERMS AND CONDITIONS 477 | 478 | ### How to Apply These Terms to Your New Libraries 479 | 480 | If you develop a new library, and you want it to be of the greatest 481 | possible use to the public, we recommend making it free software that 482 | everyone can redistribute and change. You can do so by permitting 483 | redistribution under these terms (or, alternatively, under the terms 484 | of the ordinary General Public License). 485 | 486 | To apply these terms, attach the following notices to the library. It 487 | is safest to attach them to the start of each source file to most 488 | effectively convey the exclusion of warranty; and each file should 489 | have at least the "copyright" line and a pointer to where the full 490 | notice is found. 491 | 492 | one line to give the library's name and an idea of what it does. 493 | Copyright (C) year name of author 494 | 495 | This library is free software; you can redistribute it and/or 496 | modify it under the terms of the GNU Lesser General Public 497 | License as published by the Free Software Foundation; either 498 | version 2.1 of the License, or (at your option) any later version. 499 | 500 | This library is distributed in the hope that it will be useful, 501 | but WITHOUT ANY WARRANTY; without even the implied warranty of 502 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 503 | Lesser General Public License for more details. 504 | 505 | You should have received a copy of the GNU Lesser General Public 506 | License along with this library; if not, write to the Free Software 507 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 508 | 509 | Also add information on how to contact you by electronic and paper 510 | mail. 511 | 512 | You should also get your employer (if you work as a programmer) or 513 | your school, if any, to sign a "copyright disclaimer" for the library, 514 | if necessary. Here is a sample; alter the names: 515 | 516 | Yoyodyne, Inc., hereby disclaims all copyright interest in 517 | the library `Frob' (a library for tweaking knobs) written 518 | by James Random Hacker. 519 | 520 | signature of Ty Coon, 1 April 1990 521 | Ty Coon, President of Vice 522 | 523 | That's all there is to it! 524 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean doc 2 | 3 | all: 4 | dune build @install 5 | 6 | clean: 7 | dune clean 8 | 9 | doc: 10 | dune build @doc 11 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | ## What is RES? 4 | 5 | This OCaml-library consists of a set of modules which implement automatically 6 | resizing (= reallocating) data structures that consume a contiguous part 7 | of memory. This allows appending and removing of elements to/from arrays 8 | (both boxed and unboxed), strings (buffers), bit strings and weak arrays 9 | while still maintaining fast constant-time access to elements. 10 | 11 | There are also functors that allow the generation of similar modules which 12 | use different reallocation strategies. 13 | 14 | ## Features 15 | 16 | - Fast constant-time access to indexed elements (e.g. in arrays and 17 | strings) is often a prerequisite for short execution times of programs. 18 | 19 | Still, operations like adding and/or removing elements to/from the 20 | end of such data structures are often needed. Unfortunately, having 21 | both properties at the same time sometimes requires reallocating this 22 | contiguous part of memory. 23 | 24 | This module does not eliminate this problem, but hides the process of 25 | reallocation from the user, i.e. it happens automatically. 26 | 27 | Thus, the user is liberated from this bug-attracting (e.g. index errors) 28 | task. 29 | 30 | - This library allows the user to parameterize allocation strategies at 31 | runtime. This is an important feature, because it is impossible for 32 | any allocation algorithm to perform optimally without having knowledge 33 | about the user program. 34 | 35 | For example, the programmer might know that a consecutive series of 36 | operations will alternately add and remove large batches of elements. 37 | In such a case it would be wise to keep a high reserve of available slots 38 | in the data structure, because otherwise it will resize very often during 39 | this procedure which requires a significant amount of time. 40 | 41 | By raising a corresponding threshold in appropriate places at runtime, 42 | programmers can fine-tune the behavior of e.g. their buffers for optimal 43 | performance and set this parameter back later to save memory. 44 | 45 | - Because optimal reallocation strategies may be quite complex, 46 | it was also a design goal to have users supply their own ones (if 47 | required). 48 | 49 | By using functors users can parameterize these data structures with 50 | their own reallocation strategies, giving them even more control over 51 | how and when reallocations are triggered. 52 | 53 | - Users may want to add support for additional low-level implementations 54 | that require reallocations. In this case, too, it is fairly easy to 55 | create new modules by using functors. 56 | 57 | - The library implements a large interface of functions, all of which 58 | are completely independent of the reallocation strategy and the low-level 59 | implementation. 60 | 61 | All the interfaces of the corresponding low-level implementations of 62 | data structures (e.g. array, string) are fully supported and have been 63 | extended with further functionality. There is even a new buffer module 64 | which can be used in every context of the standard one. 65 | 66 | - OCaml makes a distinction between unboxed and boxed arrays. If the type 67 | of an array is `float`, the representation will be unboxed in cases in 68 | which the array is not used in a polymorphic context (native code only). 69 | 70 | To benefit from these much faster representations there are specialized 71 | versions of automatically resizing arrays in the distribution. 72 | 73 | ## Usage 74 | 75 | The API is fully documented and can be built as HTML using `make doc`. 76 | It is also available [online](http://mmottl.github.io/res/api/res). 77 | 78 | The preparameterized modules (default strategy) and the functors for mapping 79 | strategy-implementations to this kind of modules are contained and documented 80 | in file `lib/res.mli`. 81 | 82 | For examples of how to use the functors to implement new strategies and/or 83 | low-level representations, take a look at the implementation in `lib/res.ml`. 84 | 85 | Their function interface, however, is documented in files `lib/pres_intf.ml` 86 | (for parameterized "low-level" types like e.g. normal arrays) and in 87 | `lib/nopres_intf.ml` (for non-parameterized "low-level" types like e.g. float 88 | arrays, strings (buffers), etc.). 89 | 90 | ## Convenience 91 | 92 | It should be noted that it is possible to use the standard notation for 93 | accessing elements (e.g. `ar.(42)`) with resizable arrays (and even with 94 | `Buffer`, `Bits`, etc...). This requires a short explanation of how OCaml 95 | treats such syntactic sugar: 96 | 97 | All that OCaml does is that it replaces such syntax with an appropriate 98 | `Array.get` or `Array.set`. This may be _any_ module that happens to be 99 | bound to this name in the current scope. The same principle is true for the 100 | `String`-module and the `.[]`-operator. 101 | 102 | Thus, the following works: 103 | 104 | ```ocaml 105 | module Array = Res.Bits 106 | module String = Res.Buffer 107 | 108 | let () = 109 | let ar = Array.empty () in 110 | Array.add_one ar true; 111 | print_endline (string_of_bool ar.(0)); 112 | let str = String.empty () in 113 | String.add_one str 'x'; 114 | print_char str.[0]; 115 | print_newline () 116 | ``` 117 | 118 | Do not forget that it is even possible to bind modules locally. Example: 119 | 120 | ```ocaml 121 | let () = 122 | let module Array = Res.Array in 123 | Printf.printf "%d\n" (Array.init 10 (fun x -> x * x)).(7) 124 | ``` 125 | 126 | If you want to change one of your files to make use of resizable arrays 127 | instead of standard ones without much trouble, please read the following: 128 | 129 | You may want to "save" the standard `Array`-module and its type for later 130 | access: 131 | 132 | ```ocaml 133 | module StdArray = Array 134 | type 'a std_array = 'a array 135 | ``` 136 | 137 | Make the resizable implementation (includes the index operators!) available: 138 | 139 | ```ocaml 140 | open Res 141 | ``` 142 | 143 | Or more explicitly: 144 | 145 | ```ocaml 146 | module Array = Res.Array 147 | ``` 148 | 149 | Or if you want to use a specific `Array`-implementation: 150 | 151 | ```ocaml 152 | module Array = Res.Bits 153 | ``` 154 | 155 | Then set the type: 156 | 157 | ```ocaml 158 | type 'a array = 'a Array.t 159 | ``` 160 | 161 | If you create standard arrays with the built-in syntax, change lines like: 162 | 163 | ```ocaml 164 | let ar = [| 1; 2; 3; 4 |] in 165 | ``` 166 | 167 | to: 168 | 169 | ```ocaml 170 | let ar = Array.of_array [| 1; 2; 3; 4 |] in 171 | ``` 172 | 173 | This should allow all of your sources to compile out-of-the-box with the 174 | additional functionality. In places where you still need the standard 175 | implementation you should have no problems to use the rebound module 176 | and type to do so. 177 | 178 | This trick works similarly for the old and the new Buffer-module. You might 179 | also want to replace the `String`-module in this fashion. The latter one, 180 | however, supports a number of functions like e.g. `escape`, which are not 181 | available then. 182 | 183 | ## Contact Information and Contributing 184 | 185 | Please submit bugs reports, feature requests, contributions and similar to 186 | the [GitHub issue tracker](https://github.com/mmottl/res/issues). 187 | 188 | Up-to-date information is available at: 189 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | # TODO 2 | 3 | - Extend the functionality of bit-vectors with efficient functions for e.g. 4 | `land`, `lor`, etc... 5 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -w -9 -principal)) 5 | (c_flags 6 | (:standard -Wall -pedantic -Wextra -Wunused))) 7 | (release 8 | (ocamlopt_flags 9 | (:standard -O3)))) 10 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | 3 | (name res) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github mmottl/res)) 9 | 10 | (license "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception") 11 | 12 | (homepage "https://mmottl.github.io/res") 13 | 14 | (documentation "https://mmottl.github.io/res/api") 15 | 16 | (maintainers "Markus Mottl ") 17 | 18 | (authors "Markus Mottl ") 19 | 20 | (package 21 | (name res) 22 | (synopsis "RES - Library for resizable, contiguous datastructures") 23 | (description 24 | "RES is a library containing resizable arrays, strings, and bitvectors.") 25 | (depends 26 | (ocaml 27 | (>= 4.08)))) 28 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | TARGETS = $(addsuffix .bc, buffer_ex defstrat stupid_ga weak_ex) 2 | 3 | .PHONY: all clean 4 | 5 | all: 6 | @dune build $(TARGETS) 7 | 8 | clean: 9 | @dune clean 10 | -------------------------------------------------------------------------------- /examples/buffer_ex.ml: -------------------------------------------------------------------------------- 1 | (* Reads a file given as first argument into a buffer and prints it out again. 2 | Uses an exponentially growing read-ahead during reading (just for 3 | demonstration). *) 4 | 5 | let _ = 6 | let buf = Res.Buffer.empty () and file = open_in Sys.argv.(1) in 7 | Res.Buffer.add_full_channel_f buf file 50000 (( * ) 2); 8 | Res.Buffer.output_buffer stdout buf 9 | -------------------------------------------------------------------------------- /examples/defstrat.ml: -------------------------------------------------------------------------------- 1 | (* Demonstration of the default reallocation strategy in action *) 2 | 3 | open Res.Array 4 | 5 | let info v r = Printf.printf "virtual length: %3d real length: %3d\n" v r 6 | 7 | let _ = 8 | let ar = empty () in 9 | for _i = 1 to 100 do 10 | info (length ar) (real_length ar); 11 | add_one ar 42 12 | done; 13 | for _i = 1 to 20 do 14 | info (length ar) (real_length ar); 15 | remove_n ar 5 16 | done; 17 | info (length ar) (real_length ar) 18 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names buffer_ex defstrat stupid_ga weak_ex) 3 | (libraries res) 4 | (modes byte exe)) 5 | -------------------------------------------------------------------------------- /examples/stupid_ga.ml: -------------------------------------------------------------------------------- 1 | (* You want to write a GA in less than 100 lines using bit-vectors? Here you 2 | go... (brain-dead implementation) *) 3 | 4 | module type GA_SPEC = sig 5 | val ngenes : int (* Number of genes *) 6 | val mut_prob : int (* Mutation probability in % *) 7 | val recomb_prob : int (* Recombination probability *) 8 | val evaluate_indiv : Res.Bits.t -> float (* Evaluate Individual *) 9 | end 10 | 11 | module Ga (Spec : GA_SPEC) = struct 12 | open Spec 13 | module Genes = Res.Bits 14 | 15 | type genes = Genes.t 16 | type indiv = { mutable genes : genes; mutable fitness : float option } 17 | type population = indiv array 18 | 19 | let random_bit () = Random.int 2 > 0 20 | 21 | let create_indiv () = 22 | { genes = Genes.init ngenes (fun _ -> random_bit ()); fitness = None } 23 | 24 | let print_indiv ch indiv = 25 | let print_genes ch = 26 | Genes.iter (fun g -> output_char ch (if g then '1' else '0')) 27 | and fitness = 28 | match indiv.fitness with None -> "N/A" | Some f -> string_of_float f 29 | in 30 | Printf.fprintf ch "%a -> (%s)" print_genes indiv.genes fitness 31 | 32 | let mutate_indiv indiv = 33 | let mutate_gene i _gene = 34 | if Random.int 100 < mut_prob then 35 | Genes.set indiv.genes i 36 | (if Genes.get indiv.genes i then false else true) 37 | in 38 | Genes.iteri mutate_gene indiv.genes; 39 | indiv.fitness <- None 40 | 41 | let evaluate_indiv indiv = 42 | match indiv.fitness with 43 | | Some x -> x 44 | | None -> 45 | let x = Spec.evaluate_indiv indiv.genes in 46 | indiv.fitness <- Some x; 47 | x 48 | 49 | let create_pop size = Array.init size (fun _ -> create_indiv ()) 50 | let mutate_pop = Array.iter mutate_indiv 51 | 52 | let recombine_indiv i1 i2 c = 53 | Genes.blit i2.genes c i1.genes c (ngenes - c); 54 | i1.fitness <- None 55 | 56 | let evaluate_pop pop = 57 | Array.fold_left 58 | (fun acc indiv -> 59 | if evaluate_indiv indiv < evaluate_indiv acc then indiv else acc) 60 | pop.(0) pop 61 | 62 | let recombine_pop p = 63 | let len = Array.length p in 64 | let recombine i indiv = 65 | if i + 1 < len && Random.int 100 < recomb_prob then 66 | let mate = i + Random.int (len - i - 1) + 1 in 67 | recombine_indiv indiv p.(mate) (Random.int ngenes) 68 | in 69 | Array.iteri recombine p 70 | 71 | let select_pop p = 72 | let compare a b = 73 | match (a.fitness, b.fitness) with 74 | | Some af, Some bf -> compare bf af 75 | | _ -> failwith "select_pop: unevaluated individual!" 76 | in 77 | Array.sort compare p; 78 | for i = 0 to Array.length p / 2 do 79 | p.(i) <- create_indiv () 80 | done 81 | end 82 | 83 | module MyGA_Spec = struct 84 | let ngenes = 20 85 | let mut_prob = 3 86 | let recomb_prob = 70 87 | 88 | (* Tries to evolve binary representation of 42 - cool! *) 89 | let evaluate_indiv genes = 90 | let sum = ref 0 in 91 | Res.Bits.iter (fun g -> sum := (!sum lsl 1) + if g then 1 else 0) genes; 92 | let res = float !sum -. float 42 in 93 | res *. res 94 | end 95 | 96 | module MyGA = Ga (MyGA_Spec) 97 | open MyGA 98 | 99 | let _ = 100 | Random.self_init (); 101 | let p = create_pop 100 in 102 | let best = ref p.(0) in 103 | while 104 | best := evaluate_pop p; 105 | !best.fitness <> Some 0.0 106 | do 107 | Printf.printf "best so far: %a\n" print_indiv !best; 108 | flush stdout; 109 | select_pop p; 110 | recombine_pop p; 111 | mutate_pop p 112 | done; 113 | Printf.printf "The winner is: %a\n" print_indiv !best 114 | -------------------------------------------------------------------------------- /examples/weak_ex.ml: -------------------------------------------------------------------------------- 1 | (* Demonstrates the correct behaviour of resizable weak arrays. *) 2 | 3 | module W = Res.Weak 4 | module Array = W (* allows more convenient array access *) 5 | 6 | class foo = object end 7 | 8 | let ra = W.empty () 9 | 10 | let _ = 11 | W.add_one ra (Some (new foo)); 12 | match ra.(0) with 13 | | Some _ -> print_endline "Correctly allocated!" 14 | | _ -> print_endline "Already deallocated??" 15 | 16 | let _ = 17 | Gc.full_major (); 18 | match ra.(0) with 19 | | Some _ -> print_endline "Still not deallocated?" 20 | | _ -> print_endline "Correctly deallocated!" 21 | -------------------------------------------------------------------------------- /lib/Makefile: -------------------------------------------------------------------------------- 1 | TARGETS = res.cma 2 | 3 | .PHONY: all clean 4 | 5 | all: 6 | @dune build $(TARGETS) 7 | 8 | clean: 9 | @dune clean 10 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name res)) 3 | -------------------------------------------------------------------------------- /lib/nopres_impl.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | module type Implementation = sig 20 | type el 21 | type t 22 | 23 | val name : string 24 | val length : t -> int 25 | val create : int -> t 26 | val make : int -> el -> t 27 | val unsafe_get : t -> int -> el 28 | val unsafe_set : t -> int -> el -> unit 29 | val unsafe_blit : t -> int -> t -> int -> int -> unit 30 | end 31 | 32 | module Make (S : Strat.T) (Impl : Implementation) = struct 33 | module Strategy = S 34 | 35 | type strategy = Strategy.t 36 | type el = Impl.el 37 | 38 | type t = { 39 | mutable ar : Impl.t; 40 | mutable vlix : int; 41 | mutable strategy : strategy; 42 | } 43 | 44 | let name = Impl.name 45 | let invalid_arg str = invalid_arg (name ^ "." ^ str) 46 | let failwith str = failwith (name ^ "." ^ str) 47 | let length ra = ra.vlix + 1 48 | let lix ra = ra.vlix 49 | let real_length ra = Impl.length ra.ar 50 | let real_lix ra = real_length ra - 1 51 | let unsafe_get ra ix = Impl.unsafe_get ra.ar ix 52 | let unsafe_set ra ix el = Impl.unsafe_set ra.ar ix el 53 | 54 | let get ra n = 55 | if n > ra.vlix || n < 0 then invalid_arg "get" else unsafe_get ra n 56 | 57 | let set ra n el = 58 | if n > ra.vlix || n < 0 then invalid_arg "set" else unsafe_set ra n el 59 | 60 | let creator = Impl.create 61 | let empty_ar = Impl.create 0 62 | 63 | let screate strategy n = 64 | let res = { ar = empty_ar; vlix = n - 1; strategy } in 65 | res.ar <- creator (Strategy.grow strategy n); 66 | res 67 | 68 | let smake strategy n x = 69 | let res = { ar = empty_ar; vlix = n - 1; strategy } in 70 | res.ar <- Impl.make (Strategy.grow strategy n) x; 71 | res 72 | 73 | let create_fresh n = screate Strategy.default n 74 | 75 | let create_from ra = 76 | { ar = creator (length ra); vlix = ra.vlix; strategy = ra.strategy } 77 | 78 | let sempty strategy = 79 | let res = { ar = empty_ar; vlix = -1; strategy } in 80 | res.ar <- creator (Strategy.grow strategy 0); 81 | res 82 | 83 | let empty () = sempty Strategy.default 84 | let create = screate Strategy.default 85 | let make = smake Strategy.default 86 | 87 | let sinit strategy n f = 88 | let res = smake strategy n (f 0) in 89 | let ar = res.ar in 90 | for i = 1 to n - 1 do 91 | Impl.unsafe_set ar i (f i) 92 | done; 93 | res 94 | 95 | let init n f = sinit Strategy.default n f 96 | let get_strategy ra = ra.strategy 97 | 98 | let resizer some_lix ra len = 99 | let new_ar = creator len in 100 | for i = 0 to some_lix do 101 | Impl.unsafe_set new_ar i (Impl.unsafe_get ra.ar i) 102 | done; 103 | ra.ar <- new_ar 104 | 105 | let enforce_strategy ra = 106 | let real_len = real_length ra in 107 | let new_len = length ra in 108 | let new_real_len = Strategy.shrink ra.strategy ~real_len ~new_len in 109 | if new_real_len <> -1 then resizer ra.vlix ra new_real_len 110 | 111 | let set_strategy ra strategy = 112 | ra.strategy <- strategy; 113 | enforce_strategy ra 114 | 115 | let put_strategy ra strategy = ra.strategy <- strategy 116 | let unsafe_blit_on_other ra1 ofs1 ra2 = Impl.unsafe_blit ra1.ar ofs1 ra2.ar 117 | 118 | let copy ra = 119 | let len = length ra in 120 | let ar = Impl.create len in 121 | Impl.unsafe_blit ra.ar 0 ar 0 len; 122 | { ra with ar } 123 | 124 | let append ra1 ra2 = 125 | match (ra1.vlix, ra2.vlix) with 126 | | -1, -1 -> empty () 127 | | _, -1 -> copy ra1 128 | | -1, _ -> copy ra2 129 | | _ -> 130 | let len1 = length ra1 in 131 | let len2 = length ra2 in 132 | let res = create_fresh (len1 + len2) in 133 | unsafe_blit_on_other ra1 0 res 0 len1; 134 | unsafe_blit_on_other ra2 0 res len1 len2; 135 | res 136 | 137 | let rec concat_aux res offset = function 138 | | [] -> res 139 | | h :: t -> 140 | if h.vlix < 0 then concat_aux res offset t 141 | else 142 | let len = length h in 143 | unsafe_blit_on_other h 0 res offset len; 144 | concat_aux res (offset + len) t 145 | 146 | let concat l = 147 | let len = List.fold_left (fun a el -> a + length el) 0 l in 148 | if len = 0 then empty () else concat_aux (create_fresh len) 0 l 149 | 150 | let unsafe_sub ra ofs len = 151 | let res = create_fresh len in 152 | unsafe_blit_on_other ra ofs res 0 len; 153 | res 154 | 155 | let sub ra ofs len = 156 | if ofs < 0 || len < 0 || ofs + len > length ra then invalid_arg "sub" 157 | else unsafe_sub ra ofs len 158 | 159 | let guarantee_ix ra ix = 160 | if real_lix ra < ix then 161 | resizer ra.vlix ra (Strategy.grow ra.strategy (ix + 1)) 162 | 163 | let maybe_grow_ix ra new_lix = 164 | guarantee_ix ra new_lix; 165 | ra.vlix <- new_lix 166 | 167 | let add_one ra x = 168 | let n = length ra in 169 | maybe_grow_ix ra n; 170 | unsafe_set ra n x 171 | 172 | let unsafe_remove_one ra = 173 | ra.vlix <- ra.vlix - 1; 174 | enforce_strategy ra 175 | 176 | let remove_one ra = 177 | if ra.vlix < 0 then failwith "remove_one" else unsafe_remove_one ra 178 | 179 | let unsafe_remove_n ra n = 180 | ra.vlix <- ra.vlix - n; 181 | enforce_strategy ra 182 | 183 | let remove_n ra n = 184 | if n > length ra || n < 0 then invalid_arg "remove_n" 185 | else unsafe_remove_n ra n 186 | 187 | let unsafe_remove_range ra ofs len = 188 | let ofs_len = ofs + len in 189 | unsafe_blit_on_other ra ofs_len ra ofs (length ra - ofs_len); 190 | unsafe_remove_n ra len 191 | 192 | let remove_range ra ofs len = 193 | if ofs < 0 || len < 0 || ofs + len > length ra then 194 | invalid_arg "remove_range" 195 | else unsafe_remove_range ra ofs len 196 | 197 | let clear ra = 198 | ra.vlix <- -1; 199 | enforce_strategy ra 200 | 201 | let unsafe_swap ra n m = 202 | let tmp = Impl.unsafe_get ra.ar n in 203 | Impl.unsafe_set ra.ar n (Impl.unsafe_get ra.ar m); 204 | Impl.unsafe_set ra.ar m tmp 205 | 206 | let swap ra n m = 207 | if n > ra.vlix || m > ra.vlix || n < 0 || m < 0 then invalid_arg "swap" 208 | else unsafe_swap ra n m 209 | 210 | let unsafe_swap_in_last ra n = 211 | Impl.unsafe_set ra.ar n (Impl.unsafe_get ra.ar ra.vlix); 212 | unsafe_remove_one ra 213 | 214 | let swap_in_last ra n = 215 | if n > ra.vlix || n < 0 then invalid_arg "swap_in_last" 216 | else unsafe_swap_in_last ra n 217 | 218 | let unsafe_fill ra ofs len x = 219 | let last = ofs + len - 1 in 220 | maybe_grow_ix ra (max last ra.vlix); 221 | for i = ofs to last do 222 | Impl.unsafe_set ra.ar i x 223 | done 224 | 225 | let fill ra ofs len x = 226 | if ofs < 0 || len < 0 || ofs > length ra then invalid_arg "fill" 227 | else unsafe_fill ra ofs len x 228 | 229 | let unsafe_blit ra1 ofs1 ra2 ofs2 len = 230 | guarantee_ix ra2 (ofs2 + len - 1); 231 | unsafe_blit_on_other ra1 ofs1 ra2 ofs2 len 232 | 233 | let blit ra1 ofs1 ra2 ofs2 len = 234 | if 235 | len < 0 || ofs1 < 0 || ofs2 < 0 236 | || ofs1 + len > length ra1 237 | || ofs2 > length ra2 238 | then invalid_arg "blit" 239 | else unsafe_blit ra1 ofs1 ra2 ofs2 len 240 | 241 | let rec to_list_aux ar i accu = 242 | if i < 0 then accu else to_list_aux ar (i - 1) (Impl.unsafe_get ar i :: accu) 243 | 244 | let to_list ra = to_list_aux ra.ar ra.vlix [] 245 | 246 | let rec of_list_aux ar i = function 247 | | [] -> () 248 | | h :: t -> 249 | Impl.unsafe_set ar i h; 250 | of_list_aux ar (i + 1) t 251 | 252 | let of_list l = 253 | let ra = create_fresh (List.length l) in 254 | of_list_aux ra.ar 0 l; 255 | ra 256 | 257 | let sof_list strategy l = 258 | let ra = screate strategy (List.length l) in 259 | of_list_aux ra.ar 0 l; 260 | ra 261 | 262 | let to_array ({ ar } as ra) = 263 | Array.init (length ra) (fun i -> Impl.unsafe_get ar i) 264 | 265 | let sof_array strategy ar = 266 | sinit strategy (Array.length ar) (fun i -> Array.unsafe_get ar i) 267 | 268 | let of_array ar = sof_array Strategy.default ar 269 | 270 | let iter f ({ ar } as ra) = 271 | for i = 0 to ra.vlix do 272 | f (Impl.unsafe_get ar i) 273 | done 274 | 275 | let map f ({ ar } as ra) = 276 | let res = create_from ra in 277 | let res_ar = res.ar in 278 | for i = 0 to res.vlix do 279 | Impl.unsafe_set res_ar i (f (Impl.unsafe_get ar i)) 280 | done; 281 | res 282 | 283 | let iteri f ({ ar } as ra) = 284 | for i = 0 to ra.vlix do 285 | f i (Impl.unsafe_get ar i) 286 | done 287 | 288 | let mapi f ({ ar } as ra) = 289 | let ({ ar = res_ar } as res) = create_from ra in 290 | for i = 0 to res.vlix do 291 | Impl.unsafe_set res_ar i (f i (Impl.unsafe_get ar i)) 292 | done; 293 | res 294 | 295 | let fold_left f accu ({ ar } as ra) = 296 | let res = ref accu in 297 | for i = 0 to ra.vlix do 298 | res := f !res (Impl.unsafe_get ar i) 299 | done; 300 | !res 301 | 302 | let fold_right f ra accu = 303 | let res = ref accu in 304 | for i = ra.vlix downto 0 do 305 | res := f (Impl.unsafe_get ra.ar i) !res 306 | done; 307 | !res 308 | 309 | let rec for_all_aux i p ra = 310 | i > ra.vlix || (p (unsafe_get ra i) && for_all_aux (i + 1) p ra) 311 | 312 | let for_all p ra = for_all_aux 0 p ra 313 | 314 | let rec exists_aux i p ra = 315 | i <= ra.vlix && (p (unsafe_get ra i) || exists_aux (i + 1) p ra) 316 | 317 | let exists p ra = exists_aux 0 p ra 318 | 319 | let rec mem_aux i x ra = 320 | i <= ra.vlix && (unsafe_get ra i = x || mem_aux (i + 1) x ra) 321 | 322 | let mem x ra = mem_aux 0 x ra 323 | 324 | let rec memq_aux i x ra = 325 | i <= ra.vlix && (unsafe_get ra i == x || memq_aux (i + 1) x ra) 326 | 327 | let memq x ra = memq_aux 0 x ra 328 | 329 | let rec pos_aux i x ra = 330 | if i > ra.vlix then None 331 | else if unsafe_get ra i = x then Some i 332 | else pos_aux (i + 1) x ra 333 | 334 | let pos x ra = pos_aux 0 x ra 335 | 336 | let rec posq_aux i x ra = 337 | if i > ra.vlix then None 338 | else if unsafe_get ra i == x then Some i 339 | else posq_aux (i + 1) x ra 340 | 341 | let posq x ra = posq_aux 0 x ra 342 | 343 | let rec find_aux i p ra = 344 | if i > ra.vlix then raise Not_found 345 | else 346 | let el = unsafe_get ra i in 347 | if p el then el else find_aux (i + 1) p ra 348 | 349 | let find p ra = find_aux 0 p ra 350 | 351 | let rec find_index_aux p ra i = 352 | if i > ra.vlix then raise Not_found 353 | else if p (unsafe_get ra i) then i 354 | else find_index_aux p ra (i + 1) 355 | 356 | let find_index p ra i = 357 | if i < 0 then invalid_arg "find_index" else find_index_aux p ra i 358 | 359 | let filter p ({ ar } as ra) = 360 | let res = sempty ra.strategy in 361 | for i = 0 to ra.vlix do 362 | let el = Impl.unsafe_get ar i in 363 | if p el then add_one res el 364 | done; 365 | res 366 | 367 | let find_all = filter 368 | 369 | let filter_in_place p ({ ar } as ra) = 370 | let dest = ref 0 in 371 | let pos = ref 0 in 372 | while !pos <= ra.vlix do 373 | let el = Impl.unsafe_get ar !pos in 374 | if p el then ( 375 | Impl.unsafe_set ar !dest el; 376 | incr dest); 377 | incr pos 378 | done; 379 | unsafe_remove_n ra (!pos - !dest) 380 | 381 | let partition p ra = 382 | let ((res1, res2) as res) = (sempty ra.strategy, sempty ra.strategy) in 383 | for i = 0 to ra.vlix do 384 | let el = unsafe_get ra i in 385 | if p el then add_one res1 el else add_one res2 el 386 | done; 387 | res 388 | end 389 | -------------------------------------------------------------------------------- /lib/nopres_intf.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | (** Interfaces to unparameterized resizable arrays and buffers *) 20 | 21 | (** Interface to unparameterized resizable arrays *) 22 | module type T = sig 23 | (** {5 Signatures and types} *) 24 | 25 | module Strategy : Strat.T 26 | (** Module implementing the reallocation strategy *) 27 | 28 | type strategy = Strategy.t 29 | (** Type of reallocation strategy *) 30 | 31 | type t 32 | (** Type of resizable arrays *) 33 | 34 | type el 35 | (** Type of the elements in the resizable array *) 36 | 37 | (** {5 Index and length information} *) 38 | 39 | val length : t -> int 40 | (** [length ra] 41 | 42 | @return 43 | (virtual) length of resizable array [ra] excluding the reserved space. 44 | *) 45 | 46 | val lix : t -> int 47 | (** [lix ra] 48 | 49 | @return 50 | (virtual) last index of resizable array [ra] excluding the reserved 51 | space. *) 52 | 53 | val real_length : t -> int 54 | (** [real_length ra] 55 | 56 | @return 57 | (real) length of resizable array [ra] including the reserved space. *) 58 | 59 | val real_lix : t -> int 60 | (** [real_lix ra] 61 | 62 | @return 63 | (real) last index of resizable array [ra] including the reserved space. 64 | *) 65 | 66 | (** {5 Getting and setting} *) 67 | 68 | val get : t -> int -> el 69 | (** [get ra n] 70 | 71 | @return the [n]th element of [ra]. 72 | @raise Invalid_argument if index out of bounds. *) 73 | 74 | val set : t -> int -> el -> unit 75 | (** [set ra n] sets the [n]th element of [ra]. 76 | 77 | @raise Invalid_argument if index out of bounds. *) 78 | 79 | (** {5 Creation of resizable arrays} *) 80 | 81 | val sempty : strategy -> t 82 | (** [sempty s] 83 | 84 | @return an empty resizable array using strategy [s]. *) 85 | 86 | val empty : unit -> t 87 | (** [empty ()] same as [sempty] but uses default strategy. *) 88 | 89 | val screate : strategy -> int -> t 90 | (** [screate s n] 91 | 92 | @return 93 | a resizable array with strategy [s] containing [n] arbitrary elements. 94 | 95 | {e Attention: the contents is {b not} specified!} *) 96 | 97 | val create : int -> t 98 | (** [create n] same as [screate] but uses default strategy. *) 99 | 100 | val smake : strategy -> int -> el -> t 101 | (** [smake s n el] 102 | 103 | @return 104 | a resizable array of length [n] containing element [el] only using 105 | strategy [s]. *) 106 | 107 | val make : int -> el -> t 108 | (** [make n el] same as [smake] but uses default strategy. *) 109 | 110 | val sinit : strategy -> int -> (int -> el) -> t 111 | (** [sinit s n f] 112 | 113 | @return 114 | an array of length [n] containing elements that were created by applying 115 | function [f] to the index, using strategy [s]. *) 116 | 117 | val init : int -> (int -> el) -> t 118 | (** [init n f] sames as [sinit] but uses default strategy. *) 119 | 120 | (** {5 Strategy handling} *) 121 | 122 | val get_strategy : t -> strategy 123 | (** [get_strategy ra] 124 | 125 | @return the reallocation strategy used by resizable array [ra]. *) 126 | 127 | val set_strategy : t -> strategy -> unit 128 | (** [set_strategy ra s] sets the reallocation strategy of resizable array [ra] 129 | to [s], possibly causing an immediate reallocation. *) 130 | 131 | val put_strategy : t -> strategy -> unit 132 | (** [put_strategy ra s] sets the reallocation strategy of resizable array [ra] 133 | to [s]. Reallocation is only done at later changes in size. *) 134 | 135 | val enforce_strategy : t -> unit 136 | (** [enforce_strategy ra] forces a reallocation if necessary (e.g. after a 137 | [put_strategy]). *) 138 | 139 | (** {5 Copying, blitting and range extraction} *) 140 | 141 | val copy : t -> t 142 | (** [copy ra] 143 | 144 | @return 145 | a copy of resizable array [ra]. The two arrays share the same strategy! 146 | *) 147 | 148 | val sub : t -> int -> int -> t 149 | (** [sub ra ofs len] 150 | 151 | @return 152 | a resizable subarray of length [len] from resizable array [ra] starting 153 | at offset [ofs] using the default strategy. 154 | 155 | @raise Invalid_argument if parameters do not denote a correct subarray. *) 156 | 157 | val fill : t -> int -> int -> el -> unit 158 | (** [fill ra ofs len el] fills resizable array [ra] from offset [ofs] with 159 | [len] elements [el], possibly adding elements at the end. Raises 160 | [Invalid_argument] if offset [ofs] is larger than the length of the array. 161 | *) 162 | 163 | val blit : t -> int -> t -> int -> int -> unit 164 | (** [blit ra1 ofs1 ra2 ofs2 len] blits resizable array [ra1] onto [ra2] 165 | reading [len] elements from offset [ofs1] and writing them to [ofs2], 166 | possibly adding elements at the end of ra2. Raises [Invalid_argument] if 167 | [ofs1] and [len] do not designate a valid subarray of [ra1] or if [ofs2] 168 | is larger than the length of [ra2]. *) 169 | 170 | (** {5 Combining resizable arrays} *) 171 | 172 | val append : t -> t -> t 173 | (** [append ra1 ra2] 174 | 175 | @return 176 | a new resizable array using the default strategy and copying [ra1] and 177 | [ra2] in this order onto it. *) 178 | 179 | val concat : t list -> t 180 | (** [concat l] 181 | 182 | @return 183 | a new resizable array using the default strategy and copying all 184 | resizable arrays in [l] in their respective order onto it. *) 185 | 186 | (** {5 Adding and removing elements} *) 187 | 188 | val add_one : t -> el -> unit 189 | (** [add_one ra el] adds element [el] to resizable array [ra], possibly 190 | causing a reallocation. *) 191 | 192 | val remove_one : t -> unit 193 | (** [remove_one ra] removes the last element of resizable array [ra], possibly 194 | causing a reallocation. 195 | 196 | @raise Failure if the array is empty. *) 197 | 198 | val remove_n : t -> int -> unit 199 | (** [remove_n ra n] removes the last n elements of resizable array [ra], 200 | possibly causing a reallocation. 201 | 202 | @raise Invalid_argument if there are not enough elements or [n < 0]. *) 203 | 204 | val remove_range : t -> int -> int -> unit 205 | (** [remove_range ra ofs len] removes [len] elements from resizable array [ra] 206 | starting at [ofs] and possibly causing a reallocation. 207 | 208 | @raise Invalid_argument if range is invalid. *) 209 | 210 | val clear : t -> unit 211 | (** [clear ra] removes all elements from resizable array [ra], possibly 212 | causing a reallocation. *) 213 | 214 | (** {5 Swapping} *) 215 | 216 | val swap : t -> int -> int -> unit 217 | (** [swap ra n m] swaps elements at indices [n] and [m]. 218 | 219 | @raise Invalid_argument if any index is out of range. *) 220 | 221 | val swap_in_last : t -> int -> unit 222 | (** [swap_in_last ra n] swaps the last element with the one at position [n]. 223 | 224 | @raise Invalid_argument if index [n] is out of range. *) 225 | 226 | (** {5 Array conversions} *) 227 | 228 | val to_array : t -> el array 229 | (** [to_array ra] converts a resizable array to a standard one. *) 230 | 231 | val sof_array : strategy -> el array -> t 232 | (** [sof_array s ar] converts a standard array to a resizable one, using 233 | strategy [s]. *) 234 | 235 | val of_array : el array -> t 236 | (** [of_array ar] converts a standard array to a resizable one using the 237 | default strategy. *) 238 | 239 | (** {5 List conversions} *) 240 | 241 | val to_list : t -> el list 242 | (** [to_list ra] converts resizable array [ra] to a list. *) 243 | 244 | val sof_list : strategy -> el list -> t 245 | (** [sof_list s l] creates a resizable array using strategy [s] and the 246 | elements in list [l]. *) 247 | 248 | val of_list : el list -> t 249 | (** [of_list l] creates a resizable array using the default strategy and the 250 | elements in list [l]. *) 251 | 252 | (** {5 Iterators} *) 253 | 254 | val iter : (el -> unit) -> t -> unit 255 | (** [iter f ra] applies the unit-function [f] to each element in resizable 256 | array [ra]. *) 257 | 258 | val map : (el -> el) -> t -> t 259 | (** [map f ra] 260 | 261 | @return 262 | a resizable array using the strategy of [ra] and mapping each element in 263 | [ra] to its corresponding position in the new array using function [f]. 264 | *) 265 | 266 | val iteri : (int -> el -> unit) -> t -> unit 267 | (** [iteri f ra] applies the unit-function [f] to each index and element in 268 | resizable array [ra]. *) 269 | 270 | val mapi : (int -> el -> el) -> t -> t 271 | (** [mapi f ra] 272 | 273 | @return 274 | a resizable array using the strategy of [ra] and mapping each element in 275 | [ra] to its corresponding position in the new array using function [f] 276 | and the index position. *) 277 | 278 | val fold_left : ('a -> el -> 'a) -> 'a -> t -> 'a 279 | (** [fold_left f a ra] left-folds values in resizable array [ra] using 280 | function [f] and start accumulator [a]. *) 281 | 282 | val fold_right : (el -> 'a -> 'a) -> t -> 'a -> 'a 283 | (** [fold_right f a ra] right-folds values in resizable array [ra] using 284 | function [f] and start accumulator [a]. *) 285 | 286 | (** {5 Scanning of resizable arrays} *) 287 | 288 | val for_all : (el -> bool) -> t -> bool 289 | (** [for_all p ra] 290 | 291 | @return 292 | [true] if all elements in resizable array [ra] satisfy the predicate 293 | [p], [false] otherwise. *) 294 | 295 | val exists : (el -> bool) -> t -> bool 296 | (** [exists p ra] 297 | 298 | @return 299 | [true] if at least one element in resizable array [ra] satisfies the 300 | predicate [p], [false] otherwise. *) 301 | 302 | val mem : el -> t -> bool 303 | (** [mem el ra] 304 | 305 | @return 306 | [true] if element [el] is logically equal to any element in resizable 307 | array [ra], [false] otherwise. *) 308 | 309 | val memq : el -> t -> bool 310 | (** [memq el ra] 311 | 312 | @return 313 | [true] if element [el] is physically equal to any element in resizable 314 | array [ra], [false] otherwise. *) 315 | 316 | val pos : el -> t -> int option 317 | (** [pos el ra] 318 | 319 | @return 320 | [Some index] if [el] is logically equal to the element at [index] in 321 | [ra], [None] otherwise. [index] is the index of the first element that 322 | matches. *) 323 | 324 | val posq : el -> t -> int option 325 | (** [posq el ra] 326 | 327 | @return 328 | [Some index] if [el] is physically equal to the element at [index] in 329 | [ra], [None] otherwise. [index] is the index of the first element that 330 | matches. *) 331 | 332 | (** {5 Searching of resizable arrays} *) 333 | 334 | val find : (el -> bool) -> t -> el 335 | (** [find p ra] 336 | 337 | @return 338 | the first element in resizable array [ra] that satisfies predicate [p]. 339 | 340 | @raise Not_found if there is no such element. *) 341 | 342 | val find_index : (el -> bool) -> t -> int -> int 343 | (** [find_index p ra pos] 344 | 345 | @return 346 | the index of the first element that satisfies predicate [p] in resizable 347 | array [ra], starting search at index [pos]. 348 | 349 | @raise Not_found 350 | if there is no such element or if [pos] is larger than the highest 351 | index. 352 | 353 | @raise Invalid_argument if [pos] is negative. *) 354 | 355 | val filter : (el -> bool) -> t -> t 356 | (** [filter p ra] 357 | 358 | @return 359 | a new resizable array by filtering out all elements in [ra] that satisfy 360 | predicate [p] using the same strategy as [ra]. *) 361 | 362 | val find_all : (el -> bool) -> t -> t 363 | (** [find_all p ra] is the same as [filter] *) 364 | 365 | val filter_in_place : (el -> bool) -> t -> unit 366 | (** [filter_in_place p ra] as [filter], but filters in place. *) 367 | 368 | val partition : (el -> bool) -> t -> t * t 369 | (** [partition p ra] 370 | 371 | @return 372 | a pair of resizable arrays, the left part containing only elements of 373 | [ra] that satisfy predicate [p], the right one only those that do not 374 | satisfy it. Both returned arrays are created using the strategy of [ra]. 375 | *) 376 | 377 | (** {5 {b UNSAFE STUFF - USE WITH CAUTION!}} *) 378 | 379 | val unsafe_get : t -> int -> el 380 | val unsafe_set : t -> int -> el -> unit 381 | val unsafe_sub : t -> int -> int -> t 382 | val unsafe_fill : t -> int -> int -> el -> unit 383 | val unsafe_blit : t -> int -> t -> int -> int -> unit 384 | val unsafe_remove_one : t -> unit 385 | val unsafe_remove_n : t -> int -> unit 386 | val unsafe_swap : t -> int -> int -> unit 387 | val unsafe_swap_in_last : t -> int -> unit 388 | end 389 | 390 | (** Extended interface to buffers (resizable strings) *) 391 | module type Buffer = sig 392 | include T 393 | (** Includes all functions that exist in non-parameterized arrays. *) 394 | 395 | (** {5 String conversions} *) 396 | 397 | val sof_string : strategy -> string -> t 398 | (** [sof_string s ar] converts a string to a resizable buffer using strategy 399 | [s]. *) 400 | 401 | val of_string : string -> t 402 | (** [of_string ar] converts a string to a resizable buffer using the default 403 | strategy. *) 404 | 405 | (** {5 Functions found in the standard [Buffer]-module} *) 406 | 407 | (** Note that the function [create n] ignores the parameter [n] and uses the 408 | default strategy instead. You can supply a different strategy with 409 | [creates s n] as described above. *) 410 | 411 | val contents : t -> string 412 | (** [contents b] 413 | 414 | @return a copy of the current contents of the buffer [b]. *) 415 | 416 | val reset : t -> unit 417 | (** [reset b] just clears the buffer, possibly resizing it. *) 418 | 419 | val add_char : t -> char -> unit 420 | (** [add_char b c] appends the character [c] at the end of the buffer [b]. *) 421 | 422 | val add_string : t -> string -> unit 423 | (** [add_string b s] appends the string [s] at the end of the buffer [b]. *) 424 | 425 | val add_substring : t -> string -> int -> int -> unit 426 | (** [add_substring b s ofs len] takes [len] characters from offset [ofs] in 427 | string [s] and appends them at the end of the buffer [b]. *) 428 | 429 | val add_buffer : t -> t -> unit 430 | (** [add_buffer b1 b2] appends the current contents of buffer [b2] at the end 431 | of buffer [b1]. [b2] is not modified. *) 432 | 433 | val add_channel : t -> in_channel -> int -> unit 434 | (** [add_channel b ic n] reads exactly [n] character from the input channel 435 | [ic] and stores them at the end of buffer [b]. 436 | 437 | @raise End_of_file if the channel contains fewer than [n] characters. *) 438 | 439 | val output_buffer : out_channel -> t -> unit 440 | (** [output_buffer oc b] writes the current contents of buffer [b] on the 441 | output channel [oc]. *) 442 | 443 | (** {5 Additional buffer functions} *) 444 | 445 | val add_full_channel : t -> in_channel -> unit 446 | (* [add_full_channel b ic] reads the whole channel [ic] into buffer [b]. *) 447 | 448 | val add_full_channel_f : t -> in_channel -> int -> (int -> int) -> unit 449 | (* [add_full_channel_f b ic n f] reads the whole channel [ic] into buffer [b], 450 | starting with read-ahead [n] and using function [f] to calculate the next 451 | read-ahead if end-of-file was still not found. *) 452 | end 453 | -------------------------------------------------------------------------------- /lib/pres_impl.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | module type Implementation = sig 20 | type 'a t 21 | 22 | val name : string 23 | val length : 'a t -> int 24 | val make : int -> 'a -> 'a t 25 | val unsafe_get : 'a t -> int -> 'a 26 | val unsafe_set : 'a t -> int -> 'a -> unit 27 | end 28 | 29 | module Make (S : Strat.T) (Impl : Implementation) = struct 30 | module Strategy = S 31 | 32 | type strategy = Strategy.t 33 | 34 | type 'a t = { 35 | mutable ar : 'a option Impl.t; 36 | mutable vlix : int; 37 | mutable strategy : strategy; 38 | } 39 | 40 | let name = Impl.name 41 | let invalid_arg str = invalid_arg (name ^ "." ^ str) 42 | let failwith str = failwith (name ^ "." ^ str) 43 | let length ra = ra.vlix + 1 44 | let lix ra = ra.vlix 45 | let real_length ra = Impl.length ra.ar 46 | let real_lix ra = real_length ra - 1 47 | 48 | let unsafe_get_ar ar ix = 49 | match Impl.unsafe_get ar ix with 50 | | None -> failwith "unsafe_get_ar: element undefined - concurrent access?" 51 | | Some el -> el 52 | 53 | let unsafe_get ra ix = unsafe_get_ar ra.ar ix 54 | let unsafe_set_ar ar ix el = Impl.unsafe_set ar ix (Some el) 55 | let unsafe_set ra ix el = unsafe_set_ar ra.ar ix el 56 | 57 | let get ra n = 58 | if n > ra.vlix || n < 0 then invalid_arg "get" else unsafe_get ra n 59 | 60 | let set ra n el = 61 | if n > ra.vlix || n < 0 then invalid_arg "set" else unsafe_set ra n el 62 | 63 | let creator n = Impl.make n None 64 | 65 | let screate_fresh strategy n = 66 | let res = { ar = creator 0; vlix = n - 1; strategy } in 67 | res.ar <- creator (Strategy.grow strategy n); 68 | res 69 | 70 | let create_fresh n = screate_fresh Strategy.default n 71 | 72 | let create_from ra = 73 | { ar = creator (length ra); vlix = ra.vlix; strategy = ra.strategy } 74 | 75 | let sempty strategy = 76 | let res = { ar = creator 0; vlix = -1; strategy } in 77 | res.ar <- creator (Strategy.grow strategy 0); 78 | res 79 | 80 | let empty () = sempty Strategy.default 81 | 82 | let screate strategy n x = 83 | let res = screate_fresh strategy n in 84 | let res_ar = res.ar in 85 | let el = Some x in 86 | for i = 0 to n - 1 do 87 | Impl.unsafe_set res_ar i el 88 | done; 89 | res 90 | 91 | let smake = screate 92 | let create n = smake Strategy.default n 93 | let make = create 94 | 95 | let sinit strategy n f = 96 | let res = screate_fresh strategy n in 97 | let res_ar = res.ar in 98 | for i = 0 to n - 1 do 99 | unsafe_set_ar res_ar i (f i) 100 | done; 101 | res 102 | 103 | let init n f = sinit Strategy.default n f 104 | 105 | let to_array ({ ar } as ra) = 106 | Array.init (length ra) (fun i -> unsafe_get_ar ar i) 107 | 108 | let sof_array strategy ar = 109 | sinit strategy (Array.length ar) (fun i -> Array.unsafe_get ar i) 110 | 111 | let of_array ar = sof_array Strategy.default ar 112 | let get_strategy ra = ra.strategy 113 | 114 | let resizer some_lix ra len = 115 | let ar = creator len in 116 | let old_ar = ra.ar in 117 | for i = 0 to some_lix do 118 | Impl.unsafe_set ar i (Impl.unsafe_get old_ar i) 119 | done; 120 | ra.ar <- ar 121 | 122 | let enforce_strategy ra = 123 | let real_len = real_length ra in 124 | let new_len = length ra in 125 | let new_real_len = Strategy.shrink ra.strategy ~real_len ~new_len in 126 | if new_real_len <> -1 then resizer ra.vlix ra new_real_len 127 | 128 | let set_strategy ra strategy = 129 | ra.strategy <- strategy; 130 | enforce_strategy ra 131 | 132 | let put_strategy ra strategy = ra.strategy <- strategy 133 | 134 | let make_matrix sx sy init = 135 | let res = create_fresh sx in 136 | let res_ar = res.ar in 137 | for i = 0 to res.vlix do 138 | unsafe_set_ar res_ar i (make sy init) 139 | done; 140 | res 141 | 142 | let copy ({ ar } as ra) = 143 | let new_ar = Impl.make (real_length ra) (Impl.unsafe_get ar 0) in 144 | for i = 1 to real_lix ra do 145 | Impl.unsafe_set new_ar i (Impl.unsafe_get ar i) 146 | done; 147 | { ra with ar = new_ar } 148 | 149 | let unsafe_blit_on_other ra1 ofs1 ra2 ofs2 len = 150 | let ofs_diff = ofs2 - ofs1 in 151 | for i = ofs1 to ofs1 + len - 1 do 152 | Impl.unsafe_set ra2.ar (i + ofs_diff) (Impl.unsafe_get ra1.ar i) 153 | done 154 | 155 | let append ra1 ra2 = 156 | match (ra1.vlix, ra2.vlix) with 157 | | -1, -1 -> empty () 158 | | _, -1 -> copy ra1 159 | | -1, _ -> copy ra2 160 | | _ -> 161 | let len1 = length ra1 in 162 | let len2 = length ra2 in 163 | let res = create_fresh (len1 + len2) in 164 | unsafe_blit_on_other ra1 0 res 0 len1; 165 | unsafe_blit_on_other ra2 0 res len1 len2; 166 | res 167 | 168 | let rec concat_aux res offset = function 169 | | [] -> res 170 | | h :: t -> 171 | if h.vlix < 0 then concat_aux res offset t 172 | else 173 | let len = length h in 174 | unsafe_blit_on_other h 0 res offset len; 175 | concat_aux res (offset + len) t 176 | 177 | let concat l = 178 | let len = List.fold_left (fun a el -> a + length el) 0 l in 179 | if len = 0 then empty () else concat_aux (create_fresh len) 0 l 180 | 181 | let unsafe_sub ra ofs len = 182 | let res = create_fresh len in 183 | unsafe_blit_on_other ra ofs res 0 len; 184 | res 185 | 186 | let sub ra ofs len = 187 | if ofs < 0 || len < 0 || ofs + len > length ra then invalid_arg "sub" 188 | else unsafe_sub ra ofs len 189 | 190 | let guarantee_ix ra ix = 191 | if real_lix ra < ix then 192 | resizer ra.vlix ra (Strategy.grow ra.strategy (ix + 1)) 193 | 194 | let maybe_grow_ix ra new_lix = 195 | guarantee_ix ra new_lix; 196 | ra.vlix <- new_lix 197 | 198 | let add_one ra x = 199 | let n = length ra in 200 | maybe_grow_ix ra n; 201 | unsafe_set ra n x 202 | 203 | let unsafe_remove_one ra = 204 | Impl.unsafe_set ra.ar ra.vlix None; 205 | ra.vlix <- ra.vlix - 1; 206 | enforce_strategy ra 207 | 208 | let remove_one ra = 209 | if ra.vlix < 0 then failwith "remove_one" else unsafe_remove_one ra 210 | 211 | let unsafe_remove_n ra n = 212 | let old_vlix = ra.vlix in 213 | let old_ar = ra.ar in 214 | ra.vlix <- old_vlix - n; 215 | enforce_strategy ra; 216 | if old_ar == ra.ar then 217 | for i = ra.vlix + 1 to old_vlix do 218 | Impl.unsafe_set old_ar i None 219 | done 220 | 221 | let remove_n ra n = 222 | if n > length ra || n < 0 then invalid_arg "remove_n" 223 | else unsafe_remove_n ra n 224 | 225 | let unsafe_remove_range ra ofs len = 226 | let ofs_len = ofs + len in 227 | unsafe_blit_on_other ra ofs_len ra ofs (length ra - ofs_len); 228 | unsafe_remove_n ra len 229 | 230 | let remove_range ra ofs len = 231 | if ofs < 0 || len < 0 || ofs + len > length ra then 232 | invalid_arg "remove_range" 233 | else unsafe_remove_range ra ofs len 234 | 235 | let clear ra = unsafe_remove_n ra (length ra) 236 | 237 | let unsafe_swap ra n m = 238 | let tmp = unsafe_get ra n in 239 | unsafe_set ra n (unsafe_get ra m); 240 | unsafe_set ra m tmp 241 | 242 | let swap ra n m = 243 | if n > ra.vlix || m > ra.vlix || n < 0 || m < 0 then invalid_arg "swap" 244 | else unsafe_swap ra n m 245 | 246 | let unsafe_swap_in_last ra n = 247 | Impl.unsafe_set ra.ar n (Impl.unsafe_get ra.ar ra.vlix); 248 | unsafe_remove_one ra 249 | 250 | let swap_in_last ra n = 251 | if n > ra.vlix || n < 0 then invalid_arg "swap_in_last" 252 | else unsafe_swap_in_last ra n 253 | 254 | let unsafe_fill ra ofs len x = 255 | let last = ofs + len - 1 in 256 | maybe_grow_ix ra (max last ra.vlix); 257 | let el = Some x in 258 | let ar = ra.ar in 259 | for i = ofs to last do 260 | Impl.unsafe_set ar i el 261 | done 262 | 263 | let fill ra ofs len x = 264 | if ofs < 0 || len < 0 || ofs > length ra then invalid_arg "fill" 265 | else unsafe_fill ra ofs len x 266 | 267 | let unsafe_blit ra1 ofs1 ra2 ofs2 len = 268 | guarantee_ix ra2 (ofs2 + len - 1); 269 | if ofs1 < ofs2 then 270 | for i = len - 1 downto 0 do 271 | Impl.unsafe_set ra2.ar (ofs2 + i) (Impl.unsafe_get ra1.ar (ofs1 + i)) 272 | done 273 | else 274 | for i = 0 to len - 1 do 275 | Impl.unsafe_set ra2.ar (ofs2 + i) (Impl.unsafe_get ra1.ar (ofs1 + i)) 276 | done 277 | 278 | let blit ra1 ofs1 ra2 ofs2 len = 279 | if 280 | len < 0 || ofs1 < 0 || ofs2 < 0 281 | || ofs1 + len > length ra1 282 | || ofs2 > length ra2 283 | then invalid_arg "blit" 284 | else unsafe_blit ra1 ofs1 ra2 ofs2 len 285 | 286 | let rec to_list_aux ar i accu = 287 | if i < 0 then accu else to_list_aux ar (i - 1) (unsafe_get_ar ar i :: accu) 288 | 289 | let to_list ra = to_list_aux ra.ar ra.vlix [] 290 | 291 | let rec of_list_aux res_ar i = function 292 | | [] -> () 293 | | h :: t -> 294 | unsafe_set_ar res_ar i h; 295 | of_list_aux res_ar (i + 1) t 296 | 297 | let of_list l = 298 | let res = create_fresh (List.length l) in 299 | of_list_aux res.ar 0 l; 300 | res 301 | 302 | let sof_list s l = 303 | let res = screate_fresh s (List.length l) in 304 | of_list_aux res.ar 0 l; 305 | res 306 | 307 | let iter f ({ ar } as ra) = 308 | for i = 0 to ra.vlix do 309 | f (unsafe_get_ar ar i) 310 | done 311 | 312 | let map f ({ ar } as ra) = 313 | let ({ ar = res_ar } as res) = create_from ra in 314 | for i = 0 to res.vlix do 315 | unsafe_set_ar res_ar i (f (unsafe_get_ar ar i)) 316 | done; 317 | res 318 | 319 | let iteri f ({ ar } as ra) = 320 | for i = 0 to ra.vlix do 321 | f i (unsafe_get_ar ar i) 322 | done 323 | 324 | let mapi f ({ ar } as ra) = 325 | let ({ ar = res_ar } as res) = create_from ra in 326 | for i = 0 to res.vlix do 327 | unsafe_set_ar res_ar i (f i (unsafe_get_ar ar i)) 328 | done; 329 | res 330 | 331 | let fold_left f accu ({ ar } as ra) = 332 | let res = ref accu in 333 | for i = 0 to ra.vlix do 334 | res := f !res (unsafe_get_ar ar i) 335 | done; 336 | !res 337 | 338 | let fold_right f ra accu = 339 | let res = ref accu in 340 | for i = ra.vlix downto 0 do 341 | res := f (unsafe_get_ar ra.ar i) !res 342 | done; 343 | !res 344 | 345 | let rec for_all_aux i p ra = 346 | i > ra.vlix || (p (unsafe_get ra i) && for_all_aux (i + 1) p ra) 347 | 348 | let for_all p ra = for_all_aux 0 p ra 349 | 350 | let rec exists_aux i p ra = 351 | i <= ra.vlix && (p (unsafe_get ra i) || exists_aux (i + 1) p ra) 352 | 353 | let exists p ra = exists_aux 0 p ra 354 | 355 | let rec mem_aux i x ra = 356 | i <= ra.vlix && (unsafe_get ra i = x || mem_aux (i + 1) x ra) 357 | 358 | let mem x ra = mem_aux 0 x ra 359 | 360 | let rec memq_aux i x ra = 361 | i <= ra.vlix && (unsafe_get ra i == x || memq_aux (i + 1) x ra) 362 | 363 | let memq x ra = memq_aux 0 x ra 364 | 365 | let rec pos_aux i x ra = 366 | if i > ra.vlix then None 367 | else if unsafe_get ra i = x then Some i 368 | else pos_aux (i + 1) x ra 369 | 370 | let pos x ra = pos_aux 0 x ra 371 | 372 | let rec posq_aux i x ra = 373 | if i > ra.vlix then None 374 | else if unsafe_get ra i == x then Some i 375 | else posq_aux (i + 1) x ra 376 | 377 | let posq x ra = posq_aux 0 x ra 378 | 379 | let rec find_aux i p ra = 380 | if i > ra.vlix then raise Not_found 381 | else 382 | let el = unsafe_get ra i in 383 | if p el then el else find_aux (i + 1) p ra 384 | 385 | let find p ra = find_aux 0 p ra 386 | 387 | let rec find_index_aux p ra i = 388 | if i > ra.vlix then raise Not_found 389 | else if p (unsafe_get ra i) then i 390 | else find_index_aux p ra (i + 1) 391 | 392 | let find_index p ra i = 393 | if i < 0 then invalid_arg "find_index" else find_index_aux p ra i 394 | 395 | let filter p ({ ar } as ra) = 396 | let res = sempty ra.strategy in 397 | for i = 0 to ra.vlix do 398 | let el = unsafe_get_ar ar i in 399 | if p el then add_one res el 400 | done; 401 | res 402 | 403 | let find_all = filter 404 | 405 | let filter_in_place p ({ ar } as ra) = 406 | let dest = ref 0 in 407 | let pos = ref 0 in 408 | while !pos <= ra.vlix do 409 | let el = unsafe_get_ar ar !pos in 410 | if p el then ( 411 | unsafe_set_ar ar !dest el; 412 | incr dest); 413 | incr pos 414 | done; 415 | unsafe_remove_n ra (!pos - !dest) 416 | 417 | let partition p ({ ar } as ra) = 418 | let ((res1, res2) as res) = (sempty ra.strategy, sempty ra.strategy) in 419 | for i = 0 to ra.vlix do 420 | let el = unsafe_get_ar ar i in 421 | if p el then add_one res1 el else add_one res2 el 422 | done; 423 | res 424 | end 425 | -------------------------------------------------------------------------------- /lib/pres_intf.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | (** Interface to parameterized resizable arrays *) 20 | module type T = sig 21 | (** {5 Signatures and types} *) 22 | 23 | module Strategy : Strat.T 24 | (** Module implementing the reallocation strategy *) 25 | 26 | type strategy = Strategy.t 27 | (** Type of reallocation strategy *) 28 | 29 | type 'a t 30 | (** Type of parameterized resizable arrays *) 31 | 32 | (** {5 Index and length information} *) 33 | 34 | val length : 'a t -> int 35 | (** [length ra] 36 | 37 | @return 38 | (virtual) length of resizable array [ra] excluding the reserved space. 39 | *) 40 | 41 | val lix : 'a t -> int 42 | (** [lix ra] 43 | 44 | @return 45 | (virtual) last index of resizable array [ra] excluding the reserved 46 | space. *) 47 | 48 | val real_length : 'a t -> int 49 | (** [real_length ra] 50 | 51 | @return 52 | (real) length of resizable array [ra] including the reserved space. *) 53 | 54 | val real_lix : 'a t -> int 55 | (** [real_lix ra] 56 | 57 | @return 58 | (real) last index of resizable array [ra] including the reserved space. 59 | *) 60 | 61 | (** {5 Getting and setting} *) 62 | 63 | val get : 'a t -> int -> 'a 64 | (** [get ra n] 65 | 66 | @return the [n]th element of [ra]. 67 | @raise Invalid_argument if index out of bounds. *) 68 | 69 | val set : 'a t -> int -> 'a -> unit 70 | (** [set ra n] sets the [n]th element of [ra]. 71 | 72 | @raise Invalid_argument if index out of bounds. *) 73 | 74 | (** {5 Creation of resizable arrays} *) 75 | 76 | val sempty : strategy -> 'a t 77 | (** [sempty s] 78 | 79 | @return an empty resizable array using strategy [s]. *) 80 | 81 | val empty : unit -> 'a t 82 | (** [empty ()] same as [sempty] but uses default strategy. *) 83 | 84 | val screate : strategy -> int -> 'a -> 'a t 85 | (** [screate s n el] 86 | 87 | @return 88 | a resizable array of length [n] containing element [el] only using 89 | strategy [s]. *) 90 | 91 | val create : int -> 'a -> 'a t 92 | (** [create n el] same as [screate] but uses default strategy. *) 93 | 94 | val smake : strategy -> int -> 'a -> 'a t 95 | (** [smake s n el] same as [screate]. *) 96 | 97 | val make : int -> 'a -> 'a t 98 | (** [make n el] same as [create]. *) 99 | 100 | val sinit : strategy -> int -> (int -> 'a) -> 'a t 101 | (** [sinit s n f] 102 | 103 | @return 104 | an array of length [n] containing elements that were created by applying 105 | function [f] to the index, using strategy [s]. *) 106 | 107 | val init : int -> (int -> 'a) -> 'a t 108 | (** [init n f] sames as [sinit] but uses default strategy. *) 109 | 110 | (** {5 Strategy handling} *) 111 | 112 | val get_strategy : 'a t -> strategy 113 | (** [get_strategy ra] 114 | 115 | @return the reallocation strategy used by resizable array [ra]. *) 116 | 117 | val set_strategy : 'a t -> strategy -> unit 118 | (** [set_strategy ra s] sets the reallocation strategy of resizable array [ra] 119 | to [s], possibly causing an immediate reallocation. *) 120 | 121 | val put_strategy : 'a t -> strategy -> unit 122 | (** [put_strategy ra s] sets the reallocation strategy of resizable array [ra] 123 | to [s]. Reallocation is only done at later changes in size. *) 124 | 125 | val enforce_strategy : 'a t -> unit 126 | (** [enforce_strategy ra] forces a reallocation if necessary (e.g. after a 127 | [put_strategy]). *) 128 | 129 | (** {5 Matrix functions} *) 130 | 131 | val make_matrix : int -> int -> 'a -> 'a t t 132 | (** [make_matrix sx sy el] creates a (resizable) matrix of dimensions [sx] and 133 | [sy] containing element [el] only. Both dimensions are controlled by the 134 | default strategy. *) 135 | 136 | (** {5 Copying, blitting and range extraction} *) 137 | 138 | val copy : 'a t -> 'a t 139 | (** [copy ra] 140 | 141 | @return 142 | a copy of resizable array [ra]. The two arrays share the same strategy! 143 | *) 144 | 145 | val sub : 'a t -> int -> int -> 'a t 146 | (** [sub ra ofs len] 147 | 148 | @return 149 | a resizable subarray of length [len] from resizable array [ra] starting 150 | at offset [ofs] using the default strategy. 151 | 152 | @raise Invalid_argument if parameters do not denote a correct subarray. *) 153 | 154 | val fill : 'a t -> int -> int -> 'a -> unit 155 | (** [fill ra ofs len el] fills resizable array [ra] from offset [ofs] with 156 | [len] elements [el], possibly adding elements at the end. Raises 157 | [Invalid_argument] if offset [ofs] is larger than the length of the array. 158 | *) 159 | 160 | val blit : 'a t -> int -> 'a t -> int -> int -> unit 161 | (** [blit ra1 ofs1 ra2 ofs2 len] blits resizable array [ra1] onto [ra2] 162 | reading [len] elements from offset [ofs1] and writing them to [ofs2], 163 | possibly adding elements at the end of ra2. Raises [Invalid_argument] if 164 | [ofs1] and [len] do not designate a valid subarray of [ra1] or if [ofs2] 165 | is larger than the length of [ra2]. *) 166 | 167 | (** {5 Combining resizable arrays} *) 168 | 169 | val append : 'a t -> 'a t -> 'a t 170 | (** [append ra1 ra2] 171 | 172 | @return 173 | a new resizable array using the default strategy and copying [ra1] and 174 | [ra2] in this order onto it. *) 175 | 176 | val concat : 'a t list -> 'a t 177 | (** [concat l] 178 | 179 | @return 180 | a new resizable array using the default strategy and copying all 181 | resizable arrays in [l] in their respective order onto it. *) 182 | 183 | (** {5 Adding and removing elements} *) 184 | 185 | val add_one : 'a t -> 'a -> unit 186 | (** [add_one ra el] adds element [el] to resizable array [ra], possibly 187 | causing a reallocation. *) 188 | 189 | val remove_one : 'a t -> unit 190 | (** [remove_one ra] removes the last element of resizable array [ra], possibly 191 | causing a reallocation. 192 | 193 | @raise Failure if the array is empty. *) 194 | 195 | val remove_n : 'a t -> int -> unit 196 | (** [remove_n ra n] removes the last n elements of resizable array [ra], 197 | possibly causing a reallocation. 198 | 199 | @raise Invalid_argument if there are not enough elements or [n < 0]. *) 200 | 201 | val remove_range : 'a t -> int -> int -> unit 202 | (** [remove_range ra ofs len] removes [len] elements from resizable array [ra] 203 | starting at [ofs] and possibly causing a reallocation. 204 | 205 | @raise Invalid_argument if range is invalid. *) 206 | 207 | val clear : 'a t -> unit 208 | (** [clear ra] removes all elements from resizable array [ra], possibly 209 | causing a reallocation. *) 210 | 211 | (** {5 Swapping} *) 212 | 213 | val swap : 'a t -> int -> int -> unit 214 | (** [swap ra n m] swaps elements at indices [n] and [m]. 215 | 216 | @raise Invalid_argument if any index is out of range. *) 217 | 218 | val swap_in_last : 'a t -> int -> unit 219 | (** [swap_in_last ra n] swaps the last element with the one at position [n]. 220 | 221 | @raise Invalid_argument if index [n] is out of range. *) 222 | 223 | (** {5 Array conversions} *) 224 | 225 | val to_array : 'a t -> 'a array 226 | (** [to_array ra] converts a resizable array to a standard one. *) 227 | 228 | val sof_array : strategy -> 'a array -> 'a t 229 | (** [sof_array s ar] converts a standard array to a resizable one, using 230 | strategy [s]. *) 231 | 232 | val of_array : 'a array -> 'a t 233 | (** [of_array ar] converts a standard array to a resizable one using the 234 | default strategy. *) 235 | 236 | (** {5 List conversions} *) 237 | 238 | val to_list : 'a t -> 'a list 239 | (** [to_list ra] converts resizable array [ra] to a list. *) 240 | 241 | val sof_list : strategy -> 'a list -> 'a t 242 | (** [sof_list s l] creates a resizable array using strategy [s] and the 243 | elements in list [l]. *) 244 | 245 | val of_list : 'a list -> 'a t 246 | (** [of_list l] creates a resizable array using the default strategy and the 247 | elements in list [l]. *) 248 | 249 | (** {5 Iterators} *) 250 | 251 | val iter : ('a -> unit) -> 'a t -> unit 252 | (** [iter f ra] applies the unit-function [f] to each element in resizable 253 | array [ra]. *) 254 | 255 | val map : ('a -> 'b) -> 'a t -> 'b t 256 | (** [map f ra] 257 | 258 | @return 259 | a resizable array using the strategy of [ra] and mapping each element in 260 | [ra] to its corresponding position in the new array using function [f]. 261 | *) 262 | 263 | val iteri : (int -> 'a -> unit) -> 'a t -> unit 264 | (** [iteri f ra] applies the unit-function [f] to each index and element in 265 | resizable array [ra]. *) 266 | 267 | val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t 268 | (** [mapi f ra] 269 | 270 | @return 271 | a resizable array using the strategy of [ra] and mapping each element in 272 | [ra] to its corresponding position in the new array using function [f] 273 | and the index position. *) 274 | 275 | val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b 276 | (** [fold_left f a ra] left-folds values in resizable array [ra] using 277 | function [f] and start accumulator [a]. *) 278 | 279 | val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b 280 | (** [fold_right f a ra] right-folds values in resizable array [ra] using 281 | function [f] and start accumulator [a]. *) 282 | 283 | (** {5 Scanning of resizable arrays} *) 284 | 285 | val for_all : ('a -> bool) -> 'a t -> bool 286 | (** [for_all p ra] 287 | 288 | @return 289 | [true] if all elements in resizable array [ra] satisfy the predicate 290 | [p], [false] otherwise. *) 291 | 292 | val exists : ('a -> bool) -> 'a t -> bool 293 | (** [exists p ra] 294 | 295 | @return 296 | [true] if at least one element in resizable array [ra] satisfies the 297 | predicate [p], [false] otherwise. *) 298 | 299 | val mem : 'a -> 'a t -> bool 300 | (** [mem el ra] 301 | 302 | @return 303 | [true] if element [el] is logically equal to any element in resizable 304 | array [ra], [false] otherwise. *) 305 | 306 | val memq : 'a -> 'a t -> bool 307 | (** [memq el ra] 308 | 309 | @return 310 | [true] if element [el] is physically equal to any element in resizable 311 | array [ra], [false] otherwise. *) 312 | 313 | val pos : 'a -> 'a t -> int option 314 | (** [pos el ra] 315 | 316 | @return 317 | [Some index] if [el] is logically equal to the element at [index] in 318 | [ra], [None] otherwise. [index] is the index of the first element that 319 | matches. *) 320 | 321 | val posq : 'a -> 'a t -> int option 322 | (** [posq el ra] 323 | 324 | @return 325 | [Some index] if [el] is physically equal to the element at [index] in 326 | [ra], [None] otherwise. [index] is the index of the first element that 327 | matches. *) 328 | 329 | (** {5 Searching of resizable arrays} *) 330 | 331 | val find : ('a -> bool) -> 'a t -> 'a 332 | (** [find p ra] 333 | 334 | @return 335 | the first element in resizable array [ra] that satisfies predicate [p]. 336 | 337 | @raise Not_found if there is no such element. *) 338 | 339 | val find_index : ('a -> bool) -> 'a t -> int -> int 340 | (** [find_index p ra pos] 341 | 342 | @return 343 | the index of the first element that satisfies predicate [p] in resizable 344 | array [ra], starting search at index [pos]. 345 | 346 | @raise Not_found 347 | if there is no such element or if [pos] is larger than the highest 348 | index. 349 | 350 | @raise Invalid_argument if [pos] is negative. *) 351 | 352 | val filter : ('a -> bool) -> 'a t -> 'a t 353 | (** [filter p ra] 354 | 355 | @return 356 | a new resizable array by filtering out all elements in [ra] that satisfy 357 | predicate [p] using the same strategy as [ra]. *) 358 | 359 | val find_all : ('a -> bool) -> 'a t -> 'a t 360 | (** [find_all p ra] is the same as [filter] *) 361 | 362 | val filter_in_place : ('a -> bool) -> 'a t -> unit 363 | (** [filter_in_place p ra] as [filter], but filters in place. *) 364 | 365 | val partition : ('a -> bool) -> 'a t -> 'a t * 'a t 366 | (** [partition p ra] 367 | 368 | @return 369 | a pair of resizable arrays, the left part containing only elements of 370 | [ra] that satisfy predicate [p], the right one only those that do not 371 | satisfy it. Both returned arrays are created using the strategy of [ra]. 372 | *) 373 | 374 | (** {5 {b UNSAFE STUFF - USE WITH CAUTION!}} *) 375 | 376 | val unsafe_get : 'a t -> int -> 'a 377 | val unsafe_set : 'a t -> int -> 'a -> unit 378 | val unsafe_sub : 'a t -> int -> int -> 'a t 379 | val unsafe_fill : 'a t -> int -> int -> 'a -> unit 380 | val unsafe_blit : 'a t -> int -> 'a t -> int -> int -> unit 381 | val unsafe_remove_one : 'a t -> unit 382 | val unsafe_remove_n : 'a t -> int -> unit 383 | val unsafe_swap : 'a t -> int -> int -> unit 384 | val unsafe_swap_in_last : 'a t -> int -> unit 385 | end 386 | -------------------------------------------------------------------------------- /lib/res.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | module DefStrat = struct 20 | type t = float * float * int 21 | 22 | let default = (1.5, 0.5, 16) 23 | 24 | let grow (waste, _, min_size) new_len = 25 | max (truncate (float new_len *. waste)) min_size 26 | 27 | let shrink (waste, shrink_trig, min_size) ~real_len ~new_len = 28 | if real_len > min_size && truncate (float real_len *. shrink_trig) > new_len 29 | then max (truncate (float new_len *. waste)) min_size 30 | else -1 31 | end 32 | 33 | module BitDefStrat = struct 34 | include DefStrat 35 | 36 | let default = (1.5, 0.5, 1024) 37 | end 38 | 39 | module Array_impl = struct 40 | type 'a t = 'a array 41 | 42 | let name = "Res.Array" 43 | let length = Array.length 44 | let make = Array.make 45 | let unsafe_get = Array.get 46 | let unsafe_set = Array.set 47 | end 48 | 49 | module Unsafe_float_impl = struct 50 | include Float.Array 51 | 52 | type el = float 53 | 54 | let unsafe_blit (ar1 : t) ofs1 ar2 ofs2 len = 55 | if ofs1 < ofs2 then 56 | for i = len - 1 downto 0 do 57 | unsafe_set ar2 (ofs2 + i) (unsafe_get ar1 (ofs1 + i)) 58 | done 59 | else 60 | for i = 0 to len - 1 do 61 | unsafe_set ar2 (ofs2 + i) (unsafe_get ar1 (ofs1 + i)) 62 | done 63 | end 64 | 65 | module Float_impl = struct 66 | include Unsafe_float_impl 67 | 68 | let name = "Res.Floats" 69 | let unsafe_get = get 70 | let unsafe_set = set 71 | 72 | let unsafe_blit ar1 ofs1 ar2 ofs2 len = 73 | if 74 | len < 0 || ofs1 < 0 75 | || ofs1 > length ar1 - len 76 | || ofs2 < 0 77 | || ofs2 > length ar2 - len 78 | then invalid_arg "Res.Floats.blit" 79 | else unsafe_blit ar1 ofs1 ar2 ofs2 len 80 | end 81 | 82 | (* TODO: create safe version *) 83 | (* Code of the Bit-module due to Jean-Christophe Filliatre *) 84 | module Bit_impl = struct 85 | type el = bool 86 | type t = { length : int; bits : int array } 87 | 88 | let name = "Res.Bits" 89 | let length v = v.length 90 | let bpi = Sys.word_size - 2 91 | let bit_j = Array.init bpi (fun j -> 1 lsl j) 92 | let bit_not_j = Array.init bpi (fun j -> max_int - bit_j.(j)) 93 | let low_mask = Array.make (bpi + 1) 0 94 | 95 | let () = 96 | for i = 1 to bpi do 97 | low_mask.(i) <- low_mask.(i - 1) lor bit_j.(i - 1) 98 | done 99 | 100 | let keep_lowest_bits a j = a land low_mask.(j) 101 | let high_mask = Array.init (bpi + 1) (fun j -> low_mask.(j) lsl (bpi - j)) 102 | let keep_highest_bits a j = a land high_mask.(j) 103 | 104 | let make n b = 105 | let initv = if b then max_int else 0 in 106 | let r = n mod bpi in 107 | if r = 0 then { length = n; bits = Array.make (n / bpi) initv } 108 | else 109 | let s = n / bpi in 110 | let b = Array.make (s + 1) initv in 111 | b.(s) <- b.(s) land low_mask.(r); 112 | { length = n; bits = b } 113 | 114 | let create n = make n false 115 | 116 | let pos n = 117 | let i = n / bpi in 118 | let j = n mod bpi in 119 | if j < 0 then (i - 1, j + bpi) else (i, j) 120 | 121 | let unsafe_get v n = 122 | let i, j = pos n in 123 | Array.unsafe_get v.bits i land Array.unsafe_get bit_j j > 0 124 | 125 | let unsafe_set v n b = 126 | let i, j = pos n in 127 | if b then 128 | Array.unsafe_set v.bits i 129 | (Array.unsafe_get v.bits i lor Array.unsafe_get bit_j j) 130 | else 131 | Array.unsafe_set v.bits i 132 | (Array.unsafe_get v.bits i land Array.unsafe_get bit_not_j j) 133 | 134 | let blit_bits a i m v n = 135 | let i', j = pos n in 136 | if j == 0 then 137 | Array.unsafe_set v i' 138 | (keep_lowest_bits (a lsr i) m 139 | lor keep_highest_bits (Array.unsafe_get v i') (bpi - m)) 140 | else 141 | let d = m + j - bpi in 142 | if d > 0 then ( 143 | Array.unsafe_set v i' 144 | ((keep_lowest_bits (a lsr i) (bpi - j) lsl j) 145 | lor keep_lowest_bits (Array.unsafe_get v i') j); 146 | Array.unsafe_set v (i' + 1) 147 | (keep_lowest_bits (a lsr (i + bpi - j)) d 148 | lor keep_highest_bits (Array.unsafe_get v (i' + 1)) (bpi - d))) 149 | else 150 | Array.unsafe_set v i' 151 | ((keep_lowest_bits (a lsr i) m lsl j) 152 | lor (Array.unsafe_get v i' land (low_mask.(j) lor high_mask.(-d)))) 153 | 154 | let blit_int a v n = 155 | let i, j = pos n in 156 | if j == 0 then Array.unsafe_set v i a 157 | else ( 158 | Array.unsafe_set v i 159 | (keep_lowest_bits (Array.unsafe_get v i) j 160 | lor (keep_lowest_bits a (bpi - j) lsl j)); 161 | Array.unsafe_set v (i + 1) 162 | (keep_highest_bits (Array.unsafe_get v (i + 1)) (bpi - j) 163 | lor (a lsr (bpi - j)))) 164 | 165 | let unsafe_blit v1 ofs1 v2 ofs2 len = 166 | let bi, bj = pos ofs1 in 167 | let ei, ej = pos (ofs1 + len - 1) in 168 | if bi == ei then blit_bits (Array.unsafe_get v1.bits bi) bj len v2.bits ofs2 169 | else ( 170 | blit_bits (Array.unsafe_get v1.bits bi) bj (bpi - bj) v2.bits ofs2; 171 | let n = ref (ofs2 + bpi - bj) in 172 | for i = bi + 1 to ei - 1 do 173 | blit_int (Array.unsafe_get v1.bits i) v2.bits !n; 174 | n := !n + bpi 175 | done; 176 | blit_bits (Array.unsafe_get v1.bits ei) 0 (ej + 1) v2.bits !n) 177 | end 178 | 179 | module Buffer_impl = struct 180 | type el = char 181 | type t = Bytes.t 182 | 183 | let length = Bytes.length 184 | let create = Bytes.create 185 | let make = Bytes.make 186 | let name = "Res.Buffer" 187 | let unsafe_get = Bytes.unsafe_get 188 | let unsafe_set = Bytes.unsafe_set 189 | let unsafe_blit = Bytes.unsafe_blit 190 | end 191 | 192 | module MakeArray (S : Strat.T) = Pres_impl.Make (S) (Array_impl) 193 | module MakeFloats (S : Strat.T) = Nopres_impl.Make (S) (Float_impl) 194 | module MakeBits (S : Strat.T) = Nopres_impl.Make (S) (Bit_impl) 195 | module MakeWeak (S : Strat.T) = Weak_impl.Make (S) 196 | 197 | module MakeBuffer (S : Strat.T) = struct 198 | module B = Nopres_impl.Make (S) (Buffer_impl) 199 | include B 200 | 201 | let create _ = empty () 202 | let contents buf = Bytes.sub_string buf.ar 0 (length buf) 203 | let reset = clear 204 | let add_char = add_one 205 | 206 | let add_string buf str = 207 | let old_buf_len = length buf in 208 | let len = String.length str in 209 | maybe_grow_ix buf (buf.vlix + len); 210 | Bytes.blit_string str 0 buf.ar old_buf_len len 211 | 212 | let add_substring buf str ofs len = 213 | if ofs < 0 || len < 0 || ofs + len > String.length str then 214 | invalid_arg "add_substring"; 215 | let old_buf_len = length buf in 216 | maybe_grow_ix buf (buf.vlix + len); 217 | Bytes.blit_string str ofs buf.ar old_buf_len len 218 | 219 | let add_buffer b1 b2 = 220 | let len = length b2 in 221 | let old_buf_len = length b1 in 222 | maybe_grow_ix b1 (b1.vlix + len); 223 | Bytes.blit b2.ar 0 b1.ar old_buf_len len 224 | 225 | let add_channel buf ch len = 226 | let old_buf_len = length buf in 227 | maybe_grow_ix buf (buf.vlix + len); 228 | try really_input ch buf.ar old_buf_len len 229 | with End_of_file -> 230 | buf.vlix <- old_buf_len - 1; 231 | enforce_strategy buf 232 | 233 | let rec add_full_channel_f_aux buf ch len adjust = 234 | if len > 0 then ( 235 | let old_buf_len = length buf in 236 | maybe_grow_ix buf (buf.vlix + len); 237 | let r = input ch buf.ar old_buf_len len in 238 | if r > 0 then 239 | let diff = len - r in 240 | if diff > 0 then ( 241 | buf.vlix <- buf.vlix - diff; 242 | add_full_channel_f_aux buf ch len adjust) 243 | else add_full_channel_f_aux buf ch (adjust len) adjust 244 | else buf.vlix <- buf.vlix - len) 245 | 246 | let add_full_channel_f buf ch len adjust = 247 | add_full_channel_f_aux buf ch len adjust; 248 | enforce_strategy buf 249 | 250 | let add_full_channel buf ch = add_full_channel_f buf ch 4096 (fun n -> n) 251 | let output_buffer ch buf = output ch buf.ar 0 (length buf) 252 | 253 | let sof_string strategy str = 254 | sinit strategy (String.length str) (fun i -> String.unsafe_get str i) 255 | 256 | let of_string = sof_string Strategy.default 257 | end 258 | 259 | module Array = MakeArray (DefStrat) 260 | module Floats = MakeFloats (DefStrat) 261 | module Bits = MakeBits (BitDefStrat) 262 | module Weak = MakeWeak (DefStrat) 263 | module Buffer = MakeBuffer (DefStrat) 264 | -------------------------------------------------------------------------------- /lib/res.mli: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | (** Global module for resizable datastructures and default implementations *) 20 | 21 | (** {5 Default strategies} *) 22 | 23 | (** Default strategy for resizable datastructures *) 24 | module DefStrat : Strat.T with type t = float * float * int 25 | (** [type t] is a triple [(waste, shrink_trig, min_size)], where [waste] 26 | (default: 1.5) indicates how much the array should grow in excess when 27 | reallocation is triggered, [shrink_trig] (default: 0.5) at which percentage 28 | of excess elements it should be shrunk and [min_size] (default: 16 elements) 29 | is the minimum size of the resizable array. *) 30 | 31 | module BitDefStrat : Strat.T with type t = float * float * int 32 | (** Same as [DefStrat], but the minimum size is 1024 elements (bits). *) 33 | 34 | (** {5 Default instantiation of standard resizable datastructures} *) 35 | 36 | module Array : Pres_intf.T with module Strategy = DefStrat 37 | (** Resizable parameterized array using the default reallocation strategy. *) 38 | 39 | (** Resizable float array using the default reallocation strategy. *) 40 | module Floats : 41 | Nopres_intf.T with module Strategy = DefStrat and type el = float 42 | 43 | (** Resizable bit vector using the default reallocation strategy. *) 44 | module Bits : 45 | Nopres_intf.T with module Strategy = BitDefStrat and type el = bool 46 | 47 | module Weak : Weak_intf.T with module Strategy = DefStrat 48 | (** Resizable weak array using the default reallocation strategy. *) 49 | 50 | (** Resizable buffer using the default reallocation strategy. *) 51 | module Buffer : 52 | Nopres_intf.Buffer with module Strategy = DefStrat and type el = char 53 | 54 | (** {5 Functors for creating standard resizable datastructures from strategies} 55 | *) 56 | 57 | (** Functor that creates resizable parameterized arrays from reallocation 58 | strategies. *) 59 | module MakeArray : functor (S : Strat.T) -> Pres_intf.T with module Strategy = S 60 | 61 | (** Functor that creates resizable float arrays from reallocation strategies. *) 62 | module MakeFloats : functor (S : Strat.T) -> 63 | Nopres_intf.T with module Strategy = S and type el = float 64 | 65 | (** Functor that creates resizable bit vectors from reallocation strategies. *) 66 | module MakeBits : functor (S : Strat.T) -> 67 | Nopres_intf.T with module Strategy = S and type el = bool 68 | 69 | (** Functor that creates resizable weak arrays from reallocation strategies. *) 70 | module MakeWeak : functor (S : Strat.T) -> Weak_intf.T with module Strategy = S 71 | 72 | (** Functor that creates resizable buffers (=string arrays) from reallocation 73 | strategies. *) 74 | module MakeBuffer : functor (S : Strat.T) -> 75 | Nopres_intf.Buffer with module Strategy = S and type el = char 76 | -------------------------------------------------------------------------------- /lib/strat.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | (** Interface to strategies *) 20 | module type T = sig 21 | type t 22 | (** The abstract type of strategies. *) 23 | 24 | val default : t 25 | (** Default strategy of this strategy implementation. *) 26 | 27 | val grow : t -> int -> int 28 | (** [grow strat new_len] 29 | 30 | @return 31 | the new real length of some contiguous datastructure using strategy 32 | [strat] given new virtual length [new_len]. The user should then use 33 | this new real length to resize the datastructure. 34 | 35 | Be careful, the new (real) length {b must} be larger than the new virtual 36 | length, otherwise your program will crash! *) 37 | 38 | val shrink : t -> real_len:int -> new_len:int -> int 39 | (** [shrink strat ~real_len ~new_len] 40 | 41 | @return 42 | the new real length of a resizable datastructure given its current real 43 | length [real_len] and its required new virtual length [new_len] wrt. 44 | strategy [strat]. The user should then use this new real length to 45 | resize the datastructure. If [-1] is returned, it is not necessary to 46 | resize. 47 | 48 | Be careful, the new (real) length {b must} be larger than the new virtual 49 | length [new_len], otherwise your program may crash! *) 50 | end 51 | -------------------------------------------------------------------------------- /lib/weak_impl.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | (* TODO: make safe and improve *) 20 | 21 | module Make (S : Strat.T) = struct 22 | module Strategy = S 23 | 24 | type strategy = Strategy.t 25 | 26 | type 'a t = { 27 | mutable ar : 'a Weak.t; 28 | mutable vlix : int; 29 | mutable strategy : strategy; 30 | } 31 | 32 | let name = "Res.Weak" 33 | let invalid_arg str = invalid_arg (name ^ "." ^ str) 34 | let failwith str = failwith (name ^ "." ^ str) 35 | let length ra = ra.vlix + 1 36 | let lix ra = ra.vlix 37 | let real_length ra = Weak.length ra.ar 38 | let real_lix ra = real_length ra - 1 39 | let unsafe_get ra ix = Weak.get ra.ar ix 40 | let unsafe_set ra ix el = Weak.set ra.ar ix el 41 | let check ra ix = Weak.check ra.ar ix 42 | 43 | let get ra n = 44 | if n > ra.vlix || n < 0 then invalid_arg "get" else unsafe_get ra n 45 | 46 | let get_copy ra n = 47 | if n > ra.vlix || n < 0 then invalid_arg "get_copy" 48 | else Weak.get_copy ra.ar n 49 | 50 | let set ra n = 51 | if n > ra.vlix || n < 0 then invalid_arg "set" else unsafe_set ra n 52 | 53 | let creator = Weak.create 54 | 55 | let screate_fresh strategy n = 56 | let res = { ar = creator 0; vlix = n - 1; strategy } in 57 | res.ar <- creator (Strategy.grow strategy n); 58 | res 59 | 60 | let create_fresh n = screate_fresh Strategy.default n 61 | 62 | let create_from ra = 63 | { ar = creator (length ra); vlix = ra.vlix; strategy = ra.strategy } 64 | 65 | let sempty strategy = 66 | let res = { ar = creator 0; vlix = -1; strategy } in 67 | res.ar <- creator (Strategy.grow strategy 0); 68 | res 69 | 70 | let empty () = sempty Strategy.default 71 | 72 | let smake strategy n x = 73 | let res = screate_fresh strategy n in 74 | for i = 0 to n - 1 do 75 | unsafe_set res i x 76 | done; 77 | res 78 | 79 | let make n = smake Strategy.default n 80 | let create n = make n None 81 | let screate strategy n = smake strategy n None 82 | 83 | let sinit strategy n f = 84 | let res = screate_fresh strategy n in 85 | for i = 0 to n - 1 do 86 | unsafe_set res i (f i) 87 | done; 88 | res 89 | 90 | let init n f = sinit Strategy.default n f 91 | let get_strategy ra = ra.strategy 92 | 93 | let resizer some_lix ra len = 94 | let ar = creator len in 95 | for i = 0 to some_lix do 96 | Weak.set ar i (unsafe_get ra i) 97 | done; 98 | ra.ar <- ar 99 | 100 | let enforce_strategy ra = 101 | let real_len = real_length ra in 102 | let new_len = length ra in 103 | let new_real_len = Strategy.shrink ra.strategy ~real_len ~new_len in 104 | if new_real_len <> -1 then resizer ra.vlix ra new_real_len 105 | 106 | let set_strategy ra strategy = 107 | ra.strategy <- strategy; 108 | enforce_strategy ra 109 | 110 | let put_strategy ra strategy = ra.strategy <- strategy 111 | 112 | let copy ra = 113 | let ar = Weak.create (real_length ra) in 114 | for i = 0 to real_lix ra do 115 | Weak.set ar i (unsafe_get ra i) 116 | done; 117 | { ra with ar } 118 | 119 | let unsafe_blit_on_other ra1 ofs1 ra2 ofs2 len = 120 | let ofs_diff = ofs2 - ofs1 in 121 | for i = ofs1 to ofs1 + len - 1 do 122 | unsafe_set ra2 (i + ofs_diff) (unsafe_get ra1 i) 123 | done 124 | 125 | let append ra1 ra2 = 126 | match (ra1.vlix, ra2.vlix) with 127 | | -1, -1 -> empty () 128 | | _, -1 -> copy ra1 129 | | -1, _ -> copy ra2 130 | | _ -> 131 | let len1 = length ra1 in 132 | let len2 = length ra2 in 133 | let res = create_fresh (len1 + len2) in 134 | unsafe_blit_on_other ra1 0 res 0 len1; 135 | unsafe_blit_on_other ra2 0 res len1 len2; 136 | res 137 | 138 | let rec concat_aux res offset = function 139 | | [] -> res 140 | | h :: t -> 141 | if h.vlix < 0 then concat_aux res offset t 142 | else 143 | let len = length h in 144 | unsafe_blit_on_other h 0 res offset len; 145 | concat_aux res (offset + len) t 146 | 147 | let concat l = 148 | let len = List.fold_left (fun a el -> a + length el) 0 l in 149 | if len = 0 then empty () else concat_aux (create_fresh len) 0 l 150 | 151 | let unsafe_sub ra ofs len = 152 | let res = create_fresh len in 153 | unsafe_blit_on_other ra ofs res 0 len; 154 | res 155 | 156 | let sub ra ofs len = 157 | if ofs < 0 || len < 0 || ofs + len > length ra then invalid_arg "sub" 158 | else unsafe_sub ra ofs len 159 | 160 | let guarantee_ix ra ix = 161 | if real_lix ra < ix then 162 | resizer ra.vlix ra (Strategy.grow ra.strategy (ix + 1)) 163 | 164 | let maybe_grow_ix ra new_lix = 165 | guarantee_ix ra new_lix; 166 | ra.vlix <- new_lix 167 | 168 | let add_one ra x = 169 | let n = length ra in 170 | maybe_grow_ix ra n; 171 | unsafe_set ra n x 172 | 173 | let unsafe_remove_one ra = 174 | unsafe_set ra ra.vlix None; 175 | ra.vlix <- ra.vlix - 1; 176 | enforce_strategy ra 177 | 178 | let remove_one ra = 179 | if ra.vlix < 0 then failwith "remove_one" else unsafe_remove_one ra 180 | 181 | let unsafe_remove_n ra n = 182 | let old_vlix = ra.vlix in 183 | let old_ar = ra.ar in 184 | ra.vlix <- old_vlix - n; 185 | enforce_strategy ra; 186 | if old_ar == ra.ar then 187 | for i = ra.vlix + 1 to old_vlix do 188 | unsafe_set ra i None 189 | done 190 | 191 | let remove_n ra n = 192 | if n > length ra || n < 0 then invalid_arg "remove_n" 193 | else unsafe_remove_n ra n 194 | 195 | let unsafe_remove_range ra ofs len = 196 | unsafe_blit_on_other ra (ofs + len) ra ofs (length ra - len); 197 | unsafe_remove_n ra len 198 | 199 | let remove_range ra ofs len = 200 | if ofs < 0 || len < 0 || ofs + len > length ra then 201 | invalid_arg "remove_range" 202 | else unsafe_remove_range ra ofs len 203 | 204 | let clear ra = unsafe_remove_n ra (length ra) 205 | 206 | let unsafe_swap ra n m = 207 | let tmp = unsafe_get ra n in 208 | unsafe_set ra n (unsafe_get ra m); 209 | unsafe_set ra m tmp 210 | 211 | let swap ra n m = 212 | if n > ra.vlix || m > ra.vlix || n < 0 || m < 0 then invalid_arg "swap" 213 | else unsafe_swap ra n m 214 | 215 | let unsafe_swap_in_last ra n = 216 | unsafe_set ra n (unsafe_get ra ra.vlix); 217 | unsafe_remove_one ra 218 | 219 | let swap_in_last ra n = 220 | if n > ra.vlix || n < 0 then invalid_arg "swap_in_last" 221 | else unsafe_swap_in_last ra n 222 | 223 | let unsafe_fill ra ofs len x = 224 | let last = ofs + len - 1 in 225 | maybe_grow_ix ra (max last ra.vlix); 226 | for i = ofs to last do 227 | unsafe_set ra i x 228 | done 229 | 230 | let fill ra ofs len x = 231 | if ofs < 0 || len < 0 || ofs > length ra then invalid_arg "fill" 232 | else unsafe_fill ra ofs len x 233 | 234 | let unsafe_blit ra1 ofs1 ra2 ofs2 len = 235 | guarantee_ix ra2 (ofs2 + len - 1); 236 | if ofs1 < ofs2 then 237 | for i = len - 1 downto 0 do 238 | unsafe_set ra2 (ofs2 + i) (unsafe_get ra1 (ofs1 + i)) 239 | done 240 | else 241 | for i = 0 to len - 1 do 242 | unsafe_set ra2 (ofs2 + i) (unsafe_get ra1 (ofs1 + i)) 243 | done 244 | 245 | let blit ra1 ofs1 ra2 ofs2 len = 246 | if 247 | len < 0 || ofs1 < 0 || ofs2 < 0 248 | || ofs1 + len > length ra1 249 | || ofs2 > length ra2 250 | then invalid_arg "blit" 251 | else unsafe_blit ra1 ofs1 ra2 ofs2 len 252 | 253 | let to_std ra = 254 | let wa = Weak.create (length ra) in 255 | for i = 0 to ra.vlix do 256 | Weak.set wa i (unsafe_get ra i) 257 | done; 258 | wa 259 | 260 | let sof_std strategy ar = sinit strategy (Weak.length ar) (Weak.get ar) 261 | let of_std ar = sof_std Strategy.default ar 262 | 263 | let rec to_list_aux ra i accu = 264 | if i < 0 then accu else to_list_aux ra (i - 1) (unsafe_get ra i :: accu) 265 | 266 | let to_list ra = to_list_aux ra ra.vlix [] 267 | 268 | let rec of_list_aux res i = function 269 | | [] -> res 270 | | h :: t -> 271 | unsafe_set res i h; 272 | of_list_aux res (i + 1) t 273 | 274 | let of_list l = of_list_aux (create_fresh (List.length l)) 0 l 275 | 276 | let iter f ra = 277 | for i = 0 to ra.vlix do 278 | f (unsafe_get ra i) 279 | done 280 | 281 | let iteri f ra = 282 | for i = 0 to ra.vlix do 283 | f i (unsafe_get ra i) 284 | done 285 | 286 | let fold_left f accu ra = 287 | let res = ref accu in 288 | for i = 0 to ra.vlix do 289 | res := f !res (unsafe_get ra i) 290 | done; 291 | !res 292 | 293 | let fold_right f ra accu = 294 | let res = ref accu in 295 | for i = ra.vlix downto 0 do 296 | res := f (unsafe_get ra i) !res 297 | done; 298 | !res 299 | 300 | let rec for_all_aux i p ra = 301 | if i > ra.vlix then true 302 | else if p (unsafe_get ra i) then for_all_aux (i + 1) p ra 303 | else false 304 | 305 | let for_all p ra = for_all_aux 0 p ra 306 | 307 | let rec exists_aux i p ra = 308 | if i > ra.vlix then false 309 | else if p (unsafe_get ra i) then true 310 | else exists_aux (i + 1) p ra 311 | 312 | let exists p ra = exists_aux 0 p ra 313 | 314 | let rec mem_aux i x ra = 315 | if i > ra.vlix then false 316 | else if unsafe_get ra i = x then true 317 | else mem_aux (i + 1) x ra 318 | 319 | let mem x ra = mem_aux 0 x ra 320 | 321 | let rec memq_aux i x ra = 322 | if i > ra.vlix then false 323 | else if unsafe_get ra i == x then true 324 | else memq_aux (i + 1) x ra 325 | 326 | let memq x ra = memq_aux 0 x ra 327 | 328 | let rec pos_aux i x ra = 329 | if i > ra.vlix then None 330 | else if unsafe_get ra i = x then Some i 331 | else pos_aux (i + 1) x ra 332 | 333 | let pos x ra = pos_aux 0 x ra 334 | 335 | let rec posq_aux i x ra = 336 | if i > ra.vlix then None 337 | else if unsafe_get ra i == x then Some i 338 | else posq_aux (i + 1) x ra 339 | 340 | let posq x ra = posq_aux 0 x ra 341 | 342 | let rec find_aux i p ra = 343 | if i > ra.vlix then raise Not_found 344 | else 345 | let el = unsafe_get ra i in 346 | if p el then el else find_aux (i + 1) p ra 347 | 348 | let find p ra = find_aux 0 p ra 349 | 350 | let rec find_index_aux p ra i = 351 | if i > ra.vlix then raise Not_found 352 | else if p (unsafe_get ra i) then i 353 | else find_index_aux p ra (i + 1) 354 | 355 | let find_index p ra i = 356 | if i < 0 then invalid_arg "find_index" else find_index_aux p ra i 357 | 358 | let filter p ra = 359 | let res = sempty ra.strategy in 360 | for i = 0 to ra.vlix do 361 | let el = unsafe_get ra i in 362 | if p el then add_one res el 363 | done; 364 | res 365 | 366 | let find_all = filter 367 | 368 | let filter_in_place p ra = 369 | let dest = ref 0 in 370 | let pos = ref 0 in 371 | while !pos <= ra.vlix do 372 | let el = unsafe_get ra !pos in 373 | if p el then ( 374 | unsafe_set ra !dest el; 375 | incr dest); 376 | incr pos 377 | done; 378 | unsafe_remove_n ra (!pos - !dest) 379 | 380 | let partition p ra = 381 | let ((res1, res2) as res) = (sempty ra.strategy, sempty ra.strategy) in 382 | for i = 0 to ra.vlix do 383 | let el = unsafe_get ra i in 384 | if p el then add_one res1 el else add_one res2 el 385 | done; 386 | res 387 | end 388 | -------------------------------------------------------------------------------- /lib/weak_intf.ml: -------------------------------------------------------------------------------- 1 | (* RES - Automatically Resizing Contiguous Memory for OCaml 2 | 3 | Copyright © 1999- Markus Mottl 4 | 5 | This library is free software; you can redistribute it and/or modify it under 6 | the terms of the GNU Lesser General Public License as published by the Free 7 | Software Foundation; either version 2.1 of the License, or (at your option) 8 | any later version. 9 | 10 | This library is distributed in the hope that it will be useful, but WITHOUT 11 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 | FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more 13 | details. 14 | 15 | You should have received a copy of the GNU Lesser General Public License 16 | along with this library; if not, write to the Free Software Foundation, Inc., 17 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) 18 | 19 | (** Interface to weak resizable arrays *) 20 | module type T = sig 21 | (** {5 Signatures and types} *) 22 | 23 | module Strategy : Strat.T 24 | (** Module implementing the reallocation strategy *) 25 | 26 | type strategy = Strategy.t 27 | (** Type of reallocation strategy *) 28 | 29 | type 'a t 30 | (** Type of parameterized resizable arrays *) 31 | 32 | (** {5 Index and length information} *) 33 | 34 | val length : 'a t -> int 35 | (** [length ra] 36 | 37 | @return 38 | (virtual) length of resizable array [ra] excluding the reserved space. 39 | *) 40 | 41 | val lix : 'a t -> int 42 | (** [lix ra] 43 | 44 | @return 45 | (virtual) last index of resizable array [ra] excluding the reserved 46 | space. *) 47 | 48 | val real_length : 'a t -> int 49 | (** [real_length ra] 50 | 51 | @return 52 | (real) length of resizable array [ra] including the reserved space. *) 53 | 54 | val real_lix : 'a t -> int 55 | (** [real_lix ra] 56 | 57 | @return 58 | (real) last index of resizable array [ra] including the reserved space. 59 | *) 60 | 61 | (** {5 Getting, setting and checking} *) 62 | 63 | val get : 'a t -> int -> 'a option 64 | (** [get ra n] 65 | 66 | @return the [n]th element of [ra]. 67 | @raise Invalid_argument if index out of bounds. *) 68 | 69 | val get_copy : 'a t -> int -> 'a option 70 | (** [get_copy ra n] see documentation of module [Weak] in the standard 71 | distribution. *) 72 | 73 | val check : 'a t -> int -> bool 74 | (** [check ra n] 75 | 76 | @return 77 | [true] if the [n]th cell of [ra] is full, [false] if it is empty. Note 78 | that even if [check ar n] returns [true], a subsequent {!get}[ar n] can 79 | return [None]. *) 80 | 81 | val set : 'a t -> int -> 'a option -> unit 82 | (** [set ra n] sets the [n]th element of [ra]. 83 | @raise Invalid_argument if index out of bounds. *) 84 | 85 | (** {5 Creation of resizable arrays} *) 86 | 87 | val sempty : strategy -> 'a t 88 | (** [sempty s] 89 | 90 | @return an empty resizable array using strategy [s]. *) 91 | 92 | val empty : unit -> 'a t 93 | (** [empty ()] same as [sempty] but uses default strategy. *) 94 | 95 | val screate : strategy -> int -> 'a t 96 | (** [screate s n el] 97 | 98 | @return a resizable array of length [n] using strategy [s]. *) 99 | 100 | val create : int -> 'a t 101 | (** [create n] same as [screate] but uses default strategy. *) 102 | 103 | val sinit : strategy -> int -> (int -> 'a option) -> 'a t 104 | (** [sinit s n f] 105 | 106 | @return 107 | an array of length [n] containing elements that were created by applying 108 | function [f] to the index, using strategy [s]. *) 109 | 110 | val init : int -> (int -> 'a option) -> 'a t 111 | (** [init n f] sames as [sinit] but uses default strategy. *) 112 | 113 | (** {5 Strategy handling} *) 114 | 115 | val get_strategy : 'a t -> strategy 116 | (** [get_strategy ra] 117 | 118 | @return the reallocation strategy used by resizable array [ra]. *) 119 | 120 | val set_strategy : 'a t -> strategy -> unit 121 | (** [set_strategy ra s] sets the reallocation strategy of resizable array [ra] 122 | to [s], possibly causing an immediate reallocation. *) 123 | 124 | val put_strategy : 'a t -> strategy -> unit 125 | (** [put_strategy ra s] sets the reallocation strategy of resizable array [ra] 126 | to [s]. Reallocation is only done at later changes in size. *) 127 | 128 | val enforce_strategy : 'a t -> unit 129 | (** [enforce_strategy ra] forces a reallocation if necessary (e.g. after a 130 | [put_strategy]). *) 131 | 132 | (** {5 Copying, blitting and range extraction} *) 133 | 134 | val copy : 'a t -> 'a t 135 | (** [copy ra] 136 | 137 | @return 138 | a copy of resizable array [ra]. The two arrays share the same strategy! 139 | *) 140 | 141 | val sub : 'a t -> int -> int -> 'a t 142 | (** [sub ra ofs len] 143 | 144 | @return 145 | a resizable subarray of length [len] from resizable array [ra] starting 146 | at offset [ofs] using the default strategy. 147 | 148 | @raise Invalid_argument if parameters do not denote a correct subarray. *) 149 | 150 | val fill : 'a t -> int -> int -> 'a option -> unit 151 | (** [fill ra ofs len el] fills resizable array [ra] from offset [ofs] with 152 | [len] elements [el], possibly adding elements at the end. Raises 153 | [Invalid_argument] if offset [ofs] is larger than the length of the array. 154 | *) 155 | 156 | val blit : 'a t -> int -> 'a t -> int -> int -> unit 157 | (** [blit ra1 ofs1 ra2 ofs2 len] blits resizable array [ra1] onto [ra2] 158 | reading [len] elements from offset [ofs1] and writing them to [ofs2], 159 | possibly adding elements at the end of ra2. Raises [Invalid_argument] if 160 | [ofs1] and [len] do not designate a valid subarray of [ra1] or if [ofs2] 161 | is larger than the length of [ra2]. *) 162 | 163 | (** {5 Combining resizable arrays} *) 164 | 165 | val append : 'a t -> 'a t -> 'a t 166 | (** [append ra1 ra2] 167 | 168 | @return 169 | a new resizable array using the default strategy and copying [ra1] and 170 | [ra2] in this order onto it. *) 171 | 172 | val concat : 'a t list -> 'a t 173 | (** [concat l] 174 | 175 | @return 176 | a new resizable array using the default strategy and copying all 177 | resizable arrays in [l] in their respective order onto it. *) 178 | 179 | (** {5 Adding and removing elements} *) 180 | 181 | val add_one : 'a t -> 'a option -> unit 182 | (** [add_one ra el] adds element [el] to resizable array [ra], possibly 183 | causing a reallocation. *) 184 | 185 | val remove_one : 'a t -> unit 186 | (** [remove_one ra] removes the last element of resizable array [ra], possibly 187 | causing a reallocation. 188 | 189 | @raise Failure if the array is empty. *) 190 | 191 | val remove_n : 'a t -> int -> unit 192 | (** [remove_n ra n] removes the last n elements of resizable array [ra], 193 | possibly causing a reallocation. 194 | 195 | @raise Invalid_argument if there are not enough elements or [n < 0]. *) 196 | 197 | val remove_range : 'a t -> int -> int -> unit 198 | (** [remove_range ra ofs len] removes [len] elements from resizable array [ra] 199 | starting at [ofs] and possibly causing a reallocation. 200 | 201 | @raise Invalid_argument if range is invalid. *) 202 | 203 | val clear : 'a t -> unit 204 | (** [clear ra] removes all elements from resizable array [ra], possibly 205 | causing a reallocation. *) 206 | 207 | (** {5 Swapping} *) 208 | 209 | val swap : 'a t -> int -> int -> unit 210 | (** [swap ra n m] swaps elements at indices [n] and [m]. 211 | 212 | @raise Invalid_argument if any index is out of range. *) 213 | 214 | val swap_in_last : 'a t -> int -> unit 215 | (** [swap_in_last ra n] swaps the last element with the one at position [n]. 216 | 217 | @raise Invalid_argument if index [n] is out of range. *) 218 | 219 | (** {5 Standard conversions} *) 220 | 221 | val to_std : 'a t -> 'a Weak.t 222 | (** [to_std ra] converts a resizable weak array to a standard one. *) 223 | 224 | val sof_std : strategy -> 'a Weak.t -> 'a t 225 | (** [sof_std s ar] converts a standard weak array to a resizable one, using 226 | strategy [s]. *) 227 | 228 | val of_std : 'a Weak.t -> 'a t 229 | (** [of_std ar] converts a standard weak array to a resizable one using the 230 | default strategy. *) 231 | 232 | (** {5 List conversions} *) 233 | 234 | val to_list : 'a t -> 'a option list 235 | (** [to_list ra] converts resizable array [ra] to a list. *) 236 | 237 | val of_list : 'a option list -> 'a t 238 | (** [of_list l] creates a resizable array using the default strategy and the 239 | elements in list [l]. *) 240 | 241 | (** {5 Iterators} *) 242 | 243 | val iter : ('a option -> unit) -> 'a t -> unit 244 | (** [iter f ra] applies the unit-function [f] to each element in resizable 245 | array [ra]. *) 246 | 247 | val iteri : (int -> 'a option -> unit) -> 'a t -> unit 248 | (** [iteri f ra] applies the unit-function [f] to each index and element in 249 | resizable array [ra]. *) 250 | 251 | val fold_left : ('b -> 'a option -> 'b) -> 'b -> 'a t -> 'b 252 | (** [fold_left f a ra] left-folds values in resizable array [ra] using 253 | function [f] and start accumulator [a]. *) 254 | 255 | val fold_right : ('a option -> 'b -> 'b) -> 'a t -> 'b -> 'b 256 | (** [fold_right f a ra] right-folds values in resizable array [ra] using 257 | function [f] and start accumulator [a]. *) 258 | 259 | (** {5 Scanning of resizable arrays} *) 260 | 261 | val for_all : ('a option -> bool) -> 'a t -> bool 262 | (** [for_all p ra] 263 | 264 | @return 265 | [true] if all elements in resizable array [ra] satisfy the predicate 266 | [p], [false] otherwise. *) 267 | 268 | val exists : ('a option -> bool) -> 'a t -> bool 269 | (** [exists p ra] 270 | 271 | @return 272 | [true] if at least one element in resizable array [ra] satisfies the 273 | predicate [p], [false] otherwise. *) 274 | 275 | val mem : 'a option -> 'a t -> bool 276 | (** [mem el ra] 277 | 278 | @return 279 | [true] if element [el] is logically equal to any element in resizable 280 | array [ra], [false] otherwise. *) 281 | 282 | val memq : 'a option -> 'a t -> bool 283 | (** [memq el ra] 284 | 285 | @return 286 | [true] if element [el] is physically equal to any element in resizable 287 | array [ra], [false] otherwise. *) 288 | 289 | val pos : 'a option -> 'a t -> int option 290 | (** [pos el ra] 291 | 292 | @return 293 | [Some index] if [el] is logically equal to the element at [index] in 294 | [ra], [None] otherwise. [index] is the index of the first element that 295 | matches. *) 296 | 297 | val posq : 'a option -> 'a t -> int option 298 | (** [posq el ra] 299 | 300 | @return 301 | [Some index] if [el] is physically equal to the element at [index] in 302 | [ra], [None] otherwise. [index] is the index of the first element that 303 | matches. *) 304 | 305 | (** {5 Searching of resizable arrays} *) 306 | 307 | val find : ('a option -> bool) -> 'a t -> 'a option 308 | (** [find p ra] 309 | 310 | @return 311 | the first element in resizable array [ra] that satisfies predicate [p]. 312 | 313 | @raise Not_found if there is no such element. *) 314 | 315 | val find_index : ('a option -> bool) -> 'a t -> int -> int 316 | (** [find_index p ra pos] 317 | 318 | @return 319 | the index of the first element that satisfies predicate [p] in resizable 320 | array [ra], starting search at index [pos]. 321 | 322 | @raise Not_found 323 | if there is no such element or if [pos] is larger than the highest 324 | index. 325 | 326 | @raise Invalid_argument if [pos] is negative. *) 327 | 328 | val filter : ('a option -> bool) -> 'a t -> 'a t 329 | (** [filter p ra] 330 | 331 | @return 332 | a new resizable array by filtering out all elements in [ra] that satisfy 333 | predicate [p] using the same strategy as [ra]. *) 334 | 335 | val find_all : ('a option -> bool) -> 'a t -> 'a t 336 | (** [find_all p ra] is the same as [filter] *) 337 | 338 | val filter_in_place : ('a option -> bool) -> 'a t -> unit 339 | (** [filter_in_place p ra] as [filter], but filters in place. *) 340 | 341 | val partition : ('a option -> bool) -> 'a t -> 'a t * 'a t 342 | (** [partition p ra] 343 | 344 | @return 345 | a pair of resizable arrays, the left part containing only elements of 346 | [ra] that satisfy predicate [p], the right one only those that do not 347 | satisfy it. Both returned arrays are created using the strategy of [ra]. 348 | *) 349 | 350 | (** {5 {b UNSAFE STUFF - USE WITH CAUTION!}} *) 351 | 352 | val unsafe_get : 'a t -> int -> 'a option 353 | val unsafe_set : 'a t -> int -> 'a option -> unit 354 | val unsafe_sub : 'a t -> int -> int -> 'a t 355 | val unsafe_fill : 'a t -> int -> int -> 'a option -> unit 356 | val unsafe_blit : 'a t -> int -> 'a t -> int -> int -> unit 357 | val unsafe_remove_one : 'a t -> unit 358 | val unsafe_remove_n : 'a t -> int -> unit 359 | val unsafe_swap : 'a t -> int -> int -> unit 360 | val unsafe_swap_in_last : 'a t -> int -> unit 361 | end 362 | -------------------------------------------------------------------------------- /res.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "RES - Library for resizable, contiguous datastructures" 4 | description: 5 | "RES is a library containing resizable arrays, strings, and bitvectors." 6 | maintainer: ["Markus Mottl "] 7 | authors: ["Markus Mottl "] 8 | license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception" 9 | homepage: "https://mmottl.github.io/res" 10 | doc: "https://mmottl.github.io/res/api" 11 | bug-reports: "https://github.com/mmottl/res/issues" 12 | depends: [ 13 | "dune" {>= "2.7"} 14 | "ocaml" {>= "4.08"} 15 | "odoc" {with-doc} 16 | ] 17 | build: [ 18 | ["dune" "subst"] {dev} 19 | [ 20 | "dune" 21 | "build" 22 | "-p" 23 | name 24 | "-j" 25 | jobs 26 | "@install" 27 | "@runtest" {with-test} 28 | "@doc" {with-doc} 29 | ] 30 | ] 31 | dev-repo: "git+https://github.com/mmottl/res.git" 32 | --------------------------------------------------------------------------------