├── .gitignore ├── LICENSE.LGPL+static ├── LICENSE.MIT ├── README.md ├── dune-project ├── leveldb.opam ├── leveldb.opam.template ├── src ├── dune ├── levelDB.ml ├── levelDB.mli └── leveldb_stubs.cc └── test ├── benchmark.ml ├── dune ├── test.ml └── test_utils.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.merlin 3 | *.install 4 | -------------------------------------------------------------------------------- /LICENSE.LGPL+static: -------------------------------------------------------------------------------- 1 | This library is free software; you can redistribute it and/or modify 2 | it under the terms of the GNU Lesser General Public License (LGPL) as 3 | published by the Free Software Foundation; either version 2.1 of the 4 | License (see below), or (at your option) any later version. 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 10 | that executable file under terms of your choice, without any of the 11 | additional requirements listed in clause 6 of the GNU Lesser General 12 | Public License. By "a publicly distributed version of the Library", we 13 | mean either the unmodified Library as distributed, or a modified 14 | version of the Library that is distributed under the conditions 15 | defined in clause 2 of the GNU Lesser General Public License. This 16 | exception does not however invalidate any other reasons why the 17 | executable file might be covered by the GNU Lesser General Public 18 | License. 19 | 20 | ------------ 21 | 22 | GNU LESSER GENERAL PUBLIC LICENSE 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 | Everyone is permitted to copy and distribute verbatim copies 28 | of this license document, but changing it is not allowed. 29 | 30 | [This is the first released version of the Lesser GPL. It also counts 31 | as the successor of the GNU Library Public License, version 2, hence 32 | the version number 2.1.] 33 | 34 | Preamble 35 | 36 | The licenses for most software are designed to take away your 37 | freedom to share and change it. By contrast, the GNU General Public 38 | Licenses are intended to guarantee your freedom to share and change 39 | free software--to make sure the software is free for all its users. 40 | 41 | This license, the Lesser General Public License, applies to some 42 | specially designated software packages--typically libraries--of the 43 | Free Software Foundation and other authors who decide to use it. You 44 | can use it too, but we suggest you first think carefully about whether 45 | this license or the ordinary General Public License is the better 46 | strategy to use in any particular case, based on the explanations below. 47 | 48 | When we speak of free software, we are referring to freedom of use, 49 | not price. Our General Public Licenses are designed to make sure that 50 | you have the freedom to distribute copies of free software (and charge 51 | for this service if you wish); that you receive source code or can get 52 | it if you want it; that you can change the software and use pieces of 53 | it in new free programs; and that you are informed that you can do 54 | these things. 55 | 56 | To protect your rights, we need to make restrictions that forbid 57 | distributors to deny you these rights or to ask you to surrender these 58 | rights. These restrictions translate to certain responsibilities for 59 | you if you distribute copies of the library or if you modify it. 60 | 61 | For example, if you distribute copies of the library, whether gratis 62 | or for a fee, you must give the recipients all the rights that we gave 63 | you. You must make sure that they, too, receive or can get the source 64 | code. If you link other code with the library, you must provide 65 | complete object files to the recipients, so that they can relink them 66 | with the library after making changes to the library and recompiling 67 | it. And you must show them these terms so they know their rights. 68 | 69 | We protect your rights with a two-step method: (1) we copyright the 70 | library, and (2) we offer you this license, which gives you legal 71 | permission to copy, distribute and/or modify the library. 72 | 73 | To protect each distributor, we want to make it very clear that 74 | there is no warranty for the free library. Also, if the library is 75 | modified by someone else and passed on, the recipients should know 76 | that what they have is not the original version, so that the original 77 | author's reputation will not be affected by problems that might be 78 | introduced by others. 79 | 80 | Finally, software patents pose a constant threat to the existence of 81 | any free program. We wish to make sure that a company cannot 82 | effectively restrict the users of a free program by obtaining a 83 | restrictive license from a patent holder. Therefore, we insist that 84 | any patent license obtained for a version of the library must be 85 | consistent with the full freedom of use specified in this license. 86 | 87 | Most GNU software, including some libraries, is covered by the 88 | ordinary GNU General Public License. This license, the GNU Lesser 89 | General Public License, applies to certain designated libraries, and 90 | is quite different from the ordinary General Public License. We use 91 | this license for certain libraries in order to permit linking those 92 | libraries into non-free programs. 93 | 94 | When a program is linked with a library, whether statically or using 95 | a shared library, the combination of the two is legally speaking a 96 | combined work, a derivative of the original library. The ordinary 97 | General Public License therefore permits such linking only if the 98 | entire combination fits its criteria of freedom. The Lesser General 99 | Public License permits more lax criteria for linking other code with 100 | the library. 101 | 102 | We call this license the "Lesser" General Public License because it 103 | does Less to protect the user's freedom than the ordinary General 104 | Public License. It also provides other free software developers Less 105 | of an advantage over competing non-free programs. These disadvantages 106 | are the reason we use the ordinary General Public License for many 107 | libraries. However, the Lesser license provides advantages in certain 108 | special circumstances. 109 | 110 | For example, on rare occasions, there may be a special need to 111 | encourage the widest possible use of a certain library, so that it becomes 112 | a de-facto standard. To achieve this, non-free programs must be 113 | allowed to use the library. A more frequent case is that a free 114 | library does the same job as widely used non-free libraries. In this 115 | case, there is little to gain by limiting the free library to free 116 | software only, so we use the Lesser General Public License. 117 | 118 | In other cases, permission to use a particular library in non-free 119 | programs enables a greater number of people to use a large body of 120 | free software. For example, permission to use the GNU C Library in 121 | non-free programs enables many more people to use the whole GNU 122 | operating system, as well as its variant, the GNU/Linux operating 123 | system. 124 | 125 | Although the Lesser General Public License is Less protective of the 126 | users' freedom, it does ensure that the user of a program that is 127 | linked with the Library has the freedom and the wherewithal to run 128 | that program using a modified version of the Library. 129 | 130 | The precise terms and conditions for copying, distribution and 131 | modification follow. Pay close attention to the difference between a 132 | "work based on the library" and a "work that uses the library". The 133 | former contains code derived from the library, whereas the latter must 134 | be combined with the library in order to run. 135 | 136 | GNU LESSER GENERAL PUBLIC LICENSE 137 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 138 | 139 | 0. This License Agreement applies to any software library or other 140 | program which contains a notice placed by the copyright holder or 141 | other authorized party saying it may be distributed under the terms of 142 | this Lesser General Public License (also called "this License"). 143 | Each licensee is addressed as "you". 144 | 145 | A "library" means a collection of software functions and/or data 146 | prepared so as to be conveniently linked with application programs 147 | (which use some of those functions and data) to form executables. 148 | 149 | The "Library", below, refers to any such software library or work 150 | which has been distributed under these terms. A "work based on the 151 | Library" means either the Library or any derivative work under 152 | copyright law: that is to say, a work containing the Library or a 153 | portion of it, either verbatim or with modifications and/or translated 154 | straightforwardly into another language. (Hereinafter, translation is 155 | included without limitation in the term "modification".) 156 | 157 | "Source code" for a work means the preferred form of the work for 158 | making modifications to it. For a library, complete source code means 159 | all the source code for all modules it contains, plus any associated 160 | interface definition files, plus the scripts used to control compilation 161 | and installation of the library. 162 | 163 | Activities other than copying, distribution and modification are not 164 | covered by this License; they are outside its scope. The act of 165 | running a program using the Library is not restricted, and output from 166 | such a program is covered only if its contents constitute a work based 167 | on the Library (independent of the use of the Library in a tool for 168 | writing it). Whether that is true depends on what the Library does 169 | and what the program that uses the Library does. 170 | 171 | 1. You may copy and distribute verbatim copies of the Library's 172 | complete source code as you receive it, in any medium, provided that 173 | you conspicuously and appropriately publish on each copy an 174 | appropriate copyright notice and disclaimer of warranty; keep intact 175 | all the notices that refer to this License and to the absence of any 176 | warranty; and distribute a copy of this License along with the 177 | Library. 178 | 179 | You may charge a fee for the physical act of transferring a copy, 180 | and you may at your option offer warranty protection in exchange for a 181 | fee. 182 | 183 | 2. You may modify your copy or copies of the Library or any portion 184 | of it, thus forming a work based on the Library, and copy and 185 | distribute such modifications or work under the terms of Section 1 186 | above, provided that you also meet all of these conditions: 187 | 188 | a) The modified work must itself be a software library. 189 | 190 | b) You must cause the files modified to carry prominent notices 191 | stating that you changed the files and the date of any change. 192 | 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 | 196 | d) If a facility in the modified Library refers to a function or a 197 | table of data to be supplied by an application program that uses 198 | the facility, other than as an argument passed when the facility 199 | is invoked, then you must make a good faith effort to ensure that, 200 | in the event an application does not supply such function or 201 | table, the facility still operates, and performs whatever part of 202 | its purpose remains meaningful. 203 | 204 | (For example, a function in a library to compute square roots has 205 | a purpose that is entirely well-defined independent of the 206 | application. Therefore, Subsection 2d requires that any 207 | application-supplied function or table used by this function must 208 | be optional: if the application does not supply it, the square 209 | root function must still compute square roots.) 210 | 211 | These requirements apply to the modified work as a whole. If 212 | identifiable sections of that work are not derived from the Library, 213 | and can be reasonably considered independent and separate works in 214 | themselves, then this License, and its terms, do not apply to those 215 | sections when you distribute them as separate works. But when you 216 | distribute the same sections as part of a whole which is a work based 217 | on the Library, the distribution of the whole must be on the terms of 218 | this License, whose permissions for other licensees extend to the 219 | entire whole, and thus to each and every part regardless of who wrote 220 | it. 221 | 222 | Thus, it is not the intent of this section to claim rights or contest 223 | your rights to work written entirely by you; rather, the intent is to 224 | exercise the right to control the distribution of derivative or 225 | collective works based on the Library. 226 | 227 | In addition, mere aggregation of another work not based on the Library 228 | with the Library (or with a work based on the Library) on a volume of 229 | a storage or distribution medium does not bring the other work under 230 | the scope of this License. 231 | 232 | 3. You may opt to apply the terms of the ordinary GNU General Public 233 | License instead of this License to a given copy of the Library. To do 234 | this, you must alter all the notices that refer to this License, so 235 | that they refer to the ordinary GNU General Public License, version 2, 236 | instead of to this License. (If a newer version than version 2 of the 237 | ordinary GNU General Public License has appeared, then you can specify 238 | that version instead if you wish.) Do not make any other change in 239 | these notices. 240 | 241 | Once this change is made in a given copy, it is irreversible for 242 | that copy, so the ordinary GNU General Public License applies to all 243 | subsequent copies and derivative works made from that copy. 244 | 245 | This option is useful when you wish to copy part of the code of 246 | the Library into a program that is not a library. 247 | 248 | 4. You may copy and distribute the Library (or a portion or 249 | derivative of it, under Section 2) in object code or executable form 250 | under the terms of Sections 1 and 2 above provided that you accompany 251 | it with the complete corresponding machine-readable source code, which 252 | must be distributed under the terms of Sections 1 and 2 above on a 253 | medium customarily used for software interchange. 254 | 255 | If distribution of object code is made by offering access to copy 256 | from a designated place, then offering equivalent access to copy the 257 | source code from the same place satisfies the requirement to 258 | distribute the source code, even though third parties are not 259 | compelled to copy the source along with the object code. 260 | 261 | 5. A program that contains no derivative of any portion of the 262 | Library, but is designed to work with the Library by being compiled or 263 | linked with it, is called a "work that uses the Library". Such a 264 | work, in isolation, is not a derivative work of the Library, and 265 | therefore falls outside the scope of this License. 266 | 267 | However, linking a "work that uses the Library" with the Library 268 | creates an executable that is a derivative of the Library (because it 269 | contains portions of the Library), rather than a "work that uses the 270 | library". The executable is therefore covered by this License. 271 | Section 6 states terms for distribution of such executables. 272 | 273 | When a "work that uses the Library" uses material from a header file 274 | that is part of the Library, the object code for the work may be a 275 | derivative work of the Library even though the source code is not. 276 | Whether this is true is especially significant if the work can be 277 | linked without the Library, or if the work is itself a library. The 278 | threshold for this to be true is not precisely defined by law. 279 | 280 | If such an object file uses only numerical parameters, data 281 | structure layouts and accessors, and small macros and small inline 282 | functions (ten lines or less in length), then the use of the object 283 | file is unrestricted, regardless of whether it is legally a derivative 284 | work. (Executables containing this object code plus portions of the 285 | Library will still fall under Section 6.) 286 | 287 | Otherwise, if the work is a derivative of the Library, you may 288 | distribute the object code for the work under the terms of Section 6. 289 | Any executables containing that work also fall under Section 6, 290 | whether or not they are linked directly with the Library itself. 291 | 292 | 6. As an exception to the Sections above, you may also combine or 293 | link a "work that uses the Library" with the Library to produce a 294 | work containing portions of the Library, and distribute that work 295 | under terms of your choice, provided that the terms permit 296 | modification of the work for the customer's own use and reverse 297 | engineering for debugging such modifications. 298 | 299 | You must give prominent notice with each copy of the work that the 300 | Library is used in it and that the Library and its use are covered by 301 | this License. You must supply a copy of this License. If the work 302 | during execution displays copyright notices, you must include the 303 | copyright notice for the Library among them, as well as a reference 304 | directing the user to the copy of this License. Also, you must do one 305 | of these things: 306 | 307 | a) Accompany the work with the complete corresponding 308 | machine-readable source code for the Library including whatever 309 | changes were used in the work (which must be distributed under 310 | Sections 1 and 2 above); and, if the work is an executable linked 311 | with the Library, with the complete machine-readable "work that 312 | uses the Library", as object code and/or source code, so that the 313 | user can modify the Library and then relink to produce a modified 314 | executable containing the modified Library. (It is understood 315 | that the user who changes the contents of definitions files in the 316 | Library will not necessarily be able to recompile the application 317 | to use the modified definitions.) 318 | 319 | b) Use a suitable shared library mechanism for linking with the 320 | Library. A suitable mechanism is one that (1) uses at run time a 321 | copy of the library already present on the user's computer system, 322 | rather than copying library functions into the executable, and (2) 323 | will operate properly with a modified version of the library, if 324 | the user installs one, as long as the modified version is 325 | interface-compatible with the version that the work was made with. 326 | 327 | c) Accompany the work with a written offer, valid for at 328 | least three years, to give the same user the materials 329 | specified in Subsection 6a, above, for a charge no more 330 | than the cost of performing this distribution. 331 | 332 | d) If distribution of the work is made by offering access to copy 333 | from a designated place, offer equivalent access to copy the above 334 | specified materials from the same place. 335 | 336 | e) Verify that the user has already received a copy of these 337 | materials or that you have already sent this user a copy. 338 | 339 | For an executable, the required form of the "work that uses the 340 | Library" must include any data and utility programs needed for 341 | reproducing the executable from it. However, as a special exception, 342 | the materials to be distributed need not include anything that is 343 | normally distributed (in either source or binary form) with the major 344 | components (compiler, kernel, and so on) of the operating system on 345 | which the executable runs, unless that component itself accompanies 346 | the executable. 347 | 348 | It may happen that this requirement contradicts the license 349 | restrictions of other proprietary libraries that do not normally 350 | accompany the operating system. Such a contradiction means you cannot 351 | use both them and the Library together in an executable that you 352 | distribute. 353 | 354 | 7. You may place library facilities that are a work based on the 355 | Library side-by-side in a single library together with other library 356 | facilities not covered by this License, and distribute such a combined 357 | library, provided that the separate distribution of the work based on 358 | the Library and of the other library facilities is otherwise 359 | permitted, and provided that you do these two things: 360 | 361 | a) Accompany the combined library with a copy of the same work 362 | based on the Library, uncombined with any other library 363 | facilities. This must be distributed under the terms of the 364 | Sections above. 365 | 366 | b) Give prominent notice with the combined library of the fact 367 | that part of it is a work based on the Library, and explaining 368 | where to find the accompanying uncombined form of the same work. 369 | 370 | 8. You may not copy, modify, sublicense, link with, or distribute 371 | the Library except as expressly provided under this License. Any 372 | attempt otherwise to copy, modify, sublicense, link with, or 373 | distribute the Library is void, and will automatically terminate your 374 | rights under this License. However, parties who have received copies, 375 | or rights, from you under this License will not have their licenses 376 | terminated so long as such parties remain in full compliance. 377 | 378 | 9. You are not required to accept this License, since you have not 379 | signed it. However, nothing else grants you permission to modify or 380 | distribute the Library or its derivative works. These actions are 381 | prohibited by law if you do not accept this License. Therefore, by 382 | modifying or distributing the Library (or any work based on the 383 | Library), you indicate your acceptance of this License to do so, and 384 | all its terms and conditions for copying, distributing or modifying 385 | the Library or works based on it. 386 | 387 | 10. Each time you redistribute the Library (or any work based on the 388 | Library), the recipient automatically receives a license from the 389 | original licensor to copy, distribute, link with or modify the Library 390 | subject to these terms and conditions. You may not impose any further 391 | restrictions on the recipients' exercise of the rights granted herein. 392 | You are not responsible for enforcing compliance by third parties with 393 | this License. 394 | 395 | 11. If, as a consequence of a court judgment or allegation of patent 396 | infringement or for any other reason (not limited to patent issues), 397 | conditions are imposed on you (whether by court order, agreement or 398 | otherwise) that contradict the conditions of this License, they do not 399 | excuse you from the conditions of this License. If you cannot 400 | distribute so as to satisfy simultaneously your obligations under this 401 | License and any other pertinent obligations, then as a consequence you 402 | may not distribute the Library at all. For example, if a patent 403 | license would not permit royalty-free redistribution of the Library by 404 | all those who receive copies directly or indirectly through you, then 405 | the only way you could satisfy both it and this License would be to 406 | refrain entirely from distribution of the Library. 407 | 408 | If any portion of this section is held invalid or unenforceable under any 409 | particular circumstance, the balance of the section is intended to apply, 410 | and the section as a whole is intended to apply in other circumstances. 411 | 412 | It is not the purpose of this section to induce you to infringe any 413 | patents or other property right claims or to contest validity of any 414 | such claims; this section has the sole purpose of protecting the 415 | integrity of the free software distribution system which is 416 | implemented by public license practices. Many people have made 417 | generous contributions to the wide range of software distributed 418 | through that system in reliance on consistent application of that 419 | system; it is up to the author/donor to decide if he or she is willing 420 | to distribute software through any other system and a licensee cannot 421 | impose that choice. 422 | 423 | This section is intended to make thoroughly clear what is believed to 424 | be a consequence of the rest of this License. 425 | 426 | 12. If the distribution and/or use of the Library is restricted in 427 | certain countries either by patents or by copyrighted interfaces, the 428 | original copyright holder who places the Library under this License may add 429 | an explicit geographical distribution limitation excluding those countries, 430 | so that distribution is permitted only in or among countries not thus 431 | excluded. In such case, this License incorporates the limitation as if 432 | written in the body of this License. 433 | 434 | 13. The Free Software Foundation may publish revised and/or new 435 | versions of the Lesser General Public License from time to time. 436 | Such new versions will be similar in spirit to the present version, 437 | but may differ in detail to address new problems or concerns. 438 | 439 | Each version is given a distinguishing version number. If the Library 440 | specifies a version number of this License which applies to it and 441 | "any later version", you have the option of following the terms and 442 | conditions either of that version or of any later version published by 443 | the Free Software Foundation. If the Library does not specify a 444 | license version number, you may choose any version ever published by 445 | the Free Software Foundation. 446 | 447 | 14. If you wish to incorporate parts of the Library into other free 448 | programs whose distribution conditions are incompatible with these, 449 | write to the author to ask for permission. For software which is 450 | copyrighted by the Free Software Foundation, write to the Free 451 | Software Foundation; we sometimes make exceptions for this. Our 452 | decision will be guided by the two goals of preserving the free status 453 | of all derivatives of our free software and of promoting the sharing 454 | and reuse of software generally. 455 | 456 | NO WARRANTY 457 | 458 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 459 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 460 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 461 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 462 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 463 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 464 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 465 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 466 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 467 | 468 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 469 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 470 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 471 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 472 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 473 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 474 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 475 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 476 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 477 | DAMAGES. 478 | 479 | END OF TERMS AND CONDITIONS 480 | -------------------------------------------------------------------------------- /LICENSE.MIT: -------------------------------------------------------------------------------- 1 | Copyright (C) 2011-2021 Mauricio Fernández 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | ocaml-leveldb: OCaml bindings for Google's LevelDB 3 | =================================================== 4 | Copyright (c) 2011-2021 Mauricio Fernandez 5 | 6 | These bindings expose nearly the full LevelDB C++ API, including: 7 | 8 | * iterators 9 | * snapshots 10 | * batch updates 11 | * support for custom comparators 12 | 13 | Blocking functions release the OCaml runtime system, allowing to: 14 | 15 | * run them in parallel with other OCaml code 16 | * perform multiple LevelDB operations in parallel 17 | 18 | Requirements 19 | ------------ 20 | 21 | * OCaml >= 3.12.0 22 | * GCC with C++ frontend (g++) 23 | * dune to build 24 | * ounit2 for the unit tests 25 | * LevelDB (including dev package libleveldb-dev or similar) 26 | * Snappy (including dev package libsnappy-dev or similar) 27 | 28 | Building 29 | -------- 30 | Just 31 | 32 | $ dune build @install 33 | 34 | should do. It will build both LevelDB and the OCaml bindings. 35 | 36 | You can then install with 37 | 38 | $ dune install 39 | 40 | API documentation 41 | ----------------- 42 | Refer to src/levelDB.mli. 43 | 44 | License 45 | ------- 46 | This software is dual-licensed as LGPL+static linking exception and MIT. 47 | Refer to LICENSE.MIT and LICENSE.LGPL+static. 48 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | 3 | (name leveldb) 4 | 5 | (license MIT) 6 | 7 | (authors "") 8 | 9 | (maintainers "") 10 | 11 | (source 12 | (github mfp/ocaml-leveldb)) 13 | 14 | (generate_opam_files true) 15 | 16 | (package 17 | (name leveldb) 18 | (synopsis "OCaml bindings for Google's LevelDB library") 19 | (description 20 | "These bindings expose nearly the full LevelDB C++ API, including: iterators, snapshots, batch updates and support for custom comparators. Blocking functions release the OCaml runtime system, allowing to run them in parallel with other OCaml code and to perform multiple LevelDB operations in parallel.") 21 | (depends 22 | (ocaml 23 | (>= 4.06)) 24 | (dune 25 | (>= 2.0)) 26 | (ounit2 :with-test) 27 | (odoc :with-doc) 28 | conf-leveldb)) 29 | -------------------------------------------------------------------------------- /leveldb.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "OCaml bindings for Google's LevelDB library" 4 | description: 5 | "These bindings expose nearly the full LevelDB C++ API, including: iterators, snapshots, batch updates and support for custom comparators. Blocking functions release the OCaml runtime system, allowing to run them in parallel with other OCaml code and to perform multiple LevelDB operations in parallel." 6 | maintainer: [""] 7 | authors: [""] 8 | license: "MIT" 9 | homepage: "https://github.com/mfp/ocaml-leveldb" 10 | bug-reports: "https://github.com/mfp/ocaml-leveldb/issues" 11 | depends: [ 12 | "ocaml" {>= "4.06"} 13 | "dune" {>= "2.0"} 14 | "ounit2" {with-test} 15 | "odoc" {with-doc} 16 | "conf-leveldb" 17 | ] 18 | build: [ 19 | ["dune" "subst"] {pinned} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "@install" 28 | "@runtest" {with-test} 29 | "@doc" {with-doc} 30 | ] 31 | ] 32 | dev-repo: "git+https://github.com/mfp/ocaml-leveldb.git" 33 | depexts: [ 34 | [["debian"] ["libsnappy-dev"]] 35 | [["debian"] ["libleveldb-dev"]] 36 | [["ubuntu"] ["libsnappy-dev"]] 37 | ] 38 | -------------------------------------------------------------------------------- /leveldb.opam.template: -------------------------------------------------------------------------------- 1 | depexts: [ 2 | [["debian"] ["libsnappy-dev"]] 3 | [["debian"] ["libleveldb-dev"]] 4 | [["ubuntu"] ["libsnappy-dev"]] 5 | ] 6 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name leveldb) 3 | (wrapped false) 4 | (foreign_stubs 5 | (language cxx) 6 | (names leveldb_stubs)) 7 | (c_library_flags -lleveldb -lstdc++) 8 | (libraries threads)) 9 | -------------------------------------------------------------------------------- /src/levelDB.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2011 Mauricio Fernandez 3 | * 4 | * This library is free software; you can redistribute it and/or 5 | * modify it under the terms of the GNU Lesser General Public 6 | * License as published by the Free Software Foundation; either 7 | * version 2.1 of the License, or (at your option) any later version, 8 | * with the special exception on linking described in file LICENSE. 9 | * 10 | * This library is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | * Lesser General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU Lesser General Public 16 | * License along with this library; if not, write to the Free Software 17 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | *) 19 | 20 | type db_ 21 | type snapshot_ 22 | type writebatch 23 | type iterator_ 24 | type comparator 25 | 26 | type _env 27 | type env = _env option 28 | 29 | external hash_snapshot_ : snapshot_ -> int = "ldb_snapshot_hash" [@@noalloc] 30 | external hash_iterator_ : iterator_ -> int = "ldb_iterator_hash" [@@noalloc] 31 | 32 | module RMutex = 33 | struct 34 | type t = { mutex : Mutex.t; mutable thread : int option; } 35 | 36 | let make () = { mutex = Mutex.create (); thread = None; } 37 | 38 | let with_lock t f = 39 | let id = Thread.id (Thread.self ()) in 40 | match t.thread with 41 | Some t when t = id -> f () 42 | | _ -> 43 | Mutex.lock t.mutex; 44 | t.thread <- Some id; 45 | try 46 | let y = f () in 47 | t.thread <- None; 48 | Mutex.unlock t.mutex; 49 | y 50 | with e -> 51 | t.thread <- None; 52 | Mutex.unlock t.mutex; 53 | raise e 54 | end 55 | 56 | module rec TYPES : 57 | sig 58 | module SNAPSHOTS : Weak.S with type data = TYPES.snapshot 59 | module ITERATORS : Weak.S with type data = TYPES.iterator 60 | 61 | type db = 62 | { db : db_; 63 | mutex : RMutex.t; 64 | snapshots : SNAPSHOTS.t; 65 | iterators : ITERATORS.t 66 | } 67 | type snapshot = { s_parent : db; s_handle : snapshot_ } 68 | type iterator = { i_parent : db; i_handle : iterator_ } 69 | end = 70 | struct 71 | module SNAPSHOTS = 72 | Weak.Make(struct 73 | type t = TYPES.snapshot 74 | let hash t = hash_snapshot_ t.TYPES.s_handle 75 | let equal t1 t2 = t1 == t2 76 | end) 77 | 78 | module ITERATORS = 79 | Weak.Make(struct 80 | type t = TYPES.iterator 81 | let hash t = hash_iterator_ t.TYPES.i_handle 82 | let equal t1 t2 = t1 == t2 83 | end) 84 | 85 | type db = 86 | { db : db_; 87 | mutex : RMutex.t; 88 | snapshots : SNAPSHOTS.t; 89 | iterators : ITERATORS.t 90 | } 91 | 92 | type snapshot = { s_parent : db; s_handle : snapshot_ } 93 | type iterator = { i_parent : db; i_handle : iterator_ } 94 | end 95 | 96 | include TYPES 97 | 98 | type read_access = 99 | { 100 | get_exn : string -> string; 101 | mem : string -> bool; 102 | iterator : unit -> iterator; 103 | } 104 | 105 | exception Error of string 106 | 107 | let () = 108 | Callback.register_exception "org.eigenclass/leveldb/Not_found" Not_found; 109 | Callback.register_exception "org.eigenclass/leveldb/Error" (Error "") 110 | 111 | let error fmt = 112 | Printf.ksprintf (fun s -> raise (Error s)) fmt 113 | 114 | external destroy : string -> bool = "ldb_destroy" 115 | external repair : string -> bool = "ldb_repair" 116 | 117 | external lexicographic_comparator : unit -> comparator = 118 | "ldb_lexicographic_comparator" [@@noalloc] 119 | 120 | let lexicographic_comparator = lexicographic_comparator () 121 | 122 | let default_env = None 123 | 124 | external open_db_ : 125 | string -> write_buffer_size:int -> max_open_files:int -> 126 | block_size:int -> block_restart_interval:int -> 127 | cache_size:(int option) -> comparator:comparator -> env:env -> db_ 128 | = "ldb_open_bytecode" "ldb_open_native" 129 | 130 | external close_ : db_ -> unit = "ldb_close" 131 | external get_exn_ : db_ -> string -> string = "ldb_get" 132 | 133 | external put_ : db_ -> string -> string -> sync:bool -> unit = "ldb_put" 134 | 135 | external delete_ : db_ -> string -> sync:bool -> unit = "ldb_delete" 136 | 137 | external mem_ : db_ -> string -> bool = "ldb_mem" 138 | 139 | external get_approximate_size_ : db_ -> string -> string -> Int64.t = 140 | "ldb_get_approximate_size" 141 | 142 | external get_property_ : db_ -> string -> string option = 143 | "ldb_get_property" 144 | 145 | external compact_range_ : db_ -> string option -> string option -> unit = 146 | "ldb_compact_range" 147 | 148 | external release_snapshot_ : snapshot_ -> unit = "ldb_snapshot_release" 149 | external close_iterator_ : iterator_ -> unit = "ldb_iter_close" 150 | 151 | let release_snapshot s = 152 | RMutex.with_lock s.s_parent.mutex 153 | (fun () -> SNAPSHOTS.remove s.s_parent.snapshots s); 154 | release_snapshot_ s.s_handle 155 | 156 | let close_iterator it = 157 | RMutex.with_lock it.i_parent.mutex 158 | (fun () -> ITERATORS.remove it.i_parent.iterators it); 159 | close_iterator_ it.i_handle 160 | 161 | let add_snapshot_to_db s_parent s_handle = 162 | let s = { s_handle; s_parent } in 163 | RMutex.with_lock s_parent.mutex 164 | (fun () -> SNAPSHOTS.add s_parent.snapshots s); 165 | Gc.finalise release_snapshot s; 166 | s 167 | 168 | let add_iterator_to_db db handle = 169 | let it = { i_handle = handle; i_parent = db } in 170 | RMutex.with_lock db.mutex (fun () -> ITERATORS.add db.iterators it); 171 | Gc.finalise close_iterator it; 172 | it 173 | 174 | module Batch = 175 | struct 176 | external make : unit -> writebatch = "ldb_writebatch_make" 177 | 178 | external put_substring_unsafe : 179 | writebatch -> 180 | string -> int -> int -> 181 | string -> int -> int -> 182 | unit = 183 | "ldb_writebatch_put_substring_unsafe_bytecode" 184 | "ldb_writebatch_put_substring_unsafe_native" "noalloc" 185 | 186 | let put b k v = 187 | put_substring_unsafe 188 | b k 0 (String.length k) v 0 (String.length v) 189 | 190 | let put_substring b k o1 l1 v o2 l2 = 191 | if o1 < 0 || l1 < 0 || o1 + l1 > String.length k then 192 | error "Snapshot.put_substring: invalid key substring"; 193 | if o2 < 0 || l2 < 0 || o2 + l2 > String.length v then 194 | error "Snapshot.put_substring: invalid value substring"; 195 | put_substring_unsafe b k o1 l1 v o2 l2 196 | 197 | external delete_substring_unsafe : 198 | writebatch -> string -> int -> int -> unit = 199 | "ldb_writebatch_delete_substring_unsafe" [@@noalloc] 200 | 201 | let delete b k = delete_substring_unsafe b k 0 (String.length k) 202 | 203 | let delete_substring b k off len = 204 | if off < 0 || len < 0 || off + len > String.length k then 205 | error "Snapshot.delete_substring: invalid key substring"; 206 | delete_substring_unsafe b k off len 207 | 208 | external write : db_ -> writebatch -> sync:bool -> unit = "ldb_write_batch" 209 | 210 | let write db ?(sync = false) writebatch = 211 | write db.db writebatch ~sync 212 | end 213 | 214 | module Iterator = 215 | struct 216 | external make_ : db_ -> fill_cache:bool -> iterator_ = "ldb_make_iter" 217 | external seek_to_first_ : iterator_ -> unit = "ldb_it_first" 218 | external seek_to_last_ : iterator_ -> unit = "ldb_it_last" 219 | 220 | external seek_unsafe_ : iterator_ -> string -> int -> int -> unit = 221 | "ldb_it_seek_unsafe" 222 | 223 | external next_ : iterator_ -> unit = "ldb_it_next" 224 | external prev_: iterator_ -> unit = "ldb_it_prev" 225 | 226 | external valid_ : iterator_ -> bool = "ldb_it_valid" [@@noalloc] 227 | 228 | external key_unsafe_ : iterator_ -> bytes -> int = "ldb_it_key_unsafe" 229 | external value_unsafe_ : iterator_ -> bytes -> int = "ldb_it_value_unsafe" 230 | 231 | let close = close_iterator 232 | 233 | let make ?(fill_cache=true) db = add_iterator_to_db db (make_ db.db ~fill_cache) 234 | 235 | let seek_to_first it = seek_to_first_ it.i_handle 236 | let seek_to_last it = seek_to_last_ it.i_handle 237 | 238 | let next it = next_ it.i_handle 239 | let prev it = prev_ it.i_handle 240 | let valid it = valid_ it.i_handle 241 | 242 | let seek it s off len = 243 | if off < 0 || len < 0 || off + len > String.length s then 244 | error "Iterator.seek: invalid arguments (key:%S off:%d len:%d)" 245 | s off len; 246 | seek_unsafe_ it.i_handle s off len 247 | 248 | let fill_and_resize_if_needed name f it buf = 249 | let len = f it !buf in 250 | if len <= Bytes.length !buf then len 251 | else begin 252 | if len > Sys.max_string_length then 253 | error "Iterator.%s: string is larger than Sys.max_string_length" name; 254 | buf := Bytes.create len; 255 | f it !buf 256 | end 257 | 258 | let fill_key it buf = 259 | fill_and_resize_if_needed "fill_key" key_unsafe_ it.i_handle buf 260 | 261 | let fill_value it buf = 262 | fill_and_resize_if_needed "fill_value" value_unsafe_ it.i_handle buf 263 | 264 | let get_key it = 265 | let b = ref Bytes.empty in 266 | ignore (fill_key it b); 267 | (* !b is the only remaining reference to this buffer, it is safe to cast to a string *) 268 | Bytes.unsafe_to_string !b 269 | 270 | let get_value it = 271 | let b = ref Bytes.empty in 272 | ignore (fill_value it b); 273 | (* !b is the only remaining reference to this buffer, it is safe to cast to a string *) 274 | Bytes.unsafe_to_string !b 275 | 276 | let iter_aux next f it = 277 | let finished = ref false in 278 | while not !finished && valid it do 279 | finished := not (f (get_key it) (get_value it)); 280 | next it 281 | done 282 | 283 | let iter f it = 284 | seek_to_first it; 285 | iter_aux next f it 286 | 287 | let rev_iter f it = 288 | seek_to_last it; 289 | iter_aux prev f it 290 | 291 | let iter_from f it k = 292 | seek it k 0 (String.length k); 293 | iter_aux next f it 294 | 295 | let rev_iter_from f it k = 296 | seek it k 0 (String.length k); 297 | iter_aux prev f it 298 | end 299 | 300 | module Read_access = 301 | struct 302 | let get t k = try Some (t.get_exn k) with Not_found -> None 303 | let get_exn t k = t.get_exn k 304 | let mem t k = t.mem k 305 | let iterator t = t.iterator () 306 | 307 | let iter f t = Iterator.iter f (iterator t) 308 | let rev_iter f t = Iterator.rev_iter f (iterator t) 309 | let iter_from f t k = Iterator.iter_from f (iterator t) k 310 | let rev_iter_from f t k = Iterator.rev_iter_from f (iterator t) k 311 | end 312 | 313 | module Snapshot = 314 | struct 315 | external make_ : db_ -> snapshot_ = "ldb_snapshot_make" 316 | external get_exn_ : snapshot_ -> string -> string = "ldb_snapshot_get" 317 | external mem_ : snapshot_ -> string -> bool = "ldb_snapshot_mem" 318 | external iterator_ : snapshot_ -> iterator_ = "ldb_snapshot_make_iterator" 319 | 320 | let make db = 321 | let s_handle = make_ db.db in 322 | let s = add_snapshot_to_db db s_handle in 323 | s 324 | 325 | let release = release_snapshot 326 | 327 | let get_exn s k = get_exn_ s.s_handle k 328 | let mem s k = mem_ s.s_handle k 329 | 330 | let iterator s = 331 | add_iterator_to_db s.s_parent (iterator_ s.s_handle) 332 | 333 | let get t k = try Some (get_exn t k) with Not_found -> None 334 | 335 | let read_access s = 336 | { get_exn = get_exn s; mem = mem s; 337 | iterator = (fun () -> iterator s) } 338 | 339 | let iter f t = Iterator.iter f (iterator t) 340 | let rev_iter f t = Iterator.rev_iter f (iterator t) 341 | let iter_from f t k = Iterator.iter_from f (iterator t) k 342 | let rev_iter_from f t k = Iterator.rev_iter_from f (iterator t) k 343 | end 344 | 345 | let close db = 346 | SNAPSHOTS.iter Snapshot.release db.snapshots; 347 | ITERATORS.iter Iterator.close db.iterators; 348 | close_ db.db 349 | 350 | let open_db 351 | ?(write_buffer_size = 4*1024*1024) 352 | ?(max_open_files = 1000) 353 | ?(block_size = 4096) 354 | ?(block_restart_interval = 16) 355 | ?(comparator = lexicographic_comparator) 356 | ?cache_size 357 | ?(env = default_env) 358 | path = 359 | let db = open_db_ 360 | ~write_buffer_size ~max_open_files ~block_size ~block_restart_interval 361 | ~cache_size ~comparator ~env path in 362 | let mutex = RMutex.make () in 363 | let db = 364 | { db; mutex; 365 | snapshots = SNAPSHOTS.create 13; iterators = ITERATORS.create 13; 366 | } 367 | in 368 | Gc.finalise close db; 369 | db 370 | 371 | let get_exn db k = get_exn_ db.db k 372 | 373 | let get db k = try Some (get_exn db k) with Not_found -> None 374 | 375 | let mem db k = mem_ db.db k 376 | 377 | let read_access db = 378 | { get_exn = get_exn db; mem = mem db; 379 | iterator = (fun () -> Iterator.make db) } 380 | 381 | let iterator db = Iterator.make db 382 | 383 | let delete db ?(sync = false) k = 384 | delete_ db.db ~sync k 385 | 386 | let put db ?(sync = false) k v = 387 | put_ db.db ~sync k v 388 | 389 | let iter f db = Iterator.iter f (Iterator.make db) 390 | let rev_iter f db = Iterator.rev_iter f (Iterator.make db) 391 | let iter_from f db k = Iterator.iter_from f (Iterator.make db) k 392 | let rev_iter_from f db k = Iterator.rev_iter_from f (Iterator.make db) k 393 | 394 | let get_approximate_size db k1 k2 = get_approximate_size_ db.db k1 k2 395 | let get_property db k = get_property_ db.db k 396 | let compact_range db ~from_key ~to_key = compact_range_ db.db from_key to_key 397 | -------------------------------------------------------------------------------- /src/levelDB.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2011 Mauricio Fernandez 3 | * 4 | * This library is free software; you can redistribute it and/or 5 | * modify it under the terms of the GNU Lesser General Public 6 | * License as published by the Free Software Foundation; either 7 | * version 2.1 of the License, or (at your option) any later version, 8 | * with the special exception on linking described in file LICENSE. 9 | * 10 | * This library is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | * Lesser General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU Lesser General Public 16 | * License along with this library; if not, write to the Free Software 17 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | *) 19 | 20 | (** Access to [leveldb] databases. *) 21 | 22 | (** {2 Usage in a concurrent setting} 23 | * 24 | * A database may only be opened by one process at a time; this is enforced 25 | * by LevelDB by using a file lock. Within a process, operations on a value 26 | * of type [db] (such as {!get}, {!put}, {!iterator}, {!Iterator.make} or 27 | * {!Snapshot.make}) can be performed concurrently in different threads. 28 | * Values of type [iterator], [writebatch], [snapshot] and [read_access] must 29 | * not be used simultaneously from two different threads, so external 30 | * synchronization (e.g. using [Mutex]) is required. 31 | * 32 | * As an exception to the above rule, it is possible to close a [db] with 33 | * [iterator], [snapshot] or [read_access] values in use. Values of these 34 | * types can also be released/closed in a thread while they are being used in 35 | * another. In both cases, the thread that is releasing/closing the value 36 | * will wait until the current operation is finished and invalidate the value 37 | * so that any further operations on it will fail. 38 | *) 39 | 40 | (** {2 Exceptions} *) 41 | 42 | (** Errors (apart from [Not_found]) are notified with [Error s] exceptions. *) 43 | exception Error of string 44 | 45 | (** {2 Types} *) 46 | 47 | (** Database *) 48 | type db 49 | 50 | (** Database iterators. *) 51 | type iterator 52 | 53 | (** Batch write operations. *) 54 | type writebatch 55 | 56 | (** Immutable database snapshots. *) 57 | type snapshot 58 | 59 | (** Read-only access to the DB or a snapshot. *) 60 | type read_access 61 | 62 | (** Type that represents a [const Comparator*] pointer (refer to 63 | * LevelDB's [comparator.h]). If you want to define your own, 64 | * use an external function of type [unit -> comparator] 65 | * returning the pointer.*) 66 | type comparator 67 | 68 | (** Type that represents a [const Env*] pointer (refer to 69 | * LevelDB's [options.h]). If you want to define your own, 70 | * use an external function of type [unit -> env] 71 | * returning the pointer.*) 72 | type env 73 | 74 | (** {2 Database maintenance} *) 75 | 76 | (** Destroy the contents of the database in the given directory. 77 | * @return [true] if the operation succeeded. *) 78 | val destroy : string -> bool 79 | 80 | (** If a DB cannot be opened, you may attempt to call this method to resurrect 81 | * as much of the contents of the database as possible. Some data may be 82 | * lost, so be careful when calling this function on a database that contains 83 | * important information. 84 | * @return [true] if the operation succeeded. *) 85 | val repair : string -> bool 86 | 87 | (** {2 Database operations} *) 88 | 89 | val default_env : env 90 | val lexicographic_comparator : comparator 91 | 92 | (** Open a leveldb database in the given directory. 93 | * @param cache_size size of LRU cache in MB (no cache if not given) 94 | * *) 95 | val open_db : 96 | ?write_buffer_size:int -> 97 | ?max_open_files:int -> 98 | ?block_size:int -> ?block_restart_interval:int -> 99 | ?comparator:comparator -> 100 | ?cache_size:int -> 101 | ?env:env -> 102 | string -> db 103 | 104 | (** Close the database. All further operations on it will fail. 105 | * Existing snapshots, read_access values and iterators are released and 106 | * invalidated. If such values are being used in a concurrent thread, 107 | * the current thread will wait until the operation is finished and then 108 | * proceed to invalidate the value, making any further uses on it fail, and 109 | * release it. 110 | * Note that the database is closed automatically in the finalizer if you 111 | * don't close it manually. *) 112 | val close : db -> unit 113 | 114 | (** Read-only access to the DB. *) 115 | val read_access : db -> read_access 116 | 117 | (** Return a new iterator. Refer to {!Iterator.make}. *) 118 | val iterator : db -> iterator 119 | 120 | (** [get_approximate_size from_key to_key] returns the approximate size 121 | * on disk of the range comprised between [from_key] and [to_key]. *) 122 | val get_approximate_size : db -> string -> string -> Int64.t 123 | 124 | (** Return the specified property, if existent. *) 125 | val get_property : db -> string -> string option 126 | 127 | (** Compact specified range. [None] is treated as a key before (resp. after) 128 | * all keys in the database; therefore [compact_range db None None] will 129 | * compact the whole DB. *) 130 | val compact_range : db -> from_key:string option -> to_key:string option -> unit 131 | 132 | (** {2 Read/write} *) 133 | 134 | (** Note that in the following functions the contents of the key will be 135 | * copied to the stack, so exceedingly large keys could cause a stack 136 | * overflow. *) 137 | 138 | (** Retrieve a value. *) 139 | val get : db -> string -> string option 140 | 141 | (** Retrieve a value, raising [Not_found] if missing. *) 142 | val get_exn : db -> string -> string 143 | 144 | (** [mem db key] returns [true] iff [key] is present in [db]. *) 145 | val mem : db -> string -> bool 146 | 147 | (** [put ?sync key value] adds (or replaces) a binding to the database. 148 | * @param sync whether to write synchronously (default: false) *) 149 | val put : db -> ?sync:bool -> string -> string -> unit 150 | 151 | (** [delete ?sync key] deletes the binding for the given key. 152 | * @param sync whether to write synchronously (default: false) *) 153 | val delete : db -> ?sync:bool -> string -> unit 154 | 155 | (** {3 Iteration} *) 156 | 157 | (* Note that the functions that accept a key ({!iter_from}, {!rev_iter_from}) 158 | * will copy its contents to the stack, so exceedingly large keys could cause 159 | * a stack overflow. *) 160 | 161 | (** [iter f db] applies [f] to all the bindings in [db] until it returns 162 | * [false], i.e. runs [f key value] for all the bindings in lexicographic 163 | * key order. *) 164 | val iter : (string -> string -> bool) -> db -> unit 165 | 166 | (** Like {!iter}, but proceed in reverse lexicographic order. *) 167 | val rev_iter : (string -> string -> bool) -> db -> unit 168 | 169 | (** [iter_from f db start] applies [f key value] for all the bindings after 170 | * [start] (inclusive) until it returns false. *) 171 | val iter_from : (string -> string -> bool) -> db -> string -> unit 172 | 173 | (** [iter_from f db start] applies [f key value] for all the bindings before 174 | * [start] (inclusive) in reverse lexicographic order until [f] returns 175 | * [false].. *) 176 | val rev_iter_from : (string -> string -> bool) -> db -> string -> unit 177 | 178 | (** {2 Batch operations} *) 179 | 180 | (** Batch operations applied atomically. *) 181 | module Batch : 182 | sig 183 | (** Initialize a batch operation. *) 184 | val make : unit -> writebatch 185 | 186 | (** [put writebatch key value] adds or replaces a binding. *) 187 | val put : writebatch -> string -> string -> unit 188 | 189 | (** [put_substring writebatch key off1 len1 value off2 len2] adds or 190 | * replaces a binding for the substrings of [key] and [value] delimited by 191 | * the given offsets and lengths. 192 | * @raise Error if the offset, length pairs do not represent valid 193 | * substrings *) 194 | val put_substring : writebatch -> 195 | string -> int -> int -> 196 | string -> int -> int -> unit 197 | 198 | (** [delete writebatch key] removes the binding for [key], if present.. *) 199 | val delete : writebatch -> string -> unit 200 | 201 | (** [delete writebatch s off len] removes (if present) the binding for the 202 | * substring of [s] delimited by the offset [off] and the length [len]. *) 203 | val delete_substring : writebatch -> string -> int -> int -> unit 204 | 205 | (** Apply the batch operation atomically. 206 | * @param sync whether to write synchronously (default: false) *) 207 | val write : db -> ?sync:bool -> writebatch -> unit 208 | end 209 | 210 | (** {2 Iterators} *) 211 | 212 | (** Iteration over bindings in a database. *) 213 | module Iterator : 214 | sig 215 | (** Create a new iterator. Note that the iterator keeps a reference to the 216 | * DB, so the latter will not be GCed automatically as long as the iterator 217 | * is being used. Note also that if the DB is closed manually, the iterator 218 | * will be invalidated and further operations will fail. The returned 219 | * iterator needs not be closed manually, for it will be closed in its 220 | * finalizer. *) 221 | val make : ?fill_cache:bool -> db -> iterator 222 | 223 | (** Close the iterator. Further operations on it will fail. Note that 224 | * the iterator fill be closed automatically in its finalizer if this 225 | * function is not called manually. *) 226 | val close : iterator -> unit 227 | 228 | (** Jump the the first binding in the database/snapshot. *) 229 | val seek_to_first : iterator -> unit 230 | 231 | (** Jump the the last binding in the database/snapshot. *) 232 | val seek_to_last : iterator -> unit 233 | 234 | (** [seek it s off len] seeks to first binding whose key is >= to the key 235 | * corresponding to the substring of [s] starting at [off] and of length 236 | * [len]. 237 | * Note that the contents of the key will be copied to the stack, so 238 | * exceedingly large keys could cause a stack overflow. 239 | * @raise Error if the offset/length does not represent a substring of the 240 | * key. *) 241 | val seek: iterator -> string -> int -> int -> unit 242 | 243 | (** Jump to the next binding. *) 244 | val next : iterator -> unit 245 | 246 | (** Jump to the previous binding. *) 247 | val prev : iterator -> unit 248 | 249 | (** @return true iff the iterator is pointing to a binding. *) 250 | val valid : iterator -> bool 251 | 252 | (** [fill_key it r] places the key for the current binding in the string 253 | * referred to by [r] if it fits, otherwise it creates a new string and 254 | * updates the reference. 255 | * @raise Error if the iterator is not {!valid} 256 | * @return length of the key *) 257 | val fill_key : iterator -> bytes ref -> int 258 | 259 | (** Similar to {!fill_key}, but returning the value. *) 260 | val fill_value : iterator -> bytes ref -> int 261 | 262 | (** Return the key part of the binding pointer to by the iterator. 263 | * @raise Error if the iterator is not {!valid}. *) 264 | val get_key : iterator -> string 265 | 266 | (** Return the value part of the binding pointer to by the iterator. 267 | * @raise Error if the iterator is not {!valid}. *) 268 | val get_value : iterator -> string 269 | 270 | (** [iter f db] applies [f] to all the bindings in the database/snapshot the 271 | * iterator belongs to, until [f] returns [false], i.e. runs [f key value] 272 | * for all the bindings in lexicographic key order. *) 273 | val iter : (string -> string -> bool) -> iterator -> unit 274 | 275 | (** Like {!iter}, but proceed in reverse lexicographic order. *) 276 | val rev_iter : (string -> string -> bool) -> iterator -> unit 277 | 278 | (** [iter_from f it start] applies [f key value] for all the bindings after 279 | * [start] (inclusive) until it returns false. *) 280 | val iter_from : (string -> string -> bool) -> iterator -> string -> unit 281 | 282 | (** [iter_from f it start] applies [f key value] for all the bindings before 283 | * [start] (inclusive) in reverse lexicographic order until [f] returns 284 | * [false].. *) 285 | val rev_iter_from : (string -> string -> bool) -> iterator -> string -> unit 286 | end 287 | 288 | (** {2 Snapshots} *) 289 | 290 | (** Access to database snapshots. 291 | * Note that the functions that accept a key will copy its contents to the 292 | * stack, so exceedingly large keys could cause a stack overflow. *) 293 | module Snapshot : 294 | sig 295 | (** Create a new snapshot. Note that the snapshot keeps a reference to the 296 | * DB, so the latter will not be GCed automatically as long as the snapshot 297 | * is being used. Note also that if the DB is closed manually, the snapshot 298 | * will be released and further operations will fail. The returned 299 | * snapshot needs not be released manually, for it will be released in its 300 | * finalizer. *) 301 | val make : db -> snapshot 302 | 303 | (** Release the finalizer. Further operations on it will fail. Note that 304 | * the snapshot fill be released automatically in its finalizer if this 305 | * function is not called manually. *) 306 | val release : snapshot -> unit 307 | 308 | val get : snapshot -> string -> string option 309 | val get_exn : snapshot -> string -> string 310 | 311 | val mem : snapshot -> string -> bool 312 | 313 | (** Return a new iterator. *) 314 | val iterator : snapshot -> iterator 315 | 316 | val read_access : snapshot -> read_access 317 | 318 | (** Refer to {!Iterator.iter}. *) 319 | val iter : (string -> string -> bool) -> snapshot -> unit 320 | 321 | (** Refer to {!Iterator.rev_iter}. *) 322 | val rev_iter : (string -> string -> bool) -> snapshot -> unit 323 | 324 | (** Refer to {!Iterator.iter_from}. *) 325 | val iter_from : (string -> string -> bool) -> snapshot -> string -> unit 326 | 327 | (** Refer to {!Iterator.rev_iter_from}. *) 328 | val rev_iter_from : (string -> string -> bool) -> snapshot -> string -> unit 329 | end 330 | 331 | (** {2 Abstract read-only access} *) 332 | 333 | (** Read-only access to databases and snapshots. 334 | * Note that the functions that accept a key will copy its contents to the 335 | * stack, so exceedingly large keys could cause a stack overflow. *) 336 | module Read_access : 337 | sig 338 | val get : read_access -> string -> string option 339 | val get_exn : read_access -> string -> string 340 | val mem : read_access -> string -> bool 341 | val iterator : read_access -> iterator 342 | 343 | (** Refer to {!Iterator.iter}. *) 344 | val iter : (string -> string -> bool) -> read_access -> unit 345 | 346 | (** Refer to {!Iterator.rev_iter}. *) 347 | val rev_iter : (string -> string -> bool) -> read_access -> unit 348 | 349 | (** Refer to {!Iterator.iter_from}. *) 350 | val iter_from : (string -> string -> bool) -> read_access -> string -> unit 351 | 352 | (** Refer to {!Iterator.rev_iter_from}. *) 353 | val rev_iter_from : (string -> string -> bool) -> read_access -> string -> unit 354 | end 355 | -------------------------------------------------------------------------------- /src/leveldb_stubs.cc: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2011 Mauricio Fernandez 3 | * 4 | * This library is free software; you can redistribute it and/or 5 | * modify it under the terms of the GNU Lesser General Public 6 | * License as published by the Free Software Foundation; either 7 | * version 2.1 of the License, or (at your option) any later version, 8 | * with the special exception on linking described in file LICENSE. 9 | * 10 | * This library is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | * Lesser General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU Lesser General Public 16 | * License along with this library; if not, write to the Free Software 17 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | */ 19 | 20 | #include 21 | #include 22 | #include 23 | #include "leveldb/cache.h" 24 | 25 | extern "C" { 26 | 27 | #include 28 | #include 29 | #include 30 | #include 31 | #include 32 | #include 33 | #include 34 | #include 35 | 36 | #include 37 | #include 38 | #include 39 | 40 | #define Val_none Val_int(0) 41 | 42 | typedef struct ldb_any { 43 | void *data; 44 | void (*release)(void *); 45 | intnat id; // signed int w/ same size as pointer 46 | bool closed; 47 | bool *in_use; 48 | bool auto_finalize; 49 | } ldb_any; 50 | 51 | 52 | typedef struct { leveldb::DB *db; } ldb_handle; 53 | typedef struct { leveldb::Iterator *it; } ldb_iterator; 54 | typedef struct { leveldb::WriteBatch *batch; } ldb_writebatch; 55 | 56 | typedef struct { 57 | const leveldb::Snapshot *snapshot; 58 | leveldb::DB *db; 59 | intnat id; 60 | bool closed; 61 | bool *in_use; 62 | } ldb_snapshot; 63 | 64 | static void ldb_any_finalize(value t); 65 | static int ldb_any_compare(value t1, value t2); 66 | static intnat ldb_any_hash(value t); 67 | 68 | static intnat wrapped_val_id = 1; 69 | 70 | #define LDB_ANY(x) ((ldb_any *) Data_custom_val(x)) 71 | 72 | #define LDB_HANDLE(x) (((ldb_handle *) Data_custom_val(x))->db) 73 | #define LDB_ITERATOR(x) (((ldb_iterator *) Data_custom_val(x))->it) 74 | #define LDB_WRITEBATCH(x) (((ldb_writebatch *) Data_custom_val(x))->batch) 75 | 76 | #define UNWRAP_SNAPSHOT(x) ((ldb_snapshot *) Data_custom_val(x)) 77 | 78 | #define WRAP(_dst, _data, _type, _auto_release) \ 79 | do { \ 80 | leveldb::_type *p = _data; \ 81 | _dst = caml_alloc_custom(&ldb_any_ops, sizeof(ldb_any), 0, 1); \ 82 | LDB_ANY(_dst)->data = p; \ 83 | LDB_ANY(_dst)->closed = false; \ 84 | LDB_ANY(_dst)->id = ++wrapped_val_id; \ 85 | LDB_ANY(_dst)->in_use = (bool *)malloc(sizeof(bool)); \ 86 | *(LDB_ANY(_dst)->in_use) = false; \ 87 | LDB_ANY(_dst)->auto_finalize = _auto_release; \ 88 | LDB_ANY(_dst)->release = (void (*)(void *))release_##_type; \ 89 | } while(0); 90 | 91 | static struct custom_operations ldb_any_ops = { 92 | (char *)"org.eigenclass/leveldb_any", 93 | ldb_any_finalize, 94 | ldb_any_compare, 95 | ldb_any_hash, 96 | custom_serialize_default, 97 | custom_deserialize_default 98 | }; 99 | 100 | static void ldb_snapshot_finalize(value); 101 | static intnat ldb_snapshot_hash_(value); 102 | 103 | static struct custom_operations ldb_snapshot_ops = 104 | { 105 | (char *)"org.eigenclass/leveldb_snapshot", 106 | ldb_snapshot_finalize, 107 | ldb_any_compare, 108 | ldb_snapshot_hash_, 109 | custom_serialize_default, 110 | custom_deserialize_default 111 | }; 112 | 113 | static const value *not_found_exn = 0; 114 | static const value *error_exn = 0; 115 | 116 | static void raise_error(const char *s) 117 | { 118 | if(!error_exn) error_exn = caml_named_value("org.eigenclass/leveldb/Error"); 119 | if(!error_exn) 120 | caml_failwith(s); 121 | else 122 | caml_raise_with_string(*error_exn, s); 123 | } 124 | 125 | static void 126 | raise_status_error_and_release(const leveldb::Status &status) 127 | { 128 | using namespace std; 129 | CAMLparam0(); 130 | CAMLlocal1(err); 131 | std::string msg = status.ToString(); 132 | 133 | err = caml_copy_string(msg.c_str()); 134 | 135 | msg.~string(); 136 | status.~Status(); 137 | 138 | if(!error_exn) error_exn = caml_named_value("org.eigenclass/leveldb/Error"); 139 | if(!error_exn) 140 | caml_failwith(""); 141 | else 142 | caml_raise_with_arg(*error_exn, err); 143 | 144 | CAMLreturn0; 145 | } 146 | 147 | #define RAISE_NOT_FOUND \ 148 | do { \ 149 | if(!not_found_exn) \ 150 | not_found_exn = caml_named_value("org.eigenclass/leveldb/Not_found"); \ 151 | if(!not_found_exn) \ 152 | caml_failwith("Not_found"); \ 153 | else \ 154 | caml_raise_constant(*not_found_exn); \ 155 | } while(0); 156 | 157 | #define CHECK_ERROR(status) \ 158 | do { \ 159 | if(!status.ok()) raise_status_error_and_release(status); \ 160 | } while(0); 161 | 162 | #define CHECK_ERROR_AND_CLEANUP(status, cleanup) \ 163 | do { \ 164 | if(!status.ok()) { \ 165 | do { cleanup } while(0); \ 166 | raise_status_error_and_release(status); \ 167 | } \ 168 | } while(0); 169 | 170 | #define CHECK_CLOSED(t) \ 171 | do { \ 172 | if(LDB_ANY(t)->closed || !LDB_ANY(t)->in_use || !LDB_HANDLE(t)) \ 173 | raise_error("leveldb handle closed"); \ 174 | } while(0); 175 | 176 | #define CHECK_IT_CLOSED(_it) \ 177 | do { \ 178 | if(LDB_ANY(_it)->closed || !LDB_ANY(_it)->in_use || !LDB_ITERATOR(_it)) \ 179 | raise_error("iterator closed"); \ 180 | } while(0); 181 | 182 | #define CHECK_SNAPSHOT_CLOSED(_s) \ 183 | do { \ 184 | if(UNWRAP_SNAPSHOT(_s)->closed || !UNWRAP_SNAPSHOT(_s)->in_use || \ 185 | !UNWRAP_SNAPSHOT(_s)->snapshot) \ 186 | raise_error("invalid snapshot"); \ 187 | } while(0); 188 | 189 | #define USE_HANDLE(t) \ 190 | bool *__resource_in_use__##t = LDB_ANY(t)->in_use; \ 191 | CHECK_CLOSED(t); \ 192 | *__resource_in_use__##t = true; 193 | 194 | #define USE_IT(t) \ 195 | bool *__resource_in_use__##t = LDB_ANY(t)->in_use; \ 196 | CHECK_IT_CLOSED(t); \ 197 | *__resource_in_use__##t = true; 198 | 199 | #define USE_SNAPSHOT(t) \ 200 | bool *__resource_in_use__##t = UNWRAP_SNAPSHOT(t)->in_use; \ 201 | CHECK_SNAPSHOT_CLOSED(t); \ 202 | *__resource_in_use__##t = true; 203 | 204 | #define RELEASE(t) \ 205 | do { \ 206 | *__resource_in_use__##t = false; \ 207 | } while(0); 208 | 209 | #define RELEASE_HANDLE(t) RELEASE(t) 210 | 211 | #define RELEASE_IT(t) RELEASE(t) 212 | 213 | #define RELEASE_SNAPSHOT(t) RELEASE(t) 214 | 215 | #if SIZEOF_PTR < 8 216 | 217 | // see http://www.concentric.net/~ttwang/tech/inthash.htm 218 | int32_t hash_int(int32_t key) 219 | { 220 | // >> is implementation-dependent, we assume it's arithmetic and hope for 221 | // the best (most compilers will do arithmetic if the int is signed; GCC, 222 | // for one, does) 223 | key = ~key + (key << 15); // key = (key << 15) - key - 1; 224 | key = key ^ (key >> 12); 225 | key = key + (key << 2); 226 | key = key ^ (key >> 4); 227 | key = key * 2057; // key = (key + (key << 3)) + (key << 11); 228 | key = key ^ (key >> 16); 229 | return (int32_t)key; 230 | } 231 | 232 | #else 233 | 234 | int64_t hash_int(int64_t key) 235 | { 236 | key = (~key) + (key << 21); // key = (key << 21) - key - 1; 237 | key = key ^ (key >> 24); 238 | key = (key + (key << 3)) + (key << 8); // key * 265 239 | key = key ^ (key >> 14); 240 | key = (key + (key << 2)) + (key << 4); // key * 21 241 | key = key ^ (key >> 28); 242 | key = key + (key << 31); 243 | return (int64_t)key; 244 | } 245 | #endif 246 | 247 | static void 248 | ldb_any_finalize(value t) 249 | { 250 | ldb_any *h = LDB_ANY(t); 251 | 252 | h->closed = true; 253 | // wait until the resource is not being used in another thread 254 | while(h->in_use && *(h->in_use)) { 255 | struct timeval tv; 256 | tv.tv_sec = 0; 257 | tv.tv_usec = 1000; 258 | select(0, NULL, NULL, NULL, &tv); 259 | } 260 | if(h->auto_finalize) { 261 | if(h->data) { 262 | h->release(h->data); 263 | h->data = NULL; 264 | } 265 | if(h->in_use) { 266 | free(h->in_use); 267 | h->in_use = NULL; 268 | } 269 | } 270 | } 271 | 272 | static int 273 | ldb_any_compare(value t1, value t2) 274 | { 275 | ldb_any *h1, *h2; 276 | h1 = LDB_ANY(t1); 277 | h2 = LDB_ANY(t2); 278 | return ((char*)h1->data - (char *)h2->data); 279 | } 280 | 281 | static intnat 282 | ldb_any_hash(value t) 283 | { 284 | return hash_int(LDB_ANY(t)->id); 285 | } 286 | 287 | static intnat 288 | ldb_snapshot_hash_(value t1) 289 | { 290 | return hash_int(UNWRAP_SNAPSHOT(t1)->id); 291 | } 292 | 293 | CAMLprim value 294 | ldb_snapshot_hash(value t1) 295 | { 296 | return Val_long(ldb_snapshot_hash_(t1)); 297 | } 298 | 299 | CAMLprim value 300 | ldb_iterator_hash(value t1) 301 | { 302 | return Val_long(ldb_any_hash(t1)); 303 | } 304 | 305 | static void release_DB(leveldb::DB *db) 306 | { 307 | delete db; 308 | } 309 | 310 | static void release_Iterator(leveldb::Iterator *iterator) 311 | { 312 | delete iterator; 313 | } 314 | 315 | static void release_WriteBatch(leveldb::WriteBatch *writebatch) 316 | { 317 | delete writebatch; 318 | } 319 | 320 | CAMLprim value 321 | ldb_lexicographic_comparator(value unit) 322 | { 323 | const leveldb::Comparator *c = leveldb::BytewiseComparator (); 324 | 325 | return (value)c; 326 | } 327 | 328 | CAMLprim value 329 | ldb_open_native(value s, value write_buffer_size, value max_open_files, 330 | value block_size, value block_restart_interval, 331 | value cache_size_option, value comparator, value env) 332 | { 333 | CAMLparam1(s); 334 | CAMLlocal1(r); 335 | 336 | leveldb::Options options; 337 | 338 | leveldb::DB* db; 339 | options.create_if_missing = true; 340 | options.write_buffer_size = Long_val(write_buffer_size); 341 | options.max_open_files = Int_val(max_open_files); 342 | options.block_size = Int_val(block_size); 343 | options.block_restart_interval = Int_val(block_restart_interval); 344 | 345 | if (env != Val_none) options.env = (leveldb::Env *)env; 346 | 347 | if (cache_size_option != Val_none) { 348 | options.block_cache = leveldb::NewLRUCache(Int_val(Field(cache_size_option, 0)) * 1048576); 349 | } 350 | options.comparator = (const leveldb::Comparator *)comparator; 351 | leveldb::Status status = leveldb::DB::Open(options, String_val(s), &db); 352 | CHECK_ERROR(status); 353 | 354 | WRAP(r, db, DB, false); 355 | CAMLreturn(r); 356 | } 357 | 358 | CAMLprim value 359 | ldb_open_bytecode(value *argv, int argn) 360 | { 361 | return ldb_open_native(argv[0], argv[1], argv[2], argv[3], argv[4], 362 | argv[5], argv[6], argv[7]); 363 | } 364 | 365 | CAMLprim value 366 | ldb_close(value t) 367 | { 368 | LDB_ANY(t)->auto_finalize = true; 369 | ldb_any_finalize(t); 370 | return(Val_unit); 371 | } 372 | 373 | CAMLprim value 374 | ldb_destroy(value s) 375 | { 376 | std::string _s(String_val(s), string_length(s)); 377 | 378 | caml_enter_blocking_section(); 379 | leveldb::Status status = leveldb::DestroyDB(_s, leveldb::Options()); 380 | caml_leave_blocking_section(); 381 | return(status.ok() ? Val_true : Val_false); 382 | } 383 | 384 | CAMLprim value 385 | ldb_repair(value s) 386 | { 387 | std::string _s(String_val(s), string_length(s)); 388 | 389 | caml_enter_blocking_section(); 390 | leveldb::Status status = leveldb::RepairDB(_s, leveldb::Options()); 391 | caml_leave_blocking_section(); 392 | return(status.ok() ? Val_true : Val_false); 393 | } 394 | 395 | #define TO_SLICE(x) leveldb::Slice(String_val(x), string_length(x)) 396 | 397 | #define TO_SLICE_COPY(dst, x) \ 398 | char _data_##x##_[string_length(x)]; \ 399 | memcpy(_data_##x##_, String_val(x), string_length(x)); \ 400 | leveldb::Slice dst(_data_##x##_, string_length(x)); 401 | 402 | #define COPY_FROM(dst, src) \ 403 | do { \ 404 | dst = caml_alloc_string(src.size()); \ 405 | memcpy(Bytes_val(dst), src.data(), src.size()); \ 406 | } while(0); 407 | 408 | CAMLprim value 409 | ldb_get(value t, value k) 410 | { 411 | using namespace std; 412 | CAMLparam2(t, k); 413 | CAMLlocal1(ret); 414 | leveldb::DB *db = LDB_HANDLE(t); 415 | 416 | USE_HANDLE(t); 417 | 418 | TO_SLICE_COPY(key, k); 419 | 420 | caml_enter_blocking_section(); 421 | std::string v; 422 | leveldb::Status status = db->Get(leveldb::ReadOptions(), key, &v); 423 | // must release before recovering the OCaml runtime lock because otherwise 424 | // we could be stuck waiting for it while another thread running the GC is 425 | // waiting for us to release the handle 426 | RELEASE_HANDLE(t); 427 | caml_leave_blocking_section(); 428 | 429 | if(status.IsNotFound()) { v.~string(); status.~Status(); RAISE_NOT_FOUND; } 430 | 431 | CHECK_ERROR_AND_CLEANUP(status, { v.~string(); }); 432 | 433 | COPY_FROM(ret, v); 434 | CAMLreturn(ret); 435 | } 436 | 437 | CAMLprim value 438 | ldb_put(value t, value k, value v, value sync) 439 | { 440 | using namespace std; 441 | CAMLparam3(t, k, v); 442 | leveldb::DB *db = LDB_HANDLE(t); 443 | 444 | USE_HANDLE(t); 445 | TO_SLICE_COPY(key, k); 446 | 447 | std::string val(String_val(v), string_length(v)); 448 | 449 | leveldb::WriteOptions options; 450 | 451 | options.sync = (Val_true == sync); 452 | 453 | caml_enter_blocking_section(); 454 | leveldb::Status status = db->Put(options, key, val); 455 | RELEASE_HANDLE(t); 456 | caml_leave_blocking_section(); 457 | 458 | CHECK_ERROR_AND_CLEANUP(status, { val.~string(); }); 459 | 460 | CAMLreturn(Val_unit); 461 | } 462 | 463 | 464 | CAMLprim value 465 | ldb_delete(value t, value k, value sync) 466 | { 467 | CAMLparam2(t, k); 468 | leveldb::DB *db = LDB_HANDLE(t); 469 | 470 | USE_HANDLE(t); 471 | 472 | TO_SLICE_COPY(key, k); 473 | 474 | leveldb::WriteOptions options; 475 | 476 | options.sync = (Val_true == sync); 477 | 478 | caml_enter_blocking_section(); 479 | leveldb::Status status = db->Delete(options, key); 480 | RELEASE_HANDLE(t); 481 | caml_leave_blocking_section(); 482 | 483 | CHECK_ERROR(status); 484 | 485 | CAMLreturn(Val_unit); 486 | } 487 | 488 | CAMLprim value 489 | ldb_mem(value t, value k) 490 | { 491 | using namespace std; 492 | CAMLparam2(t, k); 493 | leveldb::DB *db = LDB_HANDLE(t); 494 | 495 | USE_HANDLE(t); 496 | 497 | TO_SLICE_COPY(key, k); 498 | std::string v; 499 | 500 | caml_enter_blocking_section(); 501 | leveldb::Status status = db->Get(leveldb::ReadOptions(), key, &v); 502 | RELEASE_HANDLE(t); 503 | caml_leave_blocking_section(); 504 | 505 | if(status.IsNotFound()) CAMLreturn(Val_false); 506 | if(status.ok ()) CAMLreturn(Val_true); 507 | 508 | CHECK_ERROR_AND_CLEANUP(status, { v.~string(); }); 509 | 510 | CAMLreturn(Val_false); 511 | } 512 | 513 | CAMLprim value 514 | ldb_iterator_compare(value t1, value t2) 515 | { 516 | return Val_int(ldb_any_compare(t1, t2)); 517 | } 518 | 519 | CAMLprim value 520 | ldb_make_iter(value t, value fill_cache) 521 | { 522 | CAMLparam1(t); 523 | CAMLlocal1(it); 524 | 525 | leveldb::DB *db = LDB_HANDLE(t); 526 | 527 | CHECK_CLOSED(t); 528 | leveldb::ReadOptions options; 529 | options.fill_cache = Bool_val(fill_cache); 530 | leveldb::Iterator *_it = db->NewIterator(options); 531 | 532 | WRAP(it, _it, Iterator, false); 533 | CAMLreturn(it); 534 | } 535 | 536 | CAMLprim value 537 | ldb_iter_close(value t) 538 | { 539 | LDB_ANY(t)->auto_finalize = true; 540 | ldb_any_finalize(t); 541 | return(Val_unit); 542 | } 543 | 544 | CAMLprim value 545 | ldb_it_first(value it) 546 | { 547 | CAMLparam1(it); 548 | USE_IT(it); 549 | leveldb::Iterator *_it = LDB_ITERATOR(it); 550 | 551 | caml_enter_blocking_section(); 552 | _it->SeekToFirst(); 553 | RELEASE_IT(it); 554 | caml_leave_blocking_section(); 555 | 556 | CAMLreturn(Val_unit); 557 | } 558 | 559 | CAMLprim value 560 | ldb_it_last(value it) 561 | { 562 | CAMLparam1(it); 563 | USE_IT(it); 564 | leveldb::Iterator *_it = LDB_ITERATOR(it); 565 | 566 | caml_enter_blocking_section(); 567 | _it->SeekToLast(); 568 | RELEASE_IT(it); 569 | caml_leave_blocking_section(); 570 | 571 | CAMLreturn(Val_unit); 572 | } 573 | 574 | CAMLprim value 575 | ldb_it_seek_unsafe(value it, value s, value off, value len) 576 | { 577 | CAMLparam2(it, s); 578 | USE_IT(it); 579 | leveldb::Iterator *_it = LDB_ITERATOR(it); 580 | 581 | char key_data[Int_val(len)]; 582 | memcpy(key_data, &Byte_u(s, Int_val(off)), Int_val(len)); 583 | leveldb::Slice key(key_data, Int_val(len)); 584 | 585 | caml_enter_blocking_section(); 586 | _it->Seek(key); 587 | RELEASE_IT(it); 588 | caml_leave_blocking_section(); 589 | 590 | CAMLreturn(Val_unit); 591 | } 592 | 593 | CAMLprim value 594 | ldb_it_next(value it) 595 | { 596 | CAMLparam1(it); 597 | USE_IT(it); 598 | leveldb::Iterator *_it = LDB_ITERATOR(it); 599 | 600 | caml_enter_blocking_section(); 601 | _it->Next(); 602 | RELEASE_IT(it); 603 | caml_leave_blocking_section(); 604 | 605 | CAMLreturn(Val_unit); 606 | } 607 | 608 | CAMLprim value 609 | ldb_it_prev(value it) 610 | { 611 | CAMLparam1(it); 612 | USE_IT(it); 613 | leveldb::Iterator *_it = LDB_ITERATOR(it); 614 | 615 | caml_enter_blocking_section(); 616 | _it->Prev(); 617 | RELEASE_IT(it); 618 | caml_leave_blocking_section(); 619 | 620 | CAMLreturn(Val_unit); 621 | } 622 | 623 | CAMLprim value 624 | ldb_it_valid(value it) 625 | { 626 | leveldb::Iterator *_it = LDB_ITERATOR(it); 627 | 628 | if(LDB_ANY(it)->closed || !_it || !_it->Valid()) return Val_false; 629 | 630 | return Val_true; 631 | } 632 | 633 | /* returns: 634 | * SIZE if the key exists and its size is SIZE 635 | * if SIZE <= buf len, the key is copied into the supplied buffer 636 | */ 637 | CAMLprim value 638 | ldb_it_key_unsafe(value it, value buf) 639 | { 640 | CAMLparam2(it, buf); 641 | 642 | CHECK_IT_CLOSED(it); 643 | leveldb::Iterator *_it = LDB_ITERATOR(it); 644 | 645 | if(!_it->Valid()) raise_status_error_and_release(_it->status()); 646 | 647 | leveldb::Slice key = _it->key(); 648 | size_t size = key.size(); 649 | 650 | if(size <= string_length(buf)) 651 | memcpy(Bytes_val(buf), key.data(), size); 652 | 653 | CAMLreturn(Val_long(size)); 654 | } 655 | 656 | /* returns: 657 | * SIZE if the value exists and its size is SIZE 658 | * if SIZE <= buf len, the value is copied into the supplied buffer 659 | */ 660 | CAMLprim value 661 | ldb_it_value_unsafe(value it, value buf) 662 | { 663 | CAMLparam2(it, buf); 664 | 665 | CHECK_IT_CLOSED(it); 666 | leveldb::Iterator *_it = LDB_ITERATOR(it); 667 | 668 | if(!_it->Valid()) raise_status_error_and_release(_it->status()); 669 | 670 | leveldb::Slice v = _it->value(); 671 | size_t size = v.size(); 672 | 673 | if(size <= string_length(buf)) 674 | memcpy(Bytes_val(buf), v.data(), size); 675 | 676 | CAMLreturn(Val_long(size)); 677 | } 678 | 679 | CAMLprim value 680 | ldb_writebatch_make(value unit) 681 | { 682 | CAMLparam0(); 683 | CAMLlocal1(ret); 684 | 685 | leveldb::WriteBatch *b = new leveldb::WriteBatch; 686 | WRAP(ret, b, WriteBatch, true); 687 | 688 | CAMLreturn(ret); 689 | } 690 | 691 | CAMLprim value 692 | ldb_writebatch_put_substring_unsafe_native 693 | (value t, value k, value o1, value l1, value v, value o2, value l2) 694 | { 695 | leveldb::WriteBatch *b = LDB_WRITEBATCH(t); 696 | 697 | leveldb::Slice key = leveldb::Slice(String_val(k) + Int_val(o1), Int_val(l1)); 698 | leveldb::Slice value = leveldb::Slice(String_val(v) + Int_val(o2), Int_val(l2)); 699 | b->Put(key, value); 700 | 701 | return Val_unit; 702 | } 703 | 704 | CAMLprim value 705 | ldb_writebatch_put_substring_unsafe_bytecode(value *argv, int argn) 706 | { 707 | return 708 | ldb_writebatch_put_substring_unsafe_native(argv[0], argv[1], argv[2], 709 | argv[3], argv[4], argv[5], 710 | argv[6]); 711 | } 712 | 713 | CAMLprim value 714 | ldb_writebatch_delete_substring_unsafe(value t, value k, value off, value len) 715 | { 716 | leveldb::WriteBatch *b = LDB_WRITEBATCH(t); 717 | 718 | leveldb::Slice key = leveldb::Slice(String_val(k) + Int_val(off), Int_val(len)); 719 | b->Delete(key); 720 | 721 | return Val_unit; 722 | } 723 | 724 | CAMLprim value 725 | ldb_write_batch(value t, value batch, value sync) 726 | { 727 | CAMLparam2(t, batch); 728 | leveldb::DB *db = LDB_HANDLE(t); 729 | leveldb::WriteBatch *b = LDB_WRITEBATCH(batch); 730 | 731 | USE_HANDLE(t); 732 | leveldb::WriteOptions options; 733 | options.sync = (Val_true == sync); 734 | 735 | caml_enter_blocking_section(); 736 | leveldb::Status status = db->Write(options, b); 737 | RELEASE_HANDLE(t); 738 | caml_leave_blocking_section(); 739 | 740 | CHECK_ERROR(status); 741 | 742 | CAMLreturn(Val_unit); 743 | } 744 | 745 | CAMLprim value 746 | ldb_get_approximate_size(value t, value _from, value _to) 747 | { 748 | CAMLparam3(t, _from, _to); 749 | CAMLlocal1(ret); 750 | leveldb::DB *db = LDB_HANDLE(t); 751 | 752 | USE_HANDLE(t); 753 | 754 | TO_SLICE_COPY(__from, _from); 755 | TO_SLICE_COPY(__to, _to); 756 | 757 | leveldb::Range range(__from, __to); 758 | uint64_t size; 759 | 760 | caml_enter_blocking_section(); 761 | db->GetApproximateSizes(&range, 1, &size); 762 | RELEASE_HANDLE(t); 763 | caml_leave_blocking_section(); 764 | 765 | ret = caml_copy_int64(size); 766 | CAMLreturn(ret); 767 | } 768 | 769 | CAMLprim value 770 | ldb_get_property(value t, value s) 771 | { 772 | CAMLparam2(t, s); 773 | CAMLlocal2(ret, retstring); 774 | std::string v; 775 | 776 | CHECK_CLOSED(t); 777 | bool found = LDB_HANDLE(t)->GetProperty(TO_SLICE(s), &v); 778 | 779 | if(!found) CAMLreturn(Val_unit); 780 | 781 | COPY_FROM(retstring, v); 782 | ret = caml_alloc_small(1, 0); 783 | Field(ret, 0) = retstring; 784 | 785 | CAMLreturn(ret); 786 | } 787 | 788 | CAMLprim value 789 | ldb_compact_range(value t, value begin, value end) 790 | { 791 | CAMLparam3(t, begin, end); 792 | leveldb::DB *db = LDB_HANDLE(t); 793 | 794 | USE_HANDLE(t); 795 | 796 | #define CPP_STRING(x) std::string(String_val(x), string_length(x)) 797 | 798 | std::string begin_s = 799 | Is_block(begin) ? CPP_STRING(Field(begin, 0)) : std::string(""); 800 | 801 | std::string end_s = 802 | Is_block(end) ? CPP_STRING(Field(end, 0)) : std::string(""); 803 | 804 | leveldb::Slice begin_(begin_s), end_(end_s); 805 | 806 | caml_enter_blocking_section(); 807 | db->CompactRange(Is_block(begin) ? &begin_ : NULL, 808 | Is_block(end) ? &end_ : NULL); 809 | RELEASE_HANDLE(t); 810 | caml_leave_blocking_section(); 811 | 812 | CAMLreturn(Val_unit); 813 | } 814 | 815 | 816 | static void 817 | ldb_snapshot_finalize(value t) 818 | { 819 | ldb_snapshot *s = UNWRAP_SNAPSHOT(t); 820 | 821 | s->closed = true; 822 | 823 | // wait until the resource is not being used in another thread 824 | while(s->in_use && *(s->in_use)) { 825 | struct timeval tv; 826 | tv.tv_sec = 0; 827 | tv.tv_usec = 1000; 828 | select(0, NULL, NULL, NULL, &tv); 829 | } 830 | if(s->snapshot) { 831 | s->db->ReleaseSnapshot(s->snapshot); 832 | s->snapshot = NULL; 833 | } 834 | if(s->in_use) { 835 | free(s->in_use); 836 | s->in_use = NULL; 837 | } 838 | } 839 | 840 | CAMLprim value 841 | ldb_snapshot_compare(value t1, value t2) 842 | { 843 | return Val_int(ldb_any_compare(t1, t2)); 844 | } 845 | 846 | CAMLprim value 847 | ldb_snapshot_make(value t) 848 | { 849 | CAMLparam1(t); 850 | CAMLlocal1(ret); 851 | 852 | CHECK_CLOSED(t); 853 | leveldb::DB *db = LDB_HANDLE(t); 854 | const leveldb::Snapshot* snapshot = db->GetSnapshot(); 855 | ret = caml_alloc_custom(&ldb_snapshot_ops, sizeof(ldb_snapshot), 0, 1); 856 | ldb_snapshot *_ret = UNWRAP_SNAPSHOT(ret); 857 | _ret->id = ++wrapped_val_id; 858 | _ret->db = db; 859 | _ret->snapshot = snapshot; 860 | _ret->closed = false; 861 | _ret->in_use = (bool *)malloc(sizeof(bool)); 862 | *(_ret->in_use) = false; 863 | CAMLreturn(ret); 864 | } 865 | 866 | CAMLprim value 867 | ldb_snapshot_release(value t) 868 | { 869 | CAMLparam1(t); 870 | ldb_snapshot_finalize(t); 871 | CAMLreturn(Val_unit); 872 | } 873 | 874 | CAMLprim value 875 | ldb_snapshot_get(value t, value k) 876 | { 877 | using namespace std; 878 | CAMLparam2(t, k); 879 | CAMLlocal1(ret); 880 | 881 | USE_SNAPSHOT(t); 882 | ldb_snapshot *snap = UNWRAP_SNAPSHOT(t); 883 | leveldb::DB *db = snap->db; 884 | 885 | TO_SLICE_COPY(key, k); 886 | leveldb::ReadOptions options; 887 | 888 | options.snapshot = snap->snapshot; 889 | 890 | caml_enter_blocking_section(); 891 | std::string v; 892 | leveldb::Status status = db->Get(options, key, &v); 893 | RELEASE_SNAPSHOT(t); 894 | caml_leave_blocking_section(); 895 | 896 | if(status.IsNotFound()) { v.~string(); status.~Status(); RAISE_NOT_FOUND; } 897 | 898 | CHECK_ERROR_AND_CLEANUP(status, { v.~string(); }); 899 | 900 | COPY_FROM(ret, v); 901 | CAMLreturn(ret); 902 | } 903 | 904 | CAMLprim value 905 | ldb_snapshot_mem(value t, value k) 906 | { 907 | using namespace std; 908 | CAMLparam2(t, k); 909 | 910 | USE_SNAPSHOT(t); 911 | ldb_snapshot *snap = UNWRAP_SNAPSHOT(t); 912 | leveldb::DB *db = snap->db; 913 | 914 | TO_SLICE_COPY(key, k); 915 | leveldb::ReadOptions options; 916 | 917 | options.snapshot = snap->snapshot; 918 | 919 | std::string v; 920 | 921 | caml_enter_blocking_section(); 922 | leveldb::Status status = db->Get(options, key, &v); 923 | RELEASE_SNAPSHOT(t); 924 | caml_leave_blocking_section(); 925 | 926 | if(status.IsNotFound()) CAMLreturn(Val_false); 927 | if(status.ok ()) CAMLreturn(Val_true); 928 | 929 | CHECK_ERROR_AND_CLEANUP(status, { v.~string(); }); 930 | 931 | CAMLreturn(Val_false); 932 | } 933 | 934 | CAMLprim value 935 | ldb_snapshot_make_iterator(value t) 936 | { 937 | CAMLparam1(t); 938 | CAMLlocal1(it); 939 | 940 | CHECK_SNAPSHOT_CLOSED(t); 941 | leveldb::DB *db = UNWRAP_SNAPSHOT(t)->db; 942 | 943 | leveldb::ReadOptions options; 944 | options.snapshot = UNWRAP_SNAPSHOT(t)->snapshot; 945 | leveldb::Iterator *_it = db->NewIterator(options); 946 | 947 | WRAP(it, _it, Iterator, false); 948 | CAMLreturn(it); 949 | } 950 | 951 | } 952 | -------------------------------------------------------------------------------- /test/benchmark.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | module LDB = LevelDB 4 | 5 | module FRAND = 6 | struct 7 | type t = { mutable s0 : int; mutable s1 : int } 8 | 9 | let make ?(seed = 0) () = let s = seed in 10 | { s0 = if s = 0 then 521288629 else s; s1 = if s = 0 then 362436069 else s } 11 | 12 | let int t = let s0 = t.s0 and s1 = t.s1 in 13 | t.s0 <- (18000 * (s0 land 0xFFFF) + (s0 lsr 16)) land 0x3FFFFFFF; 14 | t.s1 <- (30903 * (s1 land 0xFFFF) + (s1 lsr 16)) land 0x3FFFFFFF; 15 | ((t.s0 lsl 16) + (t.s1 land 0xFFFF)) land 0x3FFFFFFF 16 | end 17 | 18 | let time f = 19 | let t0 = Unix.gettimeofday () in 20 | f (); 21 | Unix.gettimeofday () -. t0 22 | 23 | let loop_kv_cost n = 24 | let r = FRAND.make () in 25 | time 26 | (fun () -> 27 | for i = 1 to n do 28 | let k = FRAND.int r in 29 | ignore (string_of_int k); 30 | ignore (string_of_int i) 31 | done) 32 | 33 | let loop_k_cost n = 34 | let r = FRAND.make () in 35 | time 36 | (fun () -> 37 | for _i = 1 to n do 38 | let k = FRAND.int r in 39 | ignore (string_of_int k); 40 | done) 41 | 42 | let bm_get db ?seed n = 43 | let r = FRAND.make ?seed () in 44 | let dt = 45 | time 46 | (fun () -> 47 | for _i = 1 to n do 48 | let k = FRAND.int r in 49 | ignore (LDB.get db (string_of_int k)) 50 | done) 51 | in dt -. loop_k_cost n 52 | 53 | let bm_iter_value db ?seed n = 54 | let r = FRAND.make ?seed () in 55 | let dt = 56 | time 57 | (fun () -> 58 | let it = LDB.Iterator.make db in 59 | let v = ref Bytes.empty in 60 | for _i = 1 to n do 61 | let k = FRAND.int r in 62 | let key = string_of_int k in 63 | LDB.Iterator.seek it key 0 (String.length key); 64 | ignore (LDB.Iterator.fill_value it v) 65 | done; 66 | LDB.Iterator.close it) 67 | in dt -. loop_k_cost n 68 | 69 | let bm_put_aux ~sync db ?seed:_ n = 70 | let r = FRAND.make () in 71 | let dt = 72 | time 73 | (fun () -> 74 | for i = 1 to n do 75 | let k = FRAND.int r in 76 | LDB.put ~sync db (string_of_int k) (string_of_int i) 77 | done) 78 | in dt -. loop_kv_cost n 79 | 80 | let bm_put = bm_put_aux ~sync:false 81 | let bm_put_sync = bm_put_aux ~sync:true 82 | 83 | let bm_batch_put_sync db ?seed:_ n = 84 | let r = FRAND.make () in 85 | let dt = 86 | time 87 | (fun () -> 88 | for i = 1 to n / 1000 do 89 | let b = LDB.Batch.make () in 90 | let m = i * 1000 in 91 | for j = 0 to 1000 do 92 | let i = m + j in 93 | let k = FRAND.int r in 94 | LDB.Batch.put b (string_of_int k) (string_of_int i) 95 | done; 96 | LDB.Batch.write db ~sync:true b 97 | done) 98 | in dt -. loop_kv_cost n 99 | 100 | let bm_iter_scan_aux init next db ?seed:_ _n = 101 | let dt = 102 | time 103 | (fun () -> 104 | let it = LDB.Iterator.make db in 105 | let k = ref Bytes.empty in 106 | let v = ref Bytes.empty in 107 | init it; 108 | while LDB.Iterator.valid it do 109 | ignore (LDB.Iterator.fill_key it k); 110 | ignore (LDB.Iterator.fill_value it v); 111 | next it; 112 | done) 113 | in dt 114 | 115 | let bm_iter_seq_scan = 116 | bm_iter_scan_aux LDB.Iterator.seek_to_first LDB.Iterator.next 117 | 118 | let bm_iter_rev_scan = 119 | bm_iter_scan_aux LDB.Iterator.seek_to_last LDB.Iterator.prev 120 | 121 | let downscale factor f db ?seed n = 122 | f db ?seed (n / factor) *. float factor 123 | 124 | let () = 125 | let n = 1_000_000 in 126 | let seed = 0 in 127 | 128 | let compact () = 129 | print_endline "Compacting..."; 130 | let db = LDB.open_db ~cache_size:10 "/tmp/ldb" in 131 | LDB.compact_range db ~from_key:(Some "") ~to_key:None; 132 | LDB.close db; 133 | print_endline "DONE" in 134 | 135 | let print_stats () = 136 | let db = LDB.open_db ~cache_size:10 "/tmp/ldb" in 137 | begin match LDB.get_property db "leveldb.stats" with 138 | None -> () 139 | | Some x -> print_newline (); print_endline x 140 | end; 141 | LDB.close db 142 | 143 | in 144 | 145 | List.iter 146 | (function 147 | `O (op, f) -> 148 | let db = LDB.open_db "/tmp/ldb" in 149 | let dt = f db ?seed:(Some seed) n in 150 | printf "%20s %7d/s\n%!" op (truncate (float n /. dt)); 151 | LDB.close db 152 | | `Clear -> ignore (LDB.destroy "/tmp/ldb") 153 | | `E f -> f ()) 154 | [ 155 | `Clear; 156 | `O ("put", bm_put); 157 | `O ("get", bm_get); 158 | `O ("Iterator.value", bm_iter_value); 159 | `E compact; 160 | `O ("get", bm_get); 161 | `O ("Iterator.value", bm_iter_value); 162 | `Clear; 163 | `O ("sync put", downscale 50 bm_put_sync); 164 | `Clear; 165 | `O ("batch put", bm_batch_put_sync); 166 | `O ("seq scan", bm_iter_seq_scan); 167 | `O ("rev scan", bm_iter_rev_scan); 168 | `E compact; 169 | `O ("seq scan", bm_iter_seq_scan); 170 | `O ("rev scan", bm_iter_rev_scan); 171 | `E print_stats; 172 | ] 173 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test) 3 | (modules test test_utils) 4 | (libraries leveldb ounit2)) 5 | 6 | (executable 7 | (name benchmark) 8 | (modules benchmark) 9 | (libraries leveldb)) 10 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open OUnit 3 | open Test_utils 4 | 5 | module L = LevelDB 6 | module I = LevelDB.Iterator 7 | module B = LevelDB.Batch 8 | 9 | let string_of_binding (k, v) = sprintf "%S:%S" k v 10 | 11 | let aeq_bindings ?msg expected actual = 12 | aeq_list ?msg string_of_binding expected actual 13 | 14 | let aeq_iterator_bindings ?msg ?(next = L.Iterator.next) expected it = 15 | let l = ref [] in 16 | while I.valid it do 17 | l := (I.get_key it, I.get_value it) :: !l; 18 | next it; 19 | done; 20 | aeq_bindings ?msg expected (List.rev !l) 21 | 22 | let aeq_value = aeq_some ~msg:"Wrong value" (sprintf "%S") 23 | 24 | let assert_found db key = 25 | aeq_bool ~msg:(sprintf "mem %S" key) true (L.mem db key) 26 | 27 | let assert_not_found db key = 28 | aeq_bool ~msg:(sprintf "mem %S" key) false (L.mem db key); 29 | assert_not_found (fun () -> ignore (L.get_exn db key)) 30 | 31 | let assert_raises_error ?(msg = "") f = 32 | try 33 | ignore (f ()); 34 | assert_failure (sprintf "Should have raised an error. %s" msg) 35 | with L.Error _ -> () 36 | 37 | module TestBasic = 38 | struct 39 | let test_put_get db = 40 | aeq_none (L.get db "test_put_get"); 41 | assert_not_found db "test_put_get"; 42 | L.put db "test_put_get" "1"; 43 | L.put db "test_put_get" "2"; 44 | aeq_value "2" (L.get db "test_put_get"); 45 | aeq_string "2" (L.get_exn db "test_put_get"); 46 | assert_found db "test_put_get" 47 | 48 | let test_delete db = 49 | L.delete db "test_delete"; 50 | assert_not_found db "test_delete"; 51 | L.put db "test_delete" "x"; 52 | aeq_value "x" (L.get db "test_delete"); 53 | assert_found db "test_delete"; 54 | L.delete db "test_delete"; 55 | assert_not_found db "test_delete" 56 | 57 | let test_iter db = 58 | let vector = [ "a", "1"; "b", "2"; "c", "3" ] in 59 | List.iter (fun (k, v) -> L.put db k v) vector; 60 | let l = ref [] in 61 | L.iter (fun k v -> l := (k, v) :: !l; true) db; 62 | aeq_bindings vector (List.rev !l); 63 | l := []; 64 | L.iter (fun k v -> l:= (k, v) :: !l; false) db; 65 | aeq_bindings ["a", "1"] (List.rev !l) 66 | 67 | let test_iter_from db = 68 | let vector = [ "a", "1"; "b", "2"; "c", "3" ] in 69 | List.iter (fun (k, v) -> L.put db k v) vector; 70 | let l = ref [] in 71 | L.iter_from (fun k v -> l := (k, v) :: !l; true) db "b"; 72 | aeq_bindings ["b", "2"; "c", "3"] (List.rev !l); 73 | l := []; 74 | L.iter_from (fun k v -> l:= (k, v) :: !l; false) db "b"; 75 | aeq_bindings ["b", "2"] (List.rev !l) 76 | 77 | let test_rev_iter db = 78 | let vector = [ "a", "1"; "b", "2"; "c", "3" ] in 79 | List.iter (fun (k, v) -> L.put db k v) vector; 80 | let l = ref [] in 81 | L.rev_iter (fun k v -> l := (k, v) :: !l; true) db; 82 | aeq_bindings vector !l; 83 | l := []; 84 | L.rev_iter (fun k v -> l:= (k, v) :: !l; false) db; 85 | aeq_bindings ["c", "3"] !l 86 | 87 | let test_rev_iter_from db = 88 | let vector = [ "a", "1"; "b", "2"; "c", "3" ] in 89 | List.iter (fun (k, v) -> L.put db k v) vector; 90 | let l = ref [] in 91 | L.rev_iter_from (fun k v -> l := (k, v) :: !l; true) db "b"; 92 | aeq_bindings ["a", "1"; "b", "2"] !l; 93 | l := []; 94 | L.rev_iter_from (fun k v -> l:= (k, v) :: !l; false) db "b"; 95 | aeq_bindings ["b", "2"] !l 96 | 97 | let test_iter_stability db = 98 | let aeq ?msg expected it = 99 | I.seek_to_first it; 100 | aeq_iterator_bindings ?msg expected it in 101 | 102 | let it1 = I.make db in 103 | aeq ~msg:"it1 before put" [] it1; 104 | List.iter (fun (k, v) -> L.put db k v) [ "a", "aa"; "b", "bb" ]; 105 | let it2 = I.make db in 106 | aeq ~msg:"it1 after put" [] it1; 107 | aeq ~msg:"it2 after put" [ "a", "aa"; "b", "bb" ] it2; 108 | L.delete db "a"; 109 | let it3 = I.make db in 110 | aeq ~msg:"it1 after del" [] it1; 111 | aeq ~msg:"it2 after del" [ "a", "aa"; "b", "bb" ] it2; 112 | aeq ~msg:"it3 after del" [ "b", "bb" ] it3 113 | 114 | let test_db_close_with_iter_in_use db = 115 | List.iter (fun (k, v) -> L.put db k v) [ "a", "aa"; "b", "bb" ]; 116 | let it = I.make db in 117 | I.seek_to_first it; 118 | L.close db; 119 | aeq_bool ~msg:"Iterator.valid for iterator whose db was closed" false (I.valid it); 120 | assert_raises_error 121 | ~msg:"should raise an Error when using a closed iterator" 122 | (fun () -> ignore (I.get_key it)) 123 | 124 | let tests = 125 | [ 126 | "put/get/mem", test_put_get; 127 | "delete/mem", test_delete; 128 | "iter", test_iter; 129 | "rev_iter", test_rev_iter; 130 | "iter_from", test_iter_from; 131 | "rev_iter_from", test_rev_iter_from; 132 | "iterator stability", test_iter_stability; 133 | "DB closed when iterator in use", test_db_close_with_iter_in_use; 134 | ] 135 | end 136 | 137 | module TestSnapshot = 138 | struct 139 | module S = L.Snapshot 140 | 141 | let test_isolation db = 142 | let s = S.make db in 143 | L.put db "test_isolation" "bar"; 144 | aeq_none ~msg:"Should not find data in isolated snapshot" 145 | (S.get s "test_isolation"); 146 | aeq_bool false (S.mem s "test_isolation"); 147 | S.release s; 148 | L.put db "test_isolation" "1"; 149 | let s = S.make db in 150 | L.put db "test_isolation" "2"; 151 | aeq_some (sprintf "%S") "1" (S.get s "test_isolation"); 152 | aeq_bool ~msg:"Should find data" true (S.mem s "test_isolation"); 153 | aeq_bool true (S.mem s "test_isolation") 154 | 155 | let test_iterator db = 156 | let vector = List.map (fun k -> (k, k ^ k)) [ "a"; "b"; "c"; "x"; "w" ] in 157 | List.iter (fun (k, v) -> L.put db k v) vector; 158 | let s = S.make db in 159 | let it = S.iterator s in 160 | I.seek_to_first it; 161 | aeq_iterator_bindings (List.sort compare vector) it; 162 | List.iter (fun (k, v) -> L.put db k v) ["a", "1"; "f", "2"]; 163 | I.seek_to_first it; 164 | aeq_iterator_bindings (List.sort compare vector) it; 165 | let s = S.make db in 166 | let it = S.iterator s in 167 | I.seek_to_first it; 168 | aeq_iterator_bindings 169 | ["a", "1"; "b", "bb"; "c", "cc"; "f", "2"; "w", "ww"; "x", "xx"] 170 | it 171 | 172 | let test_db_closed_before_release db = 173 | let s = S.make db in 174 | L.close db; 175 | S.release s 176 | 177 | let test_release_when_iterator_in_use db = 178 | L.put db "a" "a"; 179 | L.put db "b" "b"; 180 | let s = S.make db in 181 | let it = S.iterator s in 182 | L.put db "c" "c"; 183 | I.seek_to_first it; 184 | aeq_bool true (I.valid it); 185 | aeq_string ~msg:"Value" "a" (I.get_value it); 186 | S.release s; 187 | I.next it; 188 | aeq_bool ~msg:"Should still be valid" true (I.valid it); 189 | aeq_string ~msg:"Value for 'b'" "b" (I.get_value it); 190 | I.next it; 191 | aeq_bool ~msg:"Should reach EOS" false (I.valid it) 192 | 193 | let test_batch_ops db = 194 | List.iter (fun (k, v) -> L.put db k v) 195 | [ "a", "1"; "b", "2" ]; 196 | let b = B.make () in 197 | B.put b "a" "x"; 198 | B.delete b "b"; 199 | assert_raises_error (fun () -> B.put_substring b "a" (-1) 1 "z" 0 1); 200 | assert_raises_error (fun () -> B.put_substring b "a" 1 1 "z" 0 1); 201 | assert_raises_error (fun () -> B.put_substring b "a" 0 2 "z" 0 1); 202 | assert_raises_error (fun () -> B.put_substring b "a" (-1) 2 "z" 0 1); 203 | assert_raises_error (fun () -> B.put_substring b "z" 0 1 "a" (-1) 1); 204 | assert_raises_error (fun () -> B.put_substring b "z" 0 1 "a" 1 1); 205 | assert_raises_error (fun () -> B.put_substring b "z" 0 1 "a" 0 2); 206 | assert_raises_error (fun () -> B.put_substring b "z" 0 1 "a" (-1) 2); 207 | B.write db b; 208 | aeq_value "x" (L.get db "a"); 209 | assert_not_found db "b" 210 | 211 | 212 | let tests = 213 | [ 214 | "isolation", test_isolation; 215 | "iterator", test_iterator; 216 | "DB closed before snapshot release", test_db_closed_before_release; 217 | "snapshot released when iterator in use", test_release_when_iterator_in_use; 218 | "batch operations", test_batch_ops; 219 | ] 220 | end 221 | 222 | let with_db f () = 223 | let dir = make_temp_dir () in 224 | let db = L.open_db dir in 225 | try 226 | f db 227 | with e -> L.close db; raise e 228 | 229 | let test_with_db (name, f) = name >:: with_db f 230 | 231 | let tests = 232 | "All" >::: 233 | [ 234 | "Basic" >::: List.map test_with_db TestBasic.tests; 235 | "Snapshot" >::: List.map test_with_db TestSnapshot.tests; 236 | ] 237 | 238 | let () = 239 | ignore (run_test_tt_main tests) 240 | -------------------------------------------------------------------------------- /test/test_utils.ml: -------------------------------------------------------------------------------- 1 | 2 | open Printf 3 | open OUnit 4 | 5 | let rounds = ref 1 6 | 7 | let string_of_list f l = "[ " ^ String.concat "; " (List.map f l) ^ " ]" 8 | let string_of_pair f (a, b) = sprintf "(%s, %s)" (f a) (f b) 9 | let string_of_tuple2 f g (a, b) = sprintf "(%s, %s)" (f a) (g b) 10 | 11 | let string_of_option f = function 12 | None -> "None" 13 | | Some x -> sprintf "Some %s" (f x) 14 | 15 | let assert_failure_fmt fmt = Printf.ksprintf assert_failure fmt 16 | 17 | let aeq_int = assert_equal ~printer:(sprintf "%d") 18 | let aeq_bool = assert_equal ~printer:(sprintf "%b") 19 | let aeq_string = assert_equal ~printer:(sprintf "%S") 20 | 21 | let aeq_none ?msg x = 22 | assert_equal ?msg ~printer:(function None -> "None" | Some _ -> "Some _") None x 23 | 24 | let cmp_tuple2 f g (a1, a2) (b1, b2) = f a1 b1 && g a2 b2 25 | 26 | let cmp_option = function 27 | None -> fun o1 o2 -> compare o1 o2 = 0 28 | | Some f -> (fun x y -> match x, y with 29 | None, Some _ | Some _, None -> false 30 | | None, None -> true 31 | | Some x, Some y -> f x y) 32 | 33 | let cmp_list = function 34 | None -> fun l1 l2 -> compare l1 l2 = 0 35 | | Some f -> 36 | fun l1 l2 -> 37 | try 38 | List.fold_left2 (fun b x y -> b && f x y) true l1 l2 39 | with Invalid_argument _ -> false 40 | 41 | let aeq_some ?msg ?cmp f x = 42 | assert_equal ?msg ~cmp:(cmp_option cmp) ~printer:(string_of_option f) (Some x) 43 | 44 | let assert_not_found ?msg f = 45 | assert_raises ?msg Not_found (fun _ -> ignore (f ())) 46 | 47 | let aeq_list ?cmp f = 48 | assert_equal ~cmp:(cmp_list cmp) ~printer:(string_of_list f) 49 | 50 | let shuffle l = 51 | let a = Array.of_list l in 52 | let n = ref (Array.length a) in 53 | while !n > 1 do 54 | decr n; 55 | let k = Random.int (!n + 1) in 56 | let tmp = a.(k) in 57 | a.(k) <- a.(!n); 58 | a.(!n) <- tmp 59 | done; 60 | Array.to_list a 61 | 62 | let make_temp_file ?(prefix = "temp") ?(suffix = ".dat") () = 63 | let file = Filename.temp_file prefix suffix in 64 | at_exit (fun () -> Sys.remove file); 65 | file 66 | 67 | let make_temp_dir ?(prefix = "temp") () = 68 | let path = Filename.temp_file prefix "" in 69 | Sys.remove path; 70 | Unix.mkdir path 0o755; 71 | at_exit (fun () -> ignore (Sys.command (sprintf "rm -rf %S" path))); 72 | path 73 | 74 | let random_list gen len = 75 | Array.to_list (Array.init len (fun _ -> gen ())) 76 | 77 | let random_string () = 78 | let s = Bytes.create (10 + Random.int 4096) in 79 | for i = 0 to Bytes.length s - 1 do 80 | Bytes.set s i (Char.chr (Char.code 'a' + Random.int 26)); 81 | done; 82 | s 83 | 84 | let random_pair f g () = (f (), g ()) 85 | --------------------------------------------------------------------------------