├── .gitignore ├── .mailmap ├── .travis.sh ├── .travis.yml ├── ChangeLog ├── FAQ ├── LICENSE ├── META.in ├── Makefile ├── README.folders ├── README.md ├── _oasis ├── _tags ├── batteries_dev.el ├── battop.ml ├── benchsuite ├── README ├── _tags ├── array_filter.ml ├── array_filter.png ├── bench.ml ├── bench_int.ml ├── bench_kahan.ml ├── bench_map.ml ├── bench_nreplace.ml ├── bench_num.ml ├── bench_set.ml ├── bitset.ml ├── deque.ml ├── dynarray_iter.ml ├── flip.ml ├── fsum.ml ├── grouping.ml ├── lazylist.ml ├── lines_of.ml ├── mid.ml ├── popcount.ml ├── rand_choice.ml └── sequence.ml ├── bsconfig.json ├── build ├── README ├── _tags ├── fix_camlp4_print.ml ├── import.ml ├── intro.text ├── mkconf.ml ├── myocamlbuild.ml ├── ocaml ├── odoc_batteries_factored.ml ├── odoc_extract_mli.ml ├── odoc_generator_batlib.ml ├── odoc_tags.ml ├── optcomp │ ├── LICENSE │ ├── META │ ├── README │ ├── _tags │ ├── optcomp.ml │ ├── optcomp_o.ml │ ├── optcomp_r.ml │ ├── pa_optcomp.ml │ ├── sample.ml │ └── sample_incl.ml ├── packdoc.ml ├── prefilter.ml └── preprocess_mli │ ├── _tags │ ├── extract_mli.ml │ ├── generate_mli.ml │ └── preprocess_common.ml ├── check_raise ├── examples ├── README ├── _tags ├── benchmark │ ├── Makefile │ ├── _tags │ ├── arg2.ml │ ├── myocamlbuild.ml │ ├── run_tests.sh │ ├── t_enum.ml │ ├── t_list.ml │ ├── t_pow.ml │ ├── t_read.log │ ├── t_read.ml │ ├── t_read_stub.c │ └── t_strstr.ml ├── euler │ ├── Makefile │ ├── euler001.ml │ ├── euler008.ml │ ├── euler009.ml │ ├── euler010.ml │ ├── euler011.ml │ ├── euler012.ml │ ├── euler013.ml │ ├── euler014.ml │ ├── euler018.ml │ ├── euler019.ml │ ├── euler021.ml │ ├── euler022.ml │ ├── euler023.ml │ ├── euler024.ml │ ├── euler067.ml │ ├── mathlib.ml │ └── names.txt ├── optionExample.re ├── pleac │ └── strings.ml ├── snippets │ ├── _tags │ ├── accumulator.ml │ ├── myocamlbuild.ml │ ├── netchan_cat.ml │ ├── parallelsort.ml │ ├── ropes_vs_strings.ml │ ├── snippets.itarget │ ├── test_printf.ml │ ├── unicode.ml │ └── unicode2.ml └── tools │ ├── _tags │ ├── browser.ml │ ├── cat.ml │ ├── cat2.ml │ ├── conv.ml │ ├── gunzip.ml │ ├── mygzip.ml │ ├── myocamlbuild.ml │ ├── now.ml │ ├── pair.ml │ ├── shuffle.ml │ ├── shuffle2.ml │ └── tools.itarget ├── howto ├── coverage.md └── release.md ├── myocamlbuild.ml ├── ocamlinit ├── opam ├── package.json ├── plot ├── qtest ├── README.md ├── _tags └── qtest_preamble.ml ├── scripts ├── find_since.sh ├── replace_since.sh └── test_install.sh ├── setup.ml ├── src ├── _tags ├── batArray.ml ├── batArray.mli ├── batAvlTree.ml ├── batAvlTree.mli ├── batBase64.ml ├── batBase64.mli ├── batBig_int.ml ├── batBig_int.mliv ├── batBigarray.mliv ├── batBigarray.mlv ├── batBitSet.ml ├── batBitSet.mli ├── batBool.ml ├── batBool.mli ├── batBounded.ml ├── batBounded.mli ├── batBuffer.mli ├── batBuffer.mlv ├── batBytes.mliv ├── batBytes.mlv ├── batCache.ml ├── batCache.mli ├── batChar.ml ├── batChar.mli ├── batCharParser.ml ├── batCharParser.mli ├── batComplex.ml ├── batComplex.mli ├── batConcreteQueue_402.ml ├── batConcreteQueue_402.mli ├── batConcreteQueue_403.ml ├── batConcreteQueue_403.mli ├── batConcurrent.ml ├── batConcurrent.mli ├── batDeque.ml ├── batDeque.mli ├── batDigest.mli ├── batDigest.mlv ├── batDllist.ml ├── batDllist.mli ├── batDynArray.ml ├── batDynArray.mli ├── batEnum.ml ├── batEnum.mli ├── batFile.ml ├── batFile.mli ├── batFingerTree.ml ├── batFingerTree.mli ├── batFloat.ml ├── batFloat.mli ├── batFormat.mliv ├── batFormat.mlv ├── batGc.ml ├── batGc.mliv ├── batGenlex.ml ├── batGenlex.mli ├── batGlobal.ml ├── batGlobal.mli ├── batHashcons.ml ├── batHashcons.mli ├── batHashtbl.mli ├── batHashtbl.mlv ├── batHeap.ml ├── batHeap.mli ├── batIMap.ml ├── batIMap.mli ├── batIO.ml ├── batIO.mli ├── batISet.ml ├── batISet.mli ├── batInnerIO.ml ├── batInnerIO.mli ├── batInnerPervasives.ml ├── batInnerShuffle.ml ├── batInnerWeaktbl.ml ├── batInnerWeaktbl.mli ├── batInt.ml ├── batInt.mli ├── batInt32.mliv ├── batInt32.mlv ├── batInt64.mliv ├── batInt64.mlv ├── batInterfaces.ml ├── batInterfaces.mli ├── batLazyList.ml ├── batLazyList.mli ├── batLexing.ml ├── batLexing.mli ├── batList.ml ├── batList.mli ├── batLog.ml ├── batLog.mli ├── batLogger.ml ├── batLogger.mli ├── batMap.ml ├── batMap.mli ├── batMarshal.mliv ├── batMarshal.mlv ├── batMultiMap.ml ├── batMultiMap.mli ├── batMultiPMap.ml ├── batMultiPMap.mli ├── batMutex.ml ├── batMutex.mli ├── batNativeint.mliv ├── batNativeint.mlv ├── batNum.ml ├── batNum.mli ├── batNumber.ml ├── batNumber.mli ├── batOo.ml ├── batOo.mli ├── batOpaqueInnerSys.ml ├── batOptParse.ml ├── batOptParse.mli ├── batOrd.ml ├── batOrd.mli ├── batParserCo.ml ├── batParserCo.mli ├── batPathGen.ml ├── batPathGen.mli ├── batPervasives.ml ├── batPervasives.mli ├── batPrintexc.ml ├── batPrintexc.mliv ├── batPrintf.mliv ├── batPrintf.mlv ├── batQueue.ml ├── batQueue.mli ├── batRMutex.ml ├── batRMutex.mli ├── batRandom.ml ├── batRandom.mli ├── batRef.ml ├── batRef.mli ├── batRefList.ml ├── batRefList.mli ├── batResult.ml ├── batResult.mli ├── batReturn.ml ├── batReturn.mli ├── batScanf.ml ├── batScanf.mli ├── batSeq.ml ├── batSeq.mli ├── batSet.ml ├── batSet.mli ├── batSplay.ml ├── batSplay.mli ├── batStack.ml ├── batStack.mli ├── batStream.mli ├── batStream.mlv ├── batString.ml ├── batString.mli ├── batSubstring.ml ├── batSubstring.mli ├── batSys.mliv ├── batSys.mlv ├── batText.ml ├── batText.mli ├── batTuple.ml ├── batTuple.mli ├── batUChar.ml ├── batUChar.mli ├── batUTF8.ml ├── batUTF8.mli ├── batUnit.ml ├── batUnit.mli ├── batUnix.mliv ├── batUnix.mlv ├── batUref.ml ├── batUref.mli ├── batVect.ml ├── batVect.mli ├── batteries.mllib ├── batteries.mlv ├── batteriesConfig.mlp ├── batteriesExceptionless.ml ├── batteriesHelp.ml ├── batteriesHelp.mli ├── batteriesPrint.ml ├── batteriesThread.ml ├── batteriesThread.mllib ├── batteries_compattest.ml ├── extlib.ml ├── option.ml └── option.mli ├── test-build ├── Makefile └── test.ml ├── testsuite ├── _tags ├── main.ml ├── myocamlbuild.ml ├── test_base64.ml ├── test_bitset.ml ├── test_bounded.ml ├── test_container.ml ├── test_digest.ml ├── test_dynarray.ml ├── test_enum.ml ├── test_file.ml ├── test_hashcons.ml ├── test_hashtbl.ml ├── test_interface.ml ├── test_map.ml ├── test_mapfunctors.ml ├── test_mappable.ml ├── test_modifiable.ml ├── test_multipmap.ml ├── test_num.ml ├── test_optparse.ml ├── test_pervasives.ml ├── test_pmap.ml ├── test_print.ml ├── test_random.ml ├── test_set.ml ├── test_stack.ml ├── test_string.ml ├── test_substring.ml ├── test_toplevel.ml ├── test_unix.ml ├── test_uref.ml └── test_vect.ml └── yarn.lock /.gitignore: -------------------------------------------------------------------------------- 1 | .vscode 2 | yarn-error.log 3 | node_modules 4 | lib 5 | .merlin 6 | *~ 7 | _build 8 | build/META 9 | build/make_suite 10 | src/batteries_config.ml 11 | doc/batteries/html/api/ 12 | hdoc/* 13 | man/* 14 | *.byte 15 | *.native 16 | /.omake* 17 | *.swp 18 | *.opt 19 | *.run 20 | apidocs 21 | batteries.docdir 22 | batteries.odocl 23 | qtest/*_t.ml 24 | qtest/test_mods.mllib 25 | bench.log 26 | qtest/all_tests.ml 27 | qtest2/all_tests.ml 28 | qtest.targets.log 29 | coverage 30 | setup.data 31 | setup.log 32 | src/batUnix.mli 33 | src/batHashtbl.ml 34 | src/batMarshal.mli 35 | src/batPrintexc.mli 36 | src/batPrintf.ml 37 | src/batPrintf.mli 38 | src/batFormat.mli 39 | src/batSys.mli 40 | src/batBigarray.mli 41 | 42 | 43 | 44 | # Created by https://www.gitignore.io/api/macos 45 | 46 | ### macOS ### 47 | *.DS_Store 48 | .AppleDouble 49 | .LSOverride 50 | 51 | # Icon must end with two \r 52 | Icon 53 | 54 | # Thumbnails 55 | ._* 56 | 57 | # Files that might appear in the root of a volume 58 | .DocumentRevisions-V100 59 | .fseventsd 60 | .Spotlight-V100 61 | .TemporaryItems 62 | .Trashes 63 | .VolumeIcon.icns 64 | .com.apple.timemachine.donotpresent 65 | 66 | # Directories potentially created on remote AFP share 67 | .AppleDB 68 | .AppleDesktop 69 | Network Trash Folder 70 | Temporary Items 71 | .apdisk 72 | 73 | # End of https://www.gitignore.io/api/macos 74 | -------------------------------------------------------------------------------- /.mailmap: -------------------------------------------------------------------------------- 1 | ben kuin ben le kuin 2 | Gabriel Scherer bluestorm 3 | Gabriel Scherer bluestorm 4 | Cedric Cellier Cedric Cellier 5 | Cedric Cellier Cedric Cellier 6 | Cedric Cellier cedric cellier 7 | Dawid Toton Dawid Toton 8 | Eric Norige Edgar Friendly 9 | Gabriel Scherer Gabriel Scherer 10 | Gabriel Scherer gasche 11 | Hezekiah M. Carty Hezekiah M. Carty 12 | Hezekiah M. Carty Hezekiah M. Carty 13 | Jérémie Dimino Jérémie Dimino 14 | Justus Matthiesen Justus Matthiesen 15 | Kaustuv Chaudhuri Kaustuv Chaudhuri 16 | Michael Ekstrand Michael D Ekstrand 17 | Michael Ekstrand Michael Ekstrand 18 | Philippe Veber pveber 19 | Philippe Veber Philippe 20 | Eric Norige thelema 21 | David Teller Yoric 22 | David Teller yoric 23 | David Teller Yoric 24 | David Teller David Teller 25 | Erkki Seppälä Erkki Seppala 26 | Erkki Seppälä Erkki Seppala 27 | -------------------------------------------------------------------------------- /.travis.sh: -------------------------------------------------------------------------------- 1 | OPAM_DEPENDS="ocamlfind ounit qtest" 2 | 3 | case "$OCAML_VERSION,$OPAM_VERSION" in 4 | 3.12.1,1.0.0) ppa=avsm/ocaml312+opam10 ;; 5 | 3.12.1,1.1.0) ppa=avsm/ocaml312+opam11 ;; 6 | 4.00.1,1.0.0) ppa=avsm/ocaml40+opam10 ;; 7 | 4.00.1,1.1.0) ppa=avsm/ocaml40+opam11 ;; 8 | 4.01.0,1.0.0) ppa=avsm/ocaml41+opam10 ;; 9 | 4.01.0,1.1.0) ppa=avsm/ocaml41+opam11 ;; 10 | *) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;; 11 | esac 12 | 13 | echo "yes" | sudo add-apt-repository ppa:$ppa 14 | sudo apt-get update -qq 15 | sudo apt-get install -qq ocaml ocaml-native-compilers camlp4-extra opam 16 | export OPAMYES=1 17 | export OPAMVERBOSE=1 18 | echo OCaml version 19 | ocaml -version 20 | echo OPAM versions 21 | opam --version 22 | opam --git-version 23 | 24 | opam init 25 | eval `opam config env` 26 | 27 | echo "==== Installing $OPAM_DEPENDS ====" 28 | opam install ${OPAM_DEPENDS} 29 | 30 | echo "==== Build ====" 31 | make 32 | 33 | echo "==== Tests ====" 34 | make test-native 35 | 36 | #echo "==== Doc ====" 37 | #make doc 38 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | script: bash -ex .travis.sh 3 | env: 4 | - OCAML_VERSION=3.12.1 OPAM_VERSION=1.1.0 5 | - OCAML_VERSION=4.00.1 OPAM_VERSION=1.1.0 6 | - OCAML_VERSION=4.01.0 OPAM_VERSION=1.1.0 7 | # - OCAML_VERSION=3.12.1 OPAM_VERSION=1.0.0 8 | # - OCAML_VERSION=4.00.1 OPAM_VERSION=1.0.0 9 | # - OCAML_VERSION=4.01.0 OPAM_VERSION=1.0.0 10 | 11 | # notifications: 12 | # email: 13 | # - simon.cruanes.2007+travis@m4x.org 14 | # - add other adresses here (or batteries-devel or something?) 15 | -------------------------------------------------------------------------------- /FAQ: -------------------------------------------------------------------------------- 1 | *** FAQ for Batteries Included *** 2 | 3 | *** Common Problems *** 4 | 5 | **** "Error: Unbound module Batteries" 6 | 7 | Check that you're using ocamlfind with `-package batteries`, or `pkg(batteries)` 8 | in OCamlBuild _tags file to tell OCaml to make Batteries available to your code. 9 | 10 | *** General *** 11 | 12 | **** What is OCaml Batteries **** 13 | 14 | OCaml Batteries Included: a community-maintained foundation library for your OCaml projecs. 15 | 16 | 17 | **** What is it good for **** 18 | 19 | Batteries Included serves the following purposes: 20 | * define a standard set of libraries which may be 21 | expected on every compliant installation of OCaml 22 | * organize these libraries into a hierarchy of modules, 23 | with one source of documentation 24 | * provide a consistent API for otherwise independent 25 | libraries. 26 | 27 | *** Installation *** 28 | 29 | **** Errors **** 30 | 31 | ERROR: omake: Symbol `FamErrlist' has different size in shared object, consider re-linking 32 | 33 | This error is caused when using Gamin rather than FAM. Gamin is a 34 | binary-compatible replacement for libfam that does not use the 35 | system-wide monitor daemon. Most packages, however, are compiled and 36 | linked against libfam from the FAM package. They will work with Gamin 37 | without recompilation, but display the symbol size discrepancy 38 | warning. This error can safely be ignored. 39 | 40 | If you really want to get rid of the warning, on an Ubuntu based OS, 41 | run the following command: 42 | 43 | sudo apt-get install libfam0 44 | 45 | Note that FAM misbehaves in certain environments, notably AFS-based 46 | systems. 47 | 48 | 49 | *** Using Batteries *** 50 | 51 | In your source code, add [open Batteries]. When you've done this, you'll 52 | have access to the Batteries modules that extend stdlib modules as part of 53 | the stdlib modules. To access the original stdlib modules, use 54 | [Legacy.List], for example. Other [BatFoo] modules provided by batteries 55 | are available as simply [Foo]. 56 | 57 | **** Compiling with Ocamlbuild **** 58 | 59 | Copy build/myocamlbuild.ml into your source directory, and use: 60 | 61 | <*>: package(batteries) 62 | 63 | in your _tags file to enable batteries for all modules. 64 | 65 | **** Bare Findlib **** 66 | 67 | ocamlfind ocamlc -package batteries -linkpkg foo.ml -o foo 68 | 69 | **** OMake **** 70 | 71 | Add the following to your OMakefile: 72 | 73 | OCAMLPACKS[] += batteries 74 | -------------------------------------------------------------------------------- /META.in: -------------------------------------------------------------------------------- 1 | name="batteries" 2 | version="@VERSION@" 3 | description="Batteries Included is a community-maintained standard library extension" 4 | requires ="unix,num,bigarray,str,bytes" 5 | requires(mt)+="threads" 6 | archive(toploop) ="batteries.cma batteriesConfig.cmo batteriesHelp.cmo batteriesPrint.cmo" 7 | archive(toploop,mt)+="batteriesThread.cma" 8 | archive(byte) ="batteries.cma" 9 | archive(byte,mt) +="batteriesThread.cma" 10 | archive(native) ="batteries.cmxa" 11 | archive(native,mt) +="batteriesThread.cmxa" 12 | -------------------------------------------------------------------------------- /README.folders: -------------------------------------------------------------------------------- 1 | The following directories contain: 2 | 3 | * benchsuite/ provide performance evaluations of Batteries functions 4 | * build/ various (old) files needed for building 5 | * examples/ example files showing how to use various features of batteries 6 | * qtest/ the inline tests 7 | * src/ the core of Batteries Included, all the batFoo modules 8 | * testsuite/ a minimal testsuite for batteries 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Bs-batteries 2 | OCaml batteries binding to bucklescript. In development. Now available: `BatArray`, `BatList`, `Option`, `BatEnum`, `BarPervasives` 3 | 4 | # Examples (in ReasonML) 5 | ## Option 6 | ``` 7 | let odd x => 8 | switch (x mod 2) { 9 | | 0 => Some x 10 | | _ => None 11 | }; 12 | 13 | let t10 = 14 | odd 10 |> Option.map ((+) 10) |> Option.map ((/) 100) |> 15 | Option.map_default string_of_int "No value"; 16 | 17 | Js.log2 "t10 value: " t10; 18 | 19 | let t11 = 20 | odd 11 |> Option.map ((+) 10) |> Option.map ((/) 2) |> 21 | Option.map_default string_of_int "No value"; 22 | 23 | Js.log2 "t11 value: " t11; 24 | ``` -------------------------------------------------------------------------------- /_oasis: -------------------------------------------------------------------------------- 1 | OASISFormat: 0.4 2 | OCamlVersion: >= 3.12.1 3 | Name: batteries 4 | Version: 2.6.0 5 | Authors: Batteries Included Team 6 | License: LGPL-2.1 with OCaml linking exception 7 | LicenseFile: LICENSE 8 | BuildType: custom (0.2) 9 | InstallType: custom (0.2) 10 | BuildTools: make 11 | Synopsis: Extended OCaml Standard Library 12 | 13 | XCustomBuild: $make all 14 | XCustomInstall: $make install 15 | XCustomUninstall: $make uninstall 16 | 17 | Document manual 18 | Type: custom (0.2) 19 | Title: Ocaml Batteries Documentation 20 | XCustom: $make doc 21 | 22 | Test main 23 | Type: custom (0.2) 24 | Command: $make test 25 | 26 | SourceRepository master 27 | Type: git 28 | Location: git://github.com/ocaml-batteries-team/batteries-included.git 29 | Branch: master 30 | Browser: https://github.com/ocaml-batteries-team/batteries-included 31 | 32 | Library "batteries" 33 | Path: src/ 34 | 35 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | <**/*.ml> : annot 2 | <**/*.ml> and not : warn_-29 3 | true: package(bytes), warn_-3, bin_annot 4 | "build": include 5 | "src": include 6 | "libs": include 7 | "testsuite": include 8 | "qtest": include 9 | "benchsuite": include 10 | ".git": -traverse 11 | "examples": -traverse 12 | : opaque 13 | -------------------------------------------------------------------------------- /batteries_dev.el: -------------------------------------------------------------------------------- 1 | ;; This file contains useful things for participating to batteries 2 | ;; Right now, this consists of 3 | ;; * colorizing specially test comments (in orange) 4 | ;; 5 | ;; To use this file, simply add the following line to your .emacs: 6 | ;; (load-file "path/to/batteries/batteries_dev.el") 7 | ;; 8 | 9 | (defface test-comment-face 10 | '((t :foreground "orangered3")) 11 | "face for test comments") 12 | 13 | (add-hook 'tuareg-mode-hook 14 | '(lambda () 15 | (defun tuareg-font-lock-syntactic-face-function (state) 16 | (if (nth 3 state) font-lock-string-face 17 | (let ((start (nth 8 state))) 18 | (save-excursion 19 | (goto-char start) 20 | (if (looking-at-p "(\\*\\$[QTRE=]") 21 | 'test-comment-face 22 | (if (looking-at-p "(\\*\\*[^*]") 23 | tuareg-doc-face 24 | font-lock-comment-face)))))))) 25 | -------------------------------------------------------------------------------- /battop.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Top - An interpreted preambule for the toplevel 3 | * Copyright (C) 2009 David Rajchenbach-Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | (** 22 | This file is meant to be invoked by a toplevel and performs initialization 23 | of OCaml Batteries Included and its libraries. 24 | 25 | Initialization consists of 26 | - loading Findlib 27 | - loading dependencies 28 | - loading the contents of the on-line help system 29 | - printing a welcome message 30 | 31 | This file is loaded by the magic line in the ocamlinit file. 32 | *) 33 | 34 | 35 | (* END CONFIGURATION *) 36 | 37 | (* MUST BE ALREADY HANDLED BY .ocamlinit 38 | #use "topfind";; 39 | *) 40 | #thread;; 41 | #require "batteries";; 42 | 43 | 44 | if !Sys.interactive then (*Only initialize help and display welcome if we're in interactive mode.*) 45 | begin 46 | BatteriesHelp.init (); 47 | let ver = BatteriesConfig.version in 48 | let vlen = String.length ver in 49 | let pad = String.make vlen '_' in 50 | let pad2 = String.make vlen ' ' in 51 | print_endline (" ___________________"^ pad ^"_______"); 52 | print_endline (" [| + | | Batteries " ^ ver ^ " - |"); 53 | print_endline (" |_____|_|___________"^ pad ^"______|"); 54 | print_endline (" ___________________"^ pad ^"_______"); 55 | print_endline (" | - Type '#help;;' "^ pad2 ^"| | + |]"); 56 | print_endline (" |___________________"^ pad ^"|_|___|"); 57 | print_newline (); 58 | print_newline (); 59 | flush_all () 60 | end;; 61 | 62 | open Batteries;; 63 | #install_printer BatteriesPrint.print_uchar;; 64 | #install_printer BatteriesPrint.print_ustring;; 65 | #install_printer BatteriesPrint.print_rope;; 66 | #install_printer BatteriesPrint.print_string_cap_rw;; 67 | #install_printer BatteriesPrint.print_string_cap_ro;; 68 | #install_printer BatteriesPrint.string_dynarray;; 69 | #install_printer BatteriesPrint.int_dynarray;; 70 | #install_printer BatteriesPrint.char_dynarray;; 71 | #install_printer BatteriesPrint.float_dynarray;; 72 | #install_printer BatteriesPrint.int_set;; 73 | #install_printer BatteriesPrint.string_set;; 74 | #install_printer BatteriesPrint.int_pset;; 75 | #install_printer BatteriesPrint.string_pset;; 76 | #install_printer BatteriesPrint.rope_pset;; 77 | #install_printer BatteriesPrint.char_pset;; 78 | #install_printer BatteriesPrint.int_enum;; 79 | #install_printer BatteriesPrint.string_enum;; 80 | #install_printer BatteriesPrint.rope_enum;; 81 | #install_printer BatteriesPrint.char_enum;; 82 | -------------------------------------------------------------------------------- /benchsuite/README: -------------------------------------------------------------------------------- 1 | The purpose of this directory is to provide performance evaluations of 2 | Batteries functions implementations. This is specially useful when 3 | testing changes against an upstream library such as INRIA's stdlib or 4 | Extlib. 5 | The benchmarks rely on the Ocaml [benchmark] library. 6 | 7 | [benchmark] http://forge.ocamlcore.org/projects/ocaml-benchmark/ 8 | -------------------------------------------------------------------------------- /benchsuite/_tags: -------------------------------------------------------------------------------- 1 | : pkg_benchmark 2 | : rectypes -------------------------------------------------------------------------------- /benchsuite/array_filter.ml: -------------------------------------------------------------------------------- 1 | let (|>) x f = f x 2 | 3 | let list_filter a p = 4 | Array.to_list a |> List.filter p |> Array.of_list 5 | 6 | open Array 7 | let new_filter xs p = 8 | let n = length xs in 9 | (* Use a bitset to store which elements will be in the final array. *) 10 | let bs = BatBitSet.create n in 11 | for i = 0 to n-1 do 12 | if p xs.(i) then BatBitSet.set bs i 13 | done; 14 | (* Allocate the final array and copy elements into it. *) 15 | let n' = BatBitSet.count bs in 16 | let j = ref 0 in 17 | init n' 18 | (fun _ -> match BatBitSet.next_set_bit bs !j with 19 | | Some i -> j := i+1; xs.(i) 20 | | None -> assert false (* not enough 1 bits - incorrect count? *) 21 | ) 22 | 23 | let old_filter xs p = 24 | let n = length xs in 25 | (* Use a bitset to store which elements will be in the final array. *) 26 | let bs = BatBitSet.create n in 27 | for i = 0 to n-1 do 28 | if p xs.(i) then BatBitSet.set bs i 29 | done; 30 | (* Allocate the final array and copy elements into it. *) 31 | let n' = BatBitSet.count bs in 32 | let j = ref 0 in 33 | let xs' = init n' 34 | (fun _ -> 35 | (* Find the next set bit in the BitSet. *) 36 | while not (BatBitSet.mem bs !j) do incr j done; 37 | let r = xs.(!j) in 38 | incr j; 39 | r) in 40 | xs' 41 | 42 | let input_gen n = Array.init n (fun x -> x) 43 | 44 | let m4 = fun x -> x mod 4 = 0 45 | let m5 = fun x -> x mod 5 = 0 46 | let m10 = fun x -> x mod 10 = 0 47 | 48 | let () = 49 | Bench.config.Bench.samples <- 100; 50 | Bench.bench_2d ["list_filter", (fun a -> list_filter a m4); 51 | "old_filter", (fun a -> old_filter a m4); 52 | "new_filter", (fun a -> new_filter a m4); 53 | ] ~input_gen (1000, 1_000_000) |> Bench.print_2d "filter.bdata" 54 | -------------------------------------------------------------------------------- /benchsuite/array_filter.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/meafmira/bs-batteries/0c9eb3e10db8f65a5d3c7bbac17e271038cf4c38/benchsuite/array_filter.png -------------------------------------------------------------------------------- /benchsuite/bench_int.ml: -------------------------------------------------------------------------------- 1 | (* cd .. && ocamlbuild benchsuite/test_int.native -- *) 2 | 3 | 4 | external primitive_int_compare : int -> int -> int = "caml_int_compare" "noalloc" 5 | 6 | let test_compare () = 7 | 8 | let length = 1000 in 9 | 10 | let input = 11 | Array.init length (fun _ -> BatRandom.(full_range_int (), full_range_int ())) in 12 | 13 | let output = Array.map (fun (x, y) -> Pervasives.compare x y) input in 14 | 15 | let test cmp n = 16 | Array.iteri (fun i (x, y) -> 17 | assert (cmp x y = output.(i)); 18 | for i = 1 to n do 19 | ignore (cmp x y); 20 | done) 21 | input in 22 | 23 | let naive_compare x y = 24 | (* this code actually mirrors an implementation that has been used 25 | as BatInt.compare *) 26 | if x > y then 1 27 | else if y > x then -1 28 | else 0 in 29 | 30 | let mfp_compare (x : int) y = 31 | if x > y then 1 32 | else if y > x then -1 33 | else 0 in 34 | 35 | let samples = Bench.bench_n 36 | [ 37 | "BatInt.compare", test BatInt.compare; 38 | "stdlib's compare", test Pervasives.compare; 39 | "external compare", test primitive_int_compare; 40 | "mfp's compare", test mfp_compare; 41 | "naive compare", test naive_compare; 42 | ] 43 | in 44 | print_endline "For comparing 1000 pairs of random integers"; 45 | Bench.summarize samples 46 | 47 | let () = 48 | test_compare (); 49 | () 50 | -------------------------------------------------------------------------------- /benchsuite/bench_num.ml: -------------------------------------------------------------------------------- 1 | let lt1 (x:int) y = x < y 2 | let lt2 x y = x < y 3 | let lt3 x y = BatInt.Compare.(<) x y 4 | 5 | let n = 100_000 6 | 7 | let test_array = Array.init n (fun _ -> BatRandom.full_range ()) 8 | 9 | let test_f f niters = 10 | for j = 1 to niters do 11 | for i = 1 to n-1 do 12 | let x = test_array.(i-1) in 13 | let y = test_array.(i) in 14 | ignore (f x y); 15 | done 16 | done 17 | 18 | let () = Bench.bench_n [ 19 | "Specialized", test_f lt1; 20 | "Polymorphic", test_f lt2; 21 | "BatInt.Compare", test_f lt3; 22 | ] 23 | -------------------------------------------------------------------------------- /benchsuite/bitset.ml: -------------------------------------------------------------------------------- 1 | let width = 100000 2 | let op_count = 1000 3 | let set_poss = Array.init op_count (fun _ -> Random.int width) 4 | let clear_poss = Array.init op_count (fun _ -> Random.int width) 5 | let get_poss = Array.init op_count (fun _ -> Random.int width) 6 | 7 | let fill_arr s = 8 | for i = 0 to op_count-1 do 9 | s.(Array.unsafe_get clear_poss i) <- false; 10 | s.(Array.unsafe_get set_poss i) <- true; 11 | done 12 | 13 | let farr n = 14 | let s = Array.create width false in 15 | for _a = 1 to n do 16 | fill_arr s; 17 | for _b = 1 to 100 do 18 | for i = 0 to op_count-1 do 19 | let _bool : bool = 20 | s.(Array.unsafe_get get_poss i) 21 | in 22 | () 23 | done 24 | done 25 | done 26 | 27 | let count_arr n = 28 | let s = Array.create width false in 29 | for _a = 1 to n do 30 | let count = ref 0 in 31 | fill_arr s; 32 | for i = 0 to op_count-1 do 33 | if s.(i) then incr count; 34 | done 35 | done 36 | 37 | let next_bit_set_arr n = 38 | count_arr n (* Code almost look like count_arr *) 39 | 40 | open Batteries 41 | 42 | let fill_bitset s = 43 | for i = 0 to op_count-1 do 44 | BitSet.unset s (Array.unsafe_get clear_poss i); 45 | BitSet.set s (Array.unsafe_get set_poss i); 46 | done 47 | 48 | let fbs n = 49 | let s = BitSet.create width in 50 | for _a = 1 to n do 51 | fill_bitset s; 52 | for _b = 1 to 100 do 53 | for i = 0 to op_count-1 do 54 | let _bool : bool = 55 | BitSet.mem s (Array.unsafe_get get_poss i) 56 | in 57 | () 58 | done 59 | done 60 | done 61 | 62 | let count_bitset n = 63 | let s = BitSet.create width in 64 | for _a = 1 to n do 65 | fill_bitset s; 66 | let _count: int = BitSet.count s in 67 | () 68 | done 69 | 70 | let next_bit_set_bitset n = 71 | let s = BitSet.create width in 72 | for _a = 1 to n do 73 | let res = ref (Some 0) in 74 | fill_bitset s; 75 | while !res <> None do 76 | match !res with 77 | | Some idx -> 78 | res := BitSet.next_set_bit s (idx + 1) 79 | | None -> 80 | () 81 | done 82 | done 83 | 84 | let next_bit_set_enum n = 85 | let s = BitSet.create width in 86 | for _a = 1 to n do 87 | let () = fill_bitset s in 88 | let enum = BitSet.enum s in 89 | BatEnum.iter ignore enum 90 | done 91 | 92 | let () = 93 | Bench.config.Bench.gc_between_tests <- true; 94 | Bench.bench_n ["bitset.general", fbs; "array.general", farr] 95 | |> Bench.summarize ~alpha:0.05; 96 | Bench.bench_n ["bitset.count", count_bitset; "array.count", count_arr] 97 | |> Bench.summarize ~alpha:0.05; 98 | Bench.bench_n ["bitset.next", next_bit_set_bitset; 99 | "array.next", next_bit_set_arr; 100 | "bitset(enum).next", next_bit_set_enum] 101 | |> Bench.summarize ~alpha:0.05; 102 | -------------------------------------------------------------------------------- /benchsuite/dynarray_iter.ml: -------------------------------------------------------------------------------- 1 | type dynarray = { 2 | mutable len : int; 3 | mutable array : int array; 4 | (* int array to have cheap Array.get, 5 | like in batDynArray *) 6 | } 7 | 8 | let len = 1000 9 | let d = { 10 | len; 11 | array = Array.make len 42; 12 | } 13 | 14 | let unsafe_iter f d = 15 | for i = 0 to d.len - 1 do 16 | f d.array.(i) 17 | done 18 | 19 | let unsafe_iter2 f d = 20 | let a = d.array in 21 | for i = 0 to d.len - 1 do 22 | f a.(i) 23 | done 24 | 25 | let iter f d = 26 | let a = d.array in 27 | let len = d.len in 28 | for i = 0 to len - 1 do 29 | f a.(i); 30 | if d.array != a || d.len <> len then failwith "whatever" 31 | done 32 | 33 | let iter2 f d = 34 | let a = d.array in 35 | let i = ref 0 in 36 | let len = d.len in 37 | while !i < d.len && !i < len do 38 | f a.(!i); 39 | incr i 40 | done 41 | 42 | let iter3 f d = 43 | let i = ref 0 in 44 | while !i < d.len do 45 | f d.array.(!i); 46 | incr i 47 | done 48 | 49 | let test iter n = 50 | for i = 0 to n - 1 do 51 | ignore i; 52 | iter ignore d 53 | done 54 | 55 | let for_ n = 56 | for i = 0 to n - 1 do 57 | ignore i; 58 | for i = 0 to d.len - 1 do 59 | ignore d.array.(i) 60 | done 61 | done 62 | 63 | let for2 n = 64 | for i = 0 to n - 1 do 65 | ignore i; 66 | let a = d.array in 67 | for i = 0 to d.len - 1 do 68 | ignore a.(i) 69 | done 70 | done 71 | 72 | let () = 73 | let readings = 74 | Bench.bench_n [ 75 | "unsafe_iter", test unsafe_iter; 76 | "unsafe_iter2", test unsafe_iter2; 77 | "iter", test iter; 78 | "iter2", test iter2; 79 | "iter3", test iter3; 80 | "for_", for_; 81 | "for2", for2; 82 | ] in 83 | Bench.summarize readings 84 | -------------------------------------------------------------------------------- /benchsuite/flip.ml: -------------------------------------------------------------------------------- 1 | open BatPervasives 2 | open BatSet 3 | 4 | let of_list l = List.fold_left (flip add) empty l 5 | let of_list2 l = List.fold_left (fun x y -> add y x) empty l 6 | let of_list3 l = BatList.enum l |> BatSet.of_enum 7 | 8 | let wrap f () = f [1;3;5;7;9;2;4;6;8;10; 2; 5; 8; 3; 1; 9; 6] 9 | 10 | let () = Bench.bench ["flip", wrap of_list; 11 | "fun", wrap of_list2; 12 | "enum", wrap of_list3] 13 | -------------------------------------------------------------------------------- /benchsuite/fsum.ml: -------------------------------------------------------------------------------- 1 | 2 | let rand_float _ = (BatRandom.float 2. -. 1.) *. 2. ** (float (BatRandom.int 80 - 40)) 3 | let nums = Array.init 10000 rand_float 4 | 5 | let test f () = f (BatArray.enum nums) 6 | 7 | let () = 8 | let results = Bench.bench_funs [ 9 | "Enum.reduce", test (BatEnum.reduce (+.)); 10 | "Enum.fsum (Kahan)", test BatEnum.fsum; 11 | "Array.fold", (fun () -> Array.fold_left (+.) 0. nums); 12 | "for loop", (fun () -> let s = ref 0. in for i = 0 to 9_999 do s := !s +. nums.(i); done; !s); 13 | "unsafe for loop", (fun () -> let s = ref 0. in for i = 0 to 9_999 do s := !s +. Array.unsafe_get nums i; done; !s); 14 | ] () in 15 | print_endline "For summing an array of 10K floats,"; 16 | Bench.summarize results 17 | -------------------------------------------------------------------------------- /benchsuite/grouping.ml: -------------------------------------------------------------------------------- 1 | let rec makeintervals_aux d lo hi acc = function 2 | | [] -> List.rev ((lo,hi)::acc) 3 | | h::t when h > hi+d -> makeintervals_aux d h h ((lo,hi)::acc) t 4 | | h::t (* h <= lim *) -> makeintervals_aux d lo h acc t 5 | 6 | let make_intervals d = function 7 | | [] -> [] 8 | | h::t -> makeintervals_aux d h h [] t 9 | 10 | let makeIntervals d = 11 | let merge s num = 12 | match s with 13 | | (start,stop) :: tail -> 14 | if abs(num-stop) <= d then 15 | (start,num) :: tail 16 | else 17 | (num,num) :: s 18 | | _ -> assert false 19 | in 20 | function 21 | | [] -> [] 22 | | head :: tail -> List.fold_left merge [(head,head)] tail 23 | 24 | let g = [1;3;5;9;12;13;14] 25 | 26 | let tests = [ "fsharp", makeIntervals 2, g; 27 | "ocaml", make_intervals 2, g; 28 | ] 29 | 30 | let () = Bench.bench tests 31 | -------------------------------------------------------------------------------- /benchsuite/lazylist.ml: -------------------------------------------------------------------------------- 1 | open BatLazyList 2 | 3 | (* append *) 4 | 5 | let test_append append n = 6 | for _i = 1 to n do 7 | iter ignore (BatList.fold_left append nil 8 | (BatList.init 50 (fun len -> init len (fun i -> i)))); 9 | done 10 | 11 | let append_inlined l1 l2 = 12 | let rec aux list = match next list with 13 | | Cons (x, (t : 'a t)) -> Cons (x, lazy (aux t)) 14 | | _ -> Lazy.force l2 15 | in lazy (aux l1) 16 | 17 | let append_folding l1 l2 = 18 | lazy_fold_right (fun x xs -> Cons (x, xs)) l1 l2 19 | 20 | 21 | (* concat *) 22 | 23 | let test_concat concat n = 24 | for _i = 1 to n do 25 | iter ignore (concat (init 100 (fun len -> init len (fun j -> j)))) 26 | done 27 | 28 | let concat_inlined (lol : ('a t) t) = 29 | let rec aux list = match next list with 30 | | Cons (li, t) -> Lazy.force (append li (lazy (aux t))) 31 | | Nil -> Nil 32 | in lazy (aux lol) 33 | 34 | let concat_folding lol = 35 | lazy_fold_right (fun li rest -> Lazy.force (append li rest)) lol nil 36 | 37 | 38 | (* exists *) 39 | 40 | let test_exists exists n = 41 | let len = 10_000 in 42 | for _i = 1 to n do 43 | assert (exists (fun i -> i > len / 2) (init len (fun i -> i))); 44 | done 45 | 46 | let exists_inlined f l = 47 | let rec aux rest = match next rest with 48 | | Cons (x, _) when f x -> true 49 | | Cons (_, t) -> aux t 50 | | Nil -> false 51 | in aux l 52 | 53 | let exists_folding p l = 54 | let test x rest = p x || Lazy.force rest in 55 | Lazy.force (lazy_fold_right test l (Lazy.lazy_from_val false)) 56 | 57 | 58 | 59 | let () = 60 | let append_benchs = Bench.bench_n [ 61 | "append inlined", test_append append_inlined; 62 | "append folding", test_append append_folding; 63 | ] in 64 | let concat_benchs = Bench.bench_n [ 65 | "concat inlined", test_concat concat_inlined; 66 | "concat folding", test_concat concat_folding; 67 | ] in 68 | let exists_benchs = Bench.bench_n [ 69 | "exists inlined", test_exists exists_inlined; 70 | "exists folding", test_exists exists_folding; 71 | ] in 72 | List.iter Bench.summarize [ append_benchs; concat_benchs; exists_benchs ] 73 | 74 | (* some approximate results: 75 | append inlined (2.82 ms) is 10.2% faster than 76 | append folding (3.14 ms) 77 | concat folding (1.38 ms) is probably (alpha=47.71%) same speed as 78 | concat inlined (1.39 ms) 79 | exists inlined (546.18 us) is 53.5% faster than 80 | exists folding (1.18 ms) 81 | *) 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | -------------------------------------------------------------------------------- /benchsuite/mid.ml: -------------------------------------------------------------------------------- 1 | let mid1 a b = 2 | if (0 <= a && 0 <= b) || (a < 0 && b < 0) then 3 | if a <= b then a + ((b-a)/2) else b + ((a-b)/2) 4 | else 5 | let s = a + b in 6 | if s >= 0 then s/2 else s - s/2 7 | 8 | let mid2 a b = (a+b)/2 9 | 10 | let mid3 a b = 11 | if (a >= 0) then 12 | if (b >= 0) then 13 | a + (b - a) / 2 14 | else 15 | (a+b) / 2 16 | else 17 | if (b < 0) then 18 | a + (b - a) / 2 19 | else 20 | (a+b) / 2 21 | 22 | let mid4 a b = 23 | if (0 <= a && 0 <= b) || (a < 0 && b < 0) then 24 | if a <= b then a + ((b-a)/2) else b + ((a-b)/2) 25 | else 26 | (a + b)/2 27 | 28 | let array_len = 10000 29 | let xs = Array.init array_len (fun _ -> BatRandom.full_range_int ()) 30 | 31 | let harn f n = 32 | for i = 1 to n do 33 | for j = 0 to array_len-2 do 34 | ignore (f xs.(j) xs.(j+1)); 35 | done 36 | done 37 | 38 | let () = Bench.(summarize ~alpha:0.05 (bench_n ["mid1", harn mid1; "mid2", harn mid2; "mid3", harn mid3; "mid4", harn mid4])) 39 | -------------------------------------------------------------------------------- /benchsuite/rand_choice.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open Random 3 | 4 | let choice e = 5 | let a = BatArray.of_enum e in 6 | let len = Array.length a in 7 | Array.get a (int len) 8 | 9 | let choice2 e = Enum.drop (int (Enum.count e)) e; Enum.get_exn e 10 | 11 | let choice3 e = 12 | if Enum.fast_count e then choice2 e 13 | else choice e 14 | 15 | let test n f = 16 | (* data structures to test *) 17 | let a = Array.init n identity in 18 | let b = List.init n identity in 19 | let c () = Random.enum_bits () |> Enum.take n in 20 | let d () = 1--n in 21 | fun () -> 22 | f (Array.enum a); 23 | f (List.enum b); 24 | f (c ()); 25 | f (d ()) 26 | 27 | let test = test 10_000 28 | 29 | let () = Bench.bench ["Choice", test choice; 30 | "Choice2", test choice2; 31 | "Choice3", test choice3; 32 | ] 33 | -------------------------------------------------------------------------------- /bsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "bs-batteries", 3 | "sources": [ 4 | { 5 | "dir": "src", 6 | "files": [ 7 | "option.ml", 8 | "option.mli", 9 | "batList.ml", 10 | "batList.mli", 11 | "batArray.ml", 12 | "batArray.mli", 13 | "batChar.ml", 14 | "batChar.mli", 15 | "batDeque.ml", 16 | "batDeque.mli", 17 | "batEnum.ml", 18 | "batEnum.mli", 19 | "batInnerPervasives.ml", 20 | "batInterfaces.ml", 21 | "batInterfaces.mli", 22 | "batLazyList.ml", 23 | "batLazyList.mli", 24 | "batMap.ml", 25 | "batMap.mli", 26 | "batOrd.ml", 27 | "batOrd.mli", 28 | "batPervasives.ml", 29 | "batPervasives.mli", 30 | "batRef.ml", 31 | "batRef.mli", 32 | "batReturn.ml", 33 | "batReturn.mli", 34 | "batString.ml", 35 | "batString.mli" 36 | ] 37 | }, 38 | { 39 | "dir": "examples" 40 | } 41 | ] 42 | } -------------------------------------------------------------------------------- /build/README: -------------------------------------------------------------------------------- 1 | This directory contains tools used during the compilation 2 | of Batteries Included. 3 | -------------------------------------------------------------------------------- /build/_tags: -------------------------------------------------------------------------------- 1 | true: package(str) 2 | -------------------------------------------------------------------------------- /build/import.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Placeholder for a future tool. 3 | 4 | This tool will import a set of interfaces from a library for quick 5 | initialization of layer code. 6 | *) 7 | -------------------------------------------------------------------------------- /build/intro.text: -------------------------------------------------------------------------------- 1 | OCaml Batteries Included documentation. 2 | 3 | OCaml Batteries included (or simply "Batteries") is a community-driven effort to standardize on an consistent, documented, and comprehensive development platform for the OCaml programming language. 4 | 5 | For the moment, Batteries Included concentrates on: 6 | 7 | {ul 8 | {- data structures} 9 | {- file manipulation} 10 | {- inputs and outputs} 11 | {- concurrency} 12 | {- numbers} 13 | {- text, including Unicode} 14 | } 15 | 16 | For more information on the installation of Batteries Included, please 17 | read the 18 | {{:https://github.com/ocaml-batteries-team/batteries-included/wiki/Installing-Batteries}Installation 19 | guide} and for an example using it in different build systems, we have 20 | the 21 | {{:https://github.com/ocaml-batteries-team/batteries-included/wiki/Getting-started}Getting 22 | started manual}. 23 | 24 | Do you have suggestions? Remarks? Bug reports ? To contact us or to be 25 | kept informed, don't hesitate to visit our 26 | {{:http://batteries.forge.ocamlcore.org/}website}, 27 | {{:https://github.com/ocaml-batteries-team/batteries-included}Git 28 | repo}, and our 29 | {{:https://github.com/ocaml-batteries-team/batteries-included/issues?sort=created&direction=desc&state=open}Issue 30 | tracker}. 31 | 32 | {6 New Data Structures in Batteries} 33 | 34 | {!modules: BatBitSet BatCache BatDeque BatDllist BatDynArray BatEnum 35 | BatFingerTree BatGlobal BatHashcons BatHeap BatIMap BatISet 36 | BatLazyList BatMultiPMap BatRefList BatSeq BatSplay BatText BatUChar 37 | BatUref BatUTF8 BatVect} 38 | 39 | {6 New Modules in Batteries} 40 | 41 | {!modules: BatBase64 BatCharParser BatFile BatInterfaces BatIO BatLog 42 | BatLogger BatNumber BatOptParse BatParserCo 43 | BatResult BatReturn } 44 | 45 | {6 Builtin Types as Modules} 46 | 47 | {!modules: BatBool BatChar BatFloat BatInt BatInt32 BatInt64 48 | BatNativeint BatOption BatRef BatTuple BatUnit } 49 | 50 | {6 Extensions to the Standard Library} 51 | 52 | These modules have base library equivalents. When using [open Batteries], [BatFoo] will replace [Foo], so that the new functions are easily available without a [Bat] prefix on the module name. As well, [BatPervasives] is opened into the global namespace. Finally, the previous versions of replaced modules are available in the [Legacy] module, i.e. [Legacy.Unix] and [Legacy.Pervasives]. 53 | 54 | {!modules: BatArray BatBigarray BatBig_int BatBuffer BatComplex 55 | BatDigest BatFormat BatGc BatGenlex BatHashtbl BatLexing BatList 56 | BatMap BatMarshal BatNum BatOo BatPervasives BatPrintexc BatPrintf 57 | BatQueue BatRandom BatScanf BatSet BatStack BatStream BatString 58 | BatSys BatUnix} 59 | 60 | {6 Thread-related Modules} 61 | 62 | These modules are available only when compiling with threads. To use 63 | them, do [open BatteriesThread] at the top of your code. 64 | 65 | {!modules: BatConcurrent BatMutex BatRMutex} 66 | 67 | {6 Incubator} 68 | 69 | These modules are available only inside [Batteries.Incubator]. Their 70 | interface is not guaranteed stable, and may be changed at any time, 71 | including with backwards incompatible changes between point releases. 72 | They are included for testing and stabilization until they can be 73 | finalized and moved to batteries proper. 74 | 75 | {!modules: BatBounded BatOrd BatPathGen BatSubstring} 76 | 77 | {6 Internal Modules} 78 | 79 | {!modules: BatAvlTree BatInnerIO BatInnerWeaktbl} 80 | -------------------------------------------------------------------------------- /build/ocaml: -------------------------------------------------------------------------------- 1 | ocaml -init `ocamlfind query batteries`/ocamlinit -------------------------------------------------------------------------------- /build/optcomp/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2008, Jeremie Dimino 2 | All rights reserved. 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are met: 5 | 6 | * Redistributions of source code must retain the above copyright 7 | notice, this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright 9 | notice, this list of conditions and the following disclaimer in the 10 | documentation and/or other materials provided with the distribution. 11 | * Neither the name of Jeremie Dimino nor the names of its 12 | contributors may be used to endorse or promote products derived 13 | from this software without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY 16 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY 19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /build/optcomp/META: -------------------------------------------------------------------------------- 1 | # -*- conf-mode -*- 2 | name = "optcomp" 3 | version = "1.1" 4 | description = "Optional compilation with cpp-like directives" 5 | requires = "camlp4" 6 | archive(syntax, preprocessor) = "pa_optcomp.cmo" 7 | -------------------------------------------------------------------------------- /build/optcomp/README: -------------------------------------------------------------------------------- 1 | Optional compilation with cpp-like directives 2 | 3 | Jeremie Dimino 4 | December 2008 5 | 6 | 7 | * What it does 8 | 9 | Optcomp is a syntax extension which handles #if, #else, ... directives 10 | in ocaml source files. 11 | 12 | For example, to switch between two pieces of code according to the 13 | ocaml compiler version, one can write: 14 | 15 | #if ocaml_version < (3, 10) 16 | let x = 1 17 | #else 18 | let x = 2 19 | #end 20 | 21 | * What the difference between cpp and optcomp ? 22 | 23 | Optcomp is more caml-friendly than cpp: 24 | 25 | - it does not interpret "//", "/*", and "*/" as comment delimiters 26 | - it does not complains about missing "'" 27 | - it is easier to integrate in the build process when using other 28 | camlp4 syntax extensions 29 | 30 | By the way optcomp does not do macro expansion while cpp does. 31 | 32 | * What the difference between pa_macro and optcomp ? 33 | 34 | Optcomp does not require code that will be dropped to be valid caml 35 | code. So for example this code will be rejected by camlp4+pa_macro: 36 | 37 | let f = function 38 | | <:patt< $id:id$ >> -> "ident" 39 | | <:patt< $int:x$ >> -> "int" 40 | | <:patt< $x$, $y$ >> -> "pair" 41 | IFDEF HAVE_LAZY_PATTERNS THEN 42 | | <:patt< lazy x >> -> "lazy" 43 | ENDIF 44 | 45 | But this one will be accepted by camlp4+optcomp: 46 | 47 | let f = function 48 | | <:patt< $id:id$ >> -> "ident" 49 | | <:patt< $int:x$ >> -> "int" 50 | | <:patt< $x$, $y$ >> -> "pair" 51 | #if HAVE_LAZY_PATTERNS 52 | | <:patt< lazy x >> -> "lazy" 53 | #endif 54 | 55 | * Building instructions 56 | 57 | To compile optcomp type: 58 | 59 | $ make 60 | 61 | * Installation 62 | 63 | To install optcomp type: 64 | 65 | $ make install 66 | 67 | and to uninstall it: 68 | 69 | $ make uninstall 70 | 71 | * How to use it 72 | 73 | You can use optcomp with ocamlfind, with the package optcomp or you 74 | can directly include it in your project. 75 | 76 | * Hacking 77 | 78 | To add support to more expressions, you can modify the eval function 79 | of pa_optcomp.ml. It takes a camlp4 expression ast and must return 80 | something of type value. 81 | 82 | * Development 83 | 84 | The last development version of optcomp can always be found in the 85 | darcs repository hosted at darcs.ocamlcore.org: 86 | 87 | $ darcs get http://darcs.ocamlcore.org/repos/optcomp/optcomp 88 | 89 | local variables: 90 | mode: outline 91 | end: 92 | -------------------------------------------------------------------------------- /build/optcomp/_tags: -------------------------------------------------------------------------------- 1 | <*>:camlp4of,use_camlp4_full 2 | : use_dynlink 3 | -------------------------------------------------------------------------------- /build/optcomp/optcomp_o.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * optcomp_o.ml 3 | * ------------ 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | (* Standalone version, original syntax *) 9 | 10 | let module M = Camlp4OCamlParser.Make(Camlp4OCamlRevisedParser.Make(Camlp4.PreCast.Syntax)) in () 11 | 12 | let _ = Optcomp.main () 13 | -------------------------------------------------------------------------------- /build/optcomp/optcomp_r.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * optcomp_r.ml 3 | * ------------ 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | (* Standalone version, revised syntax *) 9 | 10 | let module M = Camlp4OCamlRevisedParser.Make(Camlp4.PreCast.Syntax) in () 11 | 12 | let _ = Optcomp.main () 13 | -------------------------------------------------------------------------------- /build/optcomp/sample_incl.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * sample_incl.ml 3 | * -------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of optcomp. 8 | *) 9 | 10 | (* File included by "sample.ml" *) 11 | 12 | #let x = 1 13 | -------------------------------------------------------------------------------- /build/prefilter.ml: -------------------------------------------------------------------------------- 1 | let (major, minor) = 2 | Scanf.sscanf Sys.ocaml_version 3 | "%d.%d." (fun j n -> (j, n)) 4 | 5 | let filter_cookie_re = 6 | Str.regexp "^##V\\([<>]?=?\\)\\([^#]+\\)##" 7 | let version_re = 8 | Str.regexp "\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?" 9 | 10 | (* We track line count in the input source, to print location 11 | directives for the OCaml lexer: 12 | 13 | # 123 foo.mlv 14 | 15 | lets the compiler know that it should consider the current location 16 | to be line 123 in file foo.mlv, which lets it report errors in the 17 | right place in the .mlv instead of some random place in a generated 18 | .ml. 19 | 20 | The [stale] reference is purely cosmetic: it would be correct to 21 | print a lexer directive at each line, but generate much less 22 | readable preprocessed outputs. 23 | *) 24 | let mark_loc_stale = function 25 | | None -> () 26 | | Some (file, count, stale) -> stale := true 27 | 28 | let incr_loc = function 29 | | None -> () 30 | | Some (file, count, stale) -> incr count 31 | 32 | let print_loc = function 33 | | None -> () 34 | | Some (file, count, stale) -> 35 | if !stale then begin 36 | Printf.printf "# %d %S\n" !count file; 37 | stale := false; 38 | end 39 | 40 | let process_line loc line = 41 | if not (Str.string_match filter_cookie_re line 0) 42 | then print_endline line 43 | else begin 44 | let cmp = match Str.matched_group 1 line with 45 | | "<" -> (<) | ">" -> (>) | "=" -> (=) 46 | | "<=" -> (<=) | ">=" -> (>=) 47 | | _ -> failwith "The ##V8## form is now disabled, use ##V>=8## instead" 48 | in 49 | let ver_string = Str.matched_group 2 line in 50 | assert (Str.string_match version_re ver_string 0) ; 51 | let ver_maj = int_of_string (Str.matched_group 1 ver_string) in 52 | let ver_min = try int_of_string (Str.matched_group 3 ver_string) with _ -> 0 in 53 | let pass = cmp (major*100+minor) (ver_maj*100+ver_min) in 54 | if pass 55 | then print_endline (Str.replace_first filter_cookie_re "" line) 56 | else mark_loc_stale loc 57 | end 58 | 59 | let ( |> ) x f = f x 60 | 61 | let process in_channel loc = 62 | try 63 | while true do 64 | print_loc loc; 65 | input_line in_channel |> process_line loc; 66 | incr_loc loc; 67 | done 68 | with End_of_file -> () 69 | 70 | let from_stdin () = process stdin None 71 | 72 | let from_file file = 73 | let in_channel = open_in file in 74 | let loc = Some (file, ref 1, ref true) in 75 | process in_channel loc; 76 | close_in in_channel 77 | 78 | let () = 79 | if not !Sys.interactive then begin 80 | match Array.length Sys.argv with 81 | | 1 -> (* no param *) 82 | from_stdin () 83 | | 2 -> (* one filename *) 84 | from_file Sys.argv.(1) 85 | | _ -> 86 | failwith "expected zero parameter (read from stdin) or one (filename)" 87 | end 88 | -------------------------------------------------------------------------------- /build/preprocess_mli/_tags: -------------------------------------------------------------------------------- 1 | <*>:camlp4oof,use_camlp4_full,use_ocamlbuild -------------------------------------------------------------------------------- /build/preprocess_mli/extract_mli.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * generate_mli.ml 3 | * --------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * 2009, David Rajchenbach-Teller (contributor) 6 | * Licence : BSD3 7 | *) 8 | 9 | (* This file generate a .mli from a simplified .ml file. It should be 10 | invoked like that: 11 | 12 | $ generate_mli input.ml > output.mli 13 | 14 | Allowed constructions in the .ml are: 15 | 16 | - module aliases: "module Foo = Bar" 17 | ("Bar" must be an external module) 18 | - structures: "module Foo = struct ... end" 19 | - comments 20 | *) 21 | 22 | 23 | open Preprocess_common 24 | 25 | (* +------+ 26 | | Main | 27 | +------+ *) 28 | 29 | let _ = 30 | let destination = ref "" 31 | and source = ref "" 32 | and path = ref "" in 33 | Arg.parse 34 | [("-o", Arg.Set_string destination, "Output to a given file (standard output by default)"); 35 | ("-i", Arg.Set_string source, "Input from a given file (standard input by default)"); 36 | ("-path", Arg.Set_string path, "Name of the submodule to extract (default is extract everything)")] 37 | ignore 38 | (Printf.sprintf "%s [options]: extract part of the contents of a .mli file\n%!" (Filename.basename Sys.argv.(0))); 39 | try 40 | let output = match !destination with 41 | | "" -> stdout 42 | | s -> open_out s 43 | and input = match !source with 44 | | "" -> stdin 45 | | s -> open_in s 46 | and path = match !path with 47 | | "" -> [] 48 | | s -> path_of_string (Sys.argv.(2)) 49 | in 50 | extract !source input output path; 51 | flush_all () 52 | with 53 | | Exit as e -> 54 | raise e 55 | | exn -> 56 | Format.eprintf "@[%a@]@." Camlp4.ErrorHandler.print exn 57 | 58 | -------------------------------------------------------------------------------- /check_raise: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # Simple sanity checking of documentation of exceptions. 3 | # Usage: go to src/ and run ../check_raise 4 | 5 | header() { 6 | info=$1 7 | shift 8 | result=$(mktemp) 9 | $* >$result 10 | cw=$(wc -w $result | cut -f1 -d\ ) 11 | if [ "$cw" -ne "0" ] 12 | then 13 | echo $info 14 | cat $result 15 | echo 16 | fi 17 | } 18 | 19 | setminus() { 20 | diff --new-line-format= --unchanged-line-format= $1 $2 21 | } 22 | 23 | # Capitalized Raise should be rare 24 | header "Interesting places:" \ 25 | grep -n Raise *.ml *.mli | grep -v " *Raised" 26 | 27 | #header "Needs source style:" \ 28 | # grep -n "Invalid_argument[[:space:]]\"" *.mli 29 | 30 | # Modules known to have documentation of exceptions OK 31 | already_ok=$(mktemp) 32 | echo " 33 | batteriesHelp 34 | batStack 35 | batSplay 36 | batReturn 37 | batRef 38 | batRandom 39 | batQueue 40 | batDeque 41 | batConcurrent 42 | batCharParser 43 | " | sort >$already_ok 44 | 45 | use_raise=$(mktemp) 46 | doc_raise=$(mktemp) 47 | poor_doc_raise=$(mktemp) 48 | to_be_verified=$(mktemp) 49 | 50 | # Crude check for presence of exceptions in implementations and interfaces 51 | grep -n "\(raise\|invalid_arg\|failwith\)" *.ml | cut -f1 -d. | uniq | sort >$use_raise 52 | grep -n @raise *.mli | cut -f1 -d. | uniq | sort >$doc_raise 53 | grep -ni raise *.mli | cut -f1 -d. | uniq | sort >$poor_doc_raise 54 | 55 | setminus $use_raise $already_ok >$to_be_verified 56 | 57 | suspicious=$(mktemp) 58 | setminus $to_be_verified $doc_raise >$suspicious 59 | 60 | need_doc=$(mktemp) 61 | setminus $suspicious $poor_doc_raise >$need_doc 62 | 63 | header "Documentation of the following modules mentions exceptions and awaits formal @raise clauses:" \ 64 | setminus $suspicious $need_doc 65 | 66 | header "The following modules need raised exceptions to be documented (quite likely):" \ 67 | cat $need_doc 68 | 69 | # A policy: don't expose string arguments of standard exceptions 70 | header "String arguments nobody should rely upon:" \ 71 | grep -n "Invalid_argument[[:space:]]\"" *.mli 72 | 73 | header "String arguments nobody should rely upon:" \ 74 | grep -n "Failure[[:space:]]\"" *.mli 75 | 76 | # Look for mistakes 77 | 78 | header "@raises instead of @raise:" \ 79 | grep -n @raises *.ml *.mli 80 | 81 | header "Square brackets that harm ocamldoc:" \ 82 | grep -n "@raise[[:space:]]\[" *.ml *.mli 83 | 84 | header Typos: \ 85 | grep -n "Invalid_arg[[:space:]]" `find . -type f -not -name batDynArray\*` 86 | 87 | header Typos: \ 88 | grep -n Invald_argument *.ml *.mli 89 | 90 | header "consisting in => consisting of" 91 | grep -n "consisting in" *.ml *.mli 92 | 93 | header "@since NEXT_RELEASE should be filled before release" 94 | grep "@since [^0123456789]" *.ml *.mli 95 | -------------------------------------------------------------------------------- /examples/README: -------------------------------------------------------------------------------- 1 | A few examples of short programs written using OCaml Batteries Included. 2 | 3 | Directory tools/ contains small tools. 4 | Directory snippets/ contains random code extracts. 5 | Directory euler/ contains solution programs to varous eulerproject.com puzzles 6 | Directory pleac/ contains the start of a PLEAC for batteries 7 | 8 | To build all these programs, install batteries and run 9 | 10 | make 11 | 12 | from each directory. If this doesn't work, steal the makefile, _tags 13 | and myocamlbuild from another example directory, make them work for 14 | the files in the new directory and send us the patch. :) Extra points 15 | for implementing a toplevel `make examples` that makes the examples. 16 | 17 | -------------------------------------------------------------------------------- /examples/_tags: -------------------------------------------------------------------------------- 1 | 2 | : pkg_netstring 3 | : thread 4 | 5 | -------------------------------------------------------------------------------- /examples/benchmark/Makefile: -------------------------------------------------------------------------------- 1 | TESTS:=nth map folr map2 append flatten filter1 filter2 mapx folrx 2 | OPTS:=--max-i 10_000_000 3 | 4 | all: t_enum.byte 5 | 6 | t_enum.byte t_enum.native: t_enum.ml 7 | ocamlbuild t_enum.byte t_enum.native 8 | 9 | pngs: $(addsuffix .png, $(TESTS)) 10 | 11 | t_list.byte t_list.native: t_list.ml 12 | ocamlbuild t_list.byte t_list.native 13 | 14 | %.gallium_byte: t_list.byte 15 | #The following doesn't succeed for large I -- not tail-recursive 16 | - ./t_list.byte $(OPTS) -g $(basename $@) > $@ 17 | 18 | %.extlib_byte: t_list.byte 19 | ./t_list.byte $(OPTS) -e $(basename $@) > $@ 20 | 21 | %.blue_byte: t_list.byte 22 | ./t_list.byte $(OPTS) -b $(basename $@) > $@ 23 | 24 | %.core_byte: t_list.byte 25 | ./t_list.byte $(OPTS) -c $(basename $@) > $@ 26 | 27 | %.gallium_native: t_list.native 28 | #The following doesn't succeed for large I -- not tail-recursive 29 | - ./t_list.native $(OPTS) -g $(basename $@) > $@ 30 | 31 | %.extlib_native: t_list.native 32 | ./t_list.native $(OPTS) -e $(basename $@) > $@ 33 | 34 | %.blue_native: t_list.native 35 | ./t_list.native $(OPTS) -b $(basename $@) > $@ 36 | 37 | %.core_native: t_list.native 38 | ./t_list.native $(OPTS) -c $(basename $@) > $@ 39 | 40 | %.png: %.gallium_byte %.extlib_byte %.blue_byte %.core_byte %.gallium_native %.extlib_native %.blue_native %.core_native 41 | TEST=$(basename $@) 42 | echo "set logscale x; set logscale y; set terminal png; set xlabel \"List Length\"; set ylabel \"List-operations per second\"; set output \"$@\"; plot \"$(basename $@).gallium_byte\" w lp, \"$(basename $@).extlib_byte\" w lp, \"$(basename $@).blue_byte\" w lp, \"$(basename $@).core_byte\" w lp, \"$(basename $@).gallium_native\" w lp, \"$(basename $@).extlib_native\" w lp, \"$(basename $@).blue_native\" w lp, \"$(basename $@).core_native\" w lp" | gnuplot 43 | 44 | t_byte: $(addsuffix .gallium_byte, $(TESTS)) $(addsuffix .extlib_byte, $(TESTS)) 45 | 46 | clean: 47 | ocamlbuild -clean 48 | - rm *.*_byte *.*_native 49 | - rm *.png -------------------------------------------------------------------------------- /examples/benchmark/_tags: -------------------------------------------------------------------------------- 1 | : pkg_bitstring 2 | : pkg_batteries,pkg_core,debug,pkg_threads,pkg_benchmark 3 | : pkg_batteries,pkg_core,pkg_threads 4 | -------------------------------------------------------------------------------- /examples/benchmark/run_tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ocamlbuild t_list.byte 4 | 5 | TESTS="nth map mapx folr folrx map2" 6 | for a in byte 7 | do 8 | for b in $TESTS 9 | do 10 | # echo -n ${b}_g.$a, 11 | ./t_list.$a -s 200 ${b}_g | tee data/${b}_gallium.$a 12 | # echo -n ${b}_e.$a, 13 | ./t_list.$a -s 200 ${b}_e | tee data/${b}_extlib.$a 14 | done 15 | done 16 | 17 | cd data 18 | 19 | for a in byte 20 | do 21 | for b in $TESTS 22 | do 23 | G_PRE="set logscale x; set logscale y; set terminal png; set xlabel \"List Length\"; set ylabel \"actions per second\";" 24 | echo "$G_PRE set output \"$b.$a.png\"; plot \"${b}_extlib.$a\" w lp, \"${b}_gallium.$a\" w lp" | gnuplot 25 | done 26 | done -------------------------------------------------------------------------------- /examples/benchmark/t_pow.ml: -------------------------------------------------------------------------------- 1 | let generic_pow ~zero ~one ~div_two ~mod_two ~mul:( * ) = 2 | let rec pow a n = 3 | if n = zero then one 4 | else if n = one then a 5 | else 6 | let b = pow a (div_two n) in 7 | b * b * (if mod_two n = zero then one else a) 8 | in pow 9 | 10 | let n = int_of_string (Sys.argv.(1)) 11 | 12 | let bases = Array.init n (fun _ -> Random.bits ()) 13 | and exps = Array.init n (fun _ -> Random.bits ()) 14 | 15 | let pow1 = generic_pow ~zero:0 ~one:1 ~div_two:(fun n -> n/2) ~mod_two:(fun n -> n mod 2) ~mul:( * ) 16 | 17 | let pow2 = generic_pow ~zero:0 ~one:1 ~div_two:(fun n -> n asr 1) ~mod_two:(fun n -> n land 1) ~mul:( * ) 18 | 19 | let pow3 = 20 | let rec pow a n = 21 | if n = 0 then 0 22 | else if n = 1 then a 23 | else 24 | let b = pow a (n asr 1) in 25 | b * b * (if n land 1 = 0 then 1 else a) 26 | in pow 27 | 28 | let time f = 29 | let t0 = Sys.time () in 30 | for i = 0 to n-1 do 31 | ignore (f bases.(i) exps.(i)) 32 | done; 33 | Sys.time () -. t0 34 | 35 | let () = 36 | Printf.printf "Time pow1: %f\n" (time pow1); 37 | Printf.printf "Time pow2: %f\n" (time pow2); 38 | Printf.printf "Time pow3: %f\n" (time pow3) 39 | -------------------------------------------------------------------------------- /examples/benchmark/t_read.log: -------------------------------------------------------------------------------- 1 | Latencies for 30 iterations of "mmap_fn", "pread", "batio", "cdk_orig", "cdk2k", "cdk4k", "vbu1k", "vbu2k", "vbu4k", "vbp1k", "vbp2k", "vbp4k", "bitstring", "str_only": 2 | mmap_fn: 18.83 WALL (18.23 usr + 0.60 sys = 18.83 CPU) @ 1.59/s (n=30) 3 | pread: 23.47 WALL (18.78 usr + 4.69 sys = 23.47 CPU) @ 1.28/s (n=30) 4 | batio: 28.79 WALL (27.05 usr + 1.74 sys = 28.79 CPU) @ 1.04/s (n=30) 5 | cdk_orig: 27.61 WALL (25.00 usr + 2.61 sys = 27.61 CPU) @ 1.09/s (n=30) 6 | cdk2k: 29.25 WALL (26.34 usr + 2.90 sys = 29.24 CPU) @ 1.03/s (n=30) 7 | cdk4k: 27.29 WALL (25.38 usr + 1.90 sys = 27.28 CPU) @ 1.10/s (n=30) 8 | vbu1k: 28.93 WALL (26.49 usr + 2.42 sys = 28.91 CPU) @ 1.04/s (n=30) 9 | vbu2k: 27.78 WALL (25.79 usr + 1.98 sys = 27.77 CPU) @ 1.08/s (n=30) 10 | vbu4k: 28.18 WALL (26.55 usr + 1.63 sys = 28.18 CPU) @ 1.06/s (n=30) 11 | vbp1k: 30.82 WALL (27.97 usr + 2.84 sys = 30.81 CPU) @ 0.97/s (n=30) 12 | vbp2k: 29.05 WALL (26.71 usr + 2.33 sys = 29.04 CPU) @ 1.03/s (n=30) 13 | vbp4k: 28.31 WALL (26.63 usr + 1.68 sys = 28.31 CPU) @ 1.06/s (n=30) 14 | bitstring: 28.33 WALL (26.57 usr + 1.76 sys = 28.33 CPU) @ 1.06/s (n=30) 15 | str_only: 24.43 WALL (21.22 usr + 3.20 sys = 24.42 CPU) @ 1.23/s (n=30) 16 | Rate vbp1k cdk2k vbp2k vbu1k batio bitstring vbp4k vbu4k vbu2k cdk_orig cdk4k str_only pread mmap_fn 17 | vbp1k 0.974/s -- -5% -6% -6% -7% -8% -8% -9% -10% -10% -11% -21% -24% -39% 18 | cdk2k 1.03/s 5% -- -1% -1% -2% -3% -3% -4% -5% -6% -7% -16% -20% -36% 19 | vbp2k 1.03/s 6% 1% -- -0% -1% -2% -3% -3% -4% -5% -6% -16% -19% -35% 20 | vbu1k 1.04/s 7% 1% 0% -- -0% -2% -2% -3% -4% -4% -6% -16% -19% -35% 21 | batio 1.04/s 7% 2% 1% 0% -- -2% -2% -2% -4% -4% -5% -15% -18% -35% 22 | bitstring 1.06/s 9% 3% 3% 2% 2% -- -0% -1% -2% -3% -4% -14% -17% -34% 23 | vbp4k 1.06/s 9% 3% 3% 2% 2% 0% -- -0% -2% -2% -4% -14% -17% -33% 24 | vbu4k 1.06/s 9% 4% 3% 3% 2% 1% 0% -- -1% -2% -3% -13% -17% -33% 25 | vbu2k 1.08/s 11% 5% 5% 4% 4% 2% 2% 1% -- -1% -2% -12% -15% -32% 26 | cdk_orig 1.09/s 12% 6% 5% 5% 4% 3% 3% 2% 1% -- -1% -12% -15% -32% 27 | cdk4k 1.10/s 13% 7% 6% 6% 6% 4% 4% 3% 2% 1% -- -10% -14% -31% 28 | str_only 1.23/s 26% 20% 19% 18% 18% 16% 16% 15% 14% 13% 12% -- -4% -23% 29 | pread 1.28/s 31% 25% 24% 23% 23% 21% 21% 20% 18% 18% 16% 4% -- -20% 30 | mmap_fn 1.59/s 64% 55% 54% 54% 53% 50% 50% 50% 47% 47% 45% 30% 25% -- 31 | -------------------------------------------------------------------------------- /examples/benchmark/t_read_stub.c: -------------------------------------------------------------------------------- 1 | #define _XOPEN_SOURCE 500 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | 18 | CAMLprim value caml_maid_pread(value ml_fd, value ml_buffer, value ml_off) { 19 | CAMLparam3(ml_fd, ml_buffer, ml_off); 20 | // fprintf(stderr, "### caml_maid_pread()\n"); 21 | int fd = Int_val(ml_fd); 22 | struct caml_ba_array *array = Caml_ba_array_val(ml_buffer); 23 | size_t len = caml_ba_byte_size(array); 24 | uint8_t *buf = Caml_ba_data_val(ml_buffer); 25 | off_t off = Int64_val(ml_off); 26 | 27 | ssize_t res = pread(fd, buf, len, off); 28 | 29 | // FIXME: throw exception on error? 30 | // Return -1 on EOF and 0 if there is nothing to read 31 | if (res == -1 && (errno == EAGAIN || errno == EWOULDBLOCK)) { 32 | res = 0; 33 | } else if (res == 0) { 34 | res = -1; 35 | } 36 | // fprintf(stderr, " res = %d\n", (int)res); 37 | CAMLreturn(Val_int(res)); 38 | } 39 | -------------------------------------------------------------------------------- /examples/benchmark/t_strstr.ml: -------------------------------------------------------------------------------- 1 | open Bigarray 2 | 3 | 4 | let stride = 8 (* bytes *) 5 | let ba_cat = int64 6 | 7 | let blit_string_to_ba s = 8 | let ba = Array1.create ba_cat c_layout ((String.length s + stride - 1) / stride) in 9 | let s' = (Obj.magic (Obj.field (Obj.repr ba) 1) : string) in 10 | for i = 0 to String.length s - 1 do 11 | String.unsafe_set s' i (String.unsafe_get s i); 12 | done; 13 | ba 14 | 15 | let build_srch_ht n_ba = 16 | let len = Array1.dim n_ba in 17 | let ht = Hashtbl.create len in 18 | for i = 0 to len - 1 do 19 | Hashtbl.add ht (Array1.get n_ba i) i 20 | done; 21 | ht 22 | 23 | let volnit ~n_ba = 24 | let ht = build_srch_ht n_ba in 25 | let ret = ref [] in 26 | fun ~hs_ba verify -> 27 | for i = 0 to Array1.dim hs_ba - 1 do 28 | try 29 | let off = Hashtbl.find ht (Array1.unsafe_get hs_ba i) in 30 | let srch_off = i * stride - off in 31 | if verify ~off:srch_off then 32 | ret := srch_off :: !ret 33 | with 34 | Not_found -> () 35 | done; 36 | !ret 37 | 38 | 39 | let vol n = 40 | let s = volnit ~n_ba:(blit_string_to_ba n) in 41 | fun hs -> s ~hs_ba:(blit_string_to_ba hs) (fun ~off -> String.sub hs off (String.length n) = n) 42 | 43 | open Batteries 44 | 45 | let rec find_all_aux n hs last acc = 46 | match 47 | try Some (String.find_from hs (last+1) n) with Not_found -> None 48 | with 49 | | Some i -> find_all_aux n hs i (last::acc) 50 | | None -> List.rev (last::acc) 51 | 52 | let find_all n hs = 53 | try 54 | let i0 = String.find hs n in 55 | find_all_aux n hs i0 [] 56 | with Not_found -> [] 57 | 58 | let n1 = "abcde" 59 | let hs1 = "abcabcabdeabcdeabbaab" 60 | 61 | let na1 = blit_string_to_ba n1 62 | let hsa1 = blit_string_to_ba hs1 63 | 64 | let test_vol = 65 | let v = vol n1 in 66 | fun () -> v hs1 67 | 68 | let test_vol_ba = 69 | let v = volnit ~n_ba:na1 in 70 | fun () -> v ~hs_ba:hsa1 (fun ~off -> String.sub hs1 off (String.length n1) = n1) 71 | 72 | let test_bf () = find_all n1 hs1 73 | 74 | let tests = 75 | [ "vol", test_vol , (); 76 | "vol_ba", test_vol_ba, (); 77 | "batfind", test_bf, (); 78 | ] 79 | 80 | open Benchmark 81 | 82 | let () = 83 | latencyN 1_000_000L tests |> tabulate 84 | -------------------------------------------------------------------------------- /examples/euler/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean 2 | 3 | SOURCES = $(wildcard euler*.ml) 4 | TARGETS = $(SOURCES:.ml=.byte) 5 | LIBRARIES = mathlib.ml 6 | 7 | all: $(TARGETS) 8 | 9 | clean: 10 | rm *.byte *.native *.cmi *.cmo 11 | 12 | %.byte: $(LIBRARIES) %.ml 13 | ocamlfind ocamlc -thread -package threads,batteries -linkpkg $^ -o $@ 14 | 15 | %.native: $(LIBRARIES) %.ml 16 | ocamlfind ocamlc -thread -package threads,batteries -linkpkg $^ -o $@ -------------------------------------------------------------------------------- /examples/euler/euler001.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open Enum 3 | 4 | let say e = e |> map string_of_int |> print ~last:"\n" IO.nwrite stdout 5 | let print_sum e = e |> reduce (+) |> string_of_int |> print_endline 6 | 7 | let top = 999 8 | 9 | let () = 10 | (1 -- top) 11 | |> filter (fun x -> x mod 3 = 0 or x mod 5 = 0) 12 | |> print_sum 13 | 14 | let () = 15 | let mul3 = (1 -- (top / 3)) |> map ( ( * ) 3) 16 | and mul5 = (1 -- (top / 5)) |> map ( ( * ) 5) 17 | in 18 | (* say (clone mul3); 19 | say (clone mul5); *) 20 | merge (<) mul3 mul5 |> uniq |> print_sum 21 | 22 | -------------------------------------------------------------------------------- /examples/euler/euler008.ml: -------------------------------------------------------------------------------- 1 | 2 | let num = "73167176531330624919225119674426574742355349194934\ 3 | 96983520312774506326239578318016984801869478851843\ 4 | 85861560789112949495459501737958331952853208805511\ 5 | 12540698747158523863050715693290963295227443043557\ 6 | 66896648950445244523161731856403098711121722383113\ 7 | 62229893423380308135336276614282806444486645238749\ 8 | 30358907296290491560440772390713810515859307960866\ 9 | 70172427121883998797908792274921901699720888093776\ 10 | 65727333001053367881220235421809751254540594752243\ 11 | 52584907711670556013604839586446706324415722155397\ 12 | 53697817977846174064955149290862569321978468622482\ 13 | 83972241375657056057490261407972968652414535100474\ 14 | 82166370484403199890008895243450658541227588666881\ 15 | 16427171479924442928230863465674813919123162824586\ 16 | 17866458359124566529476545682848912883142607690042\ 17 | 24219022671055626321111109370544217506941658960408\ 18 | 07198403850962455444362981230987879927244284909188\ 19 | 84580156166097919133875499200524063689912560717606\ 20 | 05886116467109405077541002256983155200055935729725\ 21 | 71636269561882670428252483600823257530420752963450" 22 | 23 | let code0 = Char.code '0' 24 | let numarr = Array.init 1000 (fun i -> Char.code num.[i] - code0) 25 | 26 | let () = 27 | let best = ref 1 in 28 | for i = 0 to 999 - 5 do 29 | let prod5 = numarr.(i) * numarr.(i+1) * numarr.(i+2) * numarr.(i+3) * numarr.(i+4) in 30 | best := max !best prod5; 31 | done; 32 | print_int !best; print_newline () 33 | -------------------------------------------------------------------------------- /examples/euler/euler009.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let max_search = 100 in 3 | for n = 1 to max_search do 4 | for m = n+1 to max_search do 5 | let a = 2 * m * n 6 | and b = m * m - n * n 7 | and c = m * m + n * n 8 | in 9 | let s = a + b + c in 10 | if 1000 mod s = 0 then 11 | let m = (1000 / s) in 12 | Printf.printf "mult: %d\n" m; 13 | Printf.printf "a: %d b: %d c: %d\n" (a*m) (b*m) (c*m); 14 | print_int (a * b * c * m * m * m); print_newline (); 15 | exit 0 16 | done; 17 | done 18 | -------------------------------------------------------------------------------- /examples/euler/euler010.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open Enum 3 | 4 | let max_val = 2_000_000 5 | let max_test = max_val |> float |> sqrt |> Float.to_int 6 | 7 | let () = 8 | let primes = ref (2--max_val) in 9 | let s = ref 0 in 10 | let rec loop () = 11 | match get !primes with 12 | | None -> print_int !s; print_newline () 13 | | Some p -> 14 | s := !s + p; 15 | if p < max_test then 16 | primes := !primes // (fun x -> x mod p != 0); (* damn inefficient *) 17 | loop() 18 | in 19 | loop () 20 | -------------------------------------------------------------------------------- /examples/euler/euler011.ml: -------------------------------------------------------------------------------- 1 | let arr = 2 | [|08; 02; 22; 97; 38; 15; 00; 40; 00; 75; 04; 05; 07; 78; 52; 12; 50; 77; 91; 08; 3 | 49; 49; 99; 40; 17; 81; 18; 57; 60; 87; 17; 40; 98; 43; 69; 48; 04; 56; 62; 00; 4 | 81; 49; 31; 73; 55; 79; 14; 29; 93; 71; 40; 67; 53; 88; 30; 03; 49; 13; 36; 65; 5 | 52; 70; 95; 23; 04; 60; 11; 42; 69; 24; 68; 56; 01; 32; 56; 71; 37; 02; 36; 91; 6 | 22; 31; 16; 71; 51; 67; 63; 89; 41; 92; 36; 54; 22; 40; 40; 28; 66; 33; 13; 80; 7 | 24; 47; 32; 60; 99; 03; 45; 02; 44; 75; 33; 53; 78; 36; 84; 20; 35; 17; 12; 50; 8 | 32; 98; 81; 28; 64; 23; 67; 10; 26; 38; 40; 67; 59; 54; 70; 66; 18; 38; 64; 70; 9 | 67; 26; 20; 68; 02; 62; 12; 20; 95; 63; 94; 39; 63; 08; 40; 91; 66; 49; 94; 21; 10 | 24; 55; 58; 05; 66; 73; 99; 26; 97; 17; 78; 78; 96; 83; 14; 88; 34; 89; 63; 72; 11 | 21; 36; 23; 09; 75; 00; 76; 44; 20; 45; 35; 14; 00; 61; 33; 97; 34; 31; 33; 95; 12 | 78; 17; 53; 28; 22; 75; 31; 67; 15; 94; 03; 80; 04; 62; 16; 14; 09; 53; 56; 92; 13 | 16; 39; 05; 42; 96; 35; 31; 47; 55; 58; 88; 24; 00; 17; 54; 24; 36; 29; 85; 57; 14 | 86; 56; 00; 48; 35; 71; 89; 07; 05; 44; 44; 37; 44; 60; 21; 58; 51; 54; 17; 58; 15 | 19; 80; 81; 68; 05; 94; 47; 69; 28; 73; 92; 13; 86; 52; 17; 77; 04; 89; 55; 40; 16 | 04; 52; 08; 83; 97; 35; 99; 16; 07; 97; 57; 32; 16; 26; 26; 79; 33; 27; 98; 66; 17 | 88; 36; 68; 87; 57; 62; 20; 72; 03; 46; 33; 67; 46; 55; 12; 32; 63; 93; 53; 69; 18 | 04; 42; 16; 73; 38; 25; 39; 11; 24; 94; 72; 18; 08; 46; 29; 32; 40; 62; 76; 36; 19 | 20; 69; 36; 41; 72; 30; 23; 88; 34; 62; 99; 69; 82; 67; 59; 85; 74; 04; 36; 16; 20 | 20; 73; 35; 29; 78; 31; 90; 01; 74; 31; 49; 71; 48; 86; 81; 16; 23; 57; 05; 54; 21 | 01; 70; 54; 71; 83; 51; 54; 69; 16; 92; 33; 48; 61; 43; 52; 01; 89; 19; 67; 48; 22 | |] 23 | 24 | let get r c = arr.(r * 20 + c) 25 | 26 | 27 | let best_lr = 28 | let best = ref 1 in 29 | let test f = best := max !best (f 0 * f 1 * f 2 * f 3) in 30 | for row = 0 to 19 do 31 | for col = 0 to 19 do 32 | let lr i = get row (col + i) 33 | and tb i = get (row+i) col 34 | and d1 i = get (row+i) (col+i) 35 | and d2 i = get (row-i) (col+i) in 36 | if col + 3 <= 19 then test lr; 37 | if row + 3 <= 19 then test tb; 38 | if (row + 3 <= 19 && col + 3 <= 19) then test d1; 39 | if (row >= 3 && col >= 3) then test d2; 40 | done 41 | done; 42 | print_int !best; print_newline () 43 | -------------------------------------------------------------------------------- /examples/euler/euler012.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | let num_div x = 3 | let count = ref 1 in (* already counted 1 *) 4 | let max_test = x |> float |> sqrt |> Float.to_int in 5 | for i = 2 to max_test do 6 | if x mod i = 0 then incr count 7 | done; 8 | count := !count * 2; (* every factor < max_test has a corresponding one > *) 9 | if x mod max_test = 0 then decr count; (* dont double count root if x square *) 10 | !count 11 | 12 | let rec loop i n = 13 | let d = num_div n in 14 | if d > 500 then begin 15 | print_int n; print_newline(); exit 0 16 | end else loop (i+1) (n+i+1) 17 | 18 | let () = loop 1 1 19 | -------------------------------------------------------------------------------- /examples/euler/euler013.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | let data = [ 3 | 37107287533902; 4 | 46376937677490; 5 | 74324986199524; 6 | 91942213363574; 7 | 23067588207539; 8 | 89261670696623; 9 | 28112879812849; 10 | 44274228917432; 11 | 47451445736001; 12 | 70386486105843; 13 | 62176457141856; 14 | 64906352462741; 15 | 92575867718337; 16 | 58203565325359; 17 | 80181199384826; 18 | 35398664372827; 19 | 86515506006295; 20 | 71693888707715; 21 | 54370070576826; 22 | 53282654108756; 23 | 36123272525000; 24 | 45876576172410; 25 | 17423706905851; 26 | 81142660418086; 27 | 51934325451728; 28 | 62467221648435; 29 | 15732444386908; 30 | 55037687525678; 31 | 18336384825330; 32 | 80386287592878; 33 | 78182833757993; 34 | 16726320100436; 35 | 48403098129077; 36 | 87086987551392; 37 | 59959406895756; 38 | 69793950679652; 39 | 41052684708299; 40 | 65378607361501; 41 | 35829035317434; 42 | 94953759765105; 43 | 88902802571733; 44 | 25267680276078; 45 | 36270218540497; 46 | 24074486908231; 47 | 91430288197103; 48 | 34413065578016; 49 | 23053081172816; 50 | 11487696932154; 51 | 63783299490636; 52 | 67720186971698; 53 | 95548255300263; 54 | 76085327132285; 55 | 37774242535411; 56 | 23701913275725; 57 | 29798860272258; 58 | 18495701454879; 59 | 38298203783031; 60 | 34829543829199; 61 | 40957953066405; 62 | 29746152185502; 63 | 41698116222072; 64 | 62467957194401; 65 | 23189706772547; 66 | 86188088225875; 67 | 11306739708304; 68 | 82959174767140; 69 | 97623331044818; 70 | 42846280183517; 71 | 55121603546981; 72 | 32238195734329; 73 | 75506164965184; 74 | 62177842752192; 75 | 32924185707147; 76 | 99518671430235; 77 | 73267460800591; 78 | 76841822524674; 79 | 97142617910342; 80 | 87783646182799; 81 | 10848802521674; 82 | 71329612474782; 83 | 62184073572399; 84 | 66627891981488; 85 | 60661826293682; 86 | 85786944089552; 87 | 66024396409905; 88 | 64913982680032; 89 | 16730939319872; 90 | 94809377245048; 91 | 78639167021187; 92 | 15368713711936; 93 | 40789923115535; 94 | 44889911501440; 95 | 41503128880339; 96 | 81234880673210; 97 | 82616570773948; 98 | 22918802058777; 99 | 77158542502016; 100 | 72107838435069; 101 | 20849603980134; 102 | 53503534226472; ] 103 | 104 | let () = List.reduce (+) data |> print_int; print_newline () 105 | (* fix: print only the first 10 characters *) 106 | -------------------------------------------------------------------------------- /examples/euler/euler014.ml: -------------------------------------------------------------------------------- 1 | let rec seq i = function 2 | 1 -> i 3 | | n when n land 1 = 0 -> seq (i+1) (n asr 1) 4 | | n (* odd *) -> seq (i+1) (3*n+1) 5 | 6 | let () = 7 | let best_i = ref 1 8 | and best_n0 = ref 1 in 9 | for n = 1 to 1_000_000 do 10 | let i = seq 1 n in 11 | if i > !best_i then 12 | ( best_i := i; best_n0 := n ); 13 | done; 14 | print_int !best_n0; print_newline () 15 | -------------------------------------------------------------------------------- /examples/euler/euler018.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | let tri = 3 | [| 4 | [| 75 |]; 5 | [| 95; 64 |]; 6 | [| 17; 47; 82 |]; 7 | [| 18; 35; 87; 10 |]; 8 | [| 20; 04; 82; 47; 65 |]; 9 | [| 19; 01; 23; 75; 03; 34 |]; 10 | [| 88; 02; 77; 73; 07; 63; 67 |]; 11 | [| 99; 65; 04; 28; 06; 16; 70; 92 |]; 12 | [| 41; 41; 26; 56; 83; 40; 80; 70; 33 |]; 13 | [| 41; 48; 72; 33; 47; 32; 37; 16; 94; 29 |]; 14 | [| 53; 71; 44; 65; 25; 43; 91; 52; 97; 51; 14 |]; 15 | [| 70; 11; 33; 28; 77; 73; 17; 78; 39; 68; 17; 57 |]; 16 | [| 91; 71; 52; 38; 17; 14; 91; 43; 58; 50; 27; 29; 48 |]; 17 | [| 63; 66; 04; 68; 89; 53; 67; 30; 73; 16; 69; 87; 40; 31 |]; 18 | [| 04; 62; 98; 27; 23; 09; 70; 98; 73; 93; 38; 53; 60; 04; 23 |] 19 | |];; 20 | 21 | let () = 22 | let size = Array.length tri in 23 | print_int size; print_newline(); 24 | (* set each entry to the best possible result *) 25 | for n = 1 to size - 1 do 26 | tri.(n).(0) <- tri.(n).(0) + tri.(n-1).(0); 27 | for i = 1 to n-1 do 28 | tri.(n).(i) <- tri.(n).(i) + (max tri.(n-1).(i-1) tri.(n-1).(i)); 29 | done; 30 | tri.(n).(n) <- tri.(n).(n) + tri.(n-1).(n-1) 31 | done; 32 | Array.fold_left max (-1) tri.(size-1) |> print_int; 33 | print_newline() 34 | -------------------------------------------------------------------------------- /examples/euler/euler019.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | 3 | let daysmonth = [ 31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31 ] 4 | let daysleap = [ 31; 29; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31 ] 5 | 6 | let year_shift_f days = (List.reduce (+) days) mod 7 7 | 8 | let year_shift = year_shift_f daysmonth (* 1 *) 9 | let year_shiftleap = year_shift_f daysleap (* 2 *) 10 | 11 | let count_shift days = 12 | let ret = Array.make 7 0 in 13 | let rec loop day = function 14 | h :: [] -> 15 | let sh = 6 - day in 16 | ret.(sh) <- ret.(sh) + 1 (* and done *) 17 | | h :: t -> 18 | let sh = 6 - day in 19 | ret.(sh) <- ret.(sh) + 1; 20 | loop ((day + h) mod 7) t 21 | in 22 | loop 0 days; 23 | ret 24 | 25 | let count_year = count_shift daysmonth 26 | let count_leap = count_shift daysleap 27 | (* val count_year : int array = [|2; 2; 1; 3; 1; 1; 2|] *) 28 | (* val count_leap : int array = [|2; 1; 2; 2; 1; 1; 3|] *) 29 | 30 | let is_leap yr = 31 | if yr mod 4 <> 0 then false 32 | else if yr mod 100 <> 0 then true 33 | else if yr mod 400 <> 0 then false 34 | else true 35 | 36 | let rec count_sun (count, yr, endyr, dayone) = 37 | if yr >= endyr then count 38 | else 39 | let add, shift = 40 | if is_leap yr 41 | then count_leap.(dayone), year_shiftleap 42 | else count_year.(dayone), year_shift 43 | in 44 | count_sun ((count+add), (yr+1), endyr, ((dayone + shift) mod 7)) 45 | 46 | let () = 47 | let end_yr = 2001 48 | and start_yr = 1901 49 | and dayone = 1 (* monday *) 50 | in 51 | let count = count_sun (0, start_yr, end_yr, dayone) in 52 | print_int count; print_newline();; 53 | -------------------------------------------------------------------------------- /examples/euler/euler021.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | let d n = Mathlib.sum_factors n 3 | 4 | module ISet = Set.Make(Int) 5 | 6 | let ret_amicable ~upto = 7 | let is_amic = ref ISet.empty 8 | and not_amic = ref ISet.empty 9 | and to_test = ref ((2--upto) |> ISet.of_enum) 10 | in 11 | let rec test n = (* cleanup - ugly code *) 12 | if n >= upto then () 13 | else if ISet.mem n !is_amic 14 | || ISet.mem n !not_amic then 15 | () 16 | else 17 | let dn = d n in 18 | if dn >= upto || dn = n then 19 | not_amic := !not_amic |> ISet.add n 20 | else 21 | let ddn = d dn in 22 | if n = ddn then 23 | is_amic := !is_amic |> ISet.add n |> ISet.add dn 24 | else 25 | not_amic := !not_amic |> ISet.add n 26 | in 27 | while not (ISet.is_empty !to_test) do 28 | let n = ISet.choose !to_test in 29 | to_test := !to_test |> ISet.remove n; 30 | test n 31 | done; 32 | ISet.enum !is_amic 33 | 34 | let print_int_enum e = Enum.print (fun stdout n -> IO.nwrite stdout (string_of_int n)) stdout e 35 | 36 | let () = 37 | ret_amicable ~upto:10_000 |> Enum.reduce (+) |> print_int; 38 | print_newline();; 39 | -------------------------------------------------------------------------------- /examples/euler/euler022.ml: -------------------------------------------------------------------------------- 1 | (* uses names.txt *) 2 | 3 | -------------------------------------------------------------------------------- /examples/euler/euler023.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open List 3 | 4 | let is_abundant n = n < Mathlib.sum_factors n 5 | 6 | let max_sum = if Array.length Sys.argv > 1 7 | then int_of_string Sys.argv.(1) else 28123 8 | 9 | let () = 10 | let x = BitSet.create_full max_sum in 11 | let found = RefList.empty () in 12 | for i = 12 to max_sum do 13 | if is_abundant i then begin 14 | RefList.push found i; 15 | RefList.iter (fun j -> BitSet.unset x (i+j)) found; 16 | end 17 | done; 18 | 19 | BitSet.enum x 20 | |> Enum.reduce (+) |> print_int; 21 | 22 | print_newline () 23 | -------------------------------------------------------------------------------- /examples/euler/euler024.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open Mathlib 3 | 4 | let pos = 1_000_000 5 | 6 | let tokens = [0;1;2;3;4;5;6;7;8;9] 7 | 8 | let rec permute tokens acc pos = 9 | match tokens with 10 | [] -> List.rev (acc) 11 | | [x] -> List.rev (x :: acc) 12 | | t -> 13 | let len = List.length t in 14 | let sub_count = factorial (len-1) in 15 | let token_pos = pos / sub_count 16 | and next_pos = pos mod sub_count in 17 | let found = List.at t token_pos in 18 | Printf.printf "subperm %d: %d (pos %d clust %d) next: %d\n" pos found token_pos sub_count next_pos; 19 | permute (List.remove t found) (found::acc) next_pos 20 | 21 | let () = 22 | permute tokens [] (pos-1) |> List.iter (fun i -> print_int i); 23 | print_newline() 24 | 25 | -------------------------------------------------------------------------------- /examples/optionExample.re: -------------------------------------------------------------------------------- 1 | let odd x => 2 | switch (x mod 2) { 3 | | 0 => Some x 4 | | _ => None 5 | }; 6 | 7 | let t10 = 8 | odd 10 |> Option.map ((+) 10) |> Option.map ((/) 100) |> 9 | Option.map_default string_of_int "No value"; 10 | 11 | Js.log2 "t10 value: " t10; 12 | 13 | let t11 = 14 | odd 11 |> Option.map ((+) 10) |> Option.map ((/) 2) |> 15 | Option.map_default string_of_int "No value"; 16 | 17 | Js.log2 "t11 value: " t11; 18 | 19 | let res = Js.Result.Ok "Hello"; 20 | 21 | exception Super; 22 | 23 | let m = 24 | switch res { 25 | | Ok str => str 26 | | Error _ => raise Super 27 | }; 28 | 29 | type t0 _; 30 | 31 | type typ _ = 32 | | Int :typ int 33 | | String :typ string; 34 | 35 | let m: int = [%bs.raw "5"]; 36 | 37 | let to_string (type t) (t: typ t) (x: t) :string => 38 | switch t { 39 | | Int => string_of_int x 40 | | String => x 41 | }; 42 | 43 | Js.log (to_string String "Hello"); 44 | -------------------------------------------------------------------------------- /examples/snippets/_tags: -------------------------------------------------------------------------------- 1 | <*>: pkg_batteries, syntax_camlp4o, pkg_batteries.syntax, debug 2 | : pkg_netstring 3 | : thread -------------------------------------------------------------------------------- /examples/snippets/accumulator.ml: -------------------------------------------------------------------------------- 1 | (*A problem I found some time ago on Paul Graham's website. 2 | 3 | "Revenge of the Nerds yielded a collection of canonical solutions to 4 | the same problem in a number of languages. 5 | 6 | The problem: Write a function foo that takes a number n and returns a 7 | function that takes a number i, and returns n incremented by i. 8 | 9 | Note: (a) that's number, not integer, (b) that's incremented by, not plus." 10 | 11 | Solutions in other languages are available at 12 | http://www.paulgraham.com/accgen.html 13 | *) 14 | 15 | 16 | (** [adder t n] is an adder for elements of [numeric] typeclass [t], 17 | initialized with [n]*) 18 | let adder t n i = 19 | open Numeric in 20 | Ref.post r (t.add i) 21 | where r = ref n 22 | 23 | (*Examples:*) 24 | let adder_of_floats : float -> float = 25 | adder Float.operations 5. 26 | 27 | let adder_of_ints : int -> int = 28 | adder Int.operations 5 29 | 30 | let adder_of_complexes: Complex.t -> Complex.t = 31 | adder Complex.operations Complex.i 32 | -------------------------------------------------------------------------------- /examples/snippets/myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | ../../build/myocamlbuild.ml -------------------------------------------------------------------------------- /examples/snippets/netchan_cat.ml: -------------------------------------------------------------------------------- 1 | (* Yet another (slower) "cat" implementation, it is just meant to be a 2 | showcase for integration with ocamlnet's Netchannels. *) 3 | 4 | let oc = 5 | Netchannels.lift_out 6 | (`Rec (new Netchannels.channel_of_output IO.stdout :> 7 | Netchannels.rec_out_channel)) 8 | let _ = 9 | Netchannels.with_in_obj_channel 10 | (Netchannels.lift_in (`Rec (new Netchannels.channel_of_input IO.stdin))) 11 | (fun ic -> 12 | try 13 | while true do 14 | oc # output_string (ic # input_line () ^ "\n"); 15 | oc # flush () 16 | done 17 | with End_of_file -> ()) 18 | 19 | -------------------------------------------------------------------------------- /examples/snippets/parallelsort.ml: -------------------------------------------------------------------------------- 1 | open Threads, Event 2 | 3 | let tasks = 5 4 | 5 | let main = 6 | let input = Sys.argv in 7 | let input_len = Array.length input in 8 | let channels = Array.init tasks (fun _ -> new_channel ()) in 9 | let part_size = input_len / tasks in 10 | let gen_part i = 11 | let len = if i=tasks-1 then (input_len) - (i * part_size) else part_size in 12 | Array.sub input (i*part_size) len 13 | in 14 | let partitions = Array.init tasks gen_part in 15 | let task (c,arr) = Array.sort compare arr; send c arr |> sync in 16 | let make_thread c arr = ignore (Thread.create task (c,arr)) in 17 | Array.iter2 make_thread channels partitions; 18 | let get_print c = c |> receive |> sync |> Array.iter print_endline in 19 | Array.iter get_print channels 20 | -------------------------------------------------------------------------------- /examples/snippets/ropes_vs_strings.ml: -------------------------------------------------------------------------------- 1 | open Rope 2 | 3 | let (^^^) = append 4 | 5 | let test_strings num = 6 | let x = ref "" 7 | and s = "a" 8 | in for i = 1 to num do 9 | x := !x ^ s 10 | done 11 | 12 | let test_ropes num = 13 | let x = ref (r"") 14 | and s = r"a" 15 | in for i = 1 to num do 16 | x := !x ^^^ s 17 | done 18 | 19 | let delta f x = 20 | let t0 = Sys.time () in 21 | let _ = f x in 22 | let t1 = Sys.time () in 23 | t1 -. t0 24 | 25 | let _ = 26 | Printf.printf "Strings: %fms\n" (delta (fun () -> 27 | for i = 1 to 10 do 28 | test_strings 10000 29 | done 30 | ) ()); 31 | Printf.printf "Ropes: %fms\n" (delta (fun () -> 32 | for i = 1 to 10 do 33 | test_ropes 1000000 34 | done 35 | ) ()) 36 | 37 | 38 | -------------------------------------------------------------------------------- /examples/snippets/snippets.itarget: -------------------------------------------------------------------------------- 1 | netchan_cat.byte 2 | netchan_cat.native 3 | parallelsort.byte 4 | parallelsort.native 5 | test_printf.byte 6 | test_printf.native 7 | -------------------------------------------------------------------------------- /examples/snippets/test_printf.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open Print 3 | 4 | let _ = 5 | (* Simple test *) 6 | printf p"x = (%d, %s)\n" 1 "a"; 7 | 8 | (* With flags: *) 9 | printf p"x = %04x\n" 42; 10 | 11 | (* Test with labelled directives: *) 12 | printf p"Hello %(name:s), i am ocaml version %(version:s)\n%!" 13 | ~name:(try Sys.getenv "USER" with _ -> "toto") 14 | ~version:Sys.ocaml_version; 15 | 16 | (* Printing an object: *) 17 | printf p"o = %obj\n" 18 | (object(self) 19 | method print oc = fprintf oc p"" (Oo.id self) 20 | end); 21 | 22 | (* Printing a list: *) 23 | printf p"l = %{int option list}\n" [Some 1; None; Some 2]; 24 | 25 | (* A custom directive, printing pair of integers: *) 26 | let printer_foo k (x, y) = k (fun oc -> fprintf oc p"(%d, %d)" x y) in 27 | 28 | printf p"pair = %foo\n" (42, 1024); 29 | 30 | (* A custom directive, taking multiple arguments: *) 31 | let printer_test k x y z = k (fun oc -> fprintf oc p"(%d, %d, %d)" x y z) in 32 | 33 | printf p"x = %test\n" 1 2 3; 34 | 35 | (* Labelled directives with multiple argument: *) 36 | printf p"x = %(x,y,z:test)\n" ~x:1 ~y:2 ~z:2; 37 | printf p"x = %(x,_,z:test)\n" ~x:1 2 ~z:2 38 | -------------------------------------------------------------------------------- /examples/snippets/unicode.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/meafmira/bs-batteries/0c9eb3e10db8f65a5d3c7bbac17e271038cf4c38/examples/snippets/unicode.ml -------------------------------------------------------------------------------- /examples/snippets/unicode2.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/meafmira/bs-batteries/0c9eb3e10db8f65a5d3c7bbac17e271038cf4c38/examples/snippets/unicode2.ml -------------------------------------------------------------------------------- /examples/tools/_tags: -------------------------------------------------------------------------------- 1 | not(<*_dyn*>): pkg_batteries,debug 2 | -------------------------------------------------------------------------------- /examples/tools/browser.ml: -------------------------------------------------------------------------------- 1 | (** 2 | Call your favorite browser to browse each of the URLs entered on the command-line. 3 | *) 4 | open Batteries_config 5 | 6 | iter (fun x -> ignore **> browse x) (args ()) 7 | -------------------------------------------------------------------------------- /examples/tools/cat.ml: -------------------------------------------------------------------------------- 1 | (** Implementation of a cat-like tool: read each file whose name is 2 | given on the command-line and print the contents to stdout. 3 | 4 | Compilation: 5 | ocamlbuild cat.byte 6 | 7 | Usage: 8 | ./cat.byte *.ml 9 | 10 | *) 11 | 12 | open Batteries;; 13 | 14 | iter (fun x -> IO.copy (File.open_in x) stdout) (args ());; 15 | -------------------------------------------------------------------------------- /examples/tools/cat2.ml: -------------------------------------------------------------------------------- 1 | (** Implementation of a cat-like tool: read each file whose name is 2 | given on the command-line and print the contents to stdout. 3 | 4 | Usage: 5 | ./cat2.byte *.ml 6 | 7 | Variants based on function composition 8 | *) 9 | 10 | (* 11 | For reference 12 | 13 | write_lines : unit output -> string Enum.t -> unit 14 | stdout : unit output 15 | args : unit -> string Enum.t 16 | () : unit 17 | concat : string Enum.t Enum.t -> string Enum.t 18 | map : (string -> string Enum.t) -> string Enum.t -> string Enum.t Enum.t 19 | File.lines_of:string -> string Enum.t 20 | *) 21 | 22 | (*(*Variant 1*) 23 | let _ = 24 | write_lines stdout -| concat <| map lines_of (args ()) 25 | *) 26 | 27 | (*Variant 2*) 28 | let _ = 29 | () |> args |> (File.lines_of |> map) |> concat |> (stdout |> IO.write_lines) 30 | 31 | -------------------------------------------------------------------------------- /examples/tools/conv.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Convert encodings. 3 | Everything received from the standard input is converted and written onto the standard output, 4 | using the encodings specified on the command-line. 5 | 6 | Usage: 7 | ./conv ASCII UTF-8 < README 8 | *) 9 | open CharEncodings, Sys, IO 10 | 11 | try 12 | (*V1: Convert output: 13 | copy stdin (encoded_as (transcode_out (as_encoded stdout (`named argv.(1))) (`named argv.(2))))*) 14 | (*V2: Convert input*) 15 | copy (encoded_as **> transcode_in (as_encoded stdin **> `named argv.(1)) (`named argv.(2))) stdout; 16 | flush_all () 17 | with Not_found -> Print.eprintf p"Sorry, unknown encoding.\n%!" 18 | | Malformed_code -> Print.eprintf p"Error: This text is not encoded with encoding %S\n" (argv.(1)) 19 | | e -> Print.eprintf p"Error:\n%s\n%!" (Printexc.to_string e) 20 | -------------------------------------------------------------------------------- /examples/tools/gunzip.ml: -------------------------------------------------------------------------------- 1 | (* Open a .gz file and decompress it on the spot. 2 | 3 | Usage: 4 | ./gunzip.byte some_file.gz 5 | (produces some_file, removes some_file.gz) 6 | *) 7 | open File, IO, Filename 8 | 9 | iter f (args ()) 10 | where let f name = 11 | if check_suffix name ".gz" then 12 | with_file_in name (fun inp -> 13 | with_file_out (chop_suffix name ".gz") (fun out -> 14 | Gzip.with_in inp (fun inp'-> 15 | copy inp' out; 16 | Sys.remove name))) 17 | else prerr_endline ("I don't know what to do with file "^name) 18 | -------------------------------------------------------------------------------- /examples/tools/mygzip.ml: -------------------------------------------------------------------------------- 1 | (* Compress a file to .gz on the spot 2 | 3 | Usage: 4 | ./gzip.byte some_file 5 | (produces some_file.gz, removes some_file) 6 | *) 7 | open File, IO, Filename 8 | 9 | iter f (args ()) 10 | where let f name = 11 | with_file_out (name ^ ".gz") (fun out -> 12 | with_file_in name (fun inp -> 13 | copy inp (Gzip.compress out); 14 | Sys.remove name 15 | )) 16 | -------------------------------------------------------------------------------- /examples/tools/myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | ../../build/myocamlbuild.ml -------------------------------------------------------------------------------- /examples/tools/now.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Print the current date 3 | 4 | Usage: 5 | ./now 6 | *) 7 | 8 | open Date 9 | print stdout (now ()); 10 | print_newline () 11 | -------------------------------------------------------------------------------- /examples/tools/pair.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Print the contents of two files, optionally using a printf-style format argument. 3 | I found this useful to write module CharEncodings, and it was a three-liner at 4 | the time (before I made it parametric). 5 | 6 | Usage: 7 | ./pair file_1 file_2 8 | ./pair file_1 file_2 "%s -> %S\n" 9 | 10 | The first usage prints the first line of file_1 followed by the first line of file_2, 11 | then the second line of file_1 followed by the second line of file_2, etc. until either 12 | file_1 or file_2 ends. 13 | 14 | The second usage does the same thing but adds characters " -> " between each line of 15 | file_1 and the corresponding line of file file_2 and puts the contents of each line 16 | of file_2 between quotes. 17 | *) 18 | 19 | open Sys 20 | 21 | (*Read the format -- this is the most complicated part of the program*) 22 | let default_format : (_, _, _, _) format4 = "%s %s\n" 23 | if Array.length argv < 2 then failwith "Missing arguments" 24 | let format = if Array.length argv = 3 then default_format 25 | else Scanf.format_from_string argv.(3) default_format 26 | in 27 | (*Actually do the deed*) 28 | Enum.iter2 29 | (fun x y -> Printf.printf format x y) 30 | (File.lines_of argv.(1)) 31 | (File.lines_of argv.(2)) 32 | -------------------------------------------------------------------------------- /examples/tools/shuffle.ml: -------------------------------------------------------------------------------- 1 | (* Randomly reorder the elements given on the command-line. 2 | 3 | Usage: 4 | ./shuffle 1 2 3 4 5 6 7 8 9 5 | *) 6 | 7 | open Random with self_init () 8 | 9 | let _ = Array.print ~sep:" " ~first:"" ~last:"\n" output_string stdout (shuffle (args ()));; 10 | -------------------------------------------------------------------------------- /examples/tools/shuffle2.ml: -------------------------------------------------------------------------------- 1 | (*Randomly reorder the elements given on stdin. 2 | 3 | Usage: 4 | ./shuffle2.byte < some_file.txt 5 | *) 6 | 7 | open Random with self_init () 8 | open IO, Printf 9 | 10 | let shift x = x + 1;; 11 | 12 | Array.iteri (shift |- printf "%-2d: %s\n") (shuffle (lines_of stdin)) 13 | 14 | -------------------------------------------------------------------------------- /examples/tools/tools.itarget: -------------------------------------------------------------------------------- 1 | conv.byte 2 | conv.native 3 | now.byte 4 | now.native 5 | cat.byte 6 | cat.native 7 | cat2.byte 8 | cat2.native 9 | shuffle.byte 10 | shuffle.native 11 | shuffle2.byte 12 | shuffle2.native 13 | gzip.byte 14 | gzip.native 15 | gunzip.byte 16 | gunzip.native 17 | browser.byte 18 | browser.native -------------------------------------------------------------------------------- /howto/coverage.md: -------------------------------------------------------------------------------- 1 | Test Coverage 2 | ------------- 3 | 4 | First, you need to install `bisect` and `qtest`: 5 | 6 | $ opam install bisect qtest 7 | 8 | Then, run 9 | 10 | $ make coverage 11 | 12 | Then open the file `coverage/index.html` to see how many tests you need to write :) 13 | -------------------------------------------------------------------------------- /ocamlinit: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2011 Batteries Included Team 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 | 21 | (* This script starts loading batteries into the ocaml toplevel. 22 | * 23 | * To install, copy to your ~/.ocamlinit. If you already have an 24 | * ocamlinit file that initializes findlib, just add the last 25 | * phrase to your ocamlinit. 26 | *) 27 | 28 | (* Pretend to be in non-interactive mode to hide topfind 29 | initialization message *) 30 | 31 | let interactive = !Sys.interactive;; 32 | Sys.interactive := false;; 33 | #use "topfind";; 34 | Sys.interactive := interactive;; 35 | 36 | (* run battop.ml in toplevel *) 37 | 38 | Toploop.use_silently 39 | Format.err_formatter (Filename.concat (Findlib.package_directory 40 | "batteries") "battop.ml");; 41 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | name: "batteries" 3 | maintainer: "thelema314@gmail.com" 4 | authors: "OCaml batteries-included team" 5 | homepage: "http://batteries.forge.ocamlcore.org/" 6 | bug-reports: "https://github.com/ocaml-batteries-team/batteries-included/issues" 7 | dev-repo: "https://github.com/ocaml-batteries-team/batteries-included.git" 8 | license: "LGPL-2.1+ with OCaml linking exception" 9 | doc: "http://ocaml-batteries-team.github.io/batteries-included/hdoc2/" 10 | 11 | build: [ 12 | ["ocaml" "setup.ml" "-configure" "--prefix" prefix] 13 | [make "all"] 14 | ] 15 | install: [ 16 | [make "install"] 17 | ] 18 | remove: [["ocamlfind" "remove" "batteries"]] 19 | 20 | depends: [ 21 | "ocamlfind" {>= "1.5.3"} 22 | "ocamlbuild" {build} 23 | "qtest" {test & >= "2.0.0"} 24 | ] 25 | available: [ 26 | ocaml-version >= "3.12.1" 27 | ] 28 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "bs-batteries", 3 | "version": "0.0.14", 4 | "keywords": [ 5 | "batteries-included", 6 | "bucklescript", 7 | "bsb", 8 | "reason", 9 | "reasonml", 10 | "ocaml", 11 | "bs-batteries", 12 | "bs-platform" 13 | ], 14 | "description": "Ocaml batteries for bucklescript", 15 | "repository": "git@github.com:meafmira/bs-batteries.git", 16 | "author": "meafmira ", 17 | "license": "MIT", 18 | "scripts": { 19 | "build": "bsb -clean-world -make-world", 20 | "watch": "bsb -clean-world -make-world -w" 21 | }, 22 | "dependencies": {}, 23 | "peerDependencies": { 24 | "bs-platform": "^2.0.0" 25 | }, 26 | "devDependencies": { 27 | "bs-platform": "^2.0.0" 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /plot: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | [ $# -eq 0 ] || { 4 | echo 'unexpected command line arguments' 5 | echo 'usage: $0' 6 | echo 'Expects a stream on the standard input and draws' 7 | echo 'gnuplot graphs when it recognizes some gnuplot data' 8 | exit 1 9 | } 10 | 11 | trap cleanup EXIT SIGINT 12 | cleanup() { 13 | rm -f "$tmp" 14 | } 15 | tmp="$(mktemp)" 16 | 17 | while read line; do 18 | case "$line" in 19 | '#'*) 20 | # reading blocks of line starting with a line 21 | # starting with a sharp and ending with an empty line 22 | # this line has format #title size\tname1\tname2 etc. 23 | names=$(echo "$line" | cut -d ' ' -f 2-) 24 | title=$(echo "$line" | sed 's/^#\([^ ]*\) .*$/\1/') 25 | > "$tmp" # emptying the file 26 | while read line && [ "$line" != "" ]; do 27 | echo "$line" >> "$tmp" 28 | done 29 | gnuplot -p <( 30 | echo set key left top 31 | echo set logscale x 32 | echo set title "'$title'" 33 | echo -n 'plot ' 34 | counter=1 35 | for name in $names; do 36 | counter=$((counter+1)) 37 | if [ $counter -ne 2 ]; then 38 | echo -e -n ', \\\n ' 39 | fi 40 | echo -n \'"$tmp"\' using 1:$counter title \'"$name"\' with linespoints 41 | done 42 | echo 43 | ) 44 | esac 45 | done 46 | -------------------------------------------------------------------------------- /qtest/README.md: -------------------------------------------------------------------------------- 1 | # qTest 2 | 3 | ## Info: 4 | The inline tests are generated and run here. The qTest code itself has moved to a new location: 5 | 6 | https://github.com/vincent-hugot/iTeML 7 | 8 | 9 | ## Files: 10 | _tags : necessary to run the tests 11 | -------------------------------------------------------------------------------- /qtest/_tags: -------------------------------------------------------------------------------- 1 | true: threads, debug 2 | 3 | 4 | # Warning 52 warnings against patterns of the form 5 | # 6 | # try .. with Invalid_argument "foo" -> ... 7 | # 8 | # because they are fragile. But we want to have them in tests, for the 9 | # Invalid_argument payloads corresponding to exceptions *we* raise, as 10 | # the fact that those fragile tests break then tells us that fragile 11 | # user code would also break (and we want to be alerted when that is 12 | # a risk). 13 | true: warn(-52) 14 | 15 | -------------------------------------------------------------------------------- /qtest/qtest_preamble.ml: -------------------------------------------------------------------------------- 1 | (* this file is part of Batteries 'qtest' usage; it will be included 2 | at the top of the generated test runner, and is therefore a good 3 | location to add functions that would be convenient to write tests 4 | but have not yet found their place into Batteries proper. *) 5 | open Batteries 6 | 7 | 8 | -------------------------------------------------------------------------------- /scripts/find_since.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | # Find remaining NEXT_RELEASE tags 4 | 5 | find src/ -name '*.ml*' -exec grep NEXT_RELEASE -n {} \; -print 6 | 7 | -------------------------------------------------------------------------------- /scripts/replace_since.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | # Replace annotations of the form @since NEXT_RELEASE by the 4 | # version number given on the command line 5 | 6 | VERSION="$1" 7 | 8 | echo "version number: $VERSION" 9 | 10 | if [ -e "$VERSION" ] ; then 11 | echo "please give a version number" 12 | exit 1 13 | fi 14 | 15 | find src/ -name '*.ml*' -exec sed -i'' "s/NEXT_RELEASE/$VERSION/g" {} \; 16 | -------------------------------------------------------------------------------- /scripts/test_install.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | #set -x 4 | 5 | temp_dir=`mktemp -d` 6 | 7 | cat< $temp_dir/install_test.ml 8 | open Batteries 9 | let () = 10 | assert(List.takedrop 2 [1;2;3;4] = ([1;2], [3;4])); 11 | Printf.printf "install_test: OK\n" 12 | EOF 13 | 14 | make clean # force rebuild next 15 | make install && \ 16 | cd $temp_dir && \ 17 | rm -f install_test.native && \ 18 | ocamlbuild -pkg batteries install_test.native && \ 19 | ./install_test.native 20 | 21 | cd - # go back where we were before 22 | rm -rf $temp_dir # clean our mess 23 | -------------------------------------------------------------------------------- /src/_tags: -------------------------------------------------------------------------------- 1 | true: debug 2 | <{batMutex,batRMutex}.{ml,mli}>: threads 3 | : threads 4 | : rectypes 5 | <{batMap,batVect,batFile,batPervasives,batParserCo,batSet,batLogger,batPathGen,batSplay}.ml>: warn_z 6 | <{batPervasives,batIMap,batLog}.ml>: warn_-9 7 | : compiler-libs 8 | 9 | : inline(3) 10 | # necessary to inline ofs_of_layout on V<4.2 11 | -------------------------------------------------------------------------------- /src/batAvlTree.mli: -------------------------------------------------------------------------------- 1 | (* $Id: avlTree.mli,v 1.3 2003/06/18 15:11:07 yori Exp $ *) 2 | (* Copyright 2003 Yamagata Yoriyuki. distributed with LGPL *) 3 | (* Modified by Edgar Friendly *) 4 | 5 | (** Internals of ISet and IMap, usable as generic tree library *) 6 | 7 | type +'a tree 8 | 9 | val empty : 'a tree 10 | 11 | val is_empty : 'a tree -> bool 12 | 13 | val make_tree : 'a tree -> 'a -> 'a tree -> 'a tree 14 | 15 | val create : 'a tree -> 'a -> 'a tree -> 'a tree 16 | (** [create l v r] is similar to [make_tree l v r] but performs no rebalancing; 17 | in other words, you should use this only when you {e know} that [l] and [r] 18 | are already balanced. *) 19 | 20 | val height : 'a tree -> int 21 | 22 | val left_branch : 'a tree -> 'a tree 23 | (** @raise Not_found if the tree is empty *) 24 | 25 | val right_branch : 'a tree -> 'a tree 26 | (** @raise Not_found if the tree is empty *) 27 | 28 | val root : 'a tree -> 'a 29 | (** @raise Not_found if the tree is empty *) 30 | 31 | (* Utilities *) 32 | val singleton_tree : 'a -> 'a tree 33 | val split_leftmost : 'a tree -> 'a * 'a tree 34 | val split_rightmost : 'a tree -> 'a * 'a tree 35 | 36 | val concat : 'a tree -> 'a tree -> 'a tree 37 | 38 | val iter : ('a -> unit) -> 'a tree -> unit 39 | 40 | val fold : ('a -> 'b -> 'b) -> 'a tree -> 'b -> 'b 41 | 42 | val enum : 'a tree -> 'a BatEnum.t 43 | 44 | (* Sanity checks *) 45 | 46 | val check : 'a tree -> bool 47 | (** Check that the tree is balanced according to the AVL tree rules. 48 | An AVL tree is balanced when for every node the height of the 49 | subnodes differs by at most 1. 50 | 51 | @since 2.3.0 52 | *) 53 | 54 | (**/**) 55 | (* Helpers for testing *) 56 | 57 | val check_height_cache : 'a tree -> bool 58 | val check_height_balance : 'a tree -> bool 59 | 60 | (**/**) 61 | -------------------------------------------------------------------------------- /src/batBase64.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Base64 - Base64 codec 3 | * Copyright (C) 2003 Nicolas Cannasse 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | (** Base64 codec. 22 | 23 | 8-bit characters are encoded into 6-bit ones using ASCII lookup tables. 24 | Default tables maps 0..63 values on characters A-Z, a-z, 0-9, '+' and '/' 25 | (in that order). 26 | 27 | @documents Base64 28 | 29 | @author Nicolas Cannasse 30 | *) 31 | 32 | (** This exception is raised when reading an invalid character 33 | from a base64 input. *) 34 | exception Invalid_char 35 | 36 | (** This exception is raised if the encoding or decoding table 37 | size is not correct. *) 38 | exception Invalid_table 39 | 40 | (** An encoding table maps integers 0..63 to the corresponding char. *) 41 | type encoding_table = char array 42 | 43 | (** A decoding table maps chars 0..255 to the corresponding 0..63 value 44 | or -1 if the char is not accepted. *) 45 | type decoding_table = int array 46 | 47 | (** Encode a string into Base64. *) 48 | val str_encode : ?tbl:encoding_table -> string -> string 49 | 50 | (** Decode a string encoded into Base64, raise [Invalid_char] if a 51 | character in the input string is not a valid one. *) 52 | val str_decode : ?tbl:decoding_table -> string -> string 53 | 54 | (** Generic base64 encoding over an output. *) 55 | val encode : ?tbl:encoding_table -> 'a BatIO.output -> 'a BatIO.output 56 | 57 | (** Generic base64 decoding over an input. *) 58 | val decode : ?tbl:decoding_table -> BatIO.input -> BatIO.input 59 | 60 | (** Create a valid decoding table from an encoding one. *) 61 | val make_decoding_table : encoding_table -> decoding_table 62 | -------------------------------------------------------------------------------- /src/batBuffer.mlv: -------------------------------------------------------------------------------- 1 | (* 2 | * BatBuffer - Additional buffer operations 3 | * Copyright (C) 1999 Pierre Weis, Xavier Leroy 4 | * 2009 David Teller, LIFO, Universite d'Orleans 5 | * 2009 Dawid Toton 6 | * 7 | * This library is free software; you can redistribute it and/or 8 | * modify it under the terms of the GNU Lesser General Public 9 | * License as published by the Free Software Foundation; either 10 | * version 2.1 of the License, or (at your option) any later version, 11 | * with the special exception on linking described in file LICENSE. 12 | * 13 | * This library is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 | * Lesser General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU Lesser General Public 19 | * License along with this library; if not, write to the Free Software 20 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 21 | *) 22 | 23 | 24 | open BatString 25 | include Buffer 26 | 27 | (** The underlying buffer type. *) 28 | type buffer = 29 | {mutable buffer : string;(** Contents of the buffer *) 30 | mutable position : int; (** The end of the buffer *) 31 | mutable length : int; (** The size of the buffer *) 32 | initial_buffer : string (** For resetting to the original size **)} 33 | 34 | external buffer_of_t : t -> buffer = "%identity" 35 | external t_of_buffer : buffer -> t = "%identity" 36 | 37 | let print out t = 38 | BatString.print out (contents t) 39 | 40 | (*$Q print 41 | (Q.string) (fun s -> let b = create 5 in add_string b "foo"; add_string b s; add_string b "bar"; BatIO.to_string print b = "foo" ^ s ^ "bar") 42 | *) 43 | 44 | let enum t = 45 | let buf = buffer_of_t t in 46 | BatEnum.take buf.position (BatString.enum buf.buffer) 47 | 48 | (*$Q enum 49 | (Q.string) (fun s -> let b = create 10 in add_string b s; BatEnum.equal Char.equal (enum b) (BatString.enum s)) 50 | *) 51 | 52 | let of_enum e = 53 | let buf = 54 | if BatEnum.fast_count e 55 | then create (BatEnum.count e) 56 | else create 128 57 | in 58 | add_string buf (BatString.of_enum e); 59 | buf 60 | 61 | (*$Q of_enum 62 | (Q.string) (fun s -> let b = of_enum (BatString.enum s) in contents b = s) 63 | (Q.string) (fun s -> let e = BatString.enum s in \ 64 | let e = BatEnum.from (fun () -> BatEnum.get_exn e) in \ 65 | contents (of_enum e) = s) 66 | *) 67 | 68 | let add_input t inp n = 69 | add_string t (BatInnerIO.really_nread inp n) 70 | 71 | (*$Q add_input 72 | (Q.string) (fun s -> let b = create 10 in add_input b (BatIO.input_string s) (String.length s); contents b = s) 73 | *) 74 | 75 | let output_buffer buf = 76 | BatInnerIO.create_out 77 | ~write: (add_char buf) 78 | ~output:(fun s p l -> add_substring buf s p l; l) 79 | ~close: (fun () -> contents buf) 80 | ~flush: BatInnerIO.noop 81 | 82 | (*$Q output_buffer 83 | (Q.string) (fun s -> let b = create 10 in let oc = output_buffer b in IO.nwrite oc s; IO.close_out oc = s) 84 | *) 85 | 86 | let add_channel = add_input 87 | 88 | ##V<4.2##let add_bytes = add_string 89 | ##V<4.2##let add_subbytes = add_substring 90 | ##V<4.2##let to_bytes = contents 91 | -------------------------------------------------------------------------------- /src/batBytes.mlv: -------------------------------------------------------------------------------- 1 | include Bytes 2 | 3 | (*$T init 4 | init 5 (fun i -> Char.chr (i + int_of_char '0')) |> to_string = "01234"; 5 | *) 6 | 7 | (*$T mapi 8 | mapi (fun _ -> Char.uppercase) (of_string "Five") |> to_string = "FIVE" 9 | mapi (fun _ -> Char.uppercase) (of_string "") |> to_string = "" 10 | mapi (fun _ -> String.of_char %> failwith) (of_string "") |> to_string = "" 11 | mapi (fun i _c -> "0123456789".[9-i]) (of_string "0123456789") |> to_string = "9876543210" 12 | ignore (let last = ref (-1) in mapi (fun i _c -> assert (i > !last); last := i; '0') (of_string "012345")); true 13 | *) 14 | 15 | (* String.trim is @since 4.00 *) 16 | ##V<4.0##let trim b = Bytes.of_string (BatString.trim b) 17 | 18 | (*$T trim 19 | " \t foo\n " |> of_string |> trim |> to_string |> (=) "foo" 20 | " foo bar " |> of_string |> trim |> to_string |> (=) "foo bar" 21 | " \t " |> of_string |> trim |> to_string |> (=) "" 22 | "" |> of_string |> trim |> to_string |> (=) "" 23 | *) 24 | 25 | (* String.map is @since 4.00 *) 26 | ##V<4.0##let map f s = 27 | ##V<4.0## let len = length s in 28 | ##V<4.0## let sc = create len in 29 | ##V<4.0## for i = 0 to len - 1 do 30 | ##V<4.0## unsafe_set sc i (f (unsafe_get s i)) 31 | ##V<4.0## done; 32 | ##V<4.0## sc 33 | 34 | (*$T map 35 | "Five" |> of_string |> map Char.uppercase |> to_string |> (=) "FIVE" 36 | "" |> of_string |> map Char.uppercase |> to_string |> (=) "" 37 | "" |> of_string |> map (String.of_char %> failwith) |> to_string |> (=) "" 38 | *) 39 | 40 | (* String.iteri is @since 4.00 *) 41 | ##V<4.0##let iteri f s = 42 | ##V<4.0## for i = 0 to (Bytes.length s) - 1 do f i (Bytes.unsafe_get s i) done 43 | 44 | ##V<4.3##let equal b1 (b2 : Bytes.t) = (compare b1 b2 = 0) 45 | 46 | ##V<4.3##let uppercase_ascii s = map BatChar.uppercase_ascii s 47 | ##V<4.3##let lowercase_ascii s = map BatChar.lowercase_ascii s 48 | 49 | (*$T uppercase_ascii 50 | equal ("five" |> of_string |> uppercase_ascii |> to_string) "FIVE" 51 | equal ("école" |> of_string |> uppercase_ascii |> to_string) "éCOLE" 52 | *) 53 | 54 | (*$T lowercase_ascii 55 | equal ("FIVE" |> of_string |> lowercase_ascii |> to_string) "five" 56 | equal ("ÉCOLE" |> of_string |> lowercase_ascii |> to_string) "École" 57 | *) 58 | 59 | ##V<4.3##let map_first_char f s = 60 | ##V<4.3## let r = copy s in 61 | ##V<4.3## if length s > 0 then 62 | ##V<4.3## unsafe_set r 0 (f(unsafe_get s 0)); 63 | ##V<4.3## r 64 | 65 | ##V<4.3##let capitalize_ascii s = map_first_char BatChar.uppercase_ascii s 66 | ##V<4.3##let uncapitalize_ascii s = map_first_char BatChar.lowercase_ascii s 67 | 68 | (*$T capitalize_ascii 69 | equal ("five" |> of_string |> capitalize_ascii |> to_string) "Five" 70 | equal ("école" |> of_string |> capitalize_ascii |> to_string) "école" 71 | *) 72 | 73 | (*$T uncapitalize_ascii 74 | equal ("Five" |> of_string |> uncapitalize_ascii |> to_string) "five" 75 | equal ("École" |> of_string |> uncapitalize_ascii |> to_string) "École" 76 | *) 77 | -------------------------------------------------------------------------------- /src/batChar.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/meafmira/bs-batteries/0c9eb3e10db8f65a5d3c7bbac17e271038cf4c38/src/batChar.ml -------------------------------------------------------------------------------- /src/batChar.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/meafmira/bs-batteries/0c9eb3e10db8f65a5d3c7bbac17e271038cf4c38/src/batChar.mli -------------------------------------------------------------------------------- /src/batConcreteQueue_402.ml: -------------------------------------------------------------------------------- 1 | (* Explanation from OCaml 4.02 source: 2 | 3 | A queue is a reference to either nothing or some cell of a cyclic 4 | list. By convention, that cell is to be viewed as the last cell in 5 | the queue. The first cell in the queue is then found in constant 6 | time: it is the next cell in the cyclic list. The queue's length is 7 | also recorded, so as to make [length] a constant-time operation. 8 | 9 | The [tail] field should really be of type ['a cell option], but 10 | then it would be [None] when [length] is 0 and [Some] otherwise, 11 | leading to redundant memory allocation and accesses. We avoid this 12 | overhead by filling [tail] with a dummy value when [length] is 0. 13 | Of course, this requires bending the type system's arm slightly, 14 | because it does not have dependent sums. 15 | The dummy value used by the stdlib is (Obj.magic None). *) 16 | 17 | type 'a cell = { 18 | content: 'a; 19 | mutable next: 'a cell 20 | } 21 | and 'a t = { 22 | mutable length: int; 23 | mutable tail: 'a cell 24 | } 25 | 26 | external of_abstr : 'a Queue.t -> 'a t = "%identity" 27 | external to_abstr : 'a t -> 'a Queue.t = "%identity" 28 | 29 | let filter_inplace f ({tail} as queue) = 30 | if not (Queue.is_empty (to_abstr queue)) then 31 | let rec filter' 32 | ({ next = { content; next} as current } as prev) 33 | = 34 | if f content 35 | then 36 | (* Keep cell. Recursion to next cell unless we reached the tail *) 37 | (if current != tail then filter' current) 38 | else begin 39 | (* Remove cell. *) 40 | if current != tail 41 | then begin 42 | (* Easy case. We are not removing the tail cell. *) 43 | prev.next <- next; 44 | queue.length <- queue.length - 1; 45 | (* Recursion with the same cell, 46 | * because it is now pointing beyond current. *) 47 | filter' prev 48 | end 49 | else begin 50 | (* Removing the tail cell *) 51 | if prev == current 52 | (* Tail cell is the last cell. Just clear the queue. *) 53 | then begin 54 | Queue.clear (to_abstr queue) 55 | end 56 | else begin 57 | (* Tail cell is not the last cell. 58 | * prev is the new tail. *) 59 | prev.next <- next; 60 | queue.length <- queue.length - 1; 61 | queue.tail <- prev; 62 | end 63 | end 64 | end 65 | in 66 | filter' tail 67 | -------------------------------------------------------------------------------- /src/batConcreteQueue_402.mli: -------------------------------------------------------------------------------- 1 | type 'a t 2 | 3 | external of_abstr : 'a Queue.t -> 'a t = "%identity" 4 | external to_abstr : 'a t -> 'a Queue.t = "%identity" 5 | 6 | val filter_inplace : ('a -> bool) -> 'a t -> unit 7 | -------------------------------------------------------------------------------- /src/batConcreteQueue_403.ml: -------------------------------------------------------------------------------- 1 | type 'a cell = 2 | | Nil 3 | | Cons of { content: 'a; mutable next: 'a cell } 4 | 5 | type 'a t = { 6 | mutable length: int; 7 | mutable first: 'a cell; 8 | mutable last: 'a cell 9 | } 10 | 11 | external of_abstr : 'a Queue.t -> 'a t = "%identity" 12 | external to_abstr : 'a t -> 'a Queue.t = "%identity" 13 | 14 | let filter_inplace f queue = 15 | (* find_next returns the next 'true' cell, or Nil *) 16 | let rec find_next = function 17 | | Nil -> Nil 18 | | (Cons cell) as cons -> 19 | if f cell.content then cons 20 | else find_next cell.next 21 | in 22 | (* last is the last known 'true' Cons cell 23 | (may be Nil if no true cell has be found yet) 24 | next is the next candidate true cell 25 | (may be Nil if there is no next cell) *) 26 | let rec loop length last next = match next with 27 | | Nil -> (length, last) 28 | | (Cons cell) as cons -> 29 | let next = find_next cell.next in 30 | cell.next <- next; 31 | loop (length + 1) cons next 32 | in 33 | let first = find_next queue.first in 34 | (* returning a pair is unecessary, the writes could be made at the 35 | end of 'loop', but the present style makes it obvious that all 36 | three writes are performed atomically, without allocation, 37 | function call or return (yield points) in between, guaranteeing 38 | some form of state consistency in the face of signals, threading 39 | or what not. *) 40 | let (length, last) = loop 0 Nil first in 41 | queue.length <- length; 42 | queue.first <- first; 43 | queue.last <- last; 44 | () 45 | -------------------------------------------------------------------------------- /src/batConcreteQueue_403.mli: -------------------------------------------------------------------------------- 1 | type 'a t 2 | 3 | external of_abstr : 'a Queue.t -> 'a t = "%identity" 4 | external to_abstr : 'a t -> 'a Queue.t = "%identity" 5 | 6 | val filter_inplace : ('a -> bool) -> 'a t -> unit 7 | -------------------------------------------------------------------------------- /src/batConcurrent.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Concurrent - Generic interface for concurrent operations 3 | * Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | 22 | type lock = {execute : 'a 'b. ('a -> 'b) -> 'a -> 'b} 23 | 24 | let nolock= {execute = (fun f x -> f x)} 25 | 26 | let sync lock = lock.execute 27 | 28 | let synchronize locker f x = 29 | sync (locker ()) f x 30 | 31 | let compose {execute = a} {execute = b} = 32 | { 33 | execute = (fun f x -> b (a f) x) 34 | } 35 | 36 | let create ~enter ~leave = 37 | { 38 | execute = (fun f x -> 39 | enter (); 40 | try 41 | let result = f x in 42 | leave (); 43 | result 44 | with e -> 45 | leave (); 46 | raise e 47 | ) 48 | } 49 | 50 | 51 | module type BaseLock = 52 | sig 53 | type t (** The type of a lock. *) 54 | 55 | val create:unit -> t 56 | val lock : t -> unit 57 | val unlock:t -> unit 58 | val try_lock:t -> bool 59 | end 60 | 61 | 62 | module type Lock = 63 | sig 64 | type t (** The type of a lock. *) 65 | 66 | val create: unit -> t 67 | val lock : t -> unit 68 | val unlock: t -> unit 69 | val try_lock:t -> bool 70 | val synchronize: ?lock:t -> ('a -> 'b) -> 'a -> 'b 71 | 72 | val make : unit -> lock 73 | end 74 | 75 | let base_create = create 76 | 77 | module MakeLock(M:BaseLock) : Lock with type t = M.t = 78 | struct 79 | type t = M.t 80 | let create = M.create 81 | let lock = M.lock 82 | let unlock = M.unlock 83 | let try_lock=M.try_lock 84 | let synchronize ?(lock=M.create ()) f x = 85 | try 86 | M.lock lock; 87 | let result = f x in 88 | M.unlock lock; 89 | result 90 | with e -> M.unlock lock; 91 | raise e 92 | 93 | let make () = 94 | let lock = M.create () in 95 | base_create 96 | ~enter:(fun () -> M.lock lock) 97 | ~leave:(fun () -> M.unlock lock) 98 | 99 | end 100 | 101 | module BaseNoLock = struct 102 | type t = unit 103 | external create: unit -> t = "%ignore" 104 | external lock : t -> unit = "%ignore" 105 | external unlock: t -> unit = "%ignore" 106 | let try_lock _t = true 107 | end 108 | module NoLock = MakeLock(BaseNoLock) 109 | -------------------------------------------------------------------------------- /src/batGc.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatGC - Extended GC operations 3 | * Copyright (C) 1996 Damien Doligez 4 | * 2008 David Teller, LIFO, Universite d'Orleans 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | open BatPrintf 24 | include Gc 25 | 26 | let print_stat c = (* copied from original module *) 27 | let st = stat () in 28 | fprintf c "minor_collections: %d\n" st.minor_collections; 29 | fprintf c "major_collections: %d\n" st.major_collections; 30 | fprintf c "compactions: %d\n" st.compactions; 31 | fprintf c "\n"; 32 | let l1 = String.length (sprintf "%.0f" st.minor_words) in 33 | fprintf c "minor_words: %*.0f\n" l1 st.minor_words; 34 | fprintf c "promoted_words: %*.0f\n" l1 st.promoted_words; 35 | fprintf c "major_words: %*.0f\n" l1 st.major_words; 36 | fprintf c "\n"; 37 | let l2 = String.length (sprintf "%d" st.top_heap_words) in 38 | fprintf c "top_heap_words: %*d\n" l2 st.top_heap_words; 39 | fprintf c "heap_words: %*d\n" l2 st.heap_words; 40 | fprintf c "live_words: %*d\n" l2 st.live_words; 41 | fprintf c "free_words: %*d\n" l2 st.free_words; 42 | fprintf c "largest_free: %*d\n" l2 st.largest_free; 43 | fprintf c "fragments: %*d\n" l2 st.fragments; 44 | fprintf c "\n"; 45 | fprintf c "live_blocks: %d\n" st.live_blocks; 46 | fprintf c "free_blocks: %d\n" st.free_blocks; 47 | fprintf c "heap_chunks: %d\n" st.heap_chunks 48 | 49 | (*$T print_stat 50 | (IO.output_string () |> tap print_stat |> IO.close_out |> String.nsplit ~by:"\n" |> List.length) = 19 51 | *) 52 | -------------------------------------------------------------------------------- /src/batGlobal.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Global - Mutable global variable 3 | * Copyright (C) 2003 Nicolas Cannasse 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | 22 | exception Global_not_initialized of string 23 | 24 | type 'a t = ('a option ref * string) 25 | 26 | (*BISECT-IGNORE-BEGIN*) 27 | 28 | let empty name = 29 | (ref None, name) 30 | 31 | let name = snd 32 | 33 | let set (r, _) v = 34 | r := Some v 35 | 36 | let get_exn (r, name) = 37 | match !r with 38 | | None -> raise (Global_not_initialized name) 39 | | Some v -> v 40 | 41 | let undef (r, _) = 42 | r := None 43 | 44 | let isdef (r, _) = 45 | !r <> None 46 | 47 | let get (r,_) = !r 48 | (*BISECT-IGNORE-END*) 49 | -------------------------------------------------------------------------------- /src/batGlobal.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Global - Mutable global variable 3 | * Copyright (C) 2003 Nicolas Cannasse 4 | * Copyright (C) 2008 David Teller 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | (** Mutable global variable. 23 | 24 | Often in OCaml you want to have a global variable, which is mutable 25 | and uninitialized when declared. You can use a ['a option ref] but 26 | this is not very convenient. The Global module provides functions 27 | to easily create and manipulate such variables. 28 | 29 | @author Nicolas Cannasse 30 | @author David Teller (boilerplate code) 31 | *) 32 | 33 | type 'a t 34 | (** Abstract type of a global *) 35 | 36 | exception Global_not_initialized of string 37 | (** Raised when a global variable is accessed without first having been 38 | assigned a value. The parameter contains the name of the global. *) 39 | 40 | val empty : string -> 'a t 41 | (** Returns an new named empty global. The name of the global can be 42 | any string. It identifies the global and makes debugging 43 | easier. Using the same string twice will not return the same 44 | global twice, but will create two globals with the same name. 45 | *) 46 | 47 | val name : 'a t -> string 48 | (** Retrieve the name of a global. *) 49 | 50 | val set : 'a t -> 'a -> unit 51 | (** Set the global value contents. *) 52 | 53 | val get_exn : 'a t -> 'a 54 | (** Get the global value contents - raise Global_not_initialized if not 55 | defined. *) 56 | 57 | val get : 'a t -> 'a option 58 | (** Return [None] if the global is undefined, else [Some v] where [v] is 59 | the current global value contents. *) 60 | 61 | val undef : 'a t -> unit 62 | (** Reset the global value contents to undefined. *) 63 | 64 | val isdef : 'a t -> bool 65 | (** Return [true] if the global value has been set. *) 66 | -------------------------------------------------------------------------------- /src/batInnerPervasives.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2012 Batteries Included Development Team 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 | (* Inner functions for Pervasives, that can be accessed from other 21 | modules without pulling in all of batteries as deps. *) 22 | 23 | let finally handler f x = 24 | let r = ( 25 | try 26 | f x 27 | with 28 | e -> handler(); raise e 29 | ) in 30 | handler(); 31 | r 32 | 33 | let with_dispose ~dispose f x = 34 | finally (fun () -> dispose x) f x 35 | 36 | (* unique int generation *) 37 | let unique_value = ref 0 38 | (* let lock = ref BatConcurrent.nolock *) 39 | (* let unique () = 40 | BatConcurrent.sync !lock BatRef.post_incr unique_value *) 41 | 42 | (*$Q unique 43 | Q.unit (fun () -> unique () <> unique ()) 44 | *) 45 | 46 | type ('a, 'b) result = 47 | | Ok of 'a 48 | | Bad of 'b 49 | 50 | (* Ideas taken from Nicholas Pouillard's my_std.ml in ocamlbuild/ *) 51 | let ignore_ok = function 52 | Ok _ -> () 53 | | Bad ex -> raise ex 54 | 55 | let ok = function 56 | Ok v -> v 57 | | Bad ex -> raise ex 58 | 59 | let wrap f x = try Ok (f x) with ex -> Bad ex 60 | 61 | let forever f x = ignore (while true do f x done) 62 | 63 | let ignore_exceptions f x = try ignore (f x) with _ -> () 64 | 65 | 66 | (** {6 Operators}*) 67 | 68 | (* let ( |> ) x f = f x *) 69 | (* external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply" *) 70 | 71 | (* let ( @@ ) f x = f x *) 72 | (* external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply" *) 73 | 74 | let ( %> ) f g x = g (f x) 75 | 76 | let ( % ) f g x = f (g x) 77 | 78 | let flip f x y = f y x 79 | 80 | let curry f x y = f (x,y) 81 | 82 | let uncurry f (x,y) = f x y 83 | 84 | let const x _ = x 85 | 86 | let neg p x = not (p x) 87 | 88 | let neg2 p x y = not (p x y) 89 | 90 | external identity : 'a -> 'a = "%identity" 91 | 92 | let tap f x = f x; x 93 | 94 | let ( |? ) = Option.Infix.( |? ) 95 | -------------------------------------------------------------------------------- /src/batInnerShuffle.ml: -------------------------------------------------------------------------------- 1 | let array_shuffle ?state a = 2 | let random_int state n = match state with 3 | | None -> Random.int n 4 | | Some s -> Random.State.int s n in 5 | for n = Array.length a - 1 downto 1 do 6 | let k = random_int state (n + 1) in 7 | if k <> n then begin 8 | let buf = Array.unsafe_get a n in 9 | Array.unsafe_set a n (Array.unsafe_get a k); 10 | Array.unsafe_set a k buf 11 | end 12 | done 13 | 14 | (*$Q 15 | Q.(array_of_size Gen.(2--15) small_int) (fun a -> \ 16 | let a' = Array.copy a in \ 17 | array_shuffle a'; \ 18 | (Array.to_list a' |> List.sort Pervasives.compare) = \ 19 | (Array.to_list a |> List.sort Pervasives.compare)) 20 | *) 21 | 22 | (*$R 23 | let rec fact = function 0 -> 1 | n -> n * fact (n - 1) in 24 | let length = 5 in 25 | let test = Array.init length (fun i -> i) in (* all elements must be distinct *) 26 | let permut_number = fact length in 27 | let histogram = Hashtbl.create permut_number in 28 | for i = 1 to 50_000 do 29 | let a = Array.copy test in 30 | array_shuffle a; 31 | Hashtbl.replace histogram a (); 32 | done; 33 | assert_bool "all permutations occur" (Hashtbl.length histogram = permut_number) 34 | *) 35 | -------------------------------------------------------------------------------- /src/batInt64.mlv: -------------------------------------------------------------------------------- 1 | (* 2 | * BatInt64 - Extended 64-bit integers 3 | * Copyright (C) 2007 Bluestorm 4 | * 2008 David Teller 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | module BaseInt64 = struct 24 | include Int64 25 | 26 | let modulo = rem 27 | let pow = BatNumber.generic_pow ~zero ~one ~div_two:(fun n -> shift_right n 1) ~mod_two:(logand one) ~mul 28 | end 29 | 30 | include BatNumber.MakeNumeric(BaseInt64) 31 | 32 | let min_int = Int64.min_int 33 | let max_int = Int64.max_int 34 | let minus_one = Int64.minus_one 35 | let lognot = Int64.lognot 36 | external neg : int64 -> int64 = "%int64_neg" 37 | external add : int64 -> int64 -> int64 = "%int64_add" 38 | external sub : int64 -> int64 -> int64 = "%int64_sub" 39 | external mul : int64 -> int64 -> int64 = "%int64_mul" 40 | external div : int64 -> int64 -> int64 = "%int64_div" 41 | external rem : int64 -> int64 -> int64 = "%int64_mod" 42 | external logand : int64 -> int64 -> int64 = "%int64_and" 43 | external logor : int64 -> int64 -> int64 = "%int64_or" 44 | external logxor : int64 -> int64 -> int64 = "%int64_xor" 45 | external shift_left : int64 -> int -> int64 = "%int64_lsl" 46 | external shift_right : int64 -> int -> int64 = "%int64_asr" 47 | external shift_right_logical : int64 -> int -> int64 = "%int64_lsr" 48 | external of_int : int -> int64 = "%int64_of_int" 49 | external to_int : int64 -> int = "%int64_to_int" 50 | external of_float : float -> int64 = "caml_int64_of_float" 51 | ##V>=4.3## "caml_int64_of_float_unboxed" [@@unboxed] [@@noalloc] 52 | external to_float : int64 -> float = "caml_int64_to_float" 53 | ##V>=4.3## "caml_int64_to_float_unboxed" [@@unboxed] [@@noalloc] 54 | external of_int32 : int32 -> int64 = "%int64_of_int32" 55 | external to_int32 : int64 -> int32 = "%int64_to_int32" 56 | external of_nativeint : nativeint -> int64 = "%int64_of_nativeint" 57 | external to_nativeint : int64 -> nativeint = "%int64_to_nativeint" 58 | external of_string : string -> int64 = "caml_int64_of_string" 59 | external bits_of_float : float -> int64 = "caml_int64_bits_of_float" 60 | ##V>=4.3## "caml_int64_bits_of_float_unboxed" [@@unboxed] [@@noalloc] 61 | external float_of_bits : int64 -> float = "caml_int64_float_of_bits" 62 | ##V>=4.3## "caml_int64_float_of_bits_unboxed" [@@unboxed] [@@noalloc] 63 | external format : string -> int64 -> string = "caml_int64_format" 64 | 65 | 66 | let print out t = BatInnerIO.nwrite out (to_string t) 67 | let print_hex out t = BatPrintf.fprintf out "%Lx" t 68 | -------------------------------------------------------------------------------- /src/batInterfaces.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Interfaces - Common interfaces for data structures 3 | * Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | module type Mappable = sig 22 | type 'a mappable 23 | val map : ('a -> 'b) -> ('a mappable -> 'b mappable) 24 | end 25 | 26 | module type OrderedType = 27 | sig 28 | type t 29 | val compare : t -> t -> int 30 | end 31 | 32 | module type Monad = sig 33 | type 'a m 34 | val bind : 'a m -> ('a -> 'b m) -> 'b m 35 | val return: 'a -> 'a m 36 | end 37 | -------------------------------------------------------------------------------- /src/batLexing.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatString - Additional functions for string manipulations. 3 | * Copyright (C) 1996 Xavier Leroy, INRIA Rocquencourt 4 | * Copyright (C) 2009 David Teller, LIFO, Universite d'Orleans 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | open BatIO 24 | include Lexing 25 | let from_input inp = 26 | from_function (fun s n -> try input inp s 0 n with No_more_input -> 0) 27 | 28 | let from_channel = from_input 29 | -------------------------------------------------------------------------------- /src/batMarshal.mlv: -------------------------------------------------------------------------------- 1 | (* 2 | * BatMarshal - Extended marshaling operations 3 | * Copyright (C) 1997 Xavier Leroy 4 | * 2008 David Teller 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | include Marshal 24 | 25 | let output out ?(sharing=true) ?(closures=false) v = 26 | let flags = match sharing, closures with 27 | | true, false -> [] 28 | | true, true -> [Closures] 29 | | false, false -> [No_sharing] 30 | | false, true -> [No_sharing; Closures] 31 | in 32 | let buf = to_string v flags in 33 | BatInnerIO.nwrite out buf 34 | 35 | let input inp = 36 | let header = BatInnerIO.really_nread inp header_size in 37 | let size = data_size header 0 in 38 | from_string (header ^ (BatInnerIO.really_nread inp size)) 0 39 | 40 | let to_channel out v flags = 41 | BatInnerIO.nwrite out (to_string v flags) 42 | 43 | let from_channel = input 44 | 45 | ##V<4.2##let from_bytes = from_string 46 | ##V<4.2##external to_bytes : 47 | ##V<4.2## 'a -> extern_flags list -> Bytes.t = "caml_output_value_to_string" 48 | -------------------------------------------------------------------------------- /src/batMultiMap.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * MultiMap - Polymorphic maps with multiple associations 3 | * Copyright (C) 1996-2003 Xavier Leroy, Nicolas Cannasse, Markus Mottl 4 | * Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | type ('a, 'b) t = ('a, 'b BatSet.t) BatMap.t 24 | 25 | let empty = BatMap.empty 26 | 27 | let is_empty = BatMap.is_empty 28 | 29 | let find k t = try BatMap.find k t with Not_found -> BatSet.empty 30 | 31 | let add k d t = BatMap.modify_def BatSet.empty k (BatSet.add d) t 32 | 33 | let remove_all k t = BatMap.remove k t 34 | 35 | let remove k d t = 36 | try 37 | let set = BatSet.remove d (BatMap.find k t) in 38 | if BatSet.is_empty set then BatMap.remove k t 39 | else BatMap.add k set t; 40 | with Not_found -> t 41 | 42 | let mem = BatMap.mem 43 | (* let exists = mem *) 44 | let iter = BatMap.iter 45 | let map = BatMap.map 46 | let mapi = BatMap.mapi 47 | let fold = BatMap.fold 48 | let foldi = BatMap.foldi 49 | let modify = BatMap.modify 50 | let modify_def = BatMap.modify_def 51 | let modify_opt = BatMap.modify_opt 52 | 53 | let (|>) x f = f x 54 | let enum t = BatMap.enum t |> BatEnum.map (fun (k,s) -> BatSet.enum s |> BatEnum.map (fun x -> (k,x))) |> BatEnum.concat 55 | 56 | let of_enum e = BatEnum.fold (fun acc (k,d) -> add k d acc) empty e 57 | 58 | let print ?(first="{\n") ?(last="\n}") ?(sep=",\n") ?(kvsep=": ") print_k print_v out t = 59 | let print_one out (k,v) = 60 | BatPrintf.fprintf out "%a%s%a" print_k k kvsep print_v v 61 | in 62 | BatEnum.print ~first ~last ~sep print_one out (enum t) 63 | 64 | module Infix = 65 | struct 66 | let (-->) map key = find key map 67 | let (<--) map (key, value) = add key value map 68 | end 69 | -------------------------------------------------------------------------------- /src/batMutex.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatMutex - Additional functions for Mutexes 3 | * Copyright (C) 1996 Xavier Leroy 4 | * 1996 Damien Doligez 5 | * 2008 David Teller 6 | * 7 | * This library is free software; you can redistribute it and/or 8 | * modify it under the terms of the GNU Lesser General Public 9 | * License as published by the Free Software Foundation; either 10 | * version 2.1 of the License, or (at your option) any later version, 11 | * with the special exception on linking described in file LICENSE. 12 | * 13 | * This library is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 | * Lesser General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU Lesser General Public 19 | * License along with this library; if not, write to the Free Software 20 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 21 | *) 22 | 23 | module DebugMutex = 24 | struct 25 | module M = 26 | struct 27 | type t = 28 | { mutex : Mutex.t; 29 | id : int } 30 | 31 | let unique = 32 | let counter = ref 0 33 | and mutex = Mutex.create () 34 | in 35 | fun () -> 36 | Mutex.lock mutex; 37 | let result = !counter in 38 | incr counter; 39 | Mutex.unlock mutex; 40 | result 41 | 42 | let create () = 43 | { mutex = Mutex.create () ; 44 | id = unique () } 45 | 46 | let lock t = 47 | Printf.eprintf "[Mutex] Attempting to lock mutex %d\n" t.id; 48 | Mutex.lock t.mutex; 49 | Printf.eprintf "[Mutex] Mutex %d locked\n" t.id 50 | 51 | let unlock t = 52 | Printf.eprintf "[Mutex] Attempting to unlock mutex %d\n" t.id; 53 | Mutex.unlock t.mutex; 54 | Printf.eprintf "[Mutex] Mutex %d unlocked\n" t.id 55 | 56 | let try_lock t = 57 | Printf.eprintf "[Mutex] Attempting to trylock mutex %d\n" t.id; 58 | let result = Mutex.try_lock t.mutex in 59 | Printf.eprintf "[Mutex] Mutex %d trylocked\n" t.id; 60 | result 61 | end 62 | 63 | include M 64 | module Lock = BatConcurrent.MakeLock(M) 65 | let make = Lock.make 66 | let synchronize = Lock.synchronize 67 | end 68 | 69 | module Lock = BatConcurrent.MakeLock(Mutex) 70 | let make = Lock.make 71 | let synchronize = Lock.synchronize 72 | -------------------------------------------------------------------------------- /src/batOo.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatOO - Extended operations on objects 3 | * Copyright (C) 1996 Jerome Vouillon, INRIA 4 | * 2008 David Teller, LIFO, Universite d'Orleans 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | include Oo 24 | module Internal = CamlinternalOO 25 | -------------------------------------------------------------------------------- /src/batOpaqueInnerSys.ml: -------------------------------------------------------------------------------- 1 | (* this file must be compiled with -opaque *) 2 | let opaque_identity x = x 3 | -------------------------------------------------------------------------------- /src/batPrintexc.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatPrintexc - Extended Printexc module 3 | * Copyright (C) 1996 Xavier Leroy 4 | * 2008 David Teller, LIFO, Universite d'Orleans 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | include Printexc 24 | 25 | let pass = print 26 | let print out e = BatInnerIO.nwrite out (to_string e) 27 | let print_backtrace out = BatInnerIO.nwrite out (get_backtrace ()) 28 | -------------------------------------------------------------------------------- /src/batResult.ml: -------------------------------------------------------------------------------- 1 | 2 | type ('a, 'b) t = ('a, 'b) BatPervasives.result = 3 | | Ok of 'a 4 | | Bad of 'b 5 | 6 | let catch f x = try Ok (f x) with e -> Bad e 7 | let catch2 f x y = try Ok (f x y) with e -> Bad e 8 | let catch3 f x y z = try Ok (f x y z) with e -> Bad e 9 | 10 | let of_option = function 11 | | Some x -> Ok x 12 | | None -> Bad () 13 | 14 | let to_option = function 15 | | Ok x -> Some x 16 | | Bad _-> None 17 | 18 | let default def = function 19 | | Ok x -> x 20 | | Bad _ -> def 21 | 22 | let map f = function 23 | | Bad e -> Bad e 24 | | Ok v -> Ok (f v) 25 | (*$T map 26 | map succ (Bad (-1)) = (Bad (-1)) 27 | map succ (Bad 0) = (Bad 0) 28 | map succ (Ok 3) = (Ok 4) 29 | *) 30 | 31 | let map_both f g = function 32 | | Bad e -> Bad (g e) 33 | | Ok v -> Ok (f v) 34 | (*$T map_both 35 | map_both succ pred (Bad (-1)) = (Bad (-2)) 36 | map_both succ pred (Bad 0) = (Bad (-1)) 37 | map_both succ pred (Bad 1) = (Bad 0) 38 | map_both succ pred (Ok (-1)) = (Ok 0) 39 | map_both succ pred (Ok 0) = (Ok 1) 40 | map_both succ pred (Ok 1) = (Ok 2) 41 | *) 42 | 43 | let map_default def f = function 44 | | Ok x -> f x 45 | | Bad _ -> def 46 | 47 | let is_ok = function Ok _ -> true | Bad _ -> false 48 | 49 | let is_bad = function Bad _ -> true | Ok _ -> false 50 | 51 | let is_exn e = function Bad exn -> exn = e | Ok _ -> false 52 | 53 | let get = function Ok x -> x | Bad e -> raise e 54 | 55 | let print print_val oc = function 56 | | Ok x -> BatPrintf.fprintf oc "Ok(%a)" print_val x 57 | | Bad e -> BatPrintf.fprintf oc "Bad(%a)" BatPrintexc.print e 58 | 59 | 60 | module Monad = struct 61 | let bind m k = match m with 62 | | Ok x -> k x 63 | | Bad _ as e -> e 64 | 65 | let return x = Ok x 66 | 67 | let (>>=) = bind 68 | end 69 | 70 | module Infix = struct 71 | let (>>=) = Monad.bind 72 | end 73 | -------------------------------------------------------------------------------- /src/batReturn.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Return -- fast return in OCaml 3 | * Copyright (C) 2008 David Teller 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | 22 | type 'a t = 'a -> exn 23 | 24 | let return label value = 25 | raise (label value) 26 | 27 | let label (type u) (f : u t -> u) : u = 28 | let module M = struct exception Return of u end in 29 | try f (fun x -> M.Return x) 30 | with M.Return u -> u 31 | let with_label = label 32 | 33 | (* testing nesting with_labels *) 34 | (*$T with_label 35 | with_label (fun label1 -> \ 36 | with_label (fun _label2 -> ignore (return label1 1)); 2 \ 37 | ) = 1 38 | *) 39 | -------------------------------------------------------------------------------- /src/batReturn.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Return -- fast return in OCaml 3 | * Copyright (C) 2008 David Teller 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | (** 22 | Local exceptions/labels/goto/return. 23 | 24 | This module defines a mechanism akin to SML's exception generators 25 | or to a generalization of C's [return], i.e. the ability to define 26 | local {i labels}, which may be used for immediately terminating an 27 | expression and returning a value. By opposition to usual OCaml 28 | exceptions, this mechanism 29 | - allows polymorphic return values 30 | - makes accidental exception catching slightly harder (while a local 31 | exception can escape its scope, it cannot be caught again by accident 32 | from this module). 33 | 34 | Example: 35 | {[ 36 | let find_in_array a e = 37 | label (fun label -> 38 | for i = 0 to Array.length a - 1 do 39 | if Array.get a i = e then return label (Some i) 40 | done; 41 | None) 42 | ]} 43 | 44 | @author David Teller 45 | 46 | @documents Return 47 | *) 48 | 49 | type 'a t 50 | (** A label which may be used to return values of type ['a]*) 51 | 52 | val label : ('a t -> 'a) -> 'a 53 | (** [label f] creates a new label [x] and invokes 54 | [f x]. If, during the execution of [f], [return x v] 55 | is invoked, the execution of [f x] stops 56 | immediately and [label f] returns [v]. 57 | Otherwise, if [f x] terminates normally and 58 | returns [y], [label f] returns [y]. 59 | 60 | Calling [return x v] from outside scope [f] 61 | is a run-time error and causes termination 62 | of the program.*) 63 | val with_label : ('a t -> 'a) -> 'a 64 | (**as [label]*) 65 | 66 | val return : 'a t -> 'a -> _ 67 | (** Return to a label. [return l v] returns 68 | to the point where label [l] was obtained 69 | and produces value [l]. 70 | 71 | Calling [return l v] from outside the scope 72 | of [l] (i.e. the call to function [label] 73 | which produced [l]) is a run-time error 74 | and causes termination of the program.*) 75 | 76 | -------------------------------------------------------------------------------- /src/batScanf.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatScanf - Extended Scanf module 3 | * Copyright (C) 2009 David Rajchenbach-Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | 22 | module Scanning = 23 | struct 24 | include Scanf.Scanning 25 | 26 | let from_input inp = 27 | from_function (fun () -> try BatInnerIO.read inp with BatInnerIO.No_more_input -> raise End_of_file) 28 | (*$T 29 | bscanf (Scanning.from_input (BatIO.input_string "12 bc" )) "%d %s" (fun d s -> d = 12 && s = "bc") 30 | *) 31 | 32 | let from_channel = from_input 33 | 34 | let stdib = from_input (BatInnerIO.stdin) 35 | end 36 | 37 | type ('a, 'b, 'c, 'd) scanner = 38 | ('a, Scanning.scanbuf, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c 39 | 40 | 41 | open Scanf 42 | let fscanf = fscanf 43 | let sscanf = sscanf 44 | let scanf = scanf 45 | let kscanf = kscanf 46 | let bscanf = bscanf 47 | let bscanf_format = bscanf_format 48 | let sscanf_format = sscanf_format 49 | let format_from_string = format_from_string 50 | exception Scan_failure = Scan_failure 51 | -------------------------------------------------------------------------------- /src/batSplay.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Splay -- splay trees 3 | * Copyright (C) 2011 Batteries Included Development Team 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | (** Maps and sets based on splay trees *) 22 | 23 | module Map (Ord : BatInterfaces.OrderedType) 24 | : sig 25 | include BatMap.S with type key = Ord.t 26 | val print_as_list: 27 | ('a BatInnerIO.output -> key -> unit) -> 28 | ('a BatInnerIO.output -> 'c -> unit) -> 29 | 'a BatInnerIO.output -> 'c t -> unit 30 | val of_list : (Ord.t * 'a) list -> 'a t 31 | val to_list : 'a t -> (Ord.t * 'a) list 32 | end 33 | -------------------------------------------------------------------------------- /src/batStack.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatQueue - Extended operations on queues 3 | * Copyright (C) 1996 Xavier Leroy 4 | * 2008 David Teller, LIFO, Universite d'Orleans 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | 23 | include Stack 24 | 25 | type 'a enumerable = 'a Stack.t 26 | 27 | let of_enum e = 28 | let s = create () in 29 | BatEnum.iter (fun x -> push x s) e; 30 | s 31 | 32 | (*$T of_enum 33 | let s = create () in push 3 s; push 5 s; [3;5] |> List.enum |> of_enum = s 34 | let s = create () in of_enum (BatEnum.empty ()) = s 35 | *) 36 | 37 | (* Consumes input stack *) 38 | let enum_destruct s = 39 | let get () = try pop s with Stack.Empty -> raise BatEnum.No_more_elements in 40 | BatEnum.from get 41 | 42 | (*$T enum_destruct 43 | let s = of_enum (List.enum [2;4;6;8]) in \ 44 | enum_destruct s |> List.of_enum = [8;6;4;2] && is_empty s 45 | *) 46 | 47 | (* consumes a copy *) 48 | let enum s = enum_destruct (copy s) 49 | 50 | let print ?(first="") ?(last="") ?(sep="") print_a out t = 51 | BatEnum.print ~first ~last ~sep print_a out (enum t) 52 | 53 | (*$T print 54 | IO.to_string (print Int.print) (of_enum (List.enum [2;4;6;8])) = "8642" 55 | *) 56 | 57 | let compare cmp a b = BatEnum.compare cmp (enum a) (enum b) 58 | let equal eq a b = BatEnum.equal eq (enum a) (enum b) 59 | 60 | (*$T equal 61 | not (equal Int.equal (create()) (of_enum (List.enum [2]))) 62 | equal Int.equal (create()) (create()) 63 | equal Int.equal (of_enum (List.enum [2])) (of_enum (List.enum [2])) 64 | *) 65 | 66 | (*$T compare 67 | 0 <> (compare Int.compare (create()) (of_enum (List.enum [2]))) 68 | *) 69 | 70 | module Exceptionless = struct 71 | let top s = try Some (top s) with Empty -> None 72 | let pop s = try Some (pop s) with Empty -> None 73 | end 74 | -------------------------------------------------------------------------------- /src/batSys.mlv: -------------------------------------------------------------------------------- 1 | (* 2 | * BatSys - additional and modified functions for System 3 | * Copyright (C) 1996 Xavier Leroy 4 | * Copyright (C) 2009 David Teller, LIFO, Universite d'Orleans 5 | * 6 | * This library is free software; you can redistribute it and/or 7 | * modify it under the terms of the GNU Lesser General Public 8 | * License as published by the Free Software Foundation; either 9 | * version 2.1 of the License, or (at your option) any later version, 10 | * with the special exception on linking described in file LICENSE. 11 | * 12 | * This library is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 | * Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public 18 | * License along with this library; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20 | *) 21 | 22 | let big_endian = false (* overridden by real big_endian value in 4.00 and above *) 23 | 24 | include Sys 25 | 26 | let files_of d = BatArray.enum (readdir d) 27 | 28 | ##V<4.3##let sigbus = -22 29 | ##V<4.3##let sigpoll = -23 30 | ##V<4.3##let sigsys = -24 31 | ##V<4.3##let sigtrap = -25 32 | ##V<4.3##let sigurg = -26 33 | ##V<4.3##let sigxcpu = -27 34 | ##V<4.3##let sigxfsz = -28 35 | 36 | ##V>=4.3##external opaque_identity : 'a -> 'a = "%opaque" 37 | ##V<4.3##let opaque_identity = BatOpaqueInnerSys.opaque_identity 38 | -------------------------------------------------------------------------------- /src/batUChar.ml: -------------------------------------------------------------------------------- 1 | (** Unicode (ISO-UCS) characters. 2 | 3 | This module implements Unicode characters. 4 | *) 5 | 6 | (* Copyright (C) 2002, 2003, 2004 Yamagata Yoriyuki. *) 7 | 8 | (* This library is free software; you can redistribute it and/or *) 9 | (* modify it under the terms of the GNU Lesser General Public License *) 10 | (* as published by the Free Software Foundation; either version 2 of *) 11 | (* the License, or (at your option) any later version. *) 12 | 13 | (* As a special exception to the GNU Library General Public License, you *) 14 | (* may link, statically or dynamically, a "work that uses this library" *) 15 | (* with a publicly distributed version of this library to produce an *) 16 | (* executable file containing portions of this library, and distribute *) 17 | (* that executable file under terms of your choice, without any of the *) 18 | (* additional requirements listed in clause 6 of the GNU Library General *) 19 | (* Public License. By "a publicly distributed version of this library", *) 20 | (* we mean either the unmodified Library as distributed by the authors, *) 21 | (* or a modified version of this library that is distributed under the *) 22 | (* conditions defined in clause 3 of the GNU Library General Public *) 23 | (* License. This exception does not however invalidate any other reasons *) 24 | (* why the executable file might be covered by the GNU Library General *) 25 | (* Public License . *) 26 | 27 | (* This library is distributed in the hope that it will be useful, *) 28 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 29 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 30 | (* Lesser General Public License for more details. *) 31 | 32 | (* You should have received a copy of the GNU Lesser General Public *) 33 | (* License along with this library; if not, write to the Free Software *) 34 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 35 | (* USA *) 36 | 37 | (* You can contact the authour by sending email to *) 38 | (* yoriyuki.y@gmail.com *) 39 | 40 | type t = int 41 | 42 | exception Out_of_range 43 | 44 | external code : t -> int = "%identity" 45 | 46 | let char_of c = 47 | if c >= 0 && c < 0x100 then Char.chr c else raise Out_of_range 48 | 49 | let of_char = Char.code 50 | 51 | (* valid range: U+0000..U+D7FF and U+E000..U+10FFFF *) 52 | let chr n = 53 | if (n >= 0 && n <= 0xd7ff) || (n >= 0xe000 && n <= 0x10ffff) 54 | then n 55 | else raise Out_of_range 56 | 57 | let unsafe_chr n = n 58 | 59 | let eq (u1 : t) (u2 : t) = u1 = u2 60 | 61 | let compare u1 u2 = u1 - u2 62 | 63 | type uchar = t 64 | 65 | let int_of u = code u 66 | let of_int n = chr n 67 | 68 | let is_ascii u = u < 128 69 | -------------------------------------------------------------------------------- /src/batUChar.mli: -------------------------------------------------------------------------------- 1 | (** Unicode characters. 2 | 3 | This module implements Unicode characters. 4 | *) 5 | 6 | (* Copyright (C) 2002, 2003, 2004, 2011 Yamagata Yoriyuki. *) 7 | 8 | (* This library is free software; you can redistribute it and/or *) 9 | (* modify it under the terms of the GNU Lesser General Public License *) 10 | (* as published by the Free Software Foundation; either version 2 of *) 11 | (* the License, or (at your option) any later version. *) 12 | 13 | (* As a special exception to the GNU Library General Public License, you *) 14 | (* may link, statically or dynamically, a "work that uses this library" *) 15 | (* with a publicly distributed version of this library to produce an *) 16 | (* executable file containing portions of this library, and distribute *) 17 | (* that executable file under terms of your choice, without any of the *) 18 | (* additional requirements listed in clause 6 of the GNU Library General *) 19 | (* Public License. By "a publicly distributed version of this library", *) 20 | (* we mean either the unmodified Library as distributed by the authors, *) 21 | (* or a modified version of this library that is distributed under the *) 22 | (* conditions defined in clause 3 of the GNU Library General Public *) 23 | (* License. This exception does not however invalidate any other reasons *) 24 | (* why the executable file might be covered by the GNU Library General *) 25 | (* Public License . *) 26 | 27 | (* This library is distributed in the hope that it will be useful, *) 28 | (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 29 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) 30 | (* Lesser General Public License for more details. *) 31 | 32 | (* You should have received a copy of the GNU Lesser General Public *) 33 | (* License along with this library; if not, write to the Free Software *) 34 | (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) 35 | (* USA *) 36 | 37 | (* You can contact the authour by sending email to *) 38 | (* yori@users.sourceforge.net *) 39 | 40 | type t 41 | 42 | exception Out_of_range 43 | 44 | (** [char_of u] returns the Latin-1 representation of [u]. 45 | If [u] can not be represented by Latin-1, raises Out_of_range *) 46 | val char_of : t -> char 47 | 48 | (** [of_char c] returns the Unicode character of the Latin-1 character [c] *) 49 | val of_char : char -> t 50 | 51 | (** [code u] returns the Unicode code number of [u]. *) 52 | external code : t -> int = "%identity" 53 | 54 | (** [chr n] returns the Unicode character with the code number [n]. 55 | If n does not lay in the valid range of Unicode or designates a 56 | surrogate charactor, raises Out_of_range *) 57 | val chr : int -> t 58 | 59 | (** Equality by code point comparison *) 60 | val eq : t -> t -> bool 61 | 62 | (** [compare u1 u2] returns, 63 | a value > 0 if [u1] has a larger Unicode code number than [u2], 64 | 0 if [u1] and [u2] are the same Unicode character, 65 | a value < 0 if [u1] has a smaller Unicode code number than [u2]. *) 66 | val compare : t -> t -> int 67 | 68 | (** Aliases of [type t] *) 69 | type uchar = t 70 | 71 | (** Alias of [code] *) 72 | val int_of : uchar -> int 73 | 74 | (** Alias of [chr] *) 75 | val of_int : int -> uchar 76 | 77 | (** [true] if the char is a regular ascii char, i.e. if its code is <= 127 78 | @since 2.2.0 *) 79 | val is_ascii : uchar -> bool 80 | 81 | (**/**) 82 | 83 | val unsafe_chr : int -> t 84 | 85 | (**/**) 86 | -------------------------------------------------------------------------------- /src/batUnit.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * BatUnit - Operations on Unit 3 | * Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc. 19 | *) 20 | 21 | (*BISECT-IGNORE-BEGIN*) 22 | 23 | let unit_string = "()" 24 | 25 | type t = unit 26 | let string_of () = unit_string 27 | let of_string = function 28 | | "()" -> () 29 | | _ -> raise (Invalid_argument "unit_of_string") 30 | let compare () () = 0 31 | let ord () () = BatOrd.Eq 32 | let equal () () = true 33 | let print out () = BatInnerIO.nwrite out unit_string 34 | 35 | (*BISECT-IGNORE-END*) 36 | -------------------------------------------------------------------------------- /src/batUnit.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * BatUnit - Operations on Unit 3 | * Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc. 19 | *) 20 | 21 | (** 22 | Operations on [unit]. 23 | 24 | @author David Teller 25 | *) 26 | 27 | type t = unit 28 | (**The unit type, i.e. a type with only one element, [()].*) 29 | 30 | val string_of : t -> string 31 | (**Convert the given unit to a string. 32 | 33 | Returns ["()"]. *) 34 | 35 | val of_string : string -> t 36 | (**Convert the given string to a unit. 37 | 38 | Accepts ["()"]. 39 | @raise Invalid_argument if the given string is not ["()"]. 40 | *) 41 | 42 | val compare : t -> t -> int 43 | (** Compare two units. 44 | 45 | Always returns 0.*) 46 | 47 | val ord : t -> t -> BatOrd.order 48 | (** Always returns [BatOrd.Eq] *) 49 | 50 | val equal : t -> t -> bool 51 | (** Always returns true. *) 52 | 53 | (** {6 Boilerplate code}*) 54 | 55 | (** {7 Printing}*) 56 | val print: 'a BatInnerIO.output -> unit -> unit 57 | -------------------------------------------------------------------------------- /src/batUref.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Uref -- unifiable references 3 | * Copyright (C) 2011 Batteries Included Development Team 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | (** Unifiable references using destructive union-find *) 22 | 23 | type 'a uref 24 | (** A [t uref] is a reference to a cell that contains a 25 | value of type [t]. *) 26 | 27 | type 'a t = 'a uref 28 | (** A synonym for convenience *) 29 | 30 | val uref : 'a -> 'a uref 31 | (** [uref x] allocates a new uref and places the value [x] in it. *) 32 | 33 | val uget : 'a uref -> 'a 34 | (** [uget ur] returns the value stored in the uref [ur]. *) 35 | 36 | val uset : 'a uref -> 'a -> unit 37 | (** [uset ur x] updates the contents of [ur] with [x]. *) 38 | 39 | val unite : ?sel:('a -> 'a -> 'a) -> 'a uref -> 'a uref -> unit 40 | (** [unite ~sel ur1 ur2] unites the urefs [ur1] and [ur2], selecting 41 | the result of [sel (uget ur1) (uget ur2)] for the contents of 42 | the resulting united uref. After this operation, [uget ur1 == 43 | uget ur2]. By default, [sel] is [fun x _y -> x]. *) 44 | 45 | val equal : 'a uref -> 'a uref -> bool 46 | (** [equal ur1 ur2] returns [true] iff [ur1] and [ur2] are equal 47 | urefs, either because they are physically the same or because 48 | they have been {!unite}d. *) 49 | 50 | (** {6 Printing} *) 51 | 52 | val print : ('a, 'b) BatIO.printer -> ('a uref, 'b) BatIO.printer 53 | (** Print the uref. *) 54 | -------------------------------------------------------------------------------- /src/batteries.mllib: -------------------------------------------------------------------------------- 1 | BatInnerPervasives 2 | BatInnerShuffle 3 | BatArray 4 | BatBigarray 5 | BatBig_int 6 | BatBool 7 | BatBounded 8 | BatBuffer 9 | BatBytes 10 | BatChar 11 | BatComplex 12 | BatDeque 13 | BatDigest 14 | BatEnum 15 | BatFingerTree 16 | BatFloat 17 | BatFormat 18 | BatGc 19 | BatGenlex 20 | BatHashcons 21 | BatHashtbl 22 | BatHeap 23 | BatIO 24 | BatInnerIO 25 | BatInt32 26 | BatInt64 27 | BatInt 28 | BatLexing 29 | BatList 30 | BatMap 31 | BatMarshal 32 | BatNativeint 33 | BatNum 34 | BatOo 35 | BatPervasives 36 | BatPrintexc 37 | BatPrintf 38 | BatConcreteQueue 39 | BatQueue 40 | BatRandom 41 | BatScanf 42 | BatSet 43 | BatSplay 44 | BatStack 45 | BatStream 46 | BatString 47 | BatOpaqueInnerSys 48 | BatSys 49 | BatUnit 50 | BatUnix 51 | BatBase64 52 | BatBitSet 53 | BatCharParser 54 | BatConcurrent 55 | BatDllist 56 | BatDynArray 57 | BatFile 58 | BatGlobal 59 | BatInnerWeaktbl 60 | BatInterfaces 61 | BatLazyList 62 | BatLogger 63 | BatMultiPMap 64 | BatMultiMap 65 | BatNumber 66 | BatOption 67 | BatOptParse 68 | BatOrd 69 | BatParserCo 70 | BatPathGen 71 | BatRefList 72 | BatRef 73 | BatResult 74 | BatReturn 75 | BatSeq 76 | BatSubstring 77 | BatTuple 78 | BatUref 79 | BatVect 80 | BatAvlTree 81 | BatISet 82 | BatIMap 83 | BatCache 84 | BatLog 85 | BatUChar 86 | BatUTF8 87 | BatText 88 | BatteriesConfig 89 | BatteriesPrint 90 | Batteries 91 | BatteriesExceptionless 92 | Extlib 93 | -------------------------------------------------------------------------------- /src/batteriesConfig.mlp: -------------------------------------------------------------------------------- 1 | (* 2 | * config - Configuration module for OCaml Batteries Included 3 | * Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | let version = "@VERSION@";; 22 | let documentation_root = "@DOCROOT@";; 23 | let (browser: (_, _, _) format) = "@BROWSER_COMMAND@ %s";; 24 | 25 | (**The default function to open a www browser.*) 26 | let default_browse s = 27 | let command = Printf.sprintf browser s in 28 | Sys.command command 29 | let current_browse = ref default_browse 30 | 31 | let browse s = !current_browse s 32 | let set_browser f = current_browse := f 33 | 34 | let max_array_length = Sys.max_array_length 35 | let word_size = Sys.word_size 36 | let max_string_length= Sys.max_string_length 37 | -------------------------------------------------------------------------------- /src/batteriesHelp.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Batteries_help - Calling the help system from the toplevel 3 | * Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version, 9 | * with the special exception on linking described in file LICENSE. 10 | * 11 | * This library is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 | * Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public 17 | * License along with this library; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | *) 20 | 21 | (** Tools for reading the documentation from the toplevel 22 | 23 | All these tools are invoked automatically by the Batteries 24 | Toplevel. They are provided here if you wish to integrate them 25 | into your own toplevel. 26 | 27 | @author David Teller 28 | *) 29 | 30 | type kinds = 31 | | Values 32 | | Types 33 | | Topics 34 | | Modules 35 | | Exns 36 | | Modtypes 37 | | Classes 38 | | Methods 39 | | Attributes 40 | | Objtypes 41 | 42 | val init : unit -> unit 43 | (** Proceed to initialization. 44 | 45 | This function loads the primary help files and registers the 46 | toplevel directives. 47 | 48 | If you integrate the on-line help system into your toplevel, you 49 | must call this function before any of the other functions of this 50 | module. *) 51 | 52 | val help : unit -> unit 53 | (** [help ()] opens the tutorial.*) 54 | 55 | val man : string -> unit 56 | (** [man "something"] opens the help about subject ["something"]. 57 | *) 58 | 59 | -------------------------------------------------------------------------------- /src/batteriesThread.ml: -------------------------------------------------------------------------------- 1 | module Mutex = BatMutex 2 | module RMutex = BatRMutex 3 | 4 | let () = 5 | BatUnix.lock := RMutex.make (); 6 | BatIO.lock := RMutex.make (); 7 | BatIO.lock_factory := RMutex.make; 8 | BatPervasives.lock := RMutex.make (); 9 | () 10 | -------------------------------------------------------------------------------- /src/batteriesThread.mllib: -------------------------------------------------------------------------------- 1 | BatMutex 2 | BatRMutex 3 | BatteriesThread 4 | -------------------------------------------------------------------------------- /src/extlib.ml: -------------------------------------------------------------------------------- 1 | module Base64 = BatBase64 2 | module BitSet = BatBitSet 3 | module Dllist = BatDllist 4 | module DynArray = BatDynArray 5 | module Enum = BatEnum 6 | module ExtArray = struct 7 | module Array = struct include Array include BatArray end 8 | end 9 | module ExtHashtbl = struct 10 | module Hashtbl = BatHashtbl 11 | end 12 | module ExtList = struct 13 | module List = struct include List include BatList end 14 | end 15 | module ExtString = struct 16 | module String = BatString 17 | end 18 | module Global = BatGlobal 19 | module IO = BatIO 20 | module OptParse = BatOptParse 21 | module Option = BatOption 22 | module PMap = BatMap 23 | module RefList = BatRefList 24 | module Std = BatPervasives 25 | module UChar = BatUChar 26 | module UTF8 = BatUTF8 27 | (* module Unzip = NOT AVAILABLE *) 28 | -------------------------------------------------------------------------------- /test-build/Makefile: -------------------------------------------------------------------------------- 1 | # This test is designed to catch build issues that affect installed 2 | # versions of the library, such as the ones that plagued v2.5.0 and 3 | # v2.5.1 -- forgetting to include a new module in src/batteries.mllib, 4 | # which results in a link-time error when building from an installed 5 | # version. 6 | all: 7 | ocamlfind ocamlopt -package batteries -o test -linkpkg test.ml 8 | ./test | grep --quiet "0123456789" || exit 2 9 | rm test.cm* test.o test 10 | -------------------------------------------------------------------------------- /test-build/test.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | 3 | let digits = List.unfold 0 (fun n -> if n >= 10 then None else Some (n, n + 1)) 4 | 5 | let () = List.iter (Int.print stdout) digits; print_newline () 6 | -------------------------------------------------------------------------------- /testsuite/_tags: -------------------------------------------------------------------------------- 1 | true: pkg_oUnit, threads, debug 2 | -------------------------------------------------------------------------------- /testsuite/main.ml: -------------------------------------------------------------------------------- 1 | module X = Test_interface 2 | 3 | open OUnit 4 | 5 | let all_tests = 6 | [ 7 | Test_pervasives.tests; 8 | (* Test_base64.tests; Replaced by simple quickcheck rules inline *) 9 | (* Test_unix.tests; Moved to inline tests in BatUnix *) 10 | (* Test_print.tests; 11 | Test_toplevel.tests; *) 12 | Test_map.tests; 13 | (* pmap is actually tested in test_map.ml, as they share their 14 | implementation *) 15 | Test_multipmap.tests; 16 | (* Test_vect.tests; Moved inline to BatVect *) 17 | Test_file.tests; 18 | (* Test_string.tests; Moved inline to BatString *) 19 | Test_substring.tests; 20 | Test_digest.tests; 21 | Test_enum.tests; 22 | Test_set.tests; 23 | Test_dynarray.tests; 24 | Test_stack.tests; 25 | Test_mappable.tests; 26 | Test_num.tests; 27 | Test_hashcons.tests; 28 | Test_mapfunctors.tests; 29 | Test_optparse.tests; 30 | Test_uref.tests; 31 | Test_bitset.tests; 32 | Test_container.tests; 33 | Test_random.tests; 34 | Test_bounded.tests; 35 | Test_modifiable.tests; 36 | Test_hashtbl.tests; 37 | ] 38 | 39 | let () = 40 | ignore(OUnit.run_test_tt_main ("All" >::: all_tests)); 41 | -------------------------------------------------------------------------------- /testsuite/myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | ../build/myocamlbuild.ml -------------------------------------------------------------------------------- /testsuite/test_base64.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatBase64 3 | 4 | let string = "hello world" 5 | 6 | let assert_equal_strings s1 s2 = 7 | assert_equal ~printer:(fun s -> "“"^s^"”") s1 s2 8 | 9 | let hexa s = 10 | (* really not perf critical *) 11 | let r = ref "" in 12 | for i = 0 to String.length s - 1 do 13 | r := !r ^ (Printf.sprintf "%x" (Char.code s.[i])) 14 | done; 15 | !r 16 | 17 | let assert_equal_bytes s1 s2 = 18 | assert_equal ~printer:(fun s -> "“"^s^"” (0x"^(hexa s)^")") s1 s2 19 | 20 | let test_encdec_aux str = 21 | assert_equal_bytes str (str_decode (str_encode str)) 22 | 23 | let test_decenc_aux str = 24 | let enc = str_encode str in 25 | assert_equal_strings enc (str_encode (str_decode enc)) 26 | 27 | let random_string len = 28 | let r = String.create len in 29 | for i = 0 to len - 1 30 | do r.[i] <- BatRandom.char () done; 31 | r 32 | 33 | let map_generated_data f iters max_len = 34 | for len = 0 to max_len do 35 | for i = 1 to iters do 36 | f (random_string len) 37 | done done 38 | 39 | 40 | let test_encdec () = 41 | map_generated_data test_encdec_aux 4 50 42 | 43 | let test_decenc () = 44 | map_generated_data test_decenc_aux 4 50 45 | 46 | 47 | let tests = "Base64" >::: [ 48 | "Decode undoes encode" >:: test_encdec; 49 | "Encode undoes decode" >:: test_decenc; 50 | (*"Encode works as expected" >:: test_enc; 51 | "Decode works as expected" >:: test_dec;*) 52 | ] 53 | -------------------------------------------------------------------------------- /testsuite/test_bounded.ml: -------------------------------------------------------------------------------- 1 | open BatPervasives 2 | module R = BatRandom 3 | module U = OUnit 4 | 5 | module Int10_base = struct 6 | type base_t = int 7 | type t = int option 8 | let bounds = `c 1, `c 10 9 | let bounded = BatBounded.opt_of_ord BatInt.ord 10 | let base_of_t x = x 11 | let base_of_t_exn x = BatOption.get x 12 | module Infix = BatInt.Infix 13 | end 14 | 15 | (** Only accept integers between 1 and 10, inclusive *) 16 | module Int10 = BatBounded.MakeNumeric(Int10_base) 17 | 18 | module Float10_base = struct 19 | type base_t = float 20 | type t = float option 21 | let bounds = `o 1.0, `o 10.0 22 | let bounded = BatBounded.opt_of_ord BatFloat.ord 23 | let base_of_t x = x 24 | let base_of_t_exn x = BatOption.get x 25 | module Infix = BatFloat.Infix 26 | end 27 | 28 | (** Only accept floating point values between 1 and 10, exclusive *) 29 | module Float10 = BatBounded.MakeNumeric(Float10_base) 30 | 31 | let assert_make (type s) m to_string (xs : s list) = 32 | let module B = 33 | ( 34 | val m : 35 | BatBounded.NumericSig with type base_u = s and type u = s option 36 | ) 37 | in 38 | let min_bound, max_bound = B.bounds in 39 | let min_check = 40 | match min_bound with 41 | | `o a -> (fun x -> x > a) 42 | | `c a -> (fun x -> x >= a) 43 | | `u -> (const true) 44 | in 45 | let max_check = 46 | match max_bound with 47 | | `o a -> (fun x -> x < a) 48 | | `c a -> (fun x -> x <= a) 49 | | `u -> (const true) 50 | in 51 | List.iter ( 52 | fun x -> 53 | let printer b = Printf.sprintf "%s (%b)" (to_string x) b in 54 | U.assert_equal ~printer (max_check x && min_check x) (BatOption.is_some ((B.make %> B.extract) x)) 55 | ) xs; 56 | () 57 | 58 | let test_make () = 59 | let xs = BatList.init 100 identity in 60 | let m = 61 | (module Int10 : BatBounded.NumericSig with type base_u = int and type u = int option) 62 | in 63 | assert_make m string_of_int xs; 64 | let xs = BatList.init 110 (fun x -> float_of_int x /. 10.0) in 65 | let m = 66 | (module Float10 : BatBounded.NumericSig with type base_u = float and type u = float option) 67 | in 68 | assert_make m string_of_float xs 69 | 70 | let (>::), (>:::) = U.(>::), U.(>:::) 71 | 72 | let tests = "Bounded" >::: [ 73 | "value creation" >:: test_make 74 | ] 75 | -------------------------------------------------------------------------------- /testsuite/test_digest.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | (*1. Compute the digest of this file using Legacy.Digest*) 4 | 5 | let legacy_result () = 6 | let inp = Pervasives.open_in_bin Sys.argv.(0) in 7 | let result = Digest.channel inp (-1) in 8 | Pervasives.close_in inp; 9 | result 10 | 11 | (*2. Compute the digest of this file using Batteries.Digest*) 12 | 13 | let batteries_result () = 14 | let inp = BatFile.open_in Sys.argv.(0) in 15 | let result = BatDigest.channel inp (-1) in 16 | BatIO.close_in inp; 17 | result 18 | 19 | (*3. Compare*) 20 | let test_legacy_against_batteries () = 21 | assert_equal ~printer:(Printf.sprintf "%S") 22 | (legacy_result ()) (batteries_result ()) 23 | 24 | let tests = "Digest" >::: [ 25 | "Comparing Legacy.Digest and MD5" >:: test_legacy_against_batteries; 26 | ] 27 | -------------------------------------------------------------------------------- /testsuite/test_dynarray.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open OUnit 3 | 4 | module DA = DynArray 5 | 6 | let s1 = DA.of_list [1;2;3] 7 | let s2 = DA.of_list [1;2] 8 | 9 | let asseq_int = assert_equal ~printer:(DA.print Int.print |> IO.to_string) 10 | let asseq_str = assert_equal ~printer:identity 11 | 12 | let test_dynarray_filter () = 13 | let e = BatDynArray.create () in 14 | BatDynArray.add e "a"; 15 | BatDynArray.add e "b"; 16 | BatDynArray.keep ((=) "a") e; 17 | asseq_str (BatDynArray.get e 0) "a" 18 | 19 | 20 | let tests = "Set" >::: [ 21 | "Dynarray_filter" >:: test_dynarray_filter; 22 | ] 23 | -------------------------------------------------------------------------------- /testsuite/test_hashcons.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatHashcons 3 | 4 | type lterm = lterm_ hobj 5 | and lterm_ = 6 | | Var of string 7 | | App of lterm * lterm 8 | | Lam of string * lterm 9 | 10 | module LtermFuncs = struct 11 | type t = lterm_ 12 | let equal lt1 lt2 = match lt1, lt2 with 13 | | Var j, Var k -> j = k 14 | | App (lt11, lt12), App (lt21, lt22) -> 15 | lt11 == lt21 && lt12 == lt22 16 | | Lam (x, lt1), Lam (y, lt2) -> 17 | x = y && lt1 == lt2 18 | | _ -> false 19 | let hash = function 20 | | Var x -> H.hc1_ 0 (Hashtbl.hash x) 21 | | App (lt1, lt2) -> H.hc1_ 1 (H.hc1 lt1 (H.hc0 lt2)) 22 | | Lam (x, lt) -> H.hc1_ 2 (H.hc1_ (Hashtbl.hash x) (H.hc0 lt)) 23 | end 24 | module LtermHC = MakeTable (LtermFuncs) 25 | let _tab = LtermHC.create 1 26 | let var x : lterm = LtermHC.hashcons _tab (Var x) 27 | let app lt1 lt2 : lterm = LtermHC.hashcons _tab (App (lt1, lt2)) 28 | let lam x lt : lterm = LtermHC.hashcons _tab (Lam (x, lt)) 29 | 30 | let test_identity () = 31 | let mk_s x y z = 32 | lam x begin 33 | lam y begin 34 | lam z begin 35 | let xz = app (var x) (var z) in 36 | let yz = app (var y) (var z) in 37 | app xz yz 38 | end 39 | end 40 | end 41 | in 42 | assert_bool "mk_s produces different objects" 43 | (mk_s "x" "y" "z" == mk_s "x" "y" "z") 44 | 45 | let tests = "Hashcons" >::: [ 46 | "Pointer identity" >:: test_identity 47 | ] 48 | -------------------------------------------------------------------------------- /testsuite/test_hashtbl.ml: -------------------------------------------------------------------------------- 1 | open Batteries 2 | open OUnit 3 | 4 | (* regression tests for 5 | https://github.com/ocaml-batteries-team/batteries-included/issues/609 *) 6 | 7 | module IntIdHash = struct 8 | type t = int 9 | let hash t = t 10 | let equal = (=) 11 | end 12 | 13 | let test_issue_609_1 () = 14 | let module H = BatHashtbl.Make(IntIdHash) in 15 | let h = H.create 7 in 16 | H.replace h min_int []; 17 | let v = H.find_default h (-max_int) [] in 18 | assert_equal v [] 19 | 20 | let test_issue_609_2 () = 21 | let module H = BatHashtbl.Make(IntIdHash) in 22 | let h = H.create 7 in 23 | H.add h 0 []; 24 | H.remove_all h 0; 25 | assert_bool "0 was removed" (not (H.mem h 0)) 26 | 27 | let tests = "Hashtbl" >::: [ 28 | "PR#609 (1)" >:: test_issue_609_1; 29 | "PR#609 (2)" >:: test_issue_609_2; 30 | ] 31 | -------------------------------------------------------------------------------- /testsuite/test_interface.ml: -------------------------------------------------------------------------------- 1 | 2 | (*module X1 : module type of Arg = BatArg REMOVE BATARG? REIMPLEMENT?*) 3 | module X15 : module type of List = BatList 4 | (* 5 | module X2 : module type of Array = BatArray 6 | module X3 : module type of Bigarray = BatBigarray 7 | module X4 : module type of Big_int = BatBig_int 8 | *) 9 | (* module X5 : module type of Buffer = BatBuffer FAIL - channel -> input *) 10 | module X6 : module type of Complex = BatComplex 11 | (* 12 | module X7 : module type of Digest = BatDigest 13 | module X8 : module type of Format = BatFormat 14 | *) 15 | (* module X9 : module type of Gc = BatGc FAIL channel -> output *) 16 | (* 17 | module X10 : module type of Genlex = BatGenlex 18 | *) 19 | (* module X11 : module type of Hashtbl = BatHashtbl FAIL missing fields?*) 20 | module X12 : module type of Int32 = BatInt32 21 | module X13 : module type of Int64 = BatInt64 22 | (* 23 | module X14 : module type of Lexing = BatLexing 24 | *) 25 | (* module X16 : module type of Map = BatMap FAIL - missing fields? *) 26 | (* 27 | module X17 : module type of Marshal = BatMarshal 28 | *) 29 | module X18 : module type of Nativeint = BatNativeint 30 | (* 31 | module X19 : module type of Num = BatNum 32 | module X20 : module type of Oo = BatOo 33 | (* PERVASIVES? *) 34 | module X21 : module type of Printexc = BatPrintexc 35 | module X22 : module type of Printf = BatPrintf 36 | module X23 : module type of Queue = BatQueue 37 | *) 38 | module X24 : module type of Random = BatRandom 39 | (* 40 | module X25 : module type of Scanf = BatScanf 41 | *) 42 | (* module X26 : module type of Set = BatSet FAIL - missing fields? *) 43 | (* 44 | module X27 : module type of Stack = BatStack 45 | module X28 : module type of Stream = BatStream 46 | module X29 : module type of String = BatString 47 | module X30 : module type of Str = BatStr 48 | module X31 : module type of Sys = BatSys 49 | (* UNIX? *) 50 | *) 51 | -------------------------------------------------------------------------------- /testsuite/test_mapfunctors.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatRandom 3 | open BatPervasives 4 | 5 | module MkTest (MkMap : functor (Ord : BatInterfaces.OrderedType) 6 | -> BatMap.S with type key = Ord.t) = 7 | struct 8 | (* This is basically Test_pmap, but specialized for MkMap(Int) *) 9 | module Map = MkMap (BatInt) 10 | 11 | let print_enum out enum = 12 | BatEnum.print begin 13 | fun out (c, _) -> 14 | BatPrintf.fprintf out "%d" c 15 | end out enum 16 | 17 | let assert_equal_enums enum_1 enum_2 = 18 | match BatEnum.compare compare (enum_1 ()) (enum_2 ()) with 19 | | 0 -> (* pass *) () 20 | | _ -> 21 | assert_failure 22 | (BatPrintf.sprintf2 "Expected %a, got %a" 23 | print_enum (enum_1 ()) print_enum (enum_2 ())) 24 | 25 | let assert_equal_maps map_1 map_2 = 26 | let enum_1 () = Map.enum map_1 in 27 | let enum_2 () = Map.enum map_2 in 28 | assert_equal_enums enum_1 enum_2 29 | 30 | let gen_map state bound count = 31 | let keys = BatEnum.take count (State.enum_int state bound) in 32 | Map.of_enum (BatEnum.map (fun x -> (x, x)) keys) 33 | 34 | let test_traversal_order () = 35 | let init = State.make [|0|] in 36 | let map = gen_map init 10 50 in 37 | let enum_1 () = Map.enum map 38 | and enum_2 () = 39 | let list = BatRefList.empty () in 40 | Map.iter (fun k v -> BatRefList.push list (k, v)) map; 41 | BatRefList.backwards list 42 | in 43 | assert_equal_enums enum_1 enum_2 44 | 45 | let tests = [ 46 | "traversal order iter vs. enum" >:: test_traversal_order ; 47 | ] 48 | end 49 | 50 | let tests = 51 | let module MT1 = MkTest (BatMap.Make) in 52 | let mt1_tests = "Map.Make" >::: MT1.tests in 53 | let module MT2 = MkTest (BatSplay.Map) in 54 | let mt2_tests = "Splay.Make" >::: MT2.tests in 55 | "Generic Map tests" >::: [ 56 | mt1_tests ; 57 | mt2_tests ; 58 | ] 59 | -------------------------------------------------------------------------------- /testsuite/test_mappable.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | (* The purpose of this test file is to test properties that should be 4 | verified by all instances of a given interface, here 5 | BatInterfaces.Mappable. 6 | 7 | It is very minimal for now : it only check for one property, and 8 | only a few of the Mappable modules (it is actually a regression 9 | test for a very specific bug). New properties will be added, and 10 | hopefully they will be verified against all Mappable modules. 11 | *) 12 | 13 | module TestMappable 14 | (M : sig 15 | include BatEnum.Enumerable 16 | 17 | include BatInterfaces.Mappable 18 | with type 'a mappable = 'a enumerable 19 | end) 20 | = 21 | struct 22 | (* The property we test is that the order in which the [map] 23 | function traverse the structure (applying a given function on 24 | each element) is the same as the order of the [enum] function of 25 | the module (the order in which the elements are produced in the 26 | enumeration). 27 | *) 28 | let test_map_evaluation_order printer t = 29 | let elems_in_enum_order = BatList.of_enum (M.enum t) in 30 | let elems_in_map_order = 31 | let li = ref [] in 32 | ignore (M.map (fun x -> li := x :: !li) t); 33 | List.rev !li in 34 | assert_equal ~printer:(BatIO.to_string (BatList.print printer)) 35 | elems_in_enum_order 36 | elems_in_map_order 37 | end 38 | 39 | let test_list_mappable () = 40 | let module T = TestMappable(BatList) in 41 | T.test_map_evaluation_order BatInt.print [1; 2; 3] 42 | 43 | let test_array_mappable () = 44 | let module T = TestMappable(BatArray) in 45 | T.test_map_evaluation_order BatInt.print [|1; 2; 3|] 46 | (* 47 | let test_pair_mappable () = 48 | let module T = TestMappable(BatTuple.Tuple2) in 49 | T.test_map_evaluation_order BatInt.print (1, 2) 50 | *) 51 | 52 | let tests = "Mappable" >::: [ 53 | "Array" >:: test_array_mappable; 54 | "List" >:: test_list_mappable; 55 | (* "Pair" >:: test_pair_mappable;*) 56 | ] 57 | -------------------------------------------------------------------------------- /testsuite/test_multipmap.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatPervasives 3 | open BatMultiPMap 4 | 5 | let test_multimap_empty_assoc_lists () = 6 | let map = 7 | add 0 "foo" empty |> add 0 "bar" |> add 0 "sna" |> 8 | remove 0 "foo" |> remove 0 "bar" |> remove 0 "sna" 9 | in 10 | if mem 0 map then 11 | assert_failure 12 | (Printf.sprintf "map[0] should be empty but contains %d bindings\n" 13 | (BatSet.PSet.cardinal (find 0 map))) 14 | 15 | let tests = "MultiPMap" >::: [ 16 | "MultiPMap: removing empty association lists" >:: test_multimap_empty_assoc_lists; 17 | ] 18 | -------------------------------------------------------------------------------- /testsuite/test_num.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatNum 3 | 4 | let tests = "Num" >::: [ 5 | "of_float" >::: [ 6 | "zero" >:: begin function () -> 7 | assert_equal ~cmp:(=) ~printer:to_string zero (of_float 0.) 8 | end; 9 | "numbers" >:: begin function () -> 10 | Array.iter begin function f -> 11 | assert_equal ~printer:BatFloat.to_string f 12 | (to_float (of_float f)) 13 | end 14 | [|2.5; 1.0; 0.5; -0.5; -1.0; -2.5|] 15 | end; 16 | "infinity/nan" >::: 17 | (* set/reset pair for (re)setting the error_when_null_denominator state. 18 | * A stack is used instead of simple ref to make calls nestable. *) 19 | let (set, reset) = 20 | let saved_state = Stack.create () in 21 | begin fun state () -> 22 | Stack.push 23 | (Arith_status.get_error_when_null_denominator ()) 24 | saved_state; 25 | Arith_status.set_error_when_null_denominator state; 26 | end, 27 | begin fun () -> 28 | Arith_status.set_error_when_null_denominator 29 | (Stack.pop saved_state) 30 | end 31 | in 32 | let test () = 33 | Array.iter 34 | (* f is float, n/d are expected nominator and denominator *) 35 | begin fun (f, (n,d)) -> 36 | if Arith_status.get_error_when_null_denominator () 37 | then 38 | (* expect error *) 39 | assert_raises 40 | (Failure "create_ratio infinite or undefined rational number") 41 | (fun () -> ignore (of_float f)) 42 | else 43 | (* expect result *) 44 | assert_equal ~cmp:equal ~printer:to_string 45 | (div n d) 46 | (of_float f) 47 | end 48 | (* values to test *) 49 | [| infinity, (one,zero); neg_infinity, (neg one,zero); nan, (zero,zero) |] 50 | in 51 | [ 52 | (* allow null denominator *) 53 | "allow_null_denom" >:: bracket (set false) test reset; 54 | (* disallow null denominator *) 55 | "forbid_null_denom" >:: bracket (set true) test reset; 56 | ] 57 | ] 58 | ] 59 | -------------------------------------------------------------------------------- /testsuite/test_optparse.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatPervasives 3 | open BatOptParse 4 | 5 | let printer = dump 6 | 7 | let tests = "OptParse tests" >::: [ 8 | "parse empty" >:: begin function () -> 9 | let p = OptParser.make () in 10 | assert_equal ~printer [] (OptParser.parse p [||]) 11 | end; 12 | "parse no options" >:: begin function () -> 13 | let p = OptParser.make () in 14 | assert_equal ~printer ["foo"] (OptParser.parse p [|"foo"|]) 15 | end; 16 | "parse empty (only leading)" >:: begin function () -> 17 | let p = OptParser.make ~only_leading_opts:true () in 18 | assert_equal ~printer [] (OptParser.parse p [||]) 19 | end; 20 | "parse no options (only leading)" >:: begin function () -> 21 | let p = OptParser.make ~only_leading_opts:true () in 22 | assert_equal ~printer ["foo"] (OptParser.parse p [|"foo"|]) 23 | end; 24 | ] 25 | -------------------------------------------------------------------------------- /testsuite/test_pervasives.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Batteries 3 | 4 | let test_using () = 5 | let obj = (ref 0), (ref 0) in 6 | let dispose (_,closed) = closed := 5 in 7 | let f (run,_) = run := 7; 42 in 8 | let r = with_dispose ~dispose f obj in 9 | let printer = string_of_int in 10 | let run, closed = obj in 11 | assert_equal ~printer 42 r; 12 | assert_equal ~printer 7 (!run); 13 | assert_equal ~printer 5 (!closed) 14 | 15 | type test1 = 16 | | A of int 17 | | B of float * float 18 | | C of string * test1 19 | 20 | type test2 = { 21 | a : int; 22 | b : float * float; 23 | c : string * test2 option; 24 | } 25 | 26 | type test3 = { 27 | f1 : float; 28 | f2 : float; 29 | f3 : float; 30 | } 31 | 32 | let test_dump () = 33 | let test str value = 34 | assert_equal ~msg:str ~printer:(fun x -> x) str (BatPervasives.dump value) in 35 | 36 | (* integers *) 37 | test "0" None; 38 | test "0" false; 39 | test "1" true; 40 | test "17" 17; 41 | 42 | (* lists *) 43 | (* despite the specialized list-spotting routine, [] is printed as 44 | 0 as they have the same representation *) 45 | test "0" []; 46 | test "[1; 2]" [1; 2]; 47 | 48 | (* algebraic datatypes *) 49 | test "(1)" (A 1); 50 | test "Tag1 (2., 3.)" (B (2.,3.)); 51 | test "Tag2 (\"foo\", (1))" (C ("foo", A 1)); 52 | 53 | test "(1, (2., 3.), [\"foo\"])" {a = 1; b = (2., 3.); c = "foo", None}; 54 | 55 | (* tuples *) 56 | test "(1, 2)" (1,2); 57 | test "[0]" (0,0); 58 | 59 | (* lazy *) 60 | (* lazy immediate values are not lazyfied! 61 | test "0" (lazy 0); *) 62 | test "" (lazy (ignore ())); 63 | 64 | (* closures *) 65 | test "" (fun x -> x); 66 | 67 | (* objects *) 68 | let obj = object 69 | val x = 2 70 | val z = 3. 71 | method foo = "bar" end in 72 | test (Printf.sprintf "Object #%d (2, 3.)" (Oo.id obj)) obj; 73 | 74 | (* infix, forward? *) 75 | 76 | (* string *) 77 | let str = "foo \"bar\"\n" in 78 | test (Printf.sprintf "%S" str) str; 79 | 80 | (* double *) 81 | let test_float x = test (string_of_float x) x in 82 | List.iter test_float 83 | [0.; 1.; -2.; max_float; min_float; epsilon_float; nan]; 84 | for i = 0 to 1000 do 85 | test_float (Random.float max_float); 86 | test_float (Random.float min_float); 87 | done; 88 | 89 | (* abstract? *) 90 | 91 | (* custom? *) 92 | 93 | (* final? *) 94 | 95 | 96 | (* double array or struct *) 97 | let test_arr arr v = 98 | test (BatIO.to_string (BatArray.print BatFloat.print) arr) v in 99 | test "()" ([| |] : float array); 100 | test_arr [| 0.; 1.; 2. |] [| 0.; 1.; 2. |]; 101 | test_arr [| 0.; 1.; 2. |] { f1 = 0.; f2 = 1.; f3 = 2. }; 102 | 103 | () 104 | 105 | let tests = "Std" >::: [ 106 | "using" >:: test_using; 107 | "dump" >:: test_dump; 108 | ];; 109 | -------------------------------------------------------------------------------- /testsuite/test_pmap.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatRandom 3 | open BatPervasives 4 | 5 | let print_enum out enum = 6 | BatEnum.print (fun out (c, _) -> BatPrintf.fprintf out "%d" c) out enum 7 | 8 | let assert_equal_enums enum_1 enum_2 = 9 | match BatEnum.compare compare (enum_1 ()) (enum_2 ()) with 10 | | 0 -> (* pass *) () 11 | | _ -> 12 | assert_failure 13 | (BatPrintf.sprintf2 "Expected %a, got %a" 14 | print_enum (enum_1 ()) print_enum (enum_2 ())) 15 | 16 | let assert_equal_maps map_1 map_2 = 17 | let enum_1 () = BatPMap.enum map_1 in 18 | let enum_2 () = BatPMap.enum map_2 in 19 | assert_equal_enums enum_1 enum_2 20 | 21 | let gen_map state bound count = 22 | let keys = BatEnum.take count (State.enum_int state bound) in 23 | BatPMap.of_enum (BatEnum.map (fun x -> (x,x)) keys) 24 | 25 | let test_traversal_order () = 26 | let init = State.make [|0|] in 27 | let map = gen_map init 10 50 in 28 | let enum_1 () = BatPMap.enum map 29 | and enum_2 () = 30 | let list = BatRefList.empty () in 31 | BatPMap.iter (fun k v -> BatRefList.push list (k, v)) map; 32 | BatRefList.backwards list 33 | in 34 | assert_equal_enums enum_1 enum_2 35 | 36 | let test_split () = 37 | let do_test map v = 38 | let m1, vo, m2 = BatPMap.split v map in 39 | assert_equal_maps m1 (BatPMap.filteri (fun k _ -> k < v) map); 40 | assert_equal_maps m2 (BatPMap.filteri (fun k _ -> k > v) map); 41 | assert_equal vo (if BatPMap.mem v map then Some v else None) 42 | in 43 | let init = State.make [|0|] in 44 | for i = 0 to 50 do 45 | let bound = 40 in 46 | let count = i * 5 in 47 | do_test (gen_map init bound count) (State.int init bound) 48 | done 49 | 50 | let test_multimap_empty_assoc_lists () = 51 | let module M = BatMultiPMap in 52 | let map = 53 | M.add 0 "foo" M.empty |> M.add 0 "bar" |> M.add 0 "sna" |> 54 | M.remove 0 "foo" |> M.remove 0 "bar" |> M.remove 0 "sna" 55 | in 56 | if M.mem 0 map then 57 | assert_failure 58 | (Printf.sprintf "map[0] should be empty but contains %d bindings\n" 59 | (BatPSet.cardinal (M.find 0 map))) 60 | 61 | let tests = "PMap" >::: [ 62 | "traversal order iter vs. enum" >:: test_traversal_order; 63 | "split" >:: test_split; 64 | "MultiPMap: removing empty association lists" >:: test_multimap_empty_assoc_lists; 65 | ] 66 | -------------------------------------------------------------------------------- /testsuite/test_print.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Gc 3 | 4 | let few_tests = 10 5 | let many_tests= 100000 6 | (* (*For comparaison, not part of Batteries.*) 7 | let run_legacy number_of_runs = 8 | begin 9 | Gc.full_major (); 10 | let devnull = Legacy.Pervasives.open_out "/dev/null" in 11 | foreach (1 -- number_of_runs) (fun _ -> 12 | Legacy.Printf.fprintf devnull "%a%!" (fun ch () -> Legacy.Printf.fprintf ch "Hello, world!") () 13 | ); 14 | Legacy.Pervasives.close_out devnull; 15 | Gc.full_major (); 16 | (Gc.stat()).live_words 17 | end 18 | 19 | let test_leak_legacy () = 20 | let words_few = run_legacy few_tests in 21 | let words_many= run_legacy many_tests in 22 | if words_few < words_many then assert_failure (Printf.sprintf "Memory use grew by %d" (words_many - words_few)) 23 | *) 24 | open Printf 25 | let run_oldstyle number_of_runs = 26 | Gc.full_major (); 27 | foreach (1 -- number_of_runs) (fun _ -> 28 | fprintf stdnull "%a%!" (fun ch () -> fprintf ch "Hello, world!") () 29 | ); 30 | Gc.full_major (); 31 | (Gc.stat()).live_words 32 | 33 | let test_leak_oldstyle () = 34 | let words_few = run_oldstyle few_tests in 35 | let words_many= run_oldstyle many_tests in 36 | if words_few < words_many then assert_failure (Printf.sprintf "Memory use grew by %d" (words_many - words_few)) 37 | 38 | open Print 39 | let run_newstyle number_of_runs = 40 | Gc.full_major (); 41 | let printer_hello k () = k (fun ch -> fprintf ch p"Hello, world!") in 42 | foreach (1 -- number_of_runs) (fun _ -> 43 | fprintf stdnull p"{%hello}%!" () 44 | ); 45 | Gc.full_major (); 46 | (Gc.stat()).live_words 47 | 48 | let test_leak_newstyle () = 49 | let words_few = run_newstyle few_tests in 50 | let words_many= run_newstyle many_tests in 51 | if words_few < words_many then assert_failure (Printf.sprintf "Memory use grew by %d" (words_many - words_few)) 52 | 53 | 54 | let tests = "Print" >::: [ 55 | (* "Legacy printing memory leak" >:: test_leak_legacy ;*) 56 | "Old-style printing memory leak" >:: test_leak_oldstyle ; 57 | "New-style printing memory leak" >:: test_leak_newstyle 58 | ] 59 | -------------------------------------------------------------------------------- /testsuite/test_random.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatPervasives 3 | 4 | let assert_equal_arrays = 5 | assert_equal ~printer:(BatIO.to_string (BatArray.print BatInt.print)) 6 | 7 | let take_array n e = BatArray.of_enum (BatEnum.take n e) 8 | 9 | let test_enum_helper reset create modify = 10 | let make n = take_array n (create ()) in 11 | 12 | (* Enumerations constructed for the same state should be equal. *) 13 | let () = reset () in 14 | let a = make 10 in 15 | let () = reset () in 16 | let b = make 10 in 17 | let () = assert_equal_arrays a b in 18 | 19 | (* The states should be shared: if the state is modified then the second 20 | stream should be different. *) 21 | let () = reset () in 22 | let a = make 1000 in 23 | let () = reset () in 24 | let () = modify () in 25 | let b = make 1000 in 26 | let () = assert_bool "Different states but equal arrays" (a <> b) in 27 | 28 | (* Cloning should work even if the RNG state is changing. *) 29 | let e = create () in 30 | let e_clone = BatEnum.clone e in 31 | let () = modify () in 32 | assert_equal_arrays 33 | (take_array 10 e) 34 | (take_array 10 e_clone) 35 | 36 | (* Wrapper that assures that [cmd] does not modify the default state. *) 37 | let with_saved_state cmd = 38 | let state = BatRandom.get_state () in 39 | let () = cmd () in 40 | BatRandom.set_state state 41 | 42 | let test_enum_default () = 43 | let reset () = BatRandom.init 0 in 44 | let create () = BatRandom.enum_int 100 in 45 | let modify () = let _ = BatRandom.int 100 in () in 46 | with_saved_state 47 | (fun () -> test_enum_helper reset create modify) 48 | 49 | let test_enum_state () = 50 | let make_seed () = BatRandom.State.make [| 0 |] in 51 | let state = ref (make_seed ()) in 52 | let reset () = state := make_seed () in 53 | let create () = BatRandom.State.enum_int !state 100 in 54 | let modify () = let _ = BatRandom.State.int !state 100 in () in 55 | test_enum_helper reset create modify 56 | 57 | module PSE = BatRandom.Incubator.Private_state_enums 58 | 59 | let test_enum_default_priv () = 60 | let reset () = BatRandom.init 0 in 61 | let create () = PSE.enum_int 100 in 62 | let modify () = let _ = BatRandom.int 100 in () in 63 | with_saved_state (fun () -> test_enum_helper reset create modify) 64 | 65 | let test_enum_state_priv () = 66 | let make_seed () = BatRandom.State.make [| 0 |] in 67 | let state = ref (make_seed ()) in 68 | let reset () = state := make_seed () in 69 | let create () = PSE.State.enum_int !state 100 in 70 | let modify () = let _ = PSE.State.int !state 100 in () in 71 | test_enum_helper reset create modify 72 | 73 | 74 | let tests = "BatRandom" >::: [ 75 | "enum_default" >:: test_enum_default; 76 | "enum_state" >:: test_enum_state; 77 | "enum_default_priv" >:: test_enum_default_priv; 78 | "enum_state_priv" >:: test_enum_state_priv; 79 | ] 80 | -------------------------------------------------------------------------------- /testsuite/test_stack.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | module Enum = BatEnum 3 | module Stack = BatStack 4 | module List = BatList 5 | 6 | let tests = "Stack" >::: [ 7 | "of_enum empty" >:: begin function () -> 8 | let e = Enum.empty () in 9 | let s = Stack.of_enum e in 10 | assert_bool "stack is not empty" (Stack.is_empty s); 11 | assert_equal ~printer:string_of_int 0 (Stack.length s); 12 | end; 13 | "of_enum simple" >:: begin function () -> 14 | let e = List.enum [1;2;3] in 15 | let s = Stack.of_enum e in 16 | assert_bool "stack is empty" (not (Stack.is_empty s)); 17 | assert_equal ~printer:string_of_int 3 (Stack.length s); 18 | assert_equal ~printer:string_of_int 3 (Stack.pop s); 19 | assert_equal ~printer:string_of_int 2 (Stack.pop s); 20 | assert_equal ~printer:string_of_int 1 (Stack.pop s); 21 | assert_raises Stack.Empty (fun () -> Stack.pop s); 22 | end; 23 | "enum empty" >:: begin function () -> 24 | let e = Stack.enum (Stack.create ()) in 25 | assert_bool "enum is not empty" (Enum.is_empty e); 26 | end; 27 | "enum nonempty" >:: begin function () -> 28 | let s = Stack.create () in 29 | Stack.push 5 s; 30 | Stack.push 7 s; 31 | assert_equal [7;5] (List.of_enum (Stack.enum s)); 32 | end 33 | ] 34 | -------------------------------------------------------------------------------- /testsuite/test_string.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatString 3 | 4 | let string = "Jon \"Maddog\" Orwant" 5 | 6 | open BatEnum 7 | (* 8 | let test_take_and_skip () = 9 | let foo s : string list = 10 | let e = enum s in 11 | [? List : of_enum (f e) | 12 | f <- List : [take 5; skip 3 %> take 5; take 5 ; identity] ?] 13 | in 14 | assert_equal ~printer:(Printf.sprintf2 "%a" (List.print String.print_quoted)) 15 | ["Jon \""; "dog\" "; "Orwan"; "t"] 16 | (foo string) 17 | *) 18 | 19 | let test_starts_with () = 20 | let check expected prefix = 21 | let s = match expected with true -> "" | false -> "not " in 22 | if starts_with string prefix <> expected then 23 | assert_failure (Printf.sprintf "String %S should %sstart with %S" 24 | string s prefix) 25 | in 26 | check true "Jon"; 27 | check false "Jon \"Maddog\" Orwants"; 28 | check false "Orwants" 29 | 30 | let test_ends_with () = 31 | let check expected suffix = 32 | let s = match expected with true -> "" | false -> "not " in 33 | if ends_with string suffix <> expected then 34 | assert_failure (Printf.sprintf "String %S should %send with %S" 35 | string s suffix) 36 | in 37 | check true "want"; 38 | check false "I'm Jon \"Maddog\" Orwant"; 39 | check false "Jon" 40 | 41 | let test_nsplit () = 42 | let printer = BatPrintf.sprintf2 "%a" (BatList.print BatString.print) in 43 | let check exp s sep = assert_equal ~printer exp (nsplit s sep) in 44 | check ["a"; "b"; "c"] "a/b/c" "/"; 45 | check [""; "a"; "b"; "c"; ""; ""] "/a/b/c//" "/"; 46 | check [""; "a"; "b"; "c"; ""; ""] "FOOaFOObFOOcFOOFOO" "FOO" 47 | 48 | let assert_no_raises : ?msg:string -> (unit -> 'a) -> 'a = 49 | fun ?(msg="Function raised an exception when none was expected.") f -> 50 | try 51 | f () 52 | with exn -> 53 | assert_failure (msg ^ " " ^ Printexc.to_string exn) 54 | 55 | let test_exists () = 56 | let check haystack needle expected = 57 | let msg = 58 | Printf.sprintf "exists \"%s\" \"%s\" = %b" 59 | (String.escaped haystack) (String.escaped needle) 60 | expected 61 | in 62 | assert_equal 63 | ~msg 64 | (assert_no_raises ~msg:(msg ^ " raised exception ") 65 | (fun () -> BatString.exists haystack needle)) 66 | expected 67 | in 68 | check "" "" true; 69 | check "a" "" true; 70 | check "" "a" false; 71 | check "ab" "a" true; 72 | check "ab" "b" true; 73 | check "ab" "c" false 74 | 75 | let tests = "String" >::: [ 76 | (* "Taking and skipping" >:: test_take_and_skip; *) 77 | "Start with" >:: test_starts_with; 78 | "Ends with" >:: test_ends_with; 79 | "Splitting with nsplit" >:: test_nsplit; 80 | "Exists" >:: test_exists; 81 | ] 82 | -------------------------------------------------------------------------------- /testsuite/test_toplevel.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | 3 | (*Source code which needs to be executed*) 4 | 5 | let make_temporary_file content = 6 | File.with_temporary_out ~suffix:".ml" 7 | begin 8 | fun out name -> 9 | String.print out content; 10 | name 11 | end 12 | 13 | let expected = "read-only string";; 14 | 15 | open Compilers 16 | open IO 17 | 18 | let test_from_source_file () = 19 | let source = "Print.printf p\"%sc\" ro\"read-only string\";;" in 20 | let generated_file = make_temporary_file source in 21 | let temp_name = Filename.temp_file "ocaml" "test" in 22 | ignore (Sys.command (string_of_command (ocaml [generated_file]) ^ " > " ^ temp_name)); 23 | let obtained = File.with_file_in temp_name read_all in 24 | assert_equal ~printer:(Printf.sprintf "%S") expected obtained 25 | 26 | let test_from_simulated_cmdline () = 27 | let temp_name = Filename.temp_file "ocaml" "test" in 28 | let source = Print.sprintf 29 | p"File.with_file_out %S (fun out -> Print.fprintf out p\"%%sc\" ro\"read-only string\");;\n" 30 | temp_name in 31 | let generated_file = make_temporary_file source in 32 | let command = string_of_command (ocaml []) ^ " < " ^ generated_file ^ " > /dev/null " in 33 | (* Printf.eprintf "Running %S\nWriting to file %S\n%!" command temp_name;*) 34 | ignore (Sys.command command); 35 | flush_all (); 36 | let obtained = File.with_file_in temp_name read_all in 37 | assert_equal ~printer:(Printf.sprintf "%S") expected obtained 38 | 39 | (* 40 | let test_1 = 41 | ("OCaml: Testing from source file", fun () -> 42 | try 43 | let generated_file = 44 | File.with_temporary_out ~suffix:".ml" 45 | begin 46 | fun out name -> 47 | String.print out source; 48 | name 49 | end 50 | in 51 | let temp_name = Filename.temp_file "ocaml" "test" in 52 | ignore (Sys.command (string_of_command (ocaml [generated_file]) ^ "> temp_name")); 53 | let obtained = File.with_file_in temp_name read_all 54 | in 55 | if obtained = expected then Testing.Pass 56 | else Testing.Fail (Printf.sprintf "Expected: %S\n\tObtained: %S\n" expected obtained) 57 | with e -> Testing.Err (Printexc.to_string e)) 58 | 59 | let test_2 = 60 | ("OCaml: Testing from simulated command-line", fun () -> 61 | try 62 | let command = string_of_command (ocaml []) in 63 | let (pin, pout)=Unix.open_process ~cleanup:true command in 64 | String.print pout source; 65 | close_out pout; 66 | let obtained = read_all pin in 67 | if obtained = expected then Testing.Pass 68 | else Testing.Fail (Printf.sprintf "Expected: %S\n\tObtained: %S\n" expected obtained) 69 | with e -> Testing.Err (Printexc.to_string e)) 70 | 71 | *) 72 | 73 | let tests = "Toplevel" >::: [ 74 | "From source file" >:: test_from_source_file; 75 | "From simulated command-line" >:: test_from_simulated_cmdline; 76 | ] 77 | -------------------------------------------------------------------------------- /testsuite/test_unix.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatPrintf 3 | open BatIO 4 | 5 | let string = "hello world" 6 | 7 | let test_open_process_readline () = 8 | try 9 | let r,w = BatUnix.open_process "cat" in 10 | fprintf w "%s\n" string; 11 | close_out w; 12 | match BatIO.read_line r with 13 | | s when s = string -> () 14 | | s -> assert_failure (BatPrintf.sprintf "Expected %S, got %S" string s) 15 | with e -> assert_failure (BatPrintf.sprintf "Expected %S, got exception %s" string (Printexc.to_string e)) 16 | 17 | let test_open_process_cleanup () = 18 | try 19 | let r,w = BatUnix.open_process "cat" in 20 | BatPrintf.fprintf w "%s\n" string; 21 | close_out w; 22 | while true do 23 | ignore (BatPervasives.input_char r) (*This is a way of checking that the process is closed.*) 24 | done 25 | with End_of_file 26 | | No_more_input -> () 27 | | e -> assert_failure (BatPrintf.sprintf "Expected %S, got exception %s" string (Printexc.to_string e)) 28 | 29 | 30 | (*let test_open_process_close_process () = (*Actually, this test shouldn't work*) 31 | try 32 | let r,w = Unix.open_process "cat" in 33 | fprintf w p"%s\n" string; 34 | ignore (Unix.close_process (r, w)); 35 | while true do 36 | ignore (input_char r); (*This is a way of checking that the process is closed.*) 37 | done 38 | with End_of_file 39 | | No_more_input -> () 40 | | e -> assert_failure (sprintf p"Expected %S, got exception %exn" string e)*) 41 | 42 | let tests = "Unix" >::: [ 43 | "Open process, then read_line" >:: test_open_process_readline; 44 | "Open process, then clean up" >:: test_open_process_cleanup 45 | ] 46 | -------------------------------------------------------------------------------- /testsuite/test_vect.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open BatVect 3 | open BatPervasives 4 | 5 | (**Initialize data sample*) 6 | let state = BatRandom.State.make [|0|] 7 | let buffer = BatArray.of_enum (BatEnum.take 1000 (BatRandom.State.enum_int state 255)) 8 | let vect = of_array buffer 9 | 10 | let print_array out = 11 | BatArray.print ~sep:"; " BatInt.print out 12 | let print_vect out = 13 | BatVect.print ~sep:"; " BatInt.print out 14 | 15 | let sprint_vect v = BatPrintf.sprintf2 "%a" print_vect v 16 | 17 | let test_array_conversion () = 18 | assert_equal ~printer:sprint_vect 19 | vect 20 | (to_array vect |> of_array |> to_array |> of_array) 21 | 22 | let test_init () = 23 | let f i = i * i in 24 | let vect = init 1000 f 25 | and array = Array.init 1000 f 26 | in 27 | if BatEnum.compare ( BatInt.compare ) (enum vect) (BatArray.enum array) = 0 then 28 | () (* pass *) 29 | else assert_failure 30 | (BatPrintf.sprintf2 "Hoping: %a\n\tGot: %a" print_array array print_vect vect) 31 | 32 | let test_fold_left () = 33 | let f i = i * i 34 | and g i j = i * i + j in 35 | let vect = fold_left g 0 (init 1000 f) 36 | and array = Array.fold_left g 0 (Array.init 1000 f) 37 | in 38 | assert_equal ~printer:string_of_int array vect 39 | 40 | let test_fold_right () = 41 | let f i = i * i 42 | and g i j = i * i + j in 43 | let vect = fold_right g (init 1000 f) 0 44 | and array = Array.fold_right g (Array.init 1000 f) 0 45 | in 46 | assert_equal ~printer:string_of_int array vect 47 | 48 | let tests = "Vect" >::: [ 49 | "Converting to/from array" >:: test_array_conversion; 50 | "Init" >:: test_init; 51 | "Fold_left" >:: test_fold_left; 52 | "Fold_right" >:: test_fold_right; 53 | ] 54 | -------------------------------------------------------------------------------- /yarn.lock: -------------------------------------------------------------------------------- 1 | # THIS IS AN AUTOGENERATED FILE. DO NOT EDIT THIS FILE DIRECTLY. 2 | # yarn lockfile v1 3 | 4 | 5 | bs-platform@^1.8.2: 6 | version "1.8.2" 7 | resolved "https://registry.yarnpkg.com/bs-platform/-/bs-platform-1.8.2.tgz#2aba1cfc73e21feaa8902d67b5ddbec975938554" 8 | --------------------------------------------------------------------------------